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 (stix_sdoc, final_sdoc)
 131      where
 132         bind f x = x f
 133
 134         x86fp_kludge :: [Instr] -> [Instr]
 135         x86fp_kludge = IF_ARCH_i386(i386_insert_ffrees,id)
 136
 137         regAlloc :: InstrBlock -> [Instr]
 138         regAlloc = runRegAllocate allocatableRegs findReservedRegs
 139 \end{code}
 140
 141 Top level code generator for a chunk of stix code.  For this part of
 142 the computation, we switch from the UniqSM monad to the NatM monad.
 143 The latter carries not only a Unique, but also an Int denoting the
 144 current C stack pointer offset in the generated code; this is needed
 145 for creating correct spill offsets on architectures which don't offer,
 146 or for which it would be prohibitively expensive to employ, a frame
 147 pointer register.  Viz, x86.
 148
 149 The offset is measured in bytes, and indicates the difference between
 150 the current (simulated) C stack-ptr and the value it was at the
 151 beginning of the block.  For stacks which grow down, this value should
 152 be either zero or negative.
 153
 154 Switching between the two monads whilst carrying along the same Unique
 155 supply breaks abstraction.  Is that bad?
 156
 157 \begin{code}
 158 genMachCode :: [StixStmt] -> UniqSM InstrBlock
 159
 160 genMachCode stmts initial_us
 161   = let initial_st             = mkNatM_State initial_us 0
 162         (instr_list, final_st) = initNat initial_st (stmtsToInstrs stmts)
 163         final_us               = uniqOfNatM_State final_st
 164         final_delta            = deltaOfNatM_State final_st
 165     in
 166         if   final_delta == 0
 167         then (instr_list, final_us)
 168         else pprPanic "genMachCode: nonzero final delta"
 169                       (int final_delta)
 170 \end{code}
 171
 172 %************************************************************************
 173 %*                                                                      *
 174 \subsection[NCOpt]{The Generic Optimiser}
 175 %*                                                                      *
 176 %************************************************************************
 177
 178 This is called between translating Abstract C to its Tree and actually
 179 using the Native Code Generator to generate the annotations.  It's a
 180 chance to do some strength reductions.
 181
 182 ** Remember these all have to be machine independent ***
 183
 184 Note that constant-folding should have already happened, but we might
 185 have introduced some new opportunities for constant-folding wrt
 186 address manipulations.
 187
 188 \begin{code}
 189 genericOpt :: [StixStmt] -> [StixStmt]
 190 genericOpt = map stixStmt_ConFold . stixPeep
 191
 192
 193
 194 stixPeep :: [StixStmt] -> [StixStmt]
 195
 196 -- This transformation assumes that the temp assigned to in t1
 197 -- is not assigned to in t2; for otherwise the target of the
 198 -- second assignment would be substituted for, giving nonsense
 199 -- code.  As far as I can see, StixTemps are only ever assigned
 200 -- to once.  It would be nice to be sure!
 201
 202 stixPeep ( t1@(StAssignReg pka (StixTemp (StixVReg u pk)) rhs)
 203          : t2
 204          : ts )
 205    | stixStmt_CountTempUses u t2 == 1
 206      && sum (map (stixStmt_CountTempUses u) ts) == 0
 207    =
 208 #    ifdef NCG_DEBUG
 209      trace ("nativeGen: inlining " ++ showSDoc (pprStixExpr rhs))
 210 #    endif
 211            (stixPeep (stixStmt_Subst u rhs t2 : ts))
 212
 213 stixPeep (t1:t2:ts) = t1 : stixPeep (t2:ts)
 214 stixPeep [t1]       = [t1]
 215 stixPeep []         = []
 216 \end{code}
 217
 218 For most nodes, just optimize the children.
 219
 220 \begin{code}
 221 stixExpr_ConFold :: StixExpr -> StixExpr
 222 stixStmt_ConFold :: StixStmt -> StixStmt
 223
 224 stixStmt_ConFold stmt
 225    = case stmt of
 226         StAssignReg pk reg@(StixTemp _) src
 227            -> StAssignReg pk reg (stixExpr_ConFold src)
 228         StAssignReg pk reg@(StixMagicId mid) src
 229            -- Replace register leaves with appropriate StixTrees for
 230            -- the given target.
 231            -> case get_MagicId_reg_or_addr mid of
 232                  Left  realreg
 233                     -> StAssignReg pk reg (stixExpr_ConFold src)
 234                  Right baseRegAddr
 235                     -> stixStmt_ConFold
 236                           (StAssignMem pk baseRegAddr src)
 237         StAssignMem pk addr src
 238            -> StAssignMem pk (stixExpr_ConFold addr) (stixExpr_ConFold src)
 239         StAssignMachOp lhss mop args
 240            -> StAssignMachOp lhss mop (map stixExpr_ConFold args)
 241         StVoidable expr
 242            -> StVoidable (stixExpr_ConFold expr)
 243         StJump dsts addr
 244            -> StJump dsts (stixExpr_ConFold addr)
 245         StCondJump addr test
 246            -> let test_opt = stixExpr_ConFold test
 247               in
 248               if  manifestlyZero test_opt
 249               then StComment (_PK_ ("deleted: " ++ showSDoc (pprStixStmt stmt)))
 250               else StCondJump addr (stixExpr_ConFold test)
 251         StData pk datas
 252            -> StData pk (map stixExpr_ConFold datas)
 253         other
 254            -> other
 255      where
 256         manifestlyZero (StInt 0) = True
 257         manifestlyZero other     = False
 258
 259 stixExpr_ConFold expr
 260    = case expr of
 261         StInd pk addr
 262            -> StInd pk (stixExpr_ConFold addr)
 263         StCall fn cconv pk args
 264            -> StCall fn cconv pk (map stixExpr_ConFold args)
 265         StIndex pk (StIndex pk' base off) off'
 266            -- Fold indices together when the types match:
 267            |  pk == pk'
 268            -> StIndex pk (stixExpr_ConFold base)
 269                          (stixExpr_ConFold (StMachOp MO_Nat_Add [off, off']))
 270         StIndex pk base off
 271            -> StIndex pk (stixExpr_ConFold base) (stixExpr_ConFold off)
 272
 273         StMachOp mop args
 274            -- For PrimOps, we first optimize the children, and then we try
 275            -- our hand at some constant-folding.
 276            -> stixMachOpFold mop (map stixExpr_ConFold args)
 277         StReg (StixMagicId mid)
 278            -- Replace register leaves with appropriate StixTrees for
 279            -- the given target.
 280            -> case get_MagicId_reg_or_addr mid of
 281                  Left  realreg -> expr
 282                  Right baseRegAddr
 283                     -> stixExpr_ConFold (StInd (magicIdPrimRep mid) baseRegAddr)
 284         other
 285            -> other
 286 \end{code}
 287
 288 Now, try to constant-fold the PrimOps.  The arguments have already
 289 been optimized and folded.
 290
 291 \begin{code}
 292 stixMachOpFold
 293     :: MachOp           -- The operation from an StMachOp
 294     -> [StixExpr]       -- The optimized arguments
 295     -> StixExpr
 296
 297 stixMachOpFold mop arg@[StInt x]
 298   = case mop of
 299         MO_NatS_Neg -> StInt (-x)
 300         other       -> StMachOp mop arg
 301
 302 stixMachOpFold mop args@[StInt x, StInt y]
 303   = case mop of
 304         MO_32U_Gt   -> StInt (if x > y  then 1 else 0)
 305         MO_32U_Ge   -> StInt (if x >= y then 1 else 0)
 306         MO_32U_Eq   -> StInt (if x == y then 1 else 0)
 307         MO_32U_Ne   -> StInt (if x /= y then 1 else 0)
 308         MO_32U_Lt   -> StInt (if x < y  then 1 else 0)
 309         MO_32U_Le   -> StInt (if x <= y then 1 else 0)
 310         MO_Nat_Add  -> StInt (x + y)
 311         MO_Nat_Sub  -> StInt (x - y)
 312         MO_NatS_Mul -> StInt (x * y)
 313         MO_NatS_Quot | y /= 0 -> StInt (x `quot` y)
 314         MO_NatS_Rem  | y /= 0 -> StInt (x `rem` y)
 315         MO_NatS_Gt  -> StInt (if x > y  then 1 else 0)
 316         MO_NatS_Ge  -> StInt (if x >= y then 1 else 0)
 317         MO_Nat_Eq   -> StInt (if x == y then 1 else 0)
 318         MO_Nat_Ne   -> StInt (if x /= y then 1 else 0)
 319         MO_NatS_Lt  -> StInt (if x < y  then 1 else 0)
 320         MO_NatS_Le  -> StInt (if x <= y then 1 else 0)
 321         MO_Nat_Shl  | y >= 0 && y < 32 -> do_shl x y
 322         other       -> StMachOp mop args
 323     where
 324        do_shl :: Integer -> Integer -> StixExpr
 325        do_shl v 0         = StInt v
 326        do_shl v n | n > 0 = do_shl (v*2) (n-1)
 327 \end{code}
 328
 329 When possible, shift the constants to the right-hand side, so that we
 330 can match for strength reductions.  Note that the code generator will
 331 also assume that constants have been shifted to the right when
 332 possible.
 333
 334 \begin{code}
 335 stixMachOpFold op [x@(StInt _), y] | isCommutableMachOp op
 336    = stixMachOpFold op [y, x]
 337 \end{code}
 338
 339 We can often do something with constants of 0 and 1 ...
 340
 341 \begin{code}
 342 stixMachOpFold mop args@[x, y@(StInt 0)]
 343   = case mop of
 344         MO_Nat_Add  -> x
 345         MO_Nat_Sub  -> x
 346         MO_NatS_Mul -> y
 347         MO_NatU_Mul -> y
 348         MO_Nat_And  -> y
 349         MO_Nat_Or   -> x
 350         MO_Nat_Xor  -> x
 351         MO_Nat_Shl  -> x
 352         MO_Nat_Shr  -> x
 353         MO_Nat_Sar  -> x
 354         MO_Nat_Ne | x_is_comparison -> x
 355         other       -> StMachOp mop args
 356     where
 357        x_is_comparison
 358           = case x of
 359                StMachOp mopp [_, _] -> isComparisonMachOp mopp
 360                _                    -> False
 361
 362 stixMachOpFold mop args@[x, y@(StInt 1)]
 363   = case mop of
 364         MO_NatS_Mul  -> x
 365         MO_NatU_Mul  -> x
 366         MO_NatS_Quot -> x
 367         MO_NatU_Quot -> x
 368         MO_NatS_Rem  -> StInt 0
 369         MO_NatU_Rem  -> StInt 0
 370         other        -> StMachOp mop args
 371 \end{code}
 372
 373 Now look for multiplication/division by powers of 2 (integers).
 374
 375 \begin{code}
 376 stixMachOpFold mop args@[x, y@(StInt n)]
 377   = case mop of
 378         MO_NatS_Mul
 379            -> case exactLog2 n of
 380                  Nothing -> unchanged
 381                  Just p  -> StMachOp MO_Nat_Shl [x, StInt p]
 382         MO_NatS_Quot
 383            -> case exactLog2 n of
 384                  Nothing -> unchanged
 385                  Just p  -> StMachOp MO_Nat_Shr [x, StInt p]
 386         other
 387            -> unchanged
 388     where
 389        unchanged = StMachOp mop args
 390 \end{code}
 391
 392 Anything else is just too hard.
 393
 394 \begin{code}
 395 stixMachOpFold mop args = StMachOp mop args
 396 \end{code}