Commit 95e67967 authored by Michael D. Adams's avatar Michael D. Adams
Browse files

Factor 'callerSaveVolatileRegs' out of the NCG and into CgUtil

This is needed because CgForeign and parts of the CPS pass now use
'callerSaveVolatileRegs' and not all platforms have access to the NCG.
parent 163efd68
......@@ -18,6 +18,7 @@ import CmmUtils
import CLabel
import MachOp (MachHint(..))
import CgUtils (callerSaveVolatileRegs)
import ClosureInfo
import Maybes
......@@ -27,12 +28,6 @@ import UniqSupply
import Unique
import UniqFM
import MachRegs (callerSaveVolatileRegs)
-- HACK: this is part of the NCG so we shouldn't use this, but we need
-- it for now to eliminate the need for saved regs to be in CmmCall.
-- The long term solution is to factor callerSaveVolatileRegs
-- from nativeGen into codeGen
-- This module takes a 'CmmBasicBlock' which might have 'CmmCall'
-- statements in it with 'CmmSafe' set and breaks it up at each such call.
-- It also collects information about the block for later use
......
......@@ -17,7 +17,6 @@ import CmmCallConv
import CgProf (curCCS, curCCSAddr)
import CgUtils (cmmOffsetW)
import CgInfoTbls (entryCode)
import SMRep
import ForeignCall
......@@ -29,12 +28,6 @@ import List
import Panic
import MachRegs (callerSaveVolatileRegs)
-- HACK: this is part of the NCG so we shouldn't use this, but we need
-- it for now to eliminate the need for saved regs to be in CmmCall.
-- The long term solution is to factor callerSaveVolatileRegs
-- from nativeGen into CPS
-- The format for the call to a continuation
-- The fst is the arguments that must be passed to the continuation
-- by the continuation's caller.
......
......@@ -37,12 +37,6 @@ import Constants
import StaticFlags
import Outputable
import MachRegs (callerSaveVolatileRegs)
-- HACK: this is part of the NCG so we shouldn't use this, but we need
-- it for now to eliminate the need for saved regs to be in CmmCall.
-- The long term solution is to factor callerSaveVolatileRegs
-- from nativeGen into codeGen
import Control.Monad
-- -----------------------------------------------------------------------------
......
......@@ -19,6 +19,8 @@ module CgUtils (
emitSwitch, emitLitSwitch,
tagToClosure,
callerSaveVolatileRegs, get_GlobalReg_addr,
cmmAndWord, cmmOrWord, cmmNegate, cmmEqWord, cmmNeWord,
cmmOffsetExprW, cmmOffsetExprB,
cmmRegOffW, cmmRegOffB,
......@@ -37,6 +39,7 @@ module CgUtils (
) where
#include "HsVersions.h"
#include "MachRegs.h"
import CgMonad
import TyCon
......@@ -60,12 +63,6 @@ import FastString
import PackageConfig
import Outputable
import MachRegs (callerSaveVolatileRegs)
-- HACK: this is part of the NCG so we shouldn't use this, but we need
-- it for now to eliminate the need for saved regs to be in CmmCall.
-- The long term solution is to factor callerSaveVolatileRegs
-- from nativeGen into codeGen
import Data.Char
import Data.Bits
import Data.Word
......@@ -302,6 +299,188 @@ emitRtsCall' res fun args vols safe = do
target = CmmForeignCall fun_expr CCallConv
fun_expr = mkLblExpr (mkRtsCodeLabel 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 | n <- [0..mAX_Vanilla_REG] ]
++ [ 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) (globalRegRep reg))
: 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
(globalRegRep 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 :: MachRep -> 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.
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 GCEnter1 = oFFSET_stgGCEnter1
baseRegOffset GCFun = oFFSET_stgGCFun
#ifdef DEBUG
baseRegOffset BaseReg = panic "baseRegOffset:BaseReg"
baseRegOffset _ = panic "baseRegOffset:other"
#endif
-------------------------------------------------------------------------
--
......
......@@ -33,7 +33,6 @@ module MachRegs (
-- * Global registers
get_GlobalReg_reg_or_addr,
callerSaves, callerSaveVolatileRegs,
-- * Machine-dependent register-related stuff
allocatableRegs, argRegs, allArgRegs, callClobberedRegs,
......@@ -82,10 +81,11 @@ module MachRegs (
-- HACK: go for the max
#endif
#include "../includes/MachRegs.h"
#include "MachRegs.h"
import Cmm
import MachOp ( MachRep(..) )
import CgUtils ( get_GlobalReg_addr )
import CLabel ( CLabel, mkMainCapabilityLabel )
import Pretty
......@@ -310,75 +310,16 @@ ripRel imm = AddrBaseIndex EABaseRip EAIndexNone imm
-- 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_reg_or_addr produces either the real
-- register it is in, on this platform, or a StixExpr denoting the
-- address in the register table holding it. get_MagicId_addr always
-- produces the register table address for it.
-- register it is in, on this platform, or a CmmExpr denoting the
-- address in the register table holding it.
-- (See also get_GlobalReg_addr in CgUtils.)
get_GlobalReg_reg_or_addr :: GlobalReg -> Either Reg CmmExpr
get_GlobalReg_addr :: GlobalReg -> CmmExpr
get_Regtable_addr_from_offset :: MachRep -> Int -> CmmExpr
get_GlobalReg_reg_or_addr mid
= case globalRegMaybe mid of
Just rr -> Left rr
Nothing -> Right (get_GlobalReg_addr mid)
get_GlobalReg_addr BaseReg = regTableOffset 0
get_GlobalReg_addr mid = get_Regtable_addr_from_offset
(globalRegRep 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 rep offset
= case globalRegMaybe BaseReg of
Nothing -> regTableOffset offset
Just _ -> CmmRegOff (CmmGlobal BaseReg) offset
-- -----------------------------------------------------------------------------
-- 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 | n <- [0..mAX_Vanilla_REG] ]
++ [ 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) (globalRegRep reg))
: next
| otherwise = next
-- ---------------------------------------------------------------------------
-- Registers
......@@ -1238,117 +1179,6 @@ freeReg REG_HpLim = fastBool False
freeReg n = fastBool True
-- -----------------------------------------------------------------------------
-- 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 GCEnter1 = oFFSET_stgGCEnter1
baseRegOffset GCFun = oFFSET_stgGCFun
#ifdef DEBUG
baseRegOffset BaseReg = panic "baseRegOffset:BaseReg"
baseRegOffset _ = panic "baseRegOffset:other"
#endif
-- | 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
-- | Returns 'Nothing' if this global register is not stored
-- in a real machine register, otherwise returns @'Just' reg@, where
-- reg is the machine register it is stored in.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment