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