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