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
  10 import IO               ( Handle )
  11
  12 import MachMisc
  13 import MachRegs
  14 import MachCode
  15 import PprMach
  16
  17 import AbsCStixGen      ( genCodeAbstractC )
  18 import AbsCSyn          ( AbstractC, MagicId )
  19 import AsmRegAlloc      ( runRegAllocate )
  20 import OrdList          ( OrdList )
  21 import PrimOp           ( commutableOp, PrimOp(..) )
  22 import RegAllocInfo     ( mkMRegsState, MRegsState )
  23 import Stix             ( StixTree(..), StixReg(..), pprStixTrees )
  24 import PrimRep          ( isFloatingRep )
  25 import UniqSupply       ( returnUs, thenUs, mapUs, initUs,
  26                           initUs_, UniqSM, UniqSupply )
  27 import UniqFM           ( UniqFM, emptyUFM, addToUFM, lookupUFM )
  28 import Outputable
  29
  30 import GlaExts (trace) --tmp
  31 #include "nativeGen/NCG.h"
  32 \end{code}
  33
  34 The 96/03 native-code generator has machine-independent and
  35 machine-dependent modules (those \tr{#include}'ing \tr{NCG.h}).
  36
  37 This module (@AsmCodeGen@) is the top-level machine-independent
  38 module.  It uses @AbsCStixGen.genCodeAbstractC@ to produce @StixTree@s
  39 (defined in module @Stix@), using support code from @StixInfo@ (info
  40 tables), @StixPrim@ (primitive operations), @StixMacro@ (Abstract C
  41 macros), and @StixInteger@ (GMP arbitrary-precision operations).
  42
  43 Before entering machine-dependent land, we do some machine-independent
  44 @genericOpt@imisations (defined below) on the @StixTree@s.
  45
  46 We convert to the machine-specific @Instr@ datatype with
  47 @stmt2Instrs@, assuming an ``infinite'' supply of registers.  We then
  48 use a machine-independent register allocator (@runRegAllocate@) to
  49 rejoin reality.  Obviously, @runRegAllocate@ has machine-specific
  50 helper functions (see about @RegAllocInfo@ below).
  51
  52 The machine-dependent bits break down as follows:
  53 \begin{description}
  54 \item[@MachRegs@:]  Everything about the target platform's machine
  55     registers (and immediate operands, and addresses, which tend to
  56     intermingle/interact with registers).
  57
  58 \item[@MachMisc@:]  Includes the @Instr@ datatype (possibly should
  59     have a module of its own), plus a miscellany of other things
  60     (e.g., @targetDoubleSize@, @smStablePtrTable@, ...)
  61
  62 \item[@MachCode@:]  @stmt2Instrs@ is where @Stix@ stuff turns into
  63     machine instructions.
  64
  65 \item[@PprMach@:] @pprInstr@ turns an @Instr@ into text (well, really
  66     an @Doc@).
  67
  68 \item[@RegAllocInfo@:] In the register allocator, we manipulate
  69     @MRegsState@s, which are @BitSet@s, one bit per machine register.
  70     When we want to say something about a specific machine register
  71     (e.g., ``it gets clobbered by this instruction''), we set/unset
  72     its bit.  Obviously, we do this @BitSet@ thing for efficiency
  73     reasons.
  74
  75     The @RegAllocInfo@ module collects together the machine-specific
  76     info needed to do register allocation.
  77 \end{description}
  78
  79 So, here we go:
  80
  81 \begin{code}
  82 nativeCodeGen :: AbstractC -> UniqSupply -> (SDoc, SDoc)
  83 nativeCodeGen absC us
  84    = let (stixRaw, us1) = initUs us (genCodeAbstractC absC)
  85          stixOpt        = map (map genericOpt) stixRaw
  86          stixFinal      = map x86floatFix stixOpt
  87          insns          = initUs_ us1 (codeGen stixFinal)
  88          debug_stix     = vcat (map pprStixTrees stixFinal)
  89      in
  90          (debug_stix, insns)
  91
  92 #if i386_TARGET_ARCH
  93 x86floatFix = floatFix
  94 #else
  95 x86floatFix = id
  96 #endif
  97
  98 \end{code}
  99
 100 @codeGen@ is the top-level code-generation function:
 101 \begin{code}
 102 codeGen :: [[StixTree]] -> UniqSM SDoc
 103
 104 codeGen stixFinal
 105   = mapUs genMachCode stixFinal `thenUs` \ dynamic_codes ->
 106     let
 107         static_instrs = scheduleMachCode dynamic_codes
 108     in
 109     returnUs (vcat (map pprInstr static_instrs))
 110 \end{code}
 111
 112 Top level code generator for a chunk of stix code:
 113 \begin{code}
 114 genMachCode :: [StixTree] -> UniqSM InstrList
 115
 116 genMachCode stmts
 117   = mapUs stmt2Instrs stmts             `thenUs` \ blocks ->
 118     returnUs (foldr (.) id blocks asmVoid)
 119 \end{code}
 120
 121 The next bit does the code scheduling.  The scheduler must also deal
 122 with register allocation of temporaries.  Much parallelism can be
 123 exposed via the OrdList, but more might occur, so further analysis
 124 might be needed.
 125
 126 \begin{code}
 127 scheduleMachCode :: [InstrList] -> [Instr]
 128
 129 scheduleMachCode
 130   = concat . map (runRegAllocate freeRegsState reservedRegs)
 131   where
 132     freeRegsState = mkMRegsState (extractMappedRegNos freeRegs)
 133 \end{code}
 134
 135 %************************************************************************
 136 %*                                                                      *
 137 \subsection[NCOpt]{The Generic Optimiser}
 138 %*                                                                      *
 139 %************************************************************************
 140
 141 This is called between translating Abstract C to its Tree and actually
 142 using the Native Code Generator to generate the annotations.  It's a
 143 chance to do some strength reductions.
 144
 145 ** Remember these all have to be machine independent ***
 146
 147 Note that constant-folding should have already happened, but we might
 148 have introduced some new opportunities for constant-folding wrt
 149 address manipulations.
 150
 151 \begin{code}
 152 genericOpt :: StixTree -> StixTree
 153 \end{code}
 154
 155 For most nodes, just optimize the children.
 156
 157 \begin{code}
 158 genericOpt (StInd pk addr) = StInd pk (genericOpt addr)
 159
 160 genericOpt (StAssign pk dst src)
 161   = StAssign pk (genericOpt dst) (genericOpt src)
 162
 163 genericOpt (StJump addr) = StJump (genericOpt addr)
 164
 165 genericOpt (StCondJump addr test)
 166   = StCondJump addr (genericOpt test)
 167
 168 genericOpt (StCall fn cconv pk args)
 169   = StCall fn cconv pk (map genericOpt args)
 170 \end{code}
 171
 172 Fold indices together when the types match:
 173 \begin{code}
 174 genericOpt (StIndex pk (StIndex pk' base off) off')
 175   | pk == pk'
 176   = StIndex pk (genericOpt base)
 177                (genericOpt (StPrim IntAddOp [off, off']))
 178
 179 genericOpt (StIndex pk base off)
 180   = StIndex pk (genericOpt base) (genericOpt off)
 181 \end{code}
 182
 183 For PrimOps, we first optimize the children, and then we try our hand
 184 at some constant-folding.
 185
 186 \begin{code}
 187 genericOpt (StPrim op args) = primOpt op (map genericOpt args)
 188 \end{code}
 189
 190 Replace register leaves with appropriate StixTrees for the given
 191 target.
 192
 193 \begin{code}
 194 genericOpt leaf@(StReg (StixMagicId id))
 195   = case (stgReg id) of
 196         Always tree -> genericOpt tree
 197         Save _      -> leaf
 198
 199 genericOpt other = other
 200 \end{code}
 201
 202 Now, try to constant-fold the PrimOps.  The arguments have already
 203 been optimized and folded.
 204
 205 \begin{code}
 206 primOpt
 207     :: PrimOp           -- The operation from an StPrim
 208     -> [StixTree]       -- The optimized arguments
 209     -> StixTree
 210
 211 primOpt op arg@[StInt x]
 212   = case op of
 213         IntNegOp -> StInt (-x)
 214         _ -> StPrim op arg
 215
 216 primOpt op args@[StInt x, StInt y]
 217   = case op of
 218         CharGtOp -> StInt (if x > y  then 1 else 0)
 219         CharGeOp -> StInt (if x >= y then 1 else 0)
 220         CharEqOp -> StInt (if x == y then 1 else 0)
 221         CharNeOp -> StInt (if x /= y then 1 else 0)
 222         CharLtOp -> StInt (if x < y  then 1 else 0)
 223         CharLeOp -> StInt (if x <= y then 1 else 0)
 224         IntAddOp -> StInt (x + y)
 225         IntSubOp -> StInt (x - y)
 226         IntMulOp -> StInt (x * y)
 227         IntQuotOp -> StInt (x `quot` y)
 228         IntRemOp -> StInt (x `rem` y)
 229         IntGtOp -> StInt (if x > y  then 1 else 0)
 230         IntGeOp -> StInt (if x >= y then 1 else 0)
 231         IntEqOp -> StInt (if x == y then 1 else 0)
 232         IntNeOp -> StInt (if x /= y then 1 else 0)
 233         IntLtOp -> StInt (if x < y  then 1 else 0)
 234         IntLeOp -> StInt (if x <= y then 1 else 0)
 235         -- ToDo: WordQuotOp, WordRemOp.
 236         _ -> StPrim op args
 237 \end{code}
 238
 239 When possible, shift the constants to the right-hand side, so that we
 240 can match for strength reductions.  Note that the code generator will
 241 also assume that constants have been shifted to the right when
 242 possible.
 243
 244 \begin{code}
 245 primOpt op [x@(StInt _), y] | commutableOp op = primOpt op [y, x]
 246 \end{code}
 247
 248 We can often do something with constants of 0 and 1 ...
 249
 250 \begin{code}
 251 primOpt op args@[x, y@(StInt 0)]
 252   = case op of
 253         IntAddOp -> x
 254         IntSubOp -> x
 255         IntMulOp -> y
 256         AndOp    -> y
 257         OrOp     -> x
 258         XorOp    -> x
 259         SllOp    -> x
 260         SrlOp    -> x
 261         ISllOp   -> x
 262         ISraOp   -> x
 263         ISrlOp   -> x
 264         _        -> StPrim op args
 265
 266 primOpt op args@[x, y@(StInt 1)]
 267   = case op of
 268         IntMulOp  -> x
 269         IntQuotOp -> x
 270         IntRemOp  -> StInt 0
 271         _         -> StPrim op args
 272 \end{code}
 273
 274 Now look for multiplication/division by powers of 2 (integers).
 275
 276 \begin{code}
 277 primOpt op args@[x, y@(StInt n)]
 278   = case op of
 279         IntMulOp -> case exactLog2 n of
 280             Nothing -> StPrim op args
 281             Just p  -> StPrim ISllOp [x, StInt p]
 282         IntQuotOp -> case exactLog2 n of
 283             Nothing -> StPrim op args
 284             Just p  -> StPrim ISrlOp [x, StInt p]
 285         _ -> StPrim op args
 286 \end{code}
 287
 288 Anything else is just too hard.
 289
 290 \begin{code}
 291 primOpt op args = StPrim op args
 292 \end{code}
 293
 294 -----------------------------------------------------------------------------
 295 Fix up floating point operations for x86.
 296
 297 The problem is that the code generator can't handle the weird register
 298 naming scheme for floating point registers on the x86, so we have to
 299 deal with memory-resident floating point values wherever possible.
 300
 301 We therefore can't stand references to floating-point kinded temporary
 302 variables, and try to translate them into memory addresses wherever
 303 possible.
 304
 305 \begin{code}
 306 floatFix :: [StixTree] -> [StixTree]
 307 floatFix trees = fltFix emptyUFM trees
 308
 309 fltFix  :: UniqFM StixTree      -- mapping tmp vars to memory locations
 310         -> [StixTree]
 311         -> [StixTree]
 312 fltFix locs [] = []
 313
 314 -- The case we're interested in: loading a temporary from a memory
 315 -- address.  Eliminate the instruction and replace all future references
 316 -- to the temporary with the memory address.
 317 fltFix locs ((StAssign rep (StReg (StixTemp uq _)) loc) : trees)
 318   | isFloatingRep rep  = trace "found one" $ fltFix (addToUFM locs uq loc) trees
 319
 320 fltFix locs ((StAssign rep src dst) : trees)
 321   = StAssign rep (fltFix1 locs src) (fltFix1 locs dst) : fltFix locs trees
 322
 323 fltFix locs (tree : trees)
 324   = fltFix1 locs tree : fltFix locs trees
 325
 326
 327 fltFix1 :: UniqFM StixTree -> StixTree -> StixTree
 328 fltFix1 locs r@(StReg (StixTemp uq rep))
 329   | isFloatingRep rep = case lookupUFM locs uq of
 330                                 Nothing -> panic "fltFix1"
 331                                 Just tree -> trace "substed" $ tree
 332
 333 fltFix1 locs (StIndex rep l r) =
 334   StIndex rep (fltFix1 locs l) (fltFix1 locs r)
 335
 336 fltFix1 locs (StInd rep tree) =
 337   StInd rep (fltFix1 locs tree)
 338
 339 fltFix1 locs (StAssign rep dst src) = panic "fltFix1: StAssign"
 340
 341 fltFix1 locs (StJump tree) = StJump (fltFix1 locs tree)
 342
 343 fltFix1 locs (StCondJump lbl tree) =
 344   StCondJump lbl (fltFix1 locs tree)
 345
 346 fltFix1 locs (StPrim op trees) =
 347   StPrim op (map (fltFix1 locs) trees)
 348
 349 fltFix1 locs (StCall f conv rep trees) =
 350   StCall f conv rep (map (fltFix1 locs) trees)
 351
 352 fltFix1 locs tree = tree
 353 \end{code}