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 #include "nativeGen/NCG.h"
  10
  11 import List             ( intersperse )
  12
  13 import MachMisc
  14 import MachRegs
  15 import MachCode
  16 import PprMach
  17
  18 import AbsCStixGen      ( genCodeAbstractC )
  19 import AbsCSyn          ( AbstractC, MagicId )
  20 import AbsCUtils        ( mkAbsCStmtList )
  21 import AsmRegAlloc      ( runRegAllocate )
  22 import PrimOp           ( commutableOp, PrimOp(..) )
  23 import RegAllocInfo     ( findReservedRegs )
  24 import Stix             ( StixTree(..), StixReg(..),
  25                           pprStixTrees, pprStixTree, CodeSegment(..),
  26                           stixCountTempUses, stixSubst,
  27                           NatM, initNat, mapNat,
  28                           NatM_State, mkNatM_State,
  29                           uniqOfNatM_State, deltaOfNatM_State )
  30 import UniqSupply       ( returnUs, thenUs, mapUs, initUs,
  31                           initUs_, UniqSM, UniqSupply,
  32                           lazyThenUs, lazyMapUs )
  33 import MachMisc         ( IF_ARCH_i386(i386_insert_ffrees,) )
  34
  35 import OrdList          ( fromOL, concatOL )
  36 import Outputable
  37
  38 \end{code}
  39
  40 The 96/03 native-code generator has machine-independent and
  41 machine-dependent modules (those \tr{#include}'ing \tr{NCG.h}).
  42
  43 This module (@AsmCodeGen@) is the top-level machine-independent
  44 module.  It uses @AbsCStixGen.genCodeAbstractC@ to produce @StixTree@s
  45 (defined in module @Stix@), using support code from @StixInfo@ (info
  46 tables), @StixPrim@ (primitive operations), @StixMacro@ (Abstract C
  47 macros), and @StixInteger@ (GMP arbitrary-precision operations).
  48
  49 Before entering machine-dependent land, we do some machine-independent
  50 @genericOpt@imisations (defined below) on the @StixTree@s.
  51
  52 We convert to the machine-specific @Instr@ datatype with
  53 @stmt2Instrs@, assuming an ``infinite'' supply of registers.  We then
  54 use a machine-independent register allocator (@runRegAllocate@) to
  55 rejoin reality.  Obviously, @runRegAllocate@ has machine-specific
  56 helper functions (see about @RegAllocInfo@ below).
  57
  58 The machine-dependent bits break down as follows:
  59 \begin{description}
  60 \item[@MachRegs@:]  Everything about the target platform's machine
  61     registers (and immediate operands, and addresses, which tend to
  62     intermingle/interact with registers).
  63
  64 \item[@MachMisc@:]  Includes the @Instr@ datatype (possibly should
  65     have a module of its own), plus a miscellany of other things
  66     (e.g., @targetDoubleSize@, @smStablePtrTable@, ...)
  67
  68 \item[@MachCode@:]  @stmt2Instrs@ is where @Stix@ stuff turns into
  69     machine instructions.
  70
  71 \item[@PprMach@:] @pprInstr@ turns an @Instr@ into text (well, really
  72     an @Doc@).
  73
  74 \item[@RegAllocInfo@:] In the register allocator, we manipulate
  75     @MRegsState@s, which are @BitSet@s, one bit per machine register.
  76     When we want to say something about a specific machine register
  77     (e.g., ``it gets clobbered by this instruction''), we set/unset
  78     its bit.  Obviously, we do this @BitSet@ thing for efficiency
  79     reasons.
  80
  81     The @RegAllocInfo@ module collects together the machine-specific
  82     info needed to do register allocation.
  83 \end{description}
  84
  85 So, here we go:
  86
  87 \begin{code}
  88 nativeCodeGen :: AbstractC -> UniqSupply -> (SDoc, SDoc)
  89 nativeCodeGen absC us
  90    = let absCstmts         = mkAbsCStmtList absC
  91          (sdoc_pairs, us1) = initUs us (lazyMapUs absCtoNat absCstmts)
  92          stix_sdocs        = map fst sdoc_pairs
  93          insn_sdocs        = map snd sdoc_pairs
  94
  95          insn_sdoc         = my_vcat insn_sdocs
  96          stix_sdoc         = vcat stix_sdocs
  97
  98 #        if NCG_DEBUG
  99          my_trace m x = trace m x
 100          my_vcat sds = vcat (intersperse
 101                                 (char ' '
 102                                  $$ ptext SLIT("# __debug_NCG_split_marker")
 103                                  $$ char ' ')
 104                                  sds)
 105 #        else
 106          my_vcat sds = vcat sds
 107          my_trace m x = x
 108 #        endif
 109      in
 110          my_trace "nativeGen: begin"
 111                   (stix_sdoc, insn_sdoc)
 112
 113
 114 absCtoNat :: AbstractC -> UniqSM (SDoc, SDoc)
 115 absCtoNat absC
 116    = genCodeAbstractC absC                `thenUs` \ stixRaw ->
 117      genericOpt stixRaw                   `bind`   \ stixOpt ->
 118      genMachCode stixOpt                  `thenUs` \ pre_regalloc ->
 119      regAlloc pre_regalloc                `bind`   \ almost_final ->
 120      x86fp_kludge almost_final            `bind`   \ final_mach_code ->
 121      vcat (map pprInstr final_mach_code)  `bind`   \ final_sdoc ->
 122      pprStixTrees stixOpt                 `bind`   \ stix_sdoc ->
 123      returnUs (stix_sdoc, final_sdoc)
 124      where
 125         bind f x = x f
 126
 127         x86fp_kludge :: [Instr] -> [Instr]
 128         x86fp_kludge = IF_ARCH_i386(i386_insert_ffrees,id)
 129
 130         regAlloc :: InstrBlock -> [Instr]
 131         regAlloc = runRegAllocate allocatableRegs findReservedRegs
 132 \end{code}
 133
 134 Top level code generator for a chunk of stix code.  For this part of
 135 the computation, we switch from the UniqSM monad to the NatM monad.
 136 The latter carries not only a Unique, but also an Int denoting the
 137 current C stack pointer offset in the generated code; this is needed
 138 for creating correct spill offsets on architectures which don't offer,
 139 or for which it would be prohibitively expensive to employ, a frame
 140 pointer register.  Viz, x86.
 141
 142 The offset is measured in bytes, and indicates the difference between
 143 the current (simulated) C stack-ptr and the value it was at the
 144 beginning of the block.  For stacks which grow down, this value should
 145 be either zero or negative.
 146
 147 Switching between the two monads whilst carrying along the same Unique
 148 supply breaks abstraction.  Is that bad?
 149
 150 \begin{code}
 151 genMachCode :: [StixTree] -> UniqSM InstrBlock
 152
 153 genMachCode stmts initial_us
 154   = let initial_st         = mkNatM_State initial_us 0
 155         (blocks, final_st) = initNat initial_st
 156                                      (mapNat stmt2Instrs stmts)
 157         instr_list         = concatOL blocks
 158         final_us           = uniqOfNatM_State final_st
 159         final_delta        = deltaOfNatM_State final_st
 160     in
 161         if   final_delta == 0
 162         then (instr_list, final_us)
 163         else pprPanic "genMachCode: nonzero final delta"
 164                       (int final_delta)
 165 \end{code}
 166
 167 %************************************************************************
 168 %*                                                                      *
 169 \subsection[NCOpt]{The Generic Optimiser}
 170 %*                                                                      *
 171 %************************************************************************
 172
 173 This is called between translating Abstract C to its Tree and actually
 174 using the Native Code Generator to generate the annotations.  It's a
 175 chance to do some strength reductions.
 176
 177 ** Remember these all have to be machine independent ***
 178
 179 Note that constant-folding should have already happened, but we might
 180 have introduced some new opportunities for constant-folding wrt
 181 address manipulations.
 182
 183 \begin{code}
 184 genericOpt :: [StixTree] -> [StixTree]
 185 genericOpt = map stixConFold . stixPeep
 186
 187
 188
 189 stixPeep :: [StixTree] -> [StixTree]
 190
 191 -- This transformation assumes that the temp assigned to in t1
 192 -- is not assigned to in t2; for otherwise the target of the
 193 -- second assignment would be substituted for, giving nonsense
 194 -- code.  As far as I can see, StixTemps are only ever assigned
 195 -- to once.  It would be nice to be sure!
 196
 197 stixPeep ( t1@(StAssign pka (StReg (StixTemp u pk)) rhs)
 198          : t2
 199          : ts )
 200    | stixCountTempUses u t2 == 1
 201      && sum (map (stixCountTempUses u) ts) == 0
 202    =
 203 #    ifdef NCG_DEBUG
 204      trace ("nativeGen: inlining " ++ showSDoc (pprStixTree rhs))
 205 #    endif
 206            (stixPeep (stixSubst u rhs t2 : ts))
 207
 208 stixPeep (t1:t2:ts) = t1 : stixPeep (t2:ts)
 209 stixPeep [t1]       = [t1]
 210 stixPeep []         = []
 211
 212 -- disable stix inlining until we figure out how to fix the
 213 -- latent bugs in the register allocator which are exposed by
 214 -- the inliner.
 215 --stixPeep = id
 216 \end{code}
 217
 218 For most nodes, just optimize the children.
 219
 220 \begin{code}
 221 stixConFold :: StixTree -> StixTree
 222
 223 stixConFold (StInd pk addr) = StInd pk (stixConFold addr)
 224
 225 stixConFold (StAssign pk dst src)
 226   = StAssign pk (stixConFold dst) (stixConFold src)
 227
 228 stixConFold (StJump addr) = StJump (stixConFold addr)
 229
 230 stixConFold (StCondJump addr test)
 231   = StCondJump addr (stixConFold test)
 232
 233 stixConFold (StCall fn cconv pk args)
 234   = StCall fn cconv pk (map stixConFold args)
 235 \end{code}
 236
 237 Fold indices together when the types match:
 238 \begin{code}
 239 stixConFold (StIndex pk (StIndex pk' base off) off')
 240   | pk == pk'
 241   = StIndex pk (stixConFold base)
 242                (stixConFold (StPrim IntAddOp [off, off']))
 243
 244 stixConFold (StIndex pk base off)
 245   = StIndex pk (stixConFold base) (stixConFold off)
 246 \end{code}
 247
 248 For PrimOps, we first optimize the children, and then we try our hand
 249 at some constant-folding.
 250
 251 \begin{code}
 252 stixConFold (StPrim op args) = stixPrimFold op (map stixConFold args)
 253 \end{code}
 254
 255 Replace register leaves with appropriate StixTrees for the given
 256 target.
 257
 258 \begin{code}
 259 stixConFold leaf@(StReg (StixMagicId id))
 260   = case (stgReg id) of
 261         Always tree -> stixConFold tree
 262         Save _      -> leaf
 263
 264 stixConFold other = other
 265 \end{code}
 266
 267 Now, try to constant-fold the PrimOps.  The arguments have already
 268 been optimized and folded.
 269
 270 \begin{code}
 271 stixPrimFold
 272     :: PrimOp           -- The operation from an StPrim
 273     -> [StixTree]       -- The optimized arguments
 274     -> StixTree
 275
 276 stixPrimFold op arg@[StInt x]
 277   = case op of
 278         IntNegOp -> StInt (-x)
 279         _ -> StPrim op arg
 280
 281 stixPrimFold op args@[StInt x, StInt y]
 282   = case op of
 283         CharGtOp -> StInt (if x > y  then 1 else 0)
 284         CharGeOp -> StInt (if x >= y then 1 else 0)
 285         CharEqOp -> StInt (if x == y then 1 else 0)
 286         CharNeOp -> StInt (if x /= y then 1 else 0)
 287         CharLtOp -> StInt (if x < y  then 1 else 0)
 288         CharLeOp -> StInt (if x <= y then 1 else 0)
 289         IntAddOp -> StInt (x + y)
 290         IntSubOp -> StInt (x - y)
 291         IntMulOp -> StInt (x * y)
 292         IntQuotOp -> StInt (x `quot` y)
 293         IntRemOp -> StInt (x `rem` y)
 294         IntGtOp -> StInt (if x > y  then 1 else 0)
 295         IntGeOp -> StInt (if x >= y then 1 else 0)
 296         IntEqOp -> StInt (if x == y then 1 else 0)
 297         IntNeOp -> StInt (if x /= y then 1 else 0)
 298         IntLtOp -> StInt (if x < y  then 1 else 0)
 299         IntLeOp -> StInt (if x <= y then 1 else 0)
 300         -- ToDo: WordQuotOp, WordRemOp.
 301         _ -> StPrim op args
 302 \end{code}
 303
 304 When possible, shift the constants to the right-hand side, so that we
 305 can match for strength reductions.  Note that the code generator will
 306 also assume that constants have been shifted to the right when
 307 possible.
 308
 309 \begin{code}
 310 stixPrimFold op [x@(StInt _), y] | commutableOp op = stixPrimFold op [y, x]
 311 \end{code}
 312
 313 We can often do something with constants of 0 and 1 ...
 314
 315 \begin{code}
 316 stixPrimFold op args@[x, y@(StInt 0)]
 317   = case op of
 318         IntAddOp -> x
 319         IntSubOp -> x
 320         IntMulOp -> y
 321         AndOp    -> y
 322         OrOp     -> x
 323         XorOp    -> x
 324         SllOp    -> x
 325         SrlOp    -> x
 326         ISllOp   -> x
 327         ISraOp   -> x
 328         ISrlOp   -> x
 329         IntNeOp  | is_comparison -> x
 330         _        -> StPrim op args
 331     where
 332        is_comparison
 333           = case x of
 334                StPrim opp [_, _] -> opp `elem` comparison_ops
 335                _                 -> False
 336
 337 stixPrimFold op args@[x, y@(StInt 1)]
 338   = case op of
 339         IntMulOp  -> x
 340         IntQuotOp -> x
 341         IntRemOp  -> StInt 0
 342         _         -> StPrim op args
 343 \end{code}
 344
 345 Now look for multiplication/division by powers of 2 (integers).
 346
 347 \begin{code}
 348 stixPrimFold op args@[x, y@(StInt n)]
 349   = case op of
 350         IntMulOp -> case exactLog2 n of
 351             Nothing -> StPrim op args
 352             Just p  -> StPrim ISllOp [x, StInt p]
 353         IntQuotOp -> case exactLog2 n of
 354             Nothing -> StPrim op args
 355             Just p  -> StPrim ISrlOp [x, StInt p]
 356         _ -> StPrim op args
 357 \end{code}
 358
 359 Anything else is just too hard.
 360
 361 \begin{code}
 362 stixPrimFold op args = StPrim op args
 363 \end{code}
 364
 365 \begin{code}
 366 comparison_ops
 367    = [ CharGtOp  , CharGeOp  , CharEqOp  , CharNeOp  , CharLtOp  , CharLeOp,
 368        IntGtOp   , IntGeOp   , IntEqOp   , IntNeOp   , IntLtOp   , IntLeOp,
 369        WordGtOp  , WordGeOp  , WordEqOp  , WordNeOp  , WordLtOp  , WordLeOp,
 370        AddrGtOp  , AddrGeOp  , AddrEqOp  , AddrNeOp  , AddrLtOp  , AddrLeOp,
 371        FloatGtOp , FloatGeOp , FloatEqOp , FloatNeOp , FloatLtOp , FloatLeOp,
 372        DoubleGtOp, DoubleGeOp, DoubleEqOp, DoubleNeOp, DoubleLtOp, DoubleLeOp
 373      ]
 374 \end{code}