ghc/compiler/nativeGen/AsmCodeGen.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1995
   3 %
   4
   5 \begin{code}
   6 #include "HsVersions.h"
   7 #include "../../includes/platform.h"
   8 #include "../../includes/GhcConstants.h"
   9
  10 module AsmCodeGen (
  11         writeRealAsm,
  12         dumpRealAsm,
  13
  14         -- And, I guess we need these...
  15         AbstractC, GlobalSwitch, SwitchResult,
  16         UniqSupply, UniqSM(..)
  17     ) where
  18
  19 import AbsCSyn      ( AbstractC )
  20 import AbsCStixGen  ( genCodeAbstractC )
  21 import PrelInfo     ( PrimRep, PrimOp(..)
  22                       IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
  23                           IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
  24                     )
  25 import CmdLineOpts  ( GlobalSwitch(..), stringSwitchSet, switchIsOn, SwitchResult(..) )
  26 import MachDesc
  27 import Maybes       ( Maybe(..) )
  28 import Outputable
  29 #if alpha_TARGET_ARCH
  30 import AlphaDesc    ( mkAlpha )
  31 #endif
  32 #if i386_TARGET_ARCH
  33 import I386Desc     ( mkI386 )
  34 #endif
  35 #if sparc_TARGET_ARCH
  36 import SparcDesc    ( mkSparc )
  37 #endif
  38 import Stix
  39 import UniqSupply
  40 import Unpretty
  41 import Util
  42 \end{code}
  43
  44 This is a generic assembly language generator for the Glasgow Haskell
  45 Compiler.  It has been a long time in germinating, basically due to
  46 time constraints and the large spectrum of design possibilities.
  47 Presently it generates code for:
  48 \begin{itemize}
  49 \item Sparc
  50 \end{itemize}
  51 In the pipeline (sic) are plans and/or code for 680x0, 386/486.
  52
  53 The code generator presumes the presence of a working C port.  This is
  54 because any code that cannot be compiled (e.g. @casm@s) is re-directed
  55 via this route. It also help incremental development.  Because this
  56 code generator is specially written for the Abstract C produced by the
  57 Glasgow Haskell Compiler, several optimisation opportunities are open
  58 to us that are not open to @gcc@.  In particular, we know that the A
  59 and B stacks and the Heap are all mutually exclusive wrt. aliasing,
  60 and that expressions have no side effects (all state transformations
  61 are top level objects).
  62
  63 There are two main components to the code generator.
  64 \begin{itemize}
  65 \item Abstract C is considered in statements,
  66         with a Twig-like system handling each statement in turn.
  67 \item A scheduler turns the tree of assembly language orderings
  68       into a sequence suitable for input to an assembler.
  69 \end{itemize}
  70 The @codeGenerate@ function returns the final assembly language output
  71 (as a String).  We can return a string, because there is only one way
  72 of printing the output suitable for assembler consumption. It also
  73 allows limited abstraction of different machines from the Main module.
  74
  75 The first part is the actual assembly language generation.  First we
  76 split up the Abstract C into individual functions, then consider
  77 chunks in isolation, giving back an @OrdList@ of assembly language
  78 instructions.  The generic algorithm is heavily inspired by Twig
  79 (ref), but also draws concepts from (ref).  The basic idea is to
  80 (dynamically) walk the Abstract C syntax tree, annotating it with
  81 possible code matches.  For example, on the Sparc, a possible match
  82 (with its translation) could be
  83 @
  84    :=
  85    / \
  86   i   r2        => ST r2,[r1]
  87   |
  88   r1
  89 @
  90 where @r1,r2@ are registers, and @i@ is an indirection.  The Twig
  91 bit twiddling algorithm for tree matching has been abandoned. It is
  92 replaced with a more direct scheme.  This is because, after careful
  93 consideration it is felt that the overhead of handling many bit
  94 patterns would be heavier that simply looking at the syntax of the
  95 tree at the node being considered, and dynamically choosing and
  96 pruning rules.
  97
  98 The ultimate result of the first part is a Set of ordering lists of
  99 ordering lists of assembly language instructions (yes, really!), where
 100 each element in the set is basic chunk.  Now several (generic)
 101 simplifications and transformations can be performed.  This includes
 102 ones that turn the the ordering of orderings into just a single
 103 ordering list. (The equivalent of applying @concat@ to a list of
 104 lists.) A lot of the re-ordering and optimisation is actually done
 105 (generically) here!  The final part, the scheduler, can now be used on
 106 this structure.  The code sequence is optimised (obviously) to avoid
 107 stalling the pipeline.  This part {\em has} to be heavily machine
 108 dependent.
 109
 110 [The above seems to describe mostly dreamware.  -- JSM]
 111
 112 The flag that needs to be added is -fasm-<platform> where platform is one of
 113 the choices below.
 114
 115 \begin{code}
 116 writeRealAsm :: (GlobalSwitch -> SwitchResult) -> _FILE -> AbstractC -> UniqSupply -> PrimIO ()
 117
 118 writeRealAsm flags file absC uniq_supply
 119   = uppAppendFile file 80 (runNCG (code flags absC) uniq_supply)
 120
 121 dumpRealAsm :: (GlobalSwitch -> SwitchResult) -> AbstractC -> UniqSupply -> String
 122
 123 dumpRealAsm flags absC uniq_supply = uppShow 80 (runNCG (code flags absC) uniq_supply)
 124
 125 runNCG m uniq_supply = m uniq_supply
 126
 127 code flags absC =
 128     genCodeAbstractC target absC                    `thenUs` \ treelists ->
 129     let
 130         stix = map (map (genericOpt target)) treelists
 131     in
 132     codeGen {-target-} sty stix
 133   where
 134     sty = PprForAsm (switchIsOn flags) (underscore {-target-}) (fmtAsmLbl {-target-})
 135
 136     (target, codeGen, underscore, fmtAsmLbl)
 137       = case stringSwitchSet flags AsmTarget of
 138 #if ! OMIT_NATIVE_CODEGEN
 139 # if alpha_TARGET_ARCH
 140         Just _ {-???"alpha-dec-osf1"-} -> mkAlpha flags
 141 # endif
 142 # if i386_TARGET_ARCH
 143         Just _ {-???"i386_unknown_linuxaout"-} -> mkI386 True flags
 144 # endif
 145 # if sparc_sun_sunos4_TARGET
 146         Just _ {-???"sparc-sun-sunos4"-} -> mkSparc True flags
 147 # endif
 148 # if sparc_sun_solaris2_TARGET
 149         Just _ {-???"sparc-sun-solaris2"-} -> mkSparc False flags
 150 # endif
 151 #endif
 152         _ -> error
 153              ("ERROR:Trying to generate assembly language for an unsupported architecture\n"++
 154               "(or one for which this build is not configured).")
 155
 156 \end{code}
 157
 158 %************************************************************************
 159 %*                                                                      *
 160 \subsection[NCOpt]{The Generic Optimiser}
 161 %*                                                                      *
 162 %************************************************************************
 163
 164 This is called between translating Abstract C to its Tree
 165 and actually using the Native Code Generator to generate
 166 the annotations.  It's a chance to do some strength reductions.
 167
 168 ** Remember these all have to be machine independent ***
 169
 170 Note that constant-folding should have already happened, but we might have
 171 introduced some new opportunities for constant-folding wrt address manipulations.
 172
 173 \begin{code}
 174
 175 genericOpt
 176     :: Target
 177     -> StixTree
 178     -> StixTree
 179
 180 \end{code}
 181
 182 For most nodes, just optimize the children.
 183
 184 \begin{code}
 185 -- hacking with Uncle Will:
 186 #define target_STRICT target@(Target _ _ _ _ _ _ _ _)
 187
 188 genericOpt target_STRICT (StInd pk addr) =
 189     StInd pk (genericOpt target addr)
 190
 191 genericOpt target (StAssign pk dst src) =
 192     StAssign pk (genericOpt target dst) (genericOpt target src)
 193
 194 genericOpt target (StJump addr) =
 195     StJump (genericOpt target addr)
 196
 197 genericOpt target (StCondJump addr test) =
 198     StCondJump addr (genericOpt target test)
 199
 200 genericOpt target (StCall fn pk args) =
 201     StCall fn pk (map (genericOpt target) args)
 202
 203 \end{code}
 204
 205 Fold indices together when the types match.
 206
 207 \begin{code}
 208
 209 genericOpt target (StIndex pk (StIndex pk' base off) off')
 210   | pk == pk' =
 211     StIndex pk (genericOpt target base)
 212                (genericOpt target (StPrim IntAddOp [off, off']))
 213
 214 genericOpt target (StIndex pk base off) =
 215     StIndex pk (genericOpt target base)
 216                (genericOpt target off)
 217
 218 \end{code}
 219
 220 For primOps, we first optimize the children, and then we try our hand
 221 at some constant-folding.
 222
 223 \begin{code}
 224
 225 genericOpt target (StPrim op args) =
 226     primOpt op (map (genericOpt target) args)
 227
 228 \end{code}
 229
 230 Replace register leaves with appropriate StixTrees for the given target.
 231 (Oh, so this is why we've been hauling the target around!)
 232
 233 \begin{code}
 234
 235 genericOpt target leaf@(StReg (StixMagicId id)) =
 236     case stgReg target id of
 237         Always tree -> genericOpt target tree
 238         Save _     -> leaf
 239
 240 genericOpt target other = other
 241
 242 \end{code}
 243
 244 Now, try to constant-fold the primOps.  The arguments have
 245 already been optimized and folded.
 246
 247 \begin{code}
 248
 249 primOpt
 250     :: PrimOp           -- The operation from an StPrim
 251     -> [StixTree]       -- The optimized arguments
 252     -> StixTree
 253
 254 primOpt op arg@[StInt x] =
 255     case op of
 256         IntNegOp -> StInt (-x)
 257         IntAbsOp -> StInt (abs x)
 258         _ -> StPrim op arg
 259
 260 primOpt op args@[StInt x, StInt y] =
 261     case op of
 262         CharGtOp -> StInt (if x > y then 1 else 0)
 263         CharGeOp -> StInt (if x >= y then 1 else 0)
 264         CharEqOp -> StInt (if x == y then 1 else 0)
 265         CharNeOp -> StInt (if x /= y then 1 else 0)
 266         CharLtOp -> StInt (if x < y then 1 else 0)
 267         CharLeOp -> StInt (if x <= y then 1 else 0)
 268         IntAddOp -> StInt (x + y)
 269         IntSubOp -> StInt (x - y)
 270         IntMulOp -> StInt (x * y)
 271         IntQuotOp -> StInt (x `quot` y)
 272         IntRemOp -> StInt (x `rem` y)
 273         IntGtOp -> StInt (if x > y then 1 else 0)
 274         IntGeOp -> StInt (if x >= y then 1 else 0)
 275         IntEqOp -> StInt (if x == y then 1 else 0)
 276         IntNeOp -> StInt (if x /= y then 1 else 0)
 277         IntLtOp -> StInt (if x < y then 1 else 0)
 278         IntLeOp -> StInt (if x <= y then 1 else 0)
 279         _ -> StPrim op args
 280
 281 \end{code}
 282
 283 When possible, shift the constants to the right-hand side, so that we
 284 can match for strength reductions.  Note that the code generator will
 285 also assume that constants have been shifted to the right when possible.
 286
 287 \begin{code}
 288 primOpt op [x@(StInt _), y] | commutableOp op = primOpt op [y, x]
 289 \end{code}
 290
 291 We can often do something with constants of 0 and 1 ...
 292
 293 \begin{code}
 294 primOpt op args@[x, y@(StInt 0)] =
 295     case op of
 296         IntAddOp -> x
 297         IntSubOp -> x
 298         IntMulOp -> y
 299         AndOp  -> y
 300         OrOp   -> x
 301         SllOp  -> x
 302         SraOp  -> x
 303         SrlOp  -> x
 304         ISllOp -> x
 305         ISraOp -> x
 306         ISrlOp -> x
 307         _ -> StPrim op args
 308
 309 primOpt op args@[x, y@(StInt 1)] =
 310     case op of
 311         IntMulOp -> x
 312         IntQuotOp -> x
 313         IntRemOp -> StInt 0
 314         _ -> StPrim op args
 315 \end{code}
 316
 317 Now look for multiplication/division by powers of 2 (integers).
 318
 319 \begin{code}
 320 primOpt op args@[x, y@(StInt n)] =
 321     case op of
 322         IntMulOp -> case exact_log2 n of
 323             Nothing -> StPrim op args
 324             Just p -> StPrim SllOp [x, StInt p]
 325         IntQuotOp -> case exact_log2 n of
 326             Nothing -> StPrim op args
 327             Just p -> StPrim SraOp [x, StInt p]
 328         _ -> StPrim op args
 329 \end{code}
 330
 331 Anything else is just too hard.
 332
 333 \begin{code}
 334 primOpt op args = StPrim op args
 335 \end{code}
 336
 337 The commutable ops are those for which we will try to move constants
 338 to the right hand side for strength reduction.
 339
 340 \begin{code}
 341 commutableOp :: PrimOp -> Bool
 342
 343 commutableOp CharEqOp = True
 344 commutableOp CharNeOp = True
 345 commutableOp IntAddOp = True
 346 commutableOp IntMulOp = True
 347 commutableOp AndOp = True
 348 commutableOp OrOp = True
 349 commutableOp IntEqOp = True
 350 commutableOp IntNeOp = True
 351 commutableOp IntegerAddOp = True
 352 commutableOp IntegerMulOp = True
 353 commutableOp FloatAddOp = True
 354 commutableOp FloatMulOp = True
 355 commutableOp FloatEqOp = True
 356 commutableOp FloatNeOp = True
 357 commutableOp DoubleAddOp = True
 358 commutableOp DoubleMulOp = True
 359 commutableOp DoubleEqOp = True
 360 commutableOp DoubleNeOp = True
 361 commutableOp _ = False
 362 \end{code}
 363
 364 This algorithm for determining the $\log_2$ of exact powers of 2 comes
 365 from gcc.  It requires bit manipulation primitives, so we have a ghc
 366 version and an hbc version.  Other Haskell compilers are on their own.
 367
 368 \begin{code}
 369 w2i x = word2Int# x
 370 i2w x = int2Word# x
 371 i2w_s x = (x::Int#)
 372
 373 exact_log2 :: Integer -> Maybe Integer
 374 exact_log2 x
 375     | x <= 0 || x >= 2147483648 = Nothing
 376     | otherwise = case fromInteger x of
 377         I# x# -> if (w2i ((i2w x#) `and#` (i2w (0# -# x#))) /=# x#) then Nothing
 378                  else Just (toInteger (I# (pow2 x#)))
 379
 380             where pow2 x# | x# ==# 1# = 0#
 381                           | otherwise = 1# +# pow2 (w2i (i2w x# `shiftr` i2w_s 1#))
 382
 383                   shiftr x y = shiftRA# x y
 384 \end{code}