+ target = CmmCallee fun_expr CCallConv
+ fun_expr = mkLblExpr (mkCmmCodeLabel pkg fun)
+
+-----------------------------------------------------------------------------
+--
+-- Caller-Save Registers
+--
+-----------------------------------------------------------------------------
+
+-- Here we generate the sequence of saves/restores required around a
+-- foreign call instruction.
+
+-- TODO: reconcile with includes/Regs.h
+-- * Regs.h claims that BaseReg should be saved last and loaded first
+-- * This might not have been tickled before since BaseReg is callee save
+-- * Regs.h saves SparkHd, ParkT1, SparkBase and SparkLim
+callerSaveVolatileRegs :: Maybe [GlobalReg] -> ([CmmStmt], [CmmStmt])
+callerSaveVolatileRegs vols = (caller_save, caller_load)
+ where
+ caller_save = foldr ($!) [] (map callerSaveGlobalReg regs_to_save)
+ caller_load = foldr ($!) [] (map callerRestoreGlobalReg regs_to_save)
+
+ system_regs = [Sp,SpLim,Hp,HpLim,CurrentTSO,CurrentNursery,
+ {-SparkHd,SparkTl,SparkBase,SparkLim,-}BaseReg ]
+
+ regs_to_save = system_regs ++ vol_list
+
+ vol_list = case vols of Nothing -> all_of_em; Just regs -> regs
+
+ all_of_em = [ VanillaReg n VNonGcPtr | n <- [0..mAX_Vanilla_REG] ]
+ -- The VNonGcPtr is a lie, but I don't think it matters
+ ++ [ FloatReg n | n <- [0..mAX_Float_REG] ]
+ ++ [ DoubleReg n | n <- [0..mAX_Double_REG] ]
+ ++ [ LongReg n | n <- [0..mAX_Long_REG] ]
+
+ callerSaveGlobalReg reg next
+ | callerSaves reg =
+ CmmStore (get_GlobalReg_addr reg)
+ (CmmReg (CmmGlobal reg)) : next
+ | otherwise = next
+
+ callerRestoreGlobalReg reg next
+ | callerSaves reg =
+ CmmAssign (CmmGlobal reg)
+ (CmmLoad (get_GlobalReg_addr reg) (globalRegType reg))
+ : next
+ | otherwise = next
+
+
+-- | Returns @True@ if this global register is stored in a caller-saves
+-- machine register.
+
+callerSaves :: GlobalReg -> Bool
+
+#ifdef CALLER_SAVES_Base
+callerSaves BaseReg = True
+#endif
+#ifdef CALLER_SAVES_R1
+callerSaves (VanillaReg 1 _) = True
+#endif
+#ifdef CALLER_SAVES_R2
+callerSaves (VanillaReg 2 _) = True
+#endif
+#ifdef CALLER_SAVES_R3
+callerSaves (VanillaReg 3 _) = True
+#endif
+#ifdef CALLER_SAVES_R4
+callerSaves (VanillaReg 4 _) = True
+#endif
+#ifdef CALLER_SAVES_R5
+callerSaves (VanillaReg 5 _) = True
+#endif
+#ifdef CALLER_SAVES_R6
+callerSaves (VanillaReg 6 _) = True
+#endif
+#ifdef CALLER_SAVES_R7
+callerSaves (VanillaReg 7 _) = True
+#endif
+#ifdef CALLER_SAVES_R8
+callerSaves (VanillaReg 8 _) = True
+#endif
+#ifdef CALLER_SAVES_F1
+callerSaves (FloatReg 1) = True
+#endif
+#ifdef CALLER_SAVES_F2
+callerSaves (FloatReg 2) = True
+#endif
+#ifdef CALLER_SAVES_F3
+callerSaves (FloatReg 3) = True
+#endif
+#ifdef CALLER_SAVES_F4
+callerSaves (FloatReg 4) = True
+#endif
+#ifdef CALLER_SAVES_D1
+callerSaves (DoubleReg 1) = True
+#endif
+#ifdef CALLER_SAVES_D2
+callerSaves (DoubleReg 2) = True
+#endif
+#ifdef CALLER_SAVES_L1
+callerSaves (LongReg 1) = True
+#endif
+#ifdef CALLER_SAVES_Sp
+callerSaves Sp = True
+#endif
+#ifdef CALLER_SAVES_SpLim
+callerSaves SpLim = True
+#endif
+#ifdef CALLER_SAVES_Hp
+callerSaves Hp = True
+#endif
+#ifdef CALLER_SAVES_HpLim
+callerSaves HpLim = True
+#endif
+#ifdef CALLER_SAVES_CurrentTSO
+callerSaves CurrentTSO = True
+#endif
+#ifdef CALLER_SAVES_CurrentNursery
+callerSaves CurrentNursery = True
+#endif
+callerSaves _ = False
+
+
+-- -----------------------------------------------------------------------------
+-- Information about global registers
+
+baseRegOffset :: GlobalReg -> Int
+
+baseRegOffset (VanillaReg 1 _) = oFFSET_StgRegTable_rR1
+baseRegOffset (VanillaReg 2 _) = oFFSET_StgRegTable_rR2
+baseRegOffset (VanillaReg 3 _) = oFFSET_StgRegTable_rR3
+baseRegOffset (VanillaReg 4 _) = oFFSET_StgRegTable_rR4
+baseRegOffset (VanillaReg 5 _) = oFFSET_StgRegTable_rR5
+baseRegOffset (VanillaReg 6 _) = oFFSET_StgRegTable_rR6
+baseRegOffset (VanillaReg 7 _) = oFFSET_StgRegTable_rR7
+baseRegOffset (VanillaReg 8 _) = oFFSET_StgRegTable_rR8
+baseRegOffset (VanillaReg 9 _) = oFFSET_StgRegTable_rR9
+baseRegOffset (VanillaReg 10 _) = oFFSET_StgRegTable_rR10
+baseRegOffset (FloatReg 1) = oFFSET_StgRegTable_rF1
+baseRegOffset (FloatReg 2) = oFFSET_StgRegTable_rF2
+baseRegOffset (FloatReg 3) = oFFSET_StgRegTable_rF3
+baseRegOffset (FloatReg 4) = oFFSET_StgRegTable_rF4
+baseRegOffset (DoubleReg 1) = oFFSET_StgRegTable_rD1
+baseRegOffset (DoubleReg 2) = oFFSET_StgRegTable_rD2
+baseRegOffset Sp = oFFSET_StgRegTable_rSp
+baseRegOffset SpLim = oFFSET_StgRegTable_rSpLim
+baseRegOffset (LongReg 1) = oFFSET_StgRegTable_rL1
+baseRegOffset Hp = oFFSET_StgRegTable_rHp
+baseRegOffset HpLim = oFFSET_StgRegTable_rHpLim
+baseRegOffset CurrentTSO = oFFSET_StgRegTable_rCurrentTSO
+baseRegOffset CurrentNursery = oFFSET_StgRegTable_rCurrentNursery
+baseRegOffset HpAlloc = oFFSET_StgRegTable_rHpAlloc
+baseRegOffset EagerBlackholeInfo = oFFSET_stgEagerBlackholeInfo
+baseRegOffset GCEnter1 = oFFSET_stgGCEnter1
+baseRegOffset GCFun = oFFSET_stgGCFun
+baseRegOffset BaseReg = panic "baseRegOffset:BaseReg"
+baseRegOffset _ = panic "baseRegOffset:other"