1 --------------------------------------------------------------------------
4 -- Copyright : (c) 2006 Martin Grabmueller and Dirk Kleeblatt
7 -- Maintainer : {magr,klee}@cs.tu-berlin.de
8 -- Stability : quite experimental
9 -- Portability : portable (but generated code non-portable)
11 -- This module exports several combinators for writing loops,
12 -- conditionals and function prolog\/epilog code.
14 -- Note: this module is under heavy development and the exported API
15 -- is definitely not yet stable.
16 --------------------------------------------------------------------------
18 module Harpy.X86CGCombinators(
38 import Text.PrettyPrint.HughesPJ
43 import Harpy.CodeGenMonad
44 import Harpy.X86CodeGen
45 import Harpy.X86Assembler
47 -- | Destination for a calculated value.
48 data DataDest = RegDest Reg32 -- ^ Store into specific register
49 | StackDest -- ^ Push onto stack
50 | MemBaseDest Reg32 Word32 -- ^ Store at memory address
51 | Ignore -- ^ Throw result away.
53 -- | Destination for control transfers
54 data CtrlDest = FallThrough -- ^ Go to next instruction
55 | Return -- ^ Return from current functio
56 | Goto Label -- ^ Go to specific label
57 | Branch CtrlDest CtrlDest -- ^ Go to one of the given labels
58 -- depending on outcome of test
60 -- | User state is used to maintain bitmask of registers currently in use.
61 data UserState = UserState {}
64 -- | User environment stores code generators for accessing specific
65 -- variables as well as the current data and control destinations
66 data UserEnv = UserEnv { bindings :: [(String, CodeGen UserEnv UserState ())],
68 ctrlDest :: CtrlDest }
70 emptyUserState :: UserState
71 emptyUserState = UserState{}
73 emptyUserEnv :: UserEnv
74 emptyUserEnv = UserEnv{bindings = [], dataDest = Ignore,
77 ifThenElse :: CodeGen UserEnv s r
78 -> CodeGen UserEnv s a
79 -> CodeGen UserEnv s a1
80 -> CodeGen UserEnv s ()
81 ifThenElse condCg thenCg elseCg =
85 withDest Ignore (Branch FallThrough (Goto elseLabel)) condCg
86 withCtrlDest (case ctrlDest env of
87 FallThrough -> Goto endLabel
90 elseLabel @@ (elseCg >> continue)
93 doWhile :: CodeGen UserEnv s r -> CodeGen UserEnv s a -> CodeGen UserEnv s ()
94 doWhile condCg bodyCg =
95 do topLabel <- newLabel
98 topLabel @@ withCtrlDest FallThrough (bodyCg >> continue)
99 testLabel @@ withDest Ignore (Branch (Goto topLabel) FallThrough)
103 doFor :: (Mov a Word32, Add a Word32, Cmp a Word32) => a -> Word32 -> Word32 -> Int32 ->
104 CodeGen UserEnv s r ->
106 doFor loc from to step body =
107 do topLabel <- newLabel
108 testLabel <- newLabel
111 topLabel @@ withCtrlDest FallThrough (body >> continue)
112 testLabel @@ cmp loc to
113 add loc (fromIntegral step :: Word32)
120 continue :: CodeGen UserEnv s ()
125 cont FallThrough = return ()
126 cont (Goto l) = jmp l
127 cont (Branch _ _) = error "Branch in continue"
128 cont Return = x86_epilog 0
131 continueBranch :: Int -> Bool -> CodeGen UserEnv s ()
132 continueBranch cc isSigned =
134 let Branch c1 c2 = ctrlDest env
135 cont cc isSigned c1 c2
137 cont cc isSigned (Goto l1) (Goto l2) =
138 do x86_branch32 cc 0 isSigned
139 emitFixup l1 (-4) Fixup32
140 x86_branch32 (negateCC cc) 0 isSigned
141 emitFixup l2 (-4) Fixup32
142 cont cc isSigned (Goto l1) FallThrough =
143 do x86_branch32 cc 0 isSigned
144 emitFixup l1 (-4) Fixup32
145 cont cc isSigned FallThrough (Goto l2) =
146 do x86_branch32 (negateCC cc) 0 isSigned
147 emitFixup l2 (-4) Fixup32
148 cont cc isSigned (Goto l1) Return =
149 do x86_branch32 cc 0 isSigned
150 emitFixup l1 (-4) Fixup32
151 withCtrlDest Return continue
152 cont cc isSigned Return (Goto l2) =
153 do x86_branch32 (negateCC cc) 0 isSigned
154 emitFixup l2 (-4) Fixup32
155 withCtrlDest Return continue
156 cont _ _ _ _ = error "unhandled case in continueBranch"
160 reg' sreg (dataDest env)
162 reg' sreg (RegDest r) =
166 reg' sreg (StackDest) =
168 reg' sreg (MemBaseDest r offset) =
169 do mov (Disp offset, r) sreg
170 reg' sreg Ignore = return ()
174 membase' reg ofs (dataDest env)
176 membase' reg ofs (RegDest r) =
177 do mov r (Disp ofs, reg)
178 membase' reg ofs (StackDest) =
179 do push (Disp ofs, reg)
180 membase' reg ofs (MemBaseDest r offset) =
182 mov edi (Disp ofs, reg)
183 mov (Disp offset, r) edi
185 membase' reg ofs Ignore = return ()
189 global' ofs (dataDest env)
191 global' ofs (RegDest r) =
193 global' ofs (StackDest) =
195 global' ofs (MemBaseDest r offset) =
198 mov (Disp offset, r) edi
200 global' ofs Ignore = return ()
204 immediate' value (dataDest env)
206 immediate' value (RegDest r) =
208 immediate' value (StackDest) =
209 do x86_push_imm value
210 immediate' value (MemBaseDest r offset) =
213 mov (Disp offset, r) edi
215 immediate' ofs Ignore = return ()
217 -- | Save a number of registers on the stack, perform the given code
218 -- generation, and restore the registers.
219 saveRegs :: [Reg32] -> CodeGen UserEnv s r -> CodeGen UserEnv s ()
220 saveRegs [] cg = cg >> return ()
223 withCtrlDest FallThrough cg
227 gen_push [] = return ()
228 gen_push (r:regs) = push r >> gen_push regs
229 gen_pop [] = return ()
230 gen_pop (r:regs) = gen_pop regs >> pop r
232 -- | Perform the code generation associated with the variable given.
233 loadVar :: String -> CodeGen UserEnv UserState ()
235 do UserEnv{bindings = assoc} <- getEnv
236 case lookup name assoc of
238 Nothing -> failCodeGen (text ("undefined variable: " ++ name))
240 -- | Set the data destinations to the given values while
241 -- running the code generator.
242 withDataDest :: DataDest -> CodeGen UserEnv s r -> CodeGen UserEnv s r
243 withDataDest ddest cg =
245 withEnv (env{dataDest = ddest}) cg
247 -- | Set the control destinations to the given values while
248 -- running the code generator.
249 withCtrlDest :: CtrlDest -> CodeGen UserEnv s r -> CodeGen UserEnv s r
250 withCtrlDest cdest cg =
252 withEnv (env{ctrlDest = cdest}) cg
254 -- | Set the data and control destinations to the given values while
255 -- running the code generator.
256 withDest :: DataDest -> CtrlDest -> CodeGen UserEnv s r -> CodeGen UserEnv s r
257 withDest ddest cdest cg =
259 withEnv (env{dataDest = ddest, ctrlDest = cdest}) cg
261 -- | Emit the necessary function prolog and epilog code and invoke the
262 -- given code generator for the code inbetween.
263 function :: CodeGen UserEnv s r -> CodeGen UserEnv s r
266 withDest (RegDest eax) Return $ cg