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