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