emitRODataLits, mkRODataLits,
emitIf, emitIfThenElse,
emitRtsCall, emitRtsCallWithVols, emitRtsCallWithResult,
- assignTemp, newTemp,
+ assignTemp, assignTemp_, newTemp,
emitSimultaneously,
emitSwitch, emitLitSwitch,
tagToClosure,
- callerSaveVolatileRegs, get_GlobalReg_addr,
+ callerSaves, callerSaveVolatileRegs, get_GlobalReg_addr,
+ activeStgRegs, fixStgRegisters,
cmmAndWord, cmmOrWord, cmmNegate, cmmEqWord, cmmNeWord,
- cmmUGtWord,
+ cmmUGtWord, cmmSubWord, cmmMulWord, cmmAddWord, cmmUShrWord,
cmmOffsetExprW, cmmOffsetExprB,
cmmRegOffW, cmmRegOffB,
cmmLabelOffW, cmmLabelOffB,
import IdInfo
import Constants
import SMRep
-import PprCmm ( {- instances -} )
-import Cmm
+import OldCmm
+import OldCmmUtils
import CLabel
-import CmmUtils
import ForeignCall
import ClosureInfo
import StgSyn (SRT(..))
cmmUGeWord e1 e2 = CmmMachOp mo_wordUGe [e1, e2]
cmmUGtWord e1 e2 = CmmMachOp mo_wordUGt [e1, e2]
--cmmShlWord e1 e2 = CmmMachOp mo_wordShl [e1, e2]
---cmmUShrWord e1 e2 = CmmMachOp mo_wordUShr [e1, e2]
+cmmUShrWord e1 e2 = CmmMachOp mo_wordUShr [e1, e2]
+cmmAddWord e1 e2 = CmmMachOp mo_wordAdd [e1, e2]
cmmSubWord e1 e2 = CmmMachOp mo_wordSub [e1, e2]
+cmmMulWord e1 e2 = CmmMachOp mo_wordMul [e1, e2]
cmmNegate :: CmmExpr -> CmmExpr
cmmNegate (CmmLit (CmmInt n rep)) = CmmLit (CmmInt (-n) rep)
: next
| otherwise = next
--- -----------------------------------------------------------------------------
--- Global registers
-
--- We map STG registers onto appropriate CmmExprs. Either they map
--- to real machine registers or stored as offsets from BaseReg. Given
--- a GlobalReg, get_GlobalReg_addr always produces the
--- register table address for it.
--- (See also get_GlobalReg_reg_or_addr in MachRegs)
-
-get_GlobalReg_addr :: GlobalReg -> CmmExpr
-get_GlobalReg_addr BaseReg = regTableOffset 0
-get_GlobalReg_addr mid = get_Regtable_addr_from_offset
- (globalRegType mid) (baseRegOffset mid)
-
--- Calculate a literal representing an offset into the register table.
--- Used when we don't have an actual BaseReg to offset from.
-regTableOffset n =
- CmmLit (CmmLabelOff mkMainCapabilityLabel (oFFSET_Capability_r + n))
-
-get_Regtable_addr_from_offset :: CmmType -> Int -> CmmExpr
-get_Regtable_addr_from_offset rep offset =
-#ifdef REG_Base
- CmmRegOff (CmmGlobal BaseReg) offset
-#else
- regTableOffset offset
-#endif
-
-- | Returns @True@ if this global register is stored in a caller-saves
-- machine register.
--
-------------------------------------------------------------------------
+-- | If the expression is trivial, return it. Otherwise, assign the
+-- expression to a temporary register and return an expression
+-- referring to this register.
assignTemp :: CmmExpr -> FCode CmmExpr
-- For a non-trivial expression, e, create a local
-- variable and assign the expression to it
; stmtC (CmmAssign (CmmLocal reg) e)
; return (CmmReg (CmmLocal reg)) }
+-- | If the expression is trivial and doesn't refer to a global
+-- register, return it. Otherwise, assign the expression to a
+-- temporary register and return an expression referring to this
+-- register.
+assignTemp_ :: CmmExpr -> FCode CmmExpr
+assignTemp_ e
+ | isTrivialCmmExpr e && hasNoGlobalRegs e = return e
+ | otherwise = do
+ reg <- newTemp (cmmExprType e)
+ stmtC (CmmAssign (CmmLocal reg) e)
+ return (CmmReg (CmmLocal reg))
+
newTemp :: CmmType -> FCode LocalReg
newTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep) }
case srt of NoC_SRT -> NoCafRefs
_ -> MayHaveCafRefs
clHasCafRefs (ConInfo {}) = NoCafRefs
+
+-- -----------------------------------------------------------------------------
+--
+-- STG/Cmm GlobalReg
+--
+-- -----------------------------------------------------------------------------
+
+-- | Here is where the STG register map is defined for each target arch.
+-- The order matters (for the llvm backend anyway)! We must make sure to
+-- maintain the order here with the order used in the LLVM calling conventions.
+-- Note that also, this isn't all registers, just the ones that are currently
+-- possbily mapped to real registers.
+activeStgRegs :: [GlobalReg]
+activeStgRegs = [
+#ifdef REG_Base
+ BaseReg
+#endif
+#ifdef REG_Sp
+ ,Sp
+#endif
+#ifdef REG_Hp
+ ,Hp
+#endif
+#ifdef REG_R1
+ ,VanillaReg 1 VGcPtr
+#endif
+#ifdef REG_R2
+ ,VanillaReg 2 VGcPtr
+#endif
+#ifdef REG_R3
+ ,VanillaReg 3 VGcPtr
+#endif
+#ifdef REG_R4
+ ,VanillaReg 4 VGcPtr
+#endif
+#ifdef REG_R5
+ ,VanillaReg 5 VGcPtr
+#endif
+#ifdef REG_R6
+ ,VanillaReg 6 VGcPtr
+#endif
+#ifdef REG_R7
+ ,VanillaReg 7 VGcPtr
+#endif
+#ifdef REG_R8
+ ,VanillaReg 8 VGcPtr
+#endif
+#ifdef REG_SpLim
+ ,SpLim
+#endif
+#ifdef REG_F1
+ ,FloatReg 1
+#endif
+#ifdef REG_F2
+ ,FloatReg 2
+#endif
+#ifdef REG_F3
+ ,FloatReg 3
+#endif
+#ifdef REG_F4
+ ,FloatReg 4
+#endif
+#ifdef REG_D1
+ ,DoubleReg 1
+#endif
+#ifdef REG_D2
+ ,DoubleReg 2
+#endif
+ ]
+
+-- | We map STG registers onto appropriate CmmExprs. Either they map
+-- to real machine registers or stored as offsets from BaseReg. Given
+-- a GlobalReg, get_GlobalReg_addr always produces the
+-- register table address for it.
+get_GlobalReg_addr :: GlobalReg -> CmmExpr
+get_GlobalReg_addr BaseReg = regTableOffset 0
+get_GlobalReg_addr mid = get_Regtable_addr_from_offset
+ (globalRegType mid) (baseRegOffset mid)
+
+-- Calculate a literal representing an offset into the register table.
+-- Used when we don't have an actual BaseReg to offset from.
+regTableOffset n =
+ CmmLit (CmmLabelOff mkMainCapabilityLabel (oFFSET_Capability_r + n))
+
+get_Regtable_addr_from_offset :: CmmType -> Int -> CmmExpr
+get_Regtable_addr_from_offset rep offset =
+#ifdef REG_Base
+ CmmRegOff (CmmGlobal BaseReg) offset
+#else
+ regTableOffset offset
+#endif
+
+-- | Fixup global registers so that they assign to locations within the
+-- RegTable if they aren't pinned for the current target.
+fixStgRegisters :: RawCmmTop -> RawCmmTop
+fixStgRegisters top@(CmmData _ _) = top
+
+fixStgRegisters (CmmProc info lbl (ListGraph blocks)) =
+ let blocks' = map fixStgRegBlock blocks
+ in CmmProc info lbl $ ListGraph blocks'
+
+fixStgRegBlock :: CmmBasicBlock -> CmmBasicBlock
+fixStgRegBlock (BasicBlock id stmts) =
+ let stmts' = map fixStgRegStmt stmts
+ in BasicBlock id stmts'
+
+fixStgRegStmt :: CmmStmt -> CmmStmt
+fixStgRegStmt stmt
+ = case stmt of
+ CmmAssign (CmmGlobal reg) src ->
+ let src' = fixStgRegExpr src
+ baseAddr = get_GlobalReg_addr reg
+ in case reg `elem` activeStgRegs of
+ True -> CmmAssign (CmmGlobal reg) src'
+ False -> CmmStore baseAddr src'
+
+ CmmAssign reg src ->
+ let src' = fixStgRegExpr src
+ in CmmAssign reg src'
+
+ CmmStore addr src -> CmmStore (fixStgRegExpr addr) (fixStgRegExpr src)
+
+ CmmCall target regs args srt returns ->
+ let target' = case target of
+ CmmCallee e conv -> CmmCallee (fixStgRegExpr e) conv
+ other -> other
+ args' = map (\(CmmHinted arg hint) ->
+ (CmmHinted (fixStgRegExpr arg) hint)) args
+ in CmmCall target' regs args' srt returns
+
+ CmmCondBranch test dest -> CmmCondBranch (fixStgRegExpr test) dest
+
+ CmmSwitch expr ids -> CmmSwitch (fixStgRegExpr expr) ids
+
+ CmmJump addr regs -> CmmJump (fixStgRegExpr addr) regs
+
+ -- CmmNop, CmmComment, CmmBranch, CmmReturn
+ _other -> stmt
+
+
+fixStgRegExpr :: CmmExpr -> CmmExpr
+fixStgRegExpr expr
+ = case expr of
+ CmmLoad addr ty -> CmmLoad (fixStgRegExpr addr) ty
+
+ CmmMachOp mop args -> CmmMachOp mop args'
+ where args' = map fixStgRegExpr args
+
+ CmmReg (CmmGlobal reg) ->
+ -- Replace register leaves with appropriate StixTrees for
+ -- the given target. MagicIds which map to a reg on this
+ -- arch are left unchanged. For the rest, BaseReg is taken
+ -- to mean the address of the reg table in MainCapability,
+ -- and for all others we generate an indirection to its
+ -- location in the register table.
+ case reg `elem` activeStgRegs of
+ True -> expr
+ False ->
+ let baseAddr = get_GlobalReg_addr reg
+ in case reg of
+ BaseReg -> fixStgRegExpr baseAddr
+ _other -> fixStgRegExpr
+ (CmmLoad baseAddr (globalRegType reg))
+
+ CmmRegOff (CmmGlobal reg) offset ->
+ -- RegOf leaves are just a shorthand form. If the reg maps
+ -- to a real reg, we keep the shorthand, otherwise, we just
+ -- expand it and defer to the above code.
+ case reg `elem` activeStgRegs of
+ True -> expr
+ False -> fixStgRegExpr (CmmMachOp (MO_Add wordWidth) [
+ CmmReg (CmmGlobal reg),
+ CmmLit (CmmInt (fromIntegral offset)
+ wordWidth)])
+
+ -- CmmLit, CmmReg (CmmLocal), CmmStackSlot
+ _other -> expr
+
projects / ghc-hetmet.git / blobdiff