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