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 1 /* ifdef NCG_DEBUG */
  99          my_trace m x = trace m x
 100          my_vcat sds = vcat (intersperse (char ' '
 101                                           $$ ptext SLIT("# ___ncg_debug_marker")
 102                                           $$ char ' ')
 103                                           sds)
 104 #        else
 105          my_vcat sds = vcat sds
 106          my_trace m x = x
 107 #        endif
 108      in
 109          my_trace "nativeGen: begin"
 110                   (stix_sdoc, insn_sdoc)
 111
 112
 113 absCtoNat :: AbstractC -> UniqSM (SDoc, SDoc)
 114 absCtoNat absC
 115    = genCodeAbstractC absC                `thenUs` \ stixRaw ->
 116      genericOpt stixRaw                   `bind`   \ stixOpt ->
 117      genMachCode stixOpt                  `thenUs` \ pre_regalloc ->
 118      regAlloc pre_regalloc                `bind`   \ almost_final ->
 119      x86fp_kludge almost_final            `bind`   \ final_mach_code ->
 120      vcat (map pprInstr final_mach_code)  `bind`   \ final_sdoc ->
 121      pprStixTrees stixOpt                 `bind`   \ stix_sdoc ->
 122      returnUs (stix_sdoc, final_sdoc)
 123      where
 124         bind f x = x f
 125
 126         x86fp_kludge :: [Instr] -> [Instr]
 127         x86fp_kludge = IF_ARCH_i386(i386_insert_ffrees,id)
 128
 129         regAlloc :: InstrBlock -> [Instr]
 130         regAlloc = runRegAllocate allocatableRegs findReservedRegs
 131 \end{code}
 132
 133 Top level code generator for a chunk of stix code.  For this part of
 134 the computation, we switch from the UniqSM monad to the NatM monad.
 135 The latter carries not only a Unique, but also an Int denoting the
 136 current C stack pointer offset in the generated code; this is needed
 137 for creating correct spill offsets on architectures which don't offer,
 138 or for which it would be prohibitively expensive to employ, a frame
 139 pointer register.  Viz, x86.
 140
 141 The offset is measured in bytes, and indicates the difference between
 142 the current (simulated) C stack-ptr and the value it was at the
 143 beginning of the block.  For stacks which grow down, this value should
 144 be either zero or negative.
 145
 146 Switching between the two monads whilst carrying along the same Unique
 147 supply breaks abstraction.  Is that bad?
 148
 149 \begin{code}
 150 genMachCode :: [StixTree] -> UniqSM InstrBlock
 151
 152 genMachCode stmts initial_us
 153   = let initial_st         = mkNatM_State initial_us 0
 154         (blocks, final_st) = initNat initial_st
 155                                      (mapNat stmt2Instrs stmts)
 156         instr_list         = concatOL blocks
 157         final_us           = uniqOfNatM_State final_st
 158         final_delta        = deltaOfNatM_State final_st
 159     in
 160         if   final_delta == 0
 161         then (instr_list, final_us)
 162         else pprPanic "genMachCode: nonzero final delta"
 163                       (int final_delta)
 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 and actually
 173 using the Native Code Generator to generate the annotations.  It's a
 174 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
 179 have introduced some new opportunities for constant-folding wrt
 180 address manipulations.
 181
 182 \begin{code}
 183 genericOpt :: [StixTree] -> [StixTree]
 184 genericOpt = map stixConFold . stixPeep
 185
 186
 187
 188 stixPeep :: [StixTree] -> [StixTree]
 189
 190 -- This transformation assumes that the temp assigned to in t1
 191 -- is not assigned to in t2; for otherwise the target of the
 192 -- second assignment would be substituted for, giving nonsense
 193 -- code.  As far as I can see, StixTemps are only ever assigned
 194 -- to once.  It would be nice to be sure!
 195
 196 stixPeep ( t1@(StAssign pka (StReg (StixTemp u pk)) rhs)
 197          : t2
 198          : ts )
 199    | stixCountTempUses u t2 == 1
 200      && sum (map (stixCountTempUses u) ts) == 0
 201    =
 202 #    ifdef NCG_DEBUG
 203      trace ("nativeGen: inlining " ++ showSDoc (pprStixTree rhs))
 204 #    endif
 205            (stixPeep (stixSubst u rhs t2 : ts))
 206
 207 stixPeep (t1:t2:ts) = t1 : stixPeep (t2:ts)
 208 stixPeep [t1]       = [t1]
 209 stixPeep []         = []
 210
 211 -- disable stix inlining until we figure out how to fix the
 212 -- latent bugs in the register allocator which are exposed by
 213 -- the inliner.
 214 --stixPeep = id
 215 \end{code}
 216
 217 For most nodes, just optimize the children.
 218
 219 \begin{code}
 220 stixConFold :: StixTree -> StixTree
 221
 222 stixConFold (StInd pk addr) = StInd pk (stixConFold addr)
 223
 224 stixConFold (StAssign pk dst src)
 225   = StAssign pk (stixConFold dst) (stixConFold src)
 226
 227 stixConFold (StJump addr) = StJump (stixConFold addr)
 228
 229 stixConFold (StCondJump addr test)
 230   = StCondJump addr (stixConFold test)
 231
 232 stixConFold (StCall fn cconv pk args)
 233   = StCall fn cconv pk (map stixConFold args)
 234 \end{code}
 235
 236 Fold indices together when the types match:
 237 \begin{code}
 238 stixConFold (StIndex pk (StIndex pk' base off) off')
 239   | pk == pk'
 240   = StIndex pk (stixConFold base)
 241                (stixConFold (StPrim IntAddOp [off, off']))
 242
 243 stixConFold (StIndex pk base off)
 244   = StIndex pk (stixConFold base) (stixConFold off)
 245 \end{code}
 246
 247 For PrimOps, we first optimize the children, and then we try our hand
 248 at some constant-folding.
 249
 250 \begin{code}
 251 stixConFold (StPrim op args) = stixPrimFold op (map stixConFold args)
 252 \end{code}
 253
 254 Replace register leaves with appropriate StixTrees for the given
 255 target.
 256
 257 \begin{code}
 258 stixConFold leaf@(StReg (StixMagicId id))
 259   = case (stgReg id) of
 260         Always tree -> stixConFold tree
 261         Save _      -> leaf
 262
 263 stixConFold other = other
 264 \end{code}
 265
 266 Now, try to constant-fold the PrimOps.  The arguments have already
 267 been optimized and folded.
 268
 269 \begin{code}
 270 stixPrimFold
 271     :: PrimOp           -- The operation from an StPrim
 272     -> [StixTree]       -- The optimized arguments
 273     -> StixTree
 274
 275 stixPrimFold op arg@[StInt x]
 276   = case op of
 277         IntNegOp -> StInt (-x)
 278         _ -> StPrim op arg
 279
 280 stixPrimFold op args@[StInt x, StInt y]
 281   = case op of
 282         CharGtOp -> StInt (if x > y  then 1 else 0)
 283         CharGeOp -> StInt (if x >= y then 1 else 0)
 284         CharEqOp -> StInt (if x == y then 1 else 0)
 285         CharNeOp -> StInt (if x /= y then 1 else 0)
 286         CharLtOp -> StInt (if x < y  then 1 else 0)
 287         CharLeOp -> StInt (if x <= y then 1 else 0)
 288         IntAddOp -> StInt (x + y)
 289         IntSubOp -> StInt (x - y)
 290         IntMulOp -> StInt (x * y)
 291         IntQuotOp -> StInt (x `quot` y)
 292         IntRemOp -> StInt (x `rem` y)
 293         IntGtOp -> StInt (if x > y  then 1 else 0)
 294         IntGeOp -> StInt (if x >= y then 1 else 0)
 295         IntEqOp -> StInt (if x == y then 1 else 0)
 296         IntNeOp -> StInt (if x /= y then 1 else 0)
 297         IntLtOp -> StInt (if x < y  then 1 else 0)
 298         IntLeOp -> StInt (if x <= y then 1 else 0)
 299         -- ToDo: WordQuotOp, WordRemOp.
 300         _ -> StPrim op args
 301 \end{code}
 302
 303 When possible, shift the constants to the right-hand side, so that we
 304 can match for strength reductions.  Note that the code generator will
 305 also assume that constants have been shifted to the right when
 306 possible.
 307
 308 \begin{code}
 309 stixPrimFold op [x@(StInt _), y] | commutableOp op = stixPrimFold op [y, x]
 310 \end{code}
 311
 312 We can often do something with constants of 0 and 1 ...
 313
 314 \begin{code}
 315 stixPrimFold op args@[x, y@(StInt 0)]
 316   = case op of
 317         IntAddOp -> x
 318         IntSubOp -> x
 319         IntMulOp -> y
 320         AndOp    -> y
 321         OrOp     -> x
 322         XorOp    -> x
 323         SllOp    -> x
 324         SrlOp    -> x
 325         ISllOp   -> x
 326         ISraOp   -> x
 327         ISrlOp   -> x
 328         IntNeOp  | is_comparison -> x
 329         _        -> StPrim op args
 330     where
 331        is_comparison
 332           = case x of
 333                StPrim opp [_, _] -> opp `elem` comparison_ops
 334                _                 -> False
 335
 336 stixPrimFold op args@[x, y@(StInt 1)]
 337   = case op of
 338         IntMulOp  -> x
 339         IntQuotOp -> x
 340         IntRemOp  -> StInt 0
 341         _         -> StPrim op args
 342 \end{code}
 343
 344 Now look for multiplication/division by powers of 2 (integers).
 345
 346 \begin{code}
 347 stixPrimFold op args@[x, y@(StInt n)]
 348   = case op of
 349         IntMulOp -> case exactLog2 n of
 350             Nothing -> StPrim op args
 351             Just p  -> StPrim ISllOp [x, StInt p]
 352         IntQuotOp -> case exactLog2 n of
 353             Nothing -> StPrim op args
 354             Just p  -> StPrim ISrlOp [x, StInt p]
 355         _ -> StPrim op args
 356 \end{code}
 357
 358 Anything else is just too hard.
 359
 360 \begin{code}
 361 stixPrimFold op args = StPrim op args
 362 \end{code}
 363
 364 \begin{code}
 365 comparison_ops
 366    = [ CharGtOp  , CharGeOp  , CharEqOp  , CharNeOp  , CharLtOp  , CharLeOp,
 367        IntGtOp   , IntGeOp   , IntEqOp   , IntNeOp   , IntLtOp   , IntLeOp,
 368        WordGtOp  , WordGeOp  , WordEqOp  , WordNeOp  , WordLtOp  , WordLeOp,
 369        AddrGtOp  , AddrGeOp  , AddrEqOp  , AddrNeOp  , AddrLtOp  , AddrLeOp,
 370        FloatGtOp , FloatGeOp , FloatEqOp , FloatNeOp , FloatLtOp , FloatLeOp,
 371        DoubleGtOp, DoubleGeOp, DoubleEqOp, DoubleNeOp, DoubleLtOp, DoubleLeOp
 372      ]
 373 \end{code}