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