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 -- 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.
 232            -> case get_MagicId_reg_or_addr mid of
 233                  Left  realreg
 234                     -> StAssignReg pk reg (stixExpr_ConFold src)
 235                  Right baseRegAddr
 236                     -> stixStmt_ConFold
 237                           (StAssignMem pk baseRegAddr src)
 238         StAssignMem pk addr src
 239            -> StAssignMem pk (stixExpr_ConFold addr) (stixExpr_ConFold src)
 240         StVoidable expr
 241            -> StVoidable (stixExpr_ConFold expr)
 242         StJump dsts addr
 243            -> StJump dsts (stixExpr_ConFold addr)
 244         StCondJump addr test
 245            -> let test_opt = stixExpr_ConFold test
 246               in
 247               if  manifestlyZero test_opt
 248               then StComment (_PK_ ("deleted: " ++ showSDoc (pprStixStmt stmt)))
 249               else StCondJump addr (stixExpr_ConFold test)
 250         StData pk datas
 251            -> StData pk (map stixExpr_ConFold datas)
 252         other
 253            -> other
 254      where
 255         manifestlyZero (StInt 0) = True
 256         manifestlyZero other     = False
 257
 258 stixExpr_ConFold expr
 259    = case expr of
 260         StInd pk addr
 261            -> StInd pk (stixExpr_ConFold addr)
 262         StCall fn cconv pk args
 263            -> StCall fn cconv pk (map stixExpr_ConFold args)
 264         StIndex pk (StIndex pk' base off) off'
 265            -- Fold indices together when the types match:
 266            |  pk == pk'
 267            -> StIndex pk (stixExpr_ConFold base)
 268                          (stixExpr_ConFold (StMachOp MO_Nat_Add [off, off']))
 269         StIndex pk base off
 270            -> StIndex pk (stixExpr_ConFold base) (stixExpr_ConFold off)
 271
 272         StMachOp mop args
 273            -- For PrimOps, we first optimize the children, and then we try
 274            -- our hand at some constant-folding.
 275            -> stixMachOpFold mop (map stixExpr_ConFold args)
 276         StReg (StixMagicId mid)
 277            -- Replace register leaves with appropriate StixTrees for
 278            -- the given target.
 279            -> case get_MagicId_reg_or_addr mid of
 280                  Left  realreg -> expr
 281                  Right baseRegAddr
 282                     -> stixExpr_ConFold (StInd (magicIdPrimRep mid) baseRegAddr)
 283         other
 284            -> other
 285 \end{code}
 286
 287 Now, try to constant-fold the PrimOps.  The arguments have already
 288 been optimized and folded.
 289
 290 \begin{code}
 291 stixMachOpFold
 292     :: MachOp           -- The operation from an StMachOp
 293     -> [StixExpr]       -- The optimized arguments
 294     -> StixExpr
 295
 296 stixMachOpFold mop arg@[StInt x]
 297   = case mop of
 298         MO_NatS_Neg -> StInt (-x)
 299         other       -> StMachOp mop arg
 300
 301 stixMachOpFold mop args@[StInt x, StInt y]
 302   = case mop of
 303         MO_32U_Gt   -> StInt (if x > y  then 1 else 0)
 304         MO_32U_Ge   -> StInt (if x >= y then 1 else 0)
 305         MO_32U_Eq   -> StInt (if x == y then 1 else 0)
 306         MO_32U_Ne   -> StInt (if x /= y then 1 else 0)
 307         MO_32U_Lt   -> StInt (if x < y  then 1 else 0)
 308         MO_32U_Le   -> StInt (if x <= y then 1 else 0)
 309         MO_Nat_Add  -> StInt (x + y)
 310         MO_Nat_Sub  -> StInt (x - y)
 311         MO_NatS_Mul -> StInt (x * y)
 312         MO_NatS_Quot | y /= 0 -> StInt (x `quot` y)
 313         MO_NatS_Rem  | y /= 0 -> StInt (x `rem` y)
 314         MO_NatS_Gt  -> StInt (if x > y  then 1 else 0)
 315         MO_NatS_Ge  -> StInt (if x >= y then 1 else 0)
 316         MO_Nat_Eq   -> StInt (if x == y then 1 else 0)
 317         MO_Nat_Ne   -> StInt (if x /= y then 1 else 0)
 318         MO_NatS_Lt  -> StInt (if x < y  then 1 else 0)
 319         MO_NatS_Le  -> StInt (if x <= y then 1 else 0)
 320         MO_Nat_Shl  | y >= 0 && y < 32 -> do_shl x y
 321         other       -> StMachOp mop args
 322     where
 323        do_shl :: Integer -> Integer -> StixExpr
 324        do_shl v 0         = StInt v
 325        do_shl v n | n > 0 = do_shl (v*2) (n-1)
 326 \end{code}
 327
 328 When possible, shift the constants to the right-hand side, so that we
 329 can match for strength reductions.  Note that the code generator will
 330 also assume that constants have been shifted to the right when
 331 possible.
 332
 333 \begin{code}
 334 stixMachOpFold op [x@(StInt _), y] | isCommutableMachOp op
 335    = stixMachOpFold op [y, x]
 336 \end{code}
 337
 338 We can often do something with constants of 0 and 1 ...
 339
 340 \begin{code}
 341 stixMachOpFold mop args@[x, y@(StInt 0)]
 342   = case mop of
 343         MO_Nat_Add  -> x
 344         MO_Nat_Sub  -> x
 345         MO_NatS_Mul -> y
 346         MO_NatU_Mul -> y
 347         MO_Nat_And  -> y
 348         MO_Nat_Or   -> x
 349         MO_Nat_Xor  -> x
 350         MO_Nat_Shl  -> x
 351         MO_Nat_Shr  -> x
 352         MO_Nat_Sar  -> x
 353         MO_Nat_Ne | x_is_comparison -> x
 354         other       -> StMachOp mop args
 355     where
 356        x_is_comparison
 357           = case x of
 358                StMachOp mopp [_, _] -> isComparisonMachOp mopp
 359                _                    -> False
 360
 361 stixMachOpFold mop args@[x, y@(StInt 1)]
 362   = case mop of
 363         MO_NatS_Mul  -> x
 364         MO_NatU_Mul  -> x
 365         MO_NatS_Quot -> x
 366         MO_NatU_Quot -> x
 367         MO_NatS_Rem  -> StInt 0
 368         MO_NatU_Rem  -> StInt 0
 369         other        -> StMachOp mop args
 370 \end{code}
 371
 372 Now look for multiplication/division by powers of 2 (integers).
 373
 374 \begin{code}
 375 stixMachOpFold mop args@[x, y@(StInt n)]
 376   = case mop of
 377         MO_NatS_Mul
 378            -> case exactLog2 n of
 379                  Nothing -> unchanged
 380                  Just p  -> StMachOp MO_Nat_Shl [x, StInt p]
 381         MO_NatS_Quot
 382            -> case exactLog2 n of
 383                  Nothing -> unchanged
 384                  Just p  -> StMachOp MO_Nat_Shr [x, StInt p]
 385         other
 386            -> unchanged
 387     where
 388        unchanged = StMachOp mop args
 389 \end{code}
 390
 391 Anything else is just too hard.
 392
 393 \begin{code}
 394 stixMachOpFold mop args = StMachOp mop args
 395 \end{code}