2 % (c) The AQUA Project, Glasgow University, 1993-1995
6 #include "HsVersions.h"
7 #include "../../includes/platform.h"
8 #include "../../includes/GhcConstants.h"
11 #ifdef __GLASGOW_HASKELL__
16 -- And, I guess we need these...
17 AbstractC, GlobalSwitch, SwitchResult,
18 SplitUniqSupply, SUniqSM(..)
21 import AbsCSyn ( AbstractC )
22 import AbsCStixGen ( genCodeAbstractC )
23 import AbsPrel ( PrimKind, PrimOp(..)
24 IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
25 IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
27 import CmdLineOpts ( GlobalSwitch(..), stringSwitchSet, switchIsOn, SwitchResult(..) )
29 import Maybes ( Maybe(..) )
32 import AlphaDesc ( mkAlpha )
35 import I386Desc ( mkI386 )
38 import SparcDesc ( mkSparc )
51 This is a generic assembly language generator for the Glasgow Haskell
52 Compiler. It has been a long time in germinating, basically due to
53 time constraints and the large spectrum of design possibilities.
54 Presently it generates code for:
58 In the pipeline (sic) are plans and/or code for 680x0, 386/486.
60 The code generator presumes the presence of a working C port. This is
61 because any code that cannot be compiled (e.g. @casm@s) is re-directed
62 via this route. It also help incremental development. Because this
63 code generator is specially written for the Abstract C produced by the
64 Glasgow Haskell Compiler, several optimisation opportunities are open
65 to us that are not open to @gcc@. In particular, we know that the A
66 and B stacks and the Heap are all mutually exclusive wrt. aliasing,
67 and that expressions have no side effects (all state transformations
68 are top level objects).
70 There are two main components to the code generator.
72 \item Abstract C is considered in statements,
73 with a Twig-like system handling each statement in turn.
74 \item A scheduler turns the tree of assembly language orderings
75 into a sequence suitable for input to an assembler.
77 The @codeGenerate@ function returns the final assembly language output
78 (as a String). We can return a string, because there is only one way
79 of printing the output suitable for assembler consumption. It also
80 allows limited abstraction of different machines from the Main module.
82 The first part is the actual assembly language generation. First we
83 split up the Abstract C into individual functions, then consider
84 chunks in isolation, giving back an @OrdList@ of assembly language
85 instructions. The generic algorithm is heavily inspired by Twig
86 (ref), but also draws concepts from (ref). The basic idea is to
87 (dynamically) walk the Abstract C syntax tree, annotating it with
88 possible code matches. For example, on the Sparc, a possible match
89 (with its translation) could be
97 where @r1,r2@ are registers, and @i@ is an indirection. The Twig
98 bit twiddling algorithm for tree matching has been abandoned. It is
99 replaced with a more direct scheme. This is because, after careful
100 consideration it is felt that the overhead of handling many bit
101 patterns would be heavier that simply looking at the syntax of the
102 tree at the node being considered, and dynamically choosing and
105 The ultimate result of the first part is a Set of ordering lists of
106 ordering lists of assembly language instructions (yes, really!), where
107 each element in the set is basic chunk. Now several (generic)
108 simplifications and transformations can be performed. This includes
109 ones that turn the the ordering of orderings into just a single
110 ordering list. (The equivalent of applying @concat@ to a list of
111 lists.) A lot of the re-ordering and optimisation is actually done
112 (generically) here! The final part, the scheduler, can now be used on
113 this structure. The code sequence is optimised (obviously) to avoid
114 stalling the pipeline. This part {\em has} to be heavily machine
117 [The above seems to describe mostly dreamware. -- JSM]
119 The flag that needs to be added is -fasm-<platform> where platform is one of
124 #ifdef __GLASGOW_HASKELL__
125 # if __GLASGOW_HASKELL__ < 23
128 writeRealAsm :: (GlobalSwitch -> SwitchResult) -> _FILE -> AbstractC -> SplitUniqSupply -> PrimIO ()
130 writeRealAsm flags file absC uniq_supply
131 = uppAppendFile file 80 (runNCG (code flags absC) uniq_supply)
135 dumpRealAsm :: (GlobalSwitch -> SwitchResult) -> AbstractC -> SplitUniqSupply -> String
137 dumpRealAsm flags absC uniq_supply = uppShow 80 (runNCG (code flags absC) uniq_supply)
139 runNCG m uniq_supply = m uniq_supply
142 genCodeAbstractC target absC `thenSUs` \ treelists ->
144 stix = map (map (genericOpt target)) treelists
146 codeGen {-target-} sty stix
148 sty = PprForAsm (switchIsOn flags) (underscore {-target-}) (fmtAsmLbl {-target-})
150 (target, codeGen, underscore, fmtAsmLbl)
151 = case stringSwitchSet flags AsmTarget of
152 #if ! OMIT_NATIVE_CODEGEN
153 # if alpha_TARGET_ARCH
154 Just _ {-???"alpha-dec-osf1"-} -> mkAlpha flags
156 # if i386_TARGET_ARCH
157 Just _ {-???"i386_unknown_linuxaout"-} -> mkI386 True flags
159 # if sparc_sun_sunos4_TARGET
160 Just _ {-???"sparc-sun-sunos4"-} -> mkSparc True flags
162 # if sparc_sun_solaris2_TARGET
163 Just _ {-???"sparc-sun-solaris2"-} -> mkSparc False flags
167 ("ERROR:Trying to generate assembly language for an unsupported architecture\n"++
168 "(or one for which this build is not configured).")
172 %************************************************************************
174 \subsection[NCOpt]{The Generic Optimiser}
176 %************************************************************************
178 This is called between translating Abstract C to its Tree
179 and actually using the Native Code Generator to generate
180 the annotations. It's a chance to do some strength reductions.
182 ** Remember these all have to be machine independent ***
184 Note that constant-folding should have already happened, but we might have
185 introduced some new opportunities for constant-folding wrt address manipulations.
196 For most nodes, just optimize the children.
199 -- hacking with Uncle Will:
200 #define target_STRICT target@(Target _ _ _ _ _ _ _ _)
202 genericOpt target_STRICT (StInd pk addr) =
203 StInd pk (genericOpt target addr)
205 genericOpt target (StAssign pk dst src) =
206 StAssign pk (genericOpt target dst) (genericOpt target src)
208 genericOpt target (StJump addr) =
209 StJump (genericOpt target addr)
211 genericOpt target (StCondJump addr test) =
212 StCondJump addr (genericOpt target test)
214 genericOpt target (StCall fn pk args) =
215 StCall fn pk (map (genericOpt target) args)
219 Fold indices together when the types match.
223 genericOpt target (StIndex pk (StIndex pk' base off) off')
225 StIndex pk (genericOpt target base)
226 (genericOpt target (StPrim IntAddOp [off, off']))
228 genericOpt target (StIndex pk base off) =
229 StIndex pk (genericOpt target base)
230 (genericOpt target off)
234 For primOps, we first optimize the children, and then we try our hand
235 at some constant-folding.
239 genericOpt target (StPrim op args) =
240 primOpt op (map (genericOpt target) args)
244 Replace register leaves with appropriate StixTrees for the given target.
245 (Oh, so this is why we've been hauling the target around!)
249 genericOpt target leaf@(StReg (StixMagicId id)) =
250 case stgReg target id of
251 Always tree -> genericOpt target tree
254 genericOpt target other = other
258 Now, try to constant-fold the primOps. The arguments have
259 already been optimized and folded.
264 :: PrimOp -- The operation from an StPrim
265 -> [StixTree] -- The optimized arguments
268 primOpt op arg@[StInt x] =
270 IntNegOp -> StInt (-x)
271 IntAbsOp -> StInt (abs x)
274 primOpt op args@[StInt x, StInt y] =
276 CharGtOp -> StInt (if x > y then 1 else 0)
277 CharGeOp -> StInt (if x >= y then 1 else 0)
278 CharEqOp -> StInt (if x == y then 1 else 0)
279 CharNeOp -> StInt (if x /= y then 1 else 0)
280 CharLtOp -> StInt (if x < y then 1 else 0)
281 CharLeOp -> StInt (if x <= y then 1 else 0)
282 IntAddOp -> StInt (x + y)
283 IntSubOp -> StInt (x - y)
284 IntMulOp -> StInt (x * y)
285 IntQuotOp -> StInt (x `quot` y)
286 IntRemOp -> StInt (x `rem` y)
287 IntGtOp -> StInt (if x > y then 1 else 0)
288 IntGeOp -> StInt (if x >= y then 1 else 0)
289 IntEqOp -> StInt (if x == y then 1 else 0)
290 IntNeOp -> StInt (if x /= y then 1 else 0)
291 IntLtOp -> StInt (if x < y then 1 else 0)
292 IntLeOp -> StInt (if x <= y then 1 else 0)
297 When possible, shift the constants to the right-hand side, so that we
298 can match for strength reductions. Note that the code generator will
299 also assume that constants have been shifted to the right when possible.
303 primOpt op [x@(StInt _), y] | commutableOp op = primOpt op [y, x]
305 --primOpt op [x@(StDouble _), y] | commutableOp op = primOpt op [y, x]
309 We can often do something with constants of 0 and 1 ...
313 primOpt op args@[x, y@(StInt 0)] =
328 primOpt op args@[x, y@(StInt 1)] =
335 -- The following code tweaks a bug in early versions of GHC (pre-0.21)
337 {- OLD: (death to constant folding in ncg)
338 primOpt op args@[x, y@(StDouble 0.0)] =
348 primOpt op args@[x, y@(StDouble 1.0)] =
356 primOpt op args@[x, y@(StDouble 2.0)] =
358 FloatMulOp -> StPrim FloatAddOp [x, x]
359 DoubleMulOp -> StPrim DoubleAddOp [x, x]
365 Now look for multiplication/division by powers of 2 (integers).
369 primOpt op args@[x, y@(StInt n)] =
371 IntMulOp -> case exact_log2 n of
372 Nothing -> StPrim op args
373 Just p -> StPrim SllOp [x, StInt p]
374 IntQuotOp -> case exact_log2 n of
375 Nothing -> StPrim op args
376 Just p -> StPrim SraOp [x, StInt p]
381 Anything else is just too hard.
385 primOpt op args = StPrim op args
389 The commutable ops are those for which we will try to move constants to the
390 right hand side for strength reduction.
394 commutableOp :: PrimOp -> Bool
395 commutableOp CharEqOp = True
396 commutableOp CharNeOp = True
397 commutableOp IntAddOp = True
398 commutableOp IntMulOp = True
399 commutableOp AndOp = True
400 commutableOp OrOp = True
401 commutableOp IntEqOp = True
402 commutableOp IntNeOp = True
403 commutableOp IntegerAddOp = True
404 commutableOp IntegerMulOp = True
405 commutableOp FloatAddOp = True
406 commutableOp FloatMulOp = True
407 commutableOp FloatEqOp = True
408 commutableOp FloatNeOp = True
409 commutableOp DoubleAddOp = True
410 commutableOp DoubleMulOp = True
411 commutableOp DoubleEqOp = True
412 commutableOp DoubleNeOp = True
413 commutableOp _ = False
417 This algorithm for determining the $\log_2$ of exact powers of 2 comes from gcc. It
418 requires bit manipulation primitives, so we have a ghc version and an hbc version.
419 Other Haskell compilers are on their own.
423 #ifdef __GLASGOW_HASKELL__
429 exact_log2 :: Integer -> Maybe Integer
431 | x <= 0 || x >= 2147483648 = Nothing
432 | otherwise = case fromInteger x of
433 I# x# -> if (w2i ((i2w x#) `and#` (i2w (0# -# x#))) /=# x#) then Nothing
434 else Just (toInteger (I# (pow2 x#)))
436 where pow2 x# | x# ==# 1# = 0#
437 | otherwise = 1# +# pow2 (w2i (i2w x# `shiftr` i2w_s 1#))
439 # if __GLASGOW_HASKELL__ >= 23
440 shiftr x y = shiftRA# x y
442 shiftr x y = shiftR# x y
445 #else {-probably HBC-}
447 exact_log2 :: Integer -> Maybe Integer
449 | x <= 0 || x >= 2147483648 = Nothing
451 if x' `bitAnd` (-x') /= x' then Nothing
452 else Just (toInteger (pow2 x'))
454 where x' = ((fromInteger x) :: Word)
455 pow2 x | x == bit0 = 0 :: Int
456 | otherwise = 1 + pow2 (x `bitRsh` 1)
458 #endif {-probably HBC-}