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