[project @ 2000-01-13 12:59:58 by sewardj]
[ghc-hetmet.git] / ghc / compiler / nativeGen / AsmCodeGen.lhs
1 %
2 % (c) The AQUA Project, Glasgow University, 1993-1998
3 %
4
5 \begin{code}
6 module AsmCodeGen ( nativeCodeGen ) where
7
8 #include "HsVersions.h"
9
10 import IO               ( Handle )
11
12 import MachMisc
13 import MachRegs
14 import MachCode
15 import PprMach
16
17 import AbsCStixGen      ( genCodeAbstractC )
18 import AbsCSyn          ( AbstractC, MagicId )
19 import AsmRegAlloc      ( runRegAllocate )
20 import OrdList          ( OrdList )
21 import PrimOp           ( commutableOp, PrimOp(..) )
22 import RegAllocInfo     ( mkMRegsState, MRegsState )
23 import Stix             ( StixTree(..), StixReg(..), pprStixTrees )
24 import PrimRep          ( isFloatingRep )
25 import UniqSupply       ( returnUs, thenUs, mapUs, initUs_, UniqSM, UniqSupply )
26 import UniqFM           ( UniqFM, emptyUFM, addToUFM, lookupUFM )
27 import Outputable       
28
29 import GlaExts (trace) --tmp
30 #include "nativeGen/NCG.h"
31 \end{code}
32
33 The 96/03 native-code generator has machine-independent and
34 machine-dependent modules (those \tr{#include}'ing \tr{NCG.h}).
35
36 This module (@AsmCodeGen@) is the top-level machine-independent
37 module.  It uses @AbsCStixGen.genCodeAbstractC@ to produce @StixTree@s
38 (defined in module @Stix@), using support code from @StixInfo@ (info
39 tables), @StixPrim@ (primitive operations), @StixMacro@ (Abstract C
40 macros), and @StixInteger@ (GMP arbitrary-precision operations).
41
42 Before entering machine-dependent land, we do some machine-independent
43 @genericOpt@imisations (defined below) on the @StixTree@s.
44
45 We convert to the machine-specific @Instr@ datatype with
46 @stmt2Instrs@, assuming an ``infinite'' supply of registers.  We then
47 use a machine-independent register allocator (@runRegAllocate@) to
48 rejoin reality.  Obviously, @runRegAllocate@ has machine-specific
49 helper functions (see about @RegAllocInfo@ below).
50
51 The machine-dependent bits break down as follows:
52 \begin{description}
53 \item[@MachRegs@:]  Everything about the target platform's machine
54     registers (and immediate operands, and addresses, which tend to
55     intermingle/interact with registers).
56
57 \item[@MachMisc@:]  Includes the @Instr@ datatype (possibly should
58     have a module of its own), plus a miscellany of other things
59     (e.g., @targetDoubleSize@, @smStablePtrTable@, ...)
60
61 \item[@MachCode@:]  @stmt2Instrs@ is where @Stix@ stuff turns into
62     machine instructions.
63
64 \item[@PprMach@:] @pprInstr@ turns an @Instr@ into text (well, really
65     an @Doc@).
66
67 \item[@RegAllocInfo@:] In the register allocator, we manipulate
68     @MRegsState@s, which are @BitSet@s, one bit per machine register.
69     When we want to say something about a specific machine register
70     (e.g., ``it gets clobbered by this instruction''), we set/unset
71     its bit.  Obviously, we do this @BitSet@ thing for efficiency
72     reasons.
73
74     The @RegAllocInfo@ module collects together the machine-specific
75     info needed to do register allocation.
76 \end{description}
77
78 So, here we go:
79 \begin{code}
80 nativeCodeGen :: AbstractC -> UniqSupply -> (SDoc, SDoc, SDoc, SDoc)
81 nativeCodeGen absC us = initUs_ us (runNCG absC)
82
83 runNCG :: AbstractC -> UniqSM (SDoc, SDoc, SDoc, SDoc)
84 runNCG absC
85   = genCodeAbstractC absC       `thenUs` \ stixRaw ->
86     let
87         stixOpt   = map (map genericOpt) stixRaw
88 #if i386_TARGET_ARCH
89         stixFinal = map floatFix stixOpt
90 #else
91         stixFinal = stixOpt
92 #endif
93     in
94         codeGen (stixRaw, stixOpt, stixFinal)
95 \end{code}
96
97 @codeGen@ is the top-level code-generation function:
98 \begin{code}
99 codeGen :: ([[StixTree]],[[StixTree]],[[StixTree]]) 
100            -> UniqSM (SDoc, SDoc, SDoc, SDoc)
101
102 codeGen (stixRaw, stixOpt, stixFinal)
103   = mapUs genMachCode stixFinal `thenUs` \ dynamic_codes ->
104     let
105         static_instrs = scheduleMachCode dynamic_codes
106     in
107     returnUs (
108        text "ppr'd stixRaw",
109        text "ppr'd stixOpt",
110        vcat (map pprStixTrees stixFinal),
111        vcat (map pprInstr static_instrs)
112     )
113 \end{code}
114
115 Top level code generator for a chunk of stix code:
116 \begin{code}
117 genMachCode :: [StixTree] -> UniqSM InstrList
118
119 genMachCode stmts
120   = mapUs stmt2Instrs stmts             `thenUs` \ blocks ->
121     returnUs (foldr (.) id blocks asmVoid)
122 \end{code}
123
124 The next bit does the code scheduling.  The scheduler must also deal
125 with register allocation of temporaries.  Much parallelism can be
126 exposed via the OrdList, but more might occur, so further analysis
127 might be needed.
128
129 \begin{code}
130 scheduleMachCode :: [InstrList] -> [Instr]
131
132 scheduleMachCode
133   = concat . map (runRegAllocate freeRegsState reservedRegs)
134   where
135     freeRegsState = mkMRegsState (extractMappedRegNos freeRegs)
136 \end{code}
137
138 %************************************************************************
139 %*                                                                      *
140 \subsection[NCOpt]{The Generic Optimiser}
141 %*                                                                      *
142 %************************************************************************
143
144 This is called between translating Abstract C to its Tree and actually
145 using the Native Code Generator to generate the annotations.  It's a
146 chance to do some strength reductions.
147
148 ** Remember these all have to be machine independent ***
149
150 Note that constant-folding should have already happened, but we might
151 have introduced some new opportunities for constant-folding wrt
152 address manipulations.
153
154 \begin{code}
155 genericOpt :: StixTree -> StixTree
156 \end{code}
157
158 For most nodes, just optimize the children.
159
160 \begin{code}
161 genericOpt (StInd pk addr) = StInd pk (genericOpt addr)
162
163 genericOpt (StAssign pk dst src)
164   = StAssign pk (genericOpt dst) (genericOpt src)
165
166 genericOpt (StJump addr) = StJump (genericOpt addr)
167
168 genericOpt (StCondJump addr test)
169   = StCondJump addr (genericOpt test)
170
171 genericOpt (StCall fn cconv pk args)
172   = StCall fn cconv pk (map genericOpt args)
173 \end{code}
174
175 Fold indices together when the types match:
176 \begin{code}
177 genericOpt (StIndex pk (StIndex pk' base off) off')
178   | pk == pk'
179   = StIndex pk (genericOpt base)
180                (genericOpt (StPrim IntAddOp [off, off']))
181
182 genericOpt (StIndex pk base off)
183   = StIndex pk (genericOpt base) (genericOpt off)
184 \end{code}
185
186 For PrimOps, we first optimize the children, and then we try our hand
187 at some constant-folding.
188
189 \begin{code}
190 genericOpt (StPrim op args) = primOpt op (map genericOpt args)
191 \end{code}
192
193 Replace register leaves with appropriate StixTrees for the given
194 target.
195
196 \begin{code}
197 genericOpt leaf@(StReg (StixMagicId id))
198   = case (stgReg id) of
199         Always tree -> genericOpt tree
200         Save _      -> leaf
201
202 genericOpt other = other
203 \end{code}
204
205 Now, try to constant-fold the PrimOps.  The arguments have already
206 been optimized and folded.
207
208 \begin{code}
209 primOpt
210     :: PrimOp           -- The operation from an StPrim
211     -> [StixTree]       -- The optimized arguments
212     -> StixTree
213
214 primOpt op arg@[StInt x]
215   = case op of
216         IntNegOp -> StInt (-x)
217         _ -> StPrim op arg
218
219 primOpt op args@[StInt x, StInt y]
220   = case op of
221         CharGtOp -> StInt (if x > y  then 1 else 0)
222         CharGeOp -> StInt (if x >= y then 1 else 0)
223         CharEqOp -> StInt (if x == y then 1 else 0)
224         CharNeOp -> StInt (if x /= y then 1 else 0)
225         CharLtOp -> StInt (if x < y  then 1 else 0)
226         CharLeOp -> StInt (if x <= y then 1 else 0)
227         IntAddOp -> StInt (x + y)
228         IntSubOp -> StInt (x - y)
229         IntMulOp -> StInt (x * y)
230         IntQuotOp -> StInt (x `quot` y)
231         IntRemOp -> StInt (x `rem` y)
232         IntGtOp -> StInt (if x > y  then 1 else 0)
233         IntGeOp -> StInt (if x >= y then 1 else 0)
234         IntEqOp -> StInt (if x == y then 1 else 0)
235         IntNeOp -> StInt (if x /= y then 1 else 0)
236         IntLtOp -> StInt (if x < y  then 1 else 0)
237         IntLeOp -> StInt (if x <= y then 1 else 0)
238         -- ToDo: WordQuotOp, WordRemOp.
239         _ -> StPrim op args
240 \end{code}
241
242 When possible, shift the constants to the right-hand side, so that we
243 can match for strength reductions.  Note that the code generator will
244 also assume that constants have been shifted to the right when
245 possible.
246
247 \begin{code}
248 primOpt op [x@(StInt _), y] | commutableOp op = primOpt op [y, x]
249 \end{code}
250
251 We can often do something with constants of 0 and 1 ...
252
253 \begin{code}
254 primOpt op args@[x, y@(StInt 0)]
255   = case op of
256         IntAddOp -> x
257         IntSubOp -> x
258         IntMulOp -> y
259         AndOp    -> y
260         OrOp     -> x
261         XorOp    -> x
262         SllOp    -> x
263         SrlOp    -> x
264         ISllOp   -> x
265         ISraOp   -> x
266         ISrlOp   -> x
267         _        -> StPrim op args
268
269 primOpt op args@[x, y@(StInt 1)]
270   = case op of
271         IntMulOp  -> x
272         IntQuotOp -> x
273         IntRemOp  -> StInt 0
274         _         -> StPrim op args
275 \end{code}
276
277 Now look for multiplication/division by powers of 2 (integers).
278
279 \begin{code}
280 primOpt op args@[x, y@(StInt n)]
281   = case op of
282         IntMulOp -> case exactLog2 n of
283             Nothing -> StPrim op args
284             Just p  -> StPrim ISllOp [x, StInt p]
285         IntQuotOp -> case exactLog2 n of
286             Nothing -> StPrim op args
287             Just p  -> StPrim ISrlOp [x, StInt p]
288         _ -> StPrim op args
289 \end{code}
290
291 Anything else is just too hard.
292
293 \begin{code}
294 primOpt op args = StPrim op args
295 \end{code}
296
297 -----------------------------------------------------------------------------
298 Fix up floating point operations for x86.
299
300 The problem is that the code generator can't handle the weird register
301 naming scheme for floating point registers on the x86, so we have to
302 deal with memory-resident floating point values wherever possible.
303
304 We therefore can't stand references to floating-point kinded temporary
305 variables, and try to translate them into memory addresses wherever
306 possible.
307
308 \begin{code}
309 floatFix :: [StixTree] -> [StixTree]
310 floatFix trees = fltFix emptyUFM trees
311
312 fltFix  :: UniqFM StixTree      -- mapping tmp vars to memory locations
313         -> [StixTree]
314         -> [StixTree]
315 fltFix locs [] = []
316
317 -- The case we're interested in: loading a temporary from a memory
318 -- address.  Eliminate the instruction and replace all future references
319 -- to the temporary with the memory address.
320 fltFix locs ((StAssign rep (StReg (StixTemp uq _)) loc) : trees)
321   | isFloatingRep rep  = trace "found one" $ fltFix (addToUFM locs uq loc) trees
322
323 fltFix locs ((StAssign rep src dst) : trees)
324   = StAssign rep (fltFix1 locs src) (fltFix1 locs dst) : fltFix locs trees
325   
326 fltFix locs (tree : trees)
327   = fltFix1 locs tree : fltFix locs trees
328
329
330 fltFix1 :: UniqFM StixTree -> StixTree -> StixTree
331 fltFix1 locs r@(StReg (StixTemp uq rep))
332   | isFloatingRep rep = case lookupUFM locs uq of
333                                 Nothing -> panic "fltFix1"
334                                 Just tree -> trace "substed" $ tree
335
336 fltFix1 locs (StIndex rep l r) =
337   StIndex rep (fltFix1 locs l) (fltFix1 locs r)
338
339 fltFix1 locs (StInd rep tree) =
340   StInd rep (fltFix1 locs tree)
341
342 fltFix1 locs (StAssign rep dst src) = panic "fltFix1: StAssign"
343
344 fltFix1 locs (StJump tree) = StJump (fltFix1 locs tree)
345
346 fltFix1 locs (StCondJump lbl tree) =
347   StCondJump lbl (fltFix1 locs tree)
348
349 fltFix1 locs (StPrim op trees) = 
350   StPrim op (map (fltFix1 locs) trees)
351
352 fltFix1 locs (StCall f conv rep trees) =
353   StCall f conv rep (map (fltFix1 locs) trees)
354  
355 fltFix1 locs tree = tree
356 \end{code}