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