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 #ifdef __GLASGOW_HASKELL__
  12         writeRealAsm,
  13 #endif
  14         dumpRealAsm,
  15
  16         -- And, I guess we need these...
  17         AbstractC, GlobalSwitch, SwitchResult,
  18         SplitUniqSupply, SUniqSM(..)
  19     ) where
  20
  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)
  26                     )
  27 import CmdLineOpts  ( GlobalSwitch(..), stringSwitchSet, switchIsOn, SwitchResult(..) )
  28 import MachDesc
  29 import Maybes       ( Maybe(..) )
  30 import Outputable
  31 #if alpha_TARGET_ARCH
  32 import AlphaDesc    ( mkAlpha )
  33 #endif
  34 #if i386_TARGET_ARCH
  35 import I386Desc     ( mkI386 )
  36 #endif
  37 #if sparc_TARGET_ARCH
  38 import SparcDesc    ( mkSparc )
  39 #endif
  40 import Stix
  41 import SplitUniq
  42 import Unique
  43 import Unpretty
  44 import Util
  45 #if defined(__HBC__)
  46 import
  47        Word
  48 #endif
  49 \end{code}
  50
  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:
  55 \begin{itemize}
  56 \item Sparc
  57 \end{itemize}
  58 In the pipeline (sic) are plans and/or code for 680x0, 386/486.
  59
  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).
  69
  70 There are two main components to the code generator.
  71 \begin{itemize}
  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.
  76 \end{itemize}
  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.
  81
  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
  90 @
  91    :=
  92    / \
  93   i   r2        => ST r2,[r1]
  94   |
  95   r1
  96 @
  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
 103 pruning rules.
 104
 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
 115 dependent.
 116
 117 [The above seems to describe mostly dreamware.  -- JSM]
 118
 119 The flag that needs to be added is -fasm-<platform> where platform is one of
 120 the choices below.
 121
 122 \begin{code}
 123
 124 #ifdef __GLASGOW_HASKELL__
 125 # if __GLASGOW_HASKELL__ < 23
 126 # define _FILE _Addr
 127 # endif
 128 writeRealAsm :: (GlobalSwitch -> SwitchResult) -> _FILE -> AbstractC -> SplitUniqSupply -> PrimIO ()
 129
 130 writeRealAsm flags file absC uniq_supply
 131   = uppAppendFile file 80 (runNCG (code flags absC) uniq_supply)
 132
 133 #endif
 134
 135 dumpRealAsm :: (GlobalSwitch -> SwitchResult) -> AbstractC -> SplitUniqSupply -> String
 136
 137 dumpRealAsm flags absC uniq_supply = uppShow 80 (runNCG (code flags absC) uniq_supply)
 138
 139 runNCG m uniq_supply = m uniq_supply
 140
 141 code flags absC =
 142     genCodeAbstractC target absC                    `thenSUs` \ treelists ->
 143     let
 144         stix = map (map (genericOpt target)) treelists
 145     in
 146     codeGen {-target-} sty stix
 147   where
 148     sty = PprForAsm (switchIsOn flags) (underscore {-target-}) (fmtAsmLbl {-target-})
 149
 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
 155 # endif
 156 # if i386_TARGET_ARCH
 157         Just _ {-???"i386_unknown_linuxaout"-} -> mkI386 True flags
 158 # endif
 159 # if sparc_sun_sunos4_TARGET
 160         Just _ {-???"sparc-sun-sunos4"-} -> mkSparc True flags
 161 # endif
 162 # if sparc_sun_solaris2_TARGET
 163         Just _ {-???"sparc-sun-solaris2"-} -> mkSparc False flags
 164 # endif
 165 #endif
 166         _ -> error
 167              ("ERROR:Trying to generate assembly language for an unsupported architecture\n"++
 168               "(or one for which this build is not configured).")
 169
 170 \end{code}
 171
 172 %************************************************************************
 173 %*                                                                      *
 174 \subsection[NCOpt]{The Generic Optimiser}
 175 %*                                                                      *
 176 %************************************************************************
 177
 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.
 181
 182 ** Remember these all have to be machine independent ***
 183
 184 Note that constant-folding should have already happened, but we might have
 185 introduced some new opportunities for constant-folding wrt address manipulations.
 186
 187 \begin{code}
 188
 189 genericOpt
 190     :: Target
 191     -> StixTree
 192     -> StixTree
 193
 194 \end{code}
 195
 196 For most nodes, just optimize the children.
 197
 198 \begin{code}
 199 -- hacking with Uncle Will:
 200 #define target_STRICT target@(Target _ _ _ _ _ _ _ _)
 201
 202 genericOpt target_STRICT (StInd pk addr) =
 203     StInd pk (genericOpt target addr)
 204
 205 genericOpt target (StAssign pk dst src) =
 206     StAssign pk (genericOpt target dst) (genericOpt target src)
 207
 208 genericOpt target (StJump addr) =
 209     StJump (genericOpt target addr)
 210
 211 genericOpt target (StCondJump addr test) =
 212     StCondJump addr (genericOpt target test)
 213
 214 genericOpt target (StCall fn pk args) =
 215     StCall fn pk (map (genericOpt target) args)
 216
 217 \end{code}
 218
 219 Fold indices together when the types match.
 220
 221 \begin{code}
 222
 223 genericOpt target (StIndex pk (StIndex pk' base off) off')
 224   | pk == pk' =
 225     StIndex pk (genericOpt target base)
 226                (genericOpt target (StPrim IntAddOp [off, off']))
 227
 228 genericOpt target (StIndex pk base off) =
 229     StIndex pk (genericOpt target base)
 230                (genericOpt target off)
 231
 232 \end{code}
 233
 234 For primOps, we first optimize the children, and then we try our hand
 235 at some constant-folding.
 236
 237 \begin{code}
 238
 239 genericOpt target (StPrim op args) =
 240     primOpt op (map (genericOpt target) args)
 241
 242 \end{code}
 243
 244 Replace register leaves with appropriate StixTrees for the given target.
 245 (Oh, so this is why we've been hauling the target around!)
 246
 247 \begin{code}
 248
 249 genericOpt target leaf@(StReg (StixMagicId id)) =
 250     case stgReg target id of
 251         Always tree -> genericOpt target tree
 252         Save _     -> leaf
 253
 254 genericOpt target other = other
 255
 256 \end{code}
 257
 258 Now, try to constant-fold the primOps.  The arguments have
 259 already been optimized and folded.
 260
 261 \begin{code}
 262
 263 primOpt
 264     :: PrimOp           -- The operation from an StPrim
 265     -> [StixTree]       -- The optimized arguments
 266     -> StixTree
 267
 268 primOpt op arg@[StInt x] =
 269     case op of
 270         IntNegOp -> StInt (-x)
 271         IntAbsOp -> StInt (abs x)
 272         _ -> StPrim op arg
 273
 274 primOpt op args@[StInt x, StInt y] =
 275     case op of
 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)
 293         _ -> StPrim op args
 294
 295 \end{code}
 296
 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.
 300
 301 \begin{code}
 302
 303 primOpt op [x@(StInt _), y]    | commutableOp op = primOpt op [y, x]
 304 --OLD:
 305 --primOpt op [x@(StDouble _), y] | commutableOp op = primOpt op [y, x]
 306
 307 \end{code}
 308
 309 We can often do something with constants of 0 and 1 ...
 310
 311 \begin{code}
 312
 313 primOpt op args@[x, y@(StInt 0)] =
 314     case op of
 315         IntAddOp -> x
 316         IntSubOp -> x
 317         IntMulOp -> y
 318         AndOp  -> y
 319         OrOp   -> x
 320         SllOp  -> x
 321         SraOp  -> x
 322         SrlOp  -> x
 323         ISllOp -> x
 324         ISraOp -> x
 325         ISrlOp -> x
 326         _ -> StPrim op args
 327
 328 primOpt op args@[x, y@(StInt 1)] =
 329     case op of
 330         IntMulOp -> x
 331         IntQuotOp -> x
 332         IntRemOp -> StInt 0
 333         _ -> StPrim op args
 334
 335 -- The following code tweaks a bug in early versions of GHC (pre-0.21)
 336
 337 {- OLD: (death to constant folding in ncg)
 338 primOpt op args@[x, y@(StDouble 0.0)] =
 339     case op of
 340         FloatAddOp -> x
 341         FloatSubOp -> x
 342         FloatMulOp -> y
 343         DoubleAddOp -> x
 344         DoubleSubOp -> x
 345         DoubleMulOp -> y
 346         _ -> StPrim op args
 347
 348 primOpt op args@[x, y@(StDouble 1.0)] =
 349     case op of
 350         FloatMulOp -> x
 351         FloatDivOp -> x
 352         DoubleMulOp -> x
 353         DoubleDivOp -> x
 354         _ -> StPrim op args
 355
 356 primOpt op args@[x, y@(StDouble 2.0)] =
 357     case op of
 358         FloatMulOp -> StPrim FloatAddOp [x, x]
 359         DoubleMulOp -> StPrim DoubleAddOp [x, x]
 360         _ -> StPrim op args
 361 -}
 362
 363 \end{code}
 364
 365 Now look for multiplication/division by powers of 2 (integers).
 366
 367 \begin{code}
 368
 369 primOpt op args@[x, y@(StInt n)] =
 370     case op of
 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]
 377         _ -> StPrim op args
 378
 379 \end{code}
 380
 381 Anything else is just too hard.
 382
 383 \begin{code}
 384
 385 primOpt op args = StPrim op args
 386
 387 \end{code}
 388
 389 The commutable ops are those for which we will try to move constants to the
 390 right hand side for strength reduction.
 391
 392 \begin{code}
 393
 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
 414
 415 \end{code}
 416
 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.
 420
 421 \begin{code}
 422
 423 #ifdef __GLASGOW_HASKELL__
 424
 425 w2i x = word2Int# x
 426 i2w x = int2Word# x
 427 i2w_s x = (x::Int#)
 428
 429 exact_log2 :: Integer -> Maybe Integer
 430 exact_log2 x
 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#)))
 435
 436             where pow2 x# | x# ==# 1# = 0#
 437                           | otherwise = 1# +# pow2 (w2i (i2w x# `shiftr` i2w_s 1#))
 438
 439 # if __GLASGOW_HASKELL__ >= 23
 440                   shiftr x y = shiftRA# x y
 441 # else
 442                   shiftr x y = shiftR#  x y
 443 # endif
 444
 445 #else {-probably HBC-}
 446
 447 exact_log2 :: Integer -> Maybe Integer
 448 exact_log2 x
 449     | x <= 0 || x >= 2147483648 = Nothing
 450     | otherwise =
 451         if x' `bitAnd` (-x') /= x' then Nothing
 452         else Just (toInteger (pow2 x'))
 453
 454             where x' = ((fromInteger x) :: Word)
 455                   pow2 x | x == bit0 = 0 :: Int
 456                          | otherwise = 1 + pow2 (x `bitRsh` 1)
 457
 458 #endif {-probably HBC-}
 459
 460 \end{code}