2 % (c) The AQUA Project, Glasgow University, 1993-1998
6 module AsmCodeGen ( nativeCodeGen ) where
8 #include "HsVersions.h"
11 import List ( intersperse )
18 import AbsCStixGen ( genCodeAbstractC )
19 import AbsCSyn ( AbstractC )
20 import AbsCUtils ( mkAbsCStmtList, magicIdPrimRep )
21 import AsmRegAlloc ( runRegAllocate )
22 import MachOp ( MachOp(..), isCommutableMachOp, isComparisonMachOp )
23 import RegAllocInfo ( findReservedRegs )
24 import Stix ( StixReg(..), StixStmt(..), StixExpr(..), StixVReg(..),
25 pprStixStmts, pprStixStmt,
26 stixStmt_CountTempUses, stixStmt_Subst,
30 uniqOfNatM_State, deltaOfNatM_State )
31 import UniqSupply ( returnUs, thenUs, initUs,
34 import MachMisc ( IF_ARCH_i386(i386_insert_ffrees,) )
36 import qualified Pretty
41 The 96/03 native-code generator has machine-independent and
42 machine-dependent modules (those \tr{#include}'ing \tr{NCG.h}).
44 This module (@AsmCodeGen@) is the top-level machine-independent
45 module. It uses @AbsCStixGen.genCodeAbstractC@ to produce @StixTree@s
46 (defined in module @Stix@), using support code from @StixInfo@ (info
47 tables), @StixPrim@ (primitive operations), @StixMacro@ (Abstract C
48 macros), and @StixInteger@ (GMP arbitrary-precision operations).
50 Before entering machine-dependent land, we do some machine-independent
51 @genericOpt@imisations (defined below) on the @StixTree@s.
53 We convert to the machine-specific @Instr@ datatype with
54 @stmt2Instrs@, assuming an ``infinite'' supply of registers. We then
55 use a machine-independent register allocator (@runRegAllocate@) to
56 rejoin reality. Obviously, @runRegAllocate@ has machine-specific
57 helper functions (see about @RegAllocInfo@ below).
59 The machine-dependent bits break down as follows:
61 \item[@MachRegs@:] Everything about the target platform's machine
62 registers (and immediate operands, and addresses, which tend to
63 intermingle/interact with registers).
65 \item[@MachMisc@:] Includes the @Instr@ datatype (possibly should
66 have a module of its own), plus a miscellany of other things
67 (e.g., @targetDoubleSize@, @smStablePtrTable@, ...)
69 \item[@MachCode@:] @stmt2Instrs@ is where @Stix@ stuff turns into
72 \item[@PprMach@:] @pprInstr@ turns an @Instr@ into text (well, really
75 \item[@RegAllocInfo@:] In the register allocator, we manipulate
76 @MRegsState@s, which are @BitSet@s, one bit per machine register.
77 When we want to say something about a specific machine register
78 (e.g., ``it gets clobbered by this instruction''), we set/unset
79 its bit. Obviously, we do this @BitSet@ thing for efficiency
82 The @RegAllocInfo@ module collects together the machine-specific
83 info needed to do register allocation.
89 nativeCodeGen :: AbstractC -> UniqSupply -> (SDoc, Pretty.Doc)
91 = let absCstmts = mkAbsCStmtList absC
92 (sdoc_pairs, us1) = initUs us (lazyMapUs absCtoNat absCstmts)
93 stix_sdocs = map fst sdoc_pairs
94 insn_sdocs = map snd sdoc_pairs
96 insn_sdoc = my_vcat insn_sdocs
97 stix_sdoc = vcat stix_sdocs
100 my_trace m x = trace m x
101 my_vcat sds = Pretty.vcat (
104 Pretty.$$ Pretty.ptext SLIT("# ___ncg_debug_marker")
105 Pretty.$$ Pretty.char ' '
110 my_vcat sds = Pretty.vcat sds
114 my_trace "nativeGen: begin"
115 (stix_sdoc, insn_sdoc)
118 absCtoNat :: AbstractC -> UniqSM (SDoc, Pretty.Doc)
120 = _scc_ "genCodeAbstractC" genCodeAbstractC absC `thenUs` \ stixRaw ->
121 _scc_ "genericOpt" genericOpt stixRaw `bind` \ stixOpt ->
122 _scc_ "liftStrings" liftStrings stixOpt `thenUs` \ stixLifted ->
123 _scc_ "genMachCode" genMachCode stixLifted `thenUs` \ pre_regalloc ->
124 _scc_ "regAlloc" regAlloc pre_regalloc `bind` \ almost_final ->
125 _scc_ "x86fp_kludge" x86fp_kludge almost_final `bind` \ final_mach_code ->
126 _scc_ "vcat" Pretty.vcat (map pprInstr final_mach_code) `bind` \ final_sdoc ->
127 _scc_ "pprStixTrees" pprStixStmts stixOpt `bind` \ stix_sdoc ->
128 returnUs (stix_sdoc, final_sdoc)
132 x86fp_kludge :: [Instr] -> [Instr]
133 x86fp_kludge = IF_ARCH_i386(i386_insert_ffrees,id)
135 regAlloc :: InstrBlock -> [Instr]
136 regAlloc = runRegAllocate allocatableRegs findReservedRegs
139 Top level code generator for a chunk of stix code. For this part of
140 the computation, we switch from the UniqSM monad to the NatM monad.
141 The latter carries not only a Unique, but also an Int denoting the
142 current C stack pointer offset in the generated code; this is needed
143 for creating correct spill offsets on architectures which don't offer,
144 or for which it would be prohibitively expensive to employ, a frame
145 pointer register. Viz, x86.
147 The offset is measured in bytes, and indicates the difference between
148 the current (simulated) C stack-ptr and the value it was at the
149 beginning of the block. For stacks which grow down, this value should
150 be either zero or negative.
152 Switching between the two monads whilst carrying along the same Unique
153 supply breaks abstraction. Is that bad?
156 genMachCode :: [StixStmt] -> UniqSM InstrBlock
158 genMachCode stmts initial_us
159 = let initial_st = mkNatM_State initial_us 0
160 (instr_list, final_st) = initNat initial_st (stmtsToInstrs stmts)
161 final_us = uniqOfNatM_State final_st
162 final_delta = deltaOfNatM_State final_st
165 then (instr_list, final_us)
166 else pprPanic "genMachCode: nonzero final delta"
170 %************************************************************************
172 \subsection[NCOpt]{The Generic Optimiser}
174 %************************************************************************
176 This is called between translating Abstract C to its Tree and actually
177 using the Native Code Generator to generate the annotations. It's a
178 chance to do some strength reductions.
180 ** Remember these all have to be machine independent ***
182 Note that constant-folding should have already happened, but we might
183 have introduced some new opportunities for constant-folding wrt
184 address manipulations.
187 genericOpt :: [StixStmt] -> [StixStmt]
188 genericOpt = map stixStmt_ConFold . stixPeep
192 stixPeep :: [StixStmt] -> [StixStmt]
194 -- This transformation assumes that the temp assigned to in t1
195 -- is not assigned to in t2; for otherwise the target of the
196 -- second assignment would be substituted for, giving nonsense
197 -- code. As far as I can see, StixTemps are only ever assigned
198 -- to once. It would be nice to be sure!
200 stixPeep ( t1@(StAssignReg pka (StixTemp (StixVReg u pk)) rhs)
203 | stixStmt_CountTempUses u t2 == 1
204 && sum (map (stixStmt_CountTempUses u) ts) == 0
207 trace ("nativeGen: inlining " ++ showSDoc (pprStixExpr rhs))
209 (stixPeep (stixStmt_Subst u rhs t2 : ts))
211 stixPeep (t1:t2:ts) = t1 : stixPeep (t2:ts)
216 For most nodes, just optimize the children.
219 stixExpr_ConFold :: StixExpr -> StixExpr
220 stixStmt_ConFold :: StixStmt -> StixStmt
222 stixStmt_ConFold stmt
224 StAssignReg pk reg@(StixTemp _) src
225 -> StAssignReg pk reg (stixExpr_ConFold src)
226 StAssignReg pk reg@(StixMagicId mid) src
227 -- Replace register leaves with appropriate StixTrees for
229 -> case get_MagicId_reg_or_addr mid of
231 -> StAssignReg pk reg (stixExpr_ConFold src)
234 (StAssignMem pk baseRegAddr src)
235 StAssignMem pk addr src
236 -> StAssignMem pk (stixExpr_ConFold addr) (stixExpr_ConFold src)
237 StAssignMachOp lhss mop args
238 -> StAssignMachOp lhss mop (map stixExpr_ConFold args)
240 -> StVoidable (stixExpr_ConFold expr)
242 -> StJump dsts (stixExpr_ConFold addr)
244 -> StCondJump addr (stixExpr_ConFold test)
246 -> StData pk (map stixExpr_ConFold datas)
251 stixExpr_ConFold expr
254 -> StInd pk (stixExpr_ConFold addr)
255 StCall fn cconv pk args
256 -> StCall fn cconv pk (map stixExpr_ConFold args)
257 StIndex pk (StIndex pk' base off) off'
258 -- Fold indices together when the types match:
260 -> StIndex pk (stixExpr_ConFold base)
261 (stixExpr_ConFold (StMachOp MO_Nat_Add [off, off']))
263 -> StIndex pk (stixExpr_ConFold base) (stixExpr_ConFold off)
266 -- For PrimOps, we first optimize the children, and then we try
267 -- our hand at some constant-folding.
268 -> stixMachOpFold mop (map stixExpr_ConFold args)
269 StReg (StixMagicId mid)
270 -- Replace register leaves with appropriate StixTrees for
272 -> case get_MagicId_reg_or_addr mid of
275 -> stixExpr_ConFold (StInd (magicIdPrimRep mid) baseRegAddr)
280 Now, try to constant-fold the PrimOps. The arguments have already
281 been optimized and folded.
285 :: MachOp -- The operation from an StMachOp
286 -> [StixExpr] -- The optimized arguments
289 stixMachOpFold mop arg@[StInt x]
291 MO_NatS_Neg -> StInt (-x)
292 other -> StMachOp mop arg
294 stixMachOpFold mop args@[StInt x, StInt y]
296 MO_32U_Gt -> StInt (if x > y then 1 else 0)
297 MO_32U_Ge -> StInt (if x >= y then 1 else 0)
298 MO_32U_Eq -> StInt (if x == y then 1 else 0)
299 MO_32U_Ne -> StInt (if x /= y then 1 else 0)
300 MO_32U_Lt -> StInt (if x < y then 1 else 0)
301 MO_32U_Le -> StInt (if x <= y then 1 else 0)
302 MO_Nat_Add -> StInt (x + y)
303 MO_Nat_Sub -> StInt (x - y)
304 MO_NatS_Mul -> StInt (x * y)
305 MO_NatS_Quot | y /= 0 -> StInt (x `quot` y)
306 MO_NatS_Rem | y /= 0 -> StInt (x `rem` y)
307 MO_NatS_Gt -> StInt (if x > y then 1 else 0)
308 MO_NatS_Ge -> StInt (if x >= y then 1 else 0)
309 MO_Nat_Eq -> StInt (if x == y then 1 else 0)
310 MO_Nat_Ne -> StInt (if x /= y then 1 else 0)
311 MO_NatS_Lt -> StInt (if x < y then 1 else 0)
312 MO_NatS_Le -> StInt (if x <= y then 1 else 0)
313 MO_Nat_Shl | y >= 0 && y < 32 -> do_shl x y
314 other -> StMachOp mop args
316 do_shl :: Integer -> Integer -> StixExpr
318 do_shl v n | n > 0 = do_shl (v*2) (n-1)
321 When possible, shift the constants to the right-hand side, so that we
322 can match for strength reductions. Note that the code generator will
323 also assume that constants have been shifted to the right when
327 stixMachOpFold op [x@(StInt _), y] | isCommutableMachOp op
328 = stixMachOpFold op [y, x]
331 We can often do something with constants of 0 and 1 ...
334 stixMachOpFold mop args@[x, y@(StInt 0)]
346 MO_Nat_Ne | x_is_comparison -> x
347 other -> StMachOp mop args
351 StMachOp mopp [_, _] -> isComparisonMachOp mopp
354 stixMachOpFold mop args@[x, y@(StInt 1)]
360 MO_NatS_Rem -> StInt 0
361 MO_NatU_Rem -> StInt 0
362 other -> StMachOp mop args
365 Now look for multiplication/division by powers of 2 (integers).
368 stixMachOpFold mop args@[x, y@(StInt n)]
371 -> case exactLog2 n of
373 Just p -> StMachOp MO_Nat_Shl [x, StInt p]
375 -> case exactLog2 n of
377 Just p -> StMachOp MO_Nat_Shr [x, StInt p]
381 unchanged = StMachOp mop args
384 Anything else is just too hard.
387 stixMachOpFold mop args = StMachOp mop args