Commit 6dd23e65 authored by ian@well-typed.com's avatar ian@well-typed.com
Browse files

Move some more constants into platformConstants

parent 43e09ac7
......@@ -239,7 +239,7 @@ emitLoadThreadState = do
(bWord dflags)),
-- SpLim = stack->stack + RESERVED_STACK_WORDS;
CmmAssign spLim (cmmOffsetW dflags (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_STACK dflags))
rESERVED_STACK_WORDS),
(rESERVED_STACK_WORDS dflags)),
-- HpAlloc = 0;
-- HpAlloc is assumed to be set to non-zero only by a failed
-- a heap check, see HeapStackCheck.cmm:GC_GENERIC
......
......@@ -315,7 +315,7 @@ loadThreadState dflags tso stack = do
mkAssign sp (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_SP dflags)) (bWord dflags)),
-- SpLim = stack->stack + RESERVED_STACK_WORDS;
mkAssign spLim (cmmOffsetW dflags (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_STACK dflags))
rESERVED_STACK_WORDS),
(rESERVED_STACK_WORDS dflags)),
openNursery dflags,
-- and load the current cost centre stack from the TSO when profiling:
if dopt Opt_SccProfilingOn dflags then
......
......@@ -139,7 +139,7 @@ data NcgImpl statics instr jumpDest = NcgImpl {
shortcutStatics :: (BlockId -> Maybe jumpDest) -> statics -> statics,
shortcutJump :: (BlockId -> Maybe jumpDest) -> instr -> instr,
pprNatCmmDecl :: NatCmmDecl statics instr -> SDoc,
maxSpillSlots :: Int,
maxSpillSlots :: DynFlags -> Int,
allocatableRegs :: Platform -> [RealReg],
ncg_x86fp_kludge :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
ncgExpandTop :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
......@@ -160,7 +160,7 @@ nativeCodeGen dflags h us cmms
,shortcutStatics = X86.Instr.shortcutStatics
,shortcutJump = X86.Instr.shortcutJump
,pprNatCmmDecl = X86.Ppr.pprNatCmmDecl
,maxSpillSlots = X86.Instr.maxSpillSlots (target32Bit platform)
,maxSpillSlots = X86.Instr.maxSpillSlots
,allocatableRegs = X86.Regs.allocatableRegs
,ncg_x86fp_kludge = id
,ncgExpandTop = id
......@@ -428,7 +428,7 @@ cmmNativeGen dflags ncgImpl us cmm count
$ Color.regAlloc
dflags
alloc_regs
(mkUniqSet [0 .. maxSpillSlots ncgImpl])
(mkUniqSet [0 .. maxSpillSlots ncgImpl dflags])
withLiveness
-- dump out what happened during register allocation
......
......@@ -13,6 +13,7 @@ where
import Reg
import BlockId
import DynFlags
import OldCmm
import Platform
......@@ -105,7 +106,7 @@ class Instruction instr where
-- | An instruction to spill a register into a spill slot.
mkSpillInstr
:: Platform
:: DynFlags
-> Reg -- ^ the reg to spill
-> Int -- ^ the current stack delta
-> Int -- ^ spill slot to use
......@@ -114,7 +115,7 @@ class Instruction instr where
-- | An instruction to reload a register from a spill slot.
mkLoadInstr
:: Platform
:: DynFlags
-> Reg -- ^ the reg to reload.
-> Int -- ^ the current stack delta
-> Int -- ^ the spill slot to use
......
......@@ -34,8 +34,8 @@ import RegClass
import Reg
import CodeGen.Platform
import Constants (rESERVED_C_STACK_BYTES)
import BlockId
import DynFlags
import OldCmm
import FastString
import CLabel
......@@ -355,14 +355,15 @@ ppc_patchJumpInstr insn patchF
-- | An instruction to spill a register into a spill slot.
ppc_mkSpillInstr
:: Platform
:: DynFlags
-> Reg -- register to spill
-> Int -- current stack delta
-> Int -- spill slot to use
-> Instr
ppc_mkSpillInstr platform reg delta slot
= let off = spillSlotToOffset slot
ppc_mkSpillInstr dflags reg delta slot
= let platform = targetPlatform dflags
off = spillSlotToOffset dflags slot
in
let sz = case targetClassOfReg platform reg of
RcInteger -> II32
......@@ -372,14 +373,15 @@ ppc_mkSpillInstr platform reg delta slot
ppc_mkLoadInstr
:: Platform
:: DynFlags
-> Reg -- register to load
-> Int -- current stack delta
-> Int -- spill slot to use
-> Instr
ppc_mkLoadInstr platform reg delta slot
= let off = spillSlotToOffset slot
ppc_mkLoadInstr dflags reg delta slot
= let platform = targetPlatform dflags
off = spillSlotToOffset dflags slot
in
let sz = case targetClassOfReg platform reg of
RcInteger -> II32
......@@ -391,20 +393,21 @@ ppc_mkLoadInstr platform reg delta slot
spillSlotSize :: Int
spillSlotSize = 8
maxSpillSlots :: Int
maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1
maxSpillSlots :: DynFlags -> Int
maxSpillSlots dflags
= ((rESERVED_C_STACK_BYTES dflags - 64) `div` spillSlotSize) - 1
-- convert a spill slot number to a *byte* offset, with no sign:
-- decide on a per arch basis whether you are spilling above or below
-- the C stack pointer.
spillSlotToOffset :: Int -> Int
spillSlotToOffset slot
| slot >= 0 && slot < maxSpillSlots
spillSlotToOffset :: DynFlags -> Int -> Int
spillSlotToOffset dflags slot
| slot >= 0 && slot < maxSpillSlots dflags
= 64 + spillSlotSize * slot
| otherwise
= pprPanic "spillSlotToOffset:"
( text "invalid spill location: " <> int slot
$$ text "maxSpillSlots: " <> int maxSpillSlots)
$$ text "maxSpillSlots: " <> int (maxSpillSlots dflags))
--------------------------------------------------------------------------------
......
......@@ -174,7 +174,7 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code
-- strip off liveness information,
-- and rewrite SPILL/RELOAD pseudos into real instructions along the way
let code_final = map (stripLive platform) code_spillclean
let code_final = map (stripLive dflags) code_spillclean
-- record what happened in this stage for debugging
let stat =
......
......@@ -18,6 +18,7 @@ where
import Reg
import RegClass
import DynFlags
import Panic
import Platform
......@@ -72,13 +73,13 @@ instance FR SPARC.FreeRegs where
frInitFreeRegs = SPARC.initFreeRegs
frReleaseReg = SPARC.releaseReg
maxSpillSlots :: Platform -> Int
maxSpillSlots platform
= case platformArch platform of
ArchX86 -> X86.Instr.maxSpillSlots True -- 32bit
ArchX86_64 -> X86.Instr.maxSpillSlots False -- not 32bit
ArchPPC -> PPC.Instr.maxSpillSlots
ArchSPARC -> SPARC.Instr.maxSpillSlots
maxSpillSlots :: DynFlags -> Int
maxSpillSlots dflags
= case platformArch (targetPlatform dflags) of
ArchX86 -> X86.Instr.maxSpillSlots dflags
ArchX86_64 -> X86.Instr.maxSpillSlots dflags
ArchPPC -> PPC.Instr.maxSpillSlots dflags
ArchSPARC -> SPARC.Instr.maxSpillSlots dflags
ArchARM _ _ _ -> panic "maxSpillSlots ArchARM"
ArchPPC_64 -> panic "maxSpillSlots ArchPPC_64"
ArchUnknown -> panic "maxSpillSlots ArchUnknown"
......
......@@ -344,10 +344,10 @@ makeMove delta vreg src dst
return $ mkRegRegMoveInstr platform (RegReal s) (RegReal d)
(InMem s, InReg d) ->
do recordSpill (SpillJoinRM vreg)
return $ mkLoadInstr platform (RegReal d) delta s
return $ mkLoadInstr dflags (RegReal d) delta s
(InReg s, InMem d) ->
do recordSpill (SpillJoinRM vreg)
return $ mkSpillInstr platform (RegReal s) delta d
return $ mkSpillInstr dflags (RegReal s) delta d
_ ->
-- we don't handle memory to memory moves.
-- they shouldn't happen because we don't share
......
......@@ -208,9 +208,8 @@ linearRegAlloc'
linearRegAlloc' dflags initFreeRegs first_id block_live sccs
= do us <- getUs
let platform = targetPlatform dflags
(_, _, stats, blocks) =
runR dflags emptyBlockMap initFreeRegs emptyRegMap (emptyStackMap platform) us
let (_, _, stats, blocks) =
runR dflags emptyBlockMap initFreeRegs emptyRegMap (emptyStackMap dflags) us
$ linearRA_SCCs first_id block_live [] sccs
return (blocks, stats)
......
......@@ -28,8 +28,8 @@ where
import RegAlloc.Linear.FreeRegs
import DynFlags
import Outputable
import Platform
import UniqFM
import Unique
......@@ -47,8 +47,8 @@ data StackMap
-- | An empty stack map, with all slots available.
emptyStackMap :: Platform -> StackMap
emptyStackMap platform = StackMap [0 .. maxSpillSlots platform] emptyUFM
emptyStackMap :: DynFlags -> StackMap
emptyStackMap dflags = StackMap [0 .. maxSpillSlots dflags] emptyUFM
-- | If this vreg unique already has a stack assignment then return the slot number,
......
......@@ -96,9 +96,9 @@ spillR :: Instruction instr
=> Reg -> Unique -> RegM freeRegs (instr, Int)
spillR reg temp = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack} ->
let platform = targetPlatform (ra_DynFlags s)
let dflags = ra_DynFlags s
(stack',slot) = getStackSlotFor stack temp
instr = mkSpillInstr platform reg delta slot
instr = mkSpillInstr dflags reg delta slot
in
(# s{ra_stack=stack'}, (instr,slot) #)
......@@ -107,8 +107,8 @@ loadR :: Instruction instr
=> Reg -> Int -> RegM freeRegs instr
loadR reg slot = RegM $ \ s@RA_State{ra_delta=delta} ->
let platform = targetPlatform (ra_DynFlags s)
in (# s, mkLoadInstr platform reg delta slot #)
let dflags = ra_DynFlags s
in (# s, mkLoadInstr dflags reg delta slot #)
getFreeRegsR :: RegM freeRegs freeRegs
getFreeRegsR = RegM $ \ s@RA_State{ra_freeregs = freeregs} ->
......
......@@ -39,6 +39,7 @@ import OldCmm hiding (RegSet)
import OldPprCmm()
import Digraph
import DynFlags
import Outputable
import Platform
import Unique
......@@ -461,11 +462,11 @@ slurpReloadCoalesce live
-- | Strip away liveness information, yielding NatCmmDecl
stripLive
:: (Outputable statics, Outputable instr, Instruction instr)
=> Platform
=> DynFlags
-> LiveCmmDecl statics instr
-> NatCmmDecl statics instr
stripLive platform live
stripLive dflags live
= stripCmm live
where stripCmm :: (Outputable statics, Outputable instr, Instruction instr)
......@@ -481,7 +482,7 @@ stripLive platform live
= partition ((== first_id) . blockId) final_blocks
in CmmProc info label
(ListGraph $ map (stripLiveBlock platform) $ first' : rest')
(ListGraph $ map (stripLiveBlock dflags) $ first' : rest')
-- procs used for stg_split_markers don't contain any blocks, and have no first_id.
stripCmm (CmmProc (LiveInfo info Nothing _ _) label [])
......@@ -496,11 +497,11 @@ stripLive platform live
stripLiveBlock
:: Instruction instr
=> Platform
=> DynFlags
-> LiveBasicBlock instr
-> NatBasicBlock instr
stripLiveBlock platform (BasicBlock i lis)
stripLiveBlock dflags (BasicBlock i lis)
= BasicBlock i instrs'
where (instrs', _)
......@@ -511,11 +512,11 @@ stripLiveBlock platform (BasicBlock i lis)
spillNat acc (LiveInstr (SPILL reg slot) _ : instrs)
= do delta <- get
spillNat (mkSpillInstr platform reg delta slot : acc) instrs
spillNat (mkSpillInstr dflags reg delta slot : acc) instrs
spillNat acc (LiveInstr (RELOAD slot reg) _ : instrs)
= do delta <- get
spillNat (mkLoadInstr platform reg delta slot : acc) instrs
spillNat (mkLoadInstr dflags reg delta slot : acc) instrs
spillNat acc (LiveInstr (Instr instr) _ : instrs)
| Just i <- takeDeltaInstr instr
......
......@@ -25,7 +25,7 @@ module SPARC.Base (
where
import qualified Constants
import DynFlags
import Panic
import Data.Int
......@@ -40,9 +40,9 @@ wordLengthInBits
= wordLength * 8
-- Size of the available spill area
spillAreaLength :: Int
spillAreaLength :: DynFlags -> Int
spillAreaLength
= Constants.rESERVED_C_STACK_BYTES
= rESERVED_C_STACK_BYTES
-- | We need 8 bytes because our largest registers are 64 bit.
spillSlotSize :: Int
......
......@@ -46,6 +46,7 @@ import Size
import CLabel
import CodeGen.Platform
import BlockId
import DynFlags
import OldCmm
import FastString
import FastBool
......@@ -372,15 +373,16 @@ sparc_patchJumpInstr insn patchF
-- | Make a spill instruction.
-- On SPARC we spill below frame pointer leaving 2 words/spill
sparc_mkSpillInstr
:: Platform
:: DynFlags
-> Reg -- ^ register to spill
-> Int -- ^ current stack delta
-> Int -- ^ spill slot to use
-> Instr
sparc_mkSpillInstr platform reg _ slot
= let off = spillSlotToOffset slot
off_w = 1 + (off `div` 4)
sparc_mkSpillInstr dflags reg _ slot
= let platform = targetPlatform dflags
off = spillSlotToOffset dflags slot
off_w = 1 + (off `div` 4)
sz = case targetClassOfReg platform reg of
RcInteger -> II32
RcFloat -> FF32
......@@ -392,14 +394,15 @@ sparc_mkSpillInstr platform reg _ slot
-- | Make a spill reload instruction.
sparc_mkLoadInstr
:: Platform
:: DynFlags
-> Reg -- ^ register to load into
-> Int -- ^ current stack delta
-> Int -- ^ spill slot to use
-> Instr
sparc_mkLoadInstr platform reg _ slot
= let off = spillSlotToOffset slot
sparc_mkLoadInstr dflags reg _ slot
= let platform = targetPlatform dflags
off = spillSlotToOffset dflags slot
off_w = 1 + (off `div` 4)
sz = case targetClassOfReg platform reg of
RcInteger -> II32
......
......@@ -20,6 +20,7 @@ import SPARC.Regs
import SPARC.Base
import SPARC.Imm
import DynFlags
import Outputable
-- | Get an AddrMode relative to the address in sp.
......@@ -42,15 +43,15 @@ fpRel n
-- | Convert a spill slot number to a *byte* offset, with no sign.
--
spillSlotToOffset :: Int -> Int
spillSlotToOffset slot
| slot >= 0 && slot < maxSpillSlots
spillSlotToOffset :: DynFlags -> Int -> Int
spillSlotToOffset dflags slot
| slot >= 0 && slot < maxSpillSlots dflags
= 64 + spillSlotSize * slot
| otherwise
= pprPanic "spillSlotToOffset:"
( text "invalid spill location: " <> int slot
$$ text "maxSpillSlots: " <> int maxSpillSlots)
$$ text "maxSpillSlots: " <> int (maxSpillSlots dflags))
-- | The maximum number of spill slots available on the C stack.
......@@ -59,7 +60,7 @@ spillSlotToOffset slot
-- Why do we reserve 64 bytes, instead of using the whole thing??
-- -- BL 2009/02/15
--
maxSpillSlots :: Int
maxSpillSlots
= ((spillAreaLength - 64) `div` spillSlotSize) - 1
maxSpillSlots :: DynFlags -> Int
maxSpillSlots dflags
= ((spillAreaLength dflags - 64) `div` spillSlotSize) - 1
......@@ -30,10 +30,10 @@ import FastString
import FastBool
import Outputable
import Platform
import Constants (rESERVED_C_STACK_BYTES)
import BasicTypes (Alignment)
import CLabel
import DynFlags
import UniqSet
import Unique
......@@ -613,14 +613,14 @@ x86_patchJumpInstr insn patchF
-- -----------------------------------------------------------------------------
-- | Make a spill instruction.
x86_mkSpillInstr
:: Platform
:: DynFlags
-> Reg -- register to spill
-> Int -- current stack delta
-> Int -- spill slot to use
-> Instr
x86_mkSpillInstr platform reg delta slot
= let off = spillSlotToOffset is32Bit slot
x86_mkSpillInstr dflags reg delta slot
= let off = spillSlotToOffset dflags slot
in
let off_w = (off - delta) `div` (if is32Bit then 4 else 8)
in case targetClassOfReg platform reg of
......@@ -629,18 +629,19 @@ x86_mkSpillInstr platform reg delta slot
RcDouble -> GST FF80 reg (spRel platform off_w) {- RcFloat/RcDouble -}
RcDoubleSSE -> MOV FF64 (OpReg reg) (OpAddr (spRel platform off_w))
_ -> panic "X86.mkSpillInstr: no match"
where is32Bit = target32Bit platform
where platform = targetPlatform dflags
is32Bit = target32Bit platform
-- | Make a spill reload instruction.
x86_mkLoadInstr
:: Platform
:: DynFlags
-> Reg -- register to load
-> Int -- current stack delta
-> Int -- spill slot to use
-> Instr
x86_mkLoadInstr platform reg delta slot
= let off = spillSlotToOffset is32Bit slot
x86_mkLoadInstr dflags reg delta slot
= let off = spillSlotToOffset dflags slot
in
let off_w = (off-delta) `div` (if is32Bit then 4 else 8)
in case targetClassOfReg platform reg of
......@@ -649,26 +650,28 @@ x86_mkLoadInstr platform reg delta slot
RcDouble -> GLD FF80 (spRel platform off_w) reg {- RcFloat/RcDouble -}
RcDoubleSSE -> MOV FF64 (OpAddr (spRel platform off_w)) (OpReg reg)
_ -> panic "X86.x86_mkLoadInstr"
where is32Bit = target32Bit platform
where platform = targetPlatform dflags
is32Bit = target32Bit platform
spillSlotSize :: Bool -> Int
spillSlotSize is32Bit = if is32Bit then 12 else 8
spillSlotSize :: DynFlags -> Int
spillSlotSize dflags = if is32Bit then 12 else 8
where is32Bit = target32Bit (targetPlatform dflags)
maxSpillSlots :: Bool -> Int
maxSpillSlots is32Bit
= ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize is32Bit) - 1
maxSpillSlots :: DynFlags -> Int
maxSpillSlots dflags
= ((rESERVED_C_STACK_BYTES dflags - 64) `div` spillSlotSize dflags) - 1
-- convert a spill slot number to a *byte* offset, with no sign:
-- decide on a per arch basis whether you are spilling above or below
-- the C stack pointer.
spillSlotToOffset :: Bool -> Int -> Int
spillSlotToOffset is32Bit slot
| slot >= 0 && slot < maxSpillSlots is32Bit
= 64 + spillSlotSize is32Bit * slot
spillSlotToOffset :: DynFlags -> Int -> Int
spillSlotToOffset dflags slot
| slot >= 0 && slot < maxSpillSlots dflags
= 64 + spillSlotSize dflags * slot
| otherwise
= pprPanic "spillSlotToOffset:"
( text "invalid spill location: " <> int slot
$$ text "maxSpillSlots: " <> int (maxSpillSlots is32Bit))
$$ text "maxSpillSlots: " <> int (maxSpillSlots dflags))
--------------------------------------------------------------------------------
......
......@@ -42,24 +42,6 @@ dOUBLE_SIZE = SIZEOF_DOUBLE
wORD64_SIZE :: Int
wORD64_SIZE = 8
-- This tells the native code generator the size of the spill
-- area is has available.
rESERVED_C_STACK_BYTES :: Int
rESERVED_C_STACK_BYTES = RESERVED_C_STACK_BYTES
-- The amount of (Haskell) stack to leave free for saving registers when
-- returning to the scheduler.
rESERVED_STACK_WORDS :: Int
rESERVED_STACK_WORDS = RESERVED_STACK_WORDS
-- Continuations that need more than this amount of stack should do their
-- own stack check (see bug #1466).
aP_STACK_SPLIM :: Int
aP_STACK_SPLIM = AP_STACK_SPLIM
-- Size of a word, in bytes
wORD_SIZE :: Int
......
......@@ -673,6 +673,16 @@ main(int argc, char *argv[])
constantInt("mAX_Real_Double_REG", MAX_REAL_DOUBLE_REG);
constantInt("mAX_Real_Long_REG", MAX_REAL_LONG_REG);
// This tells the native code generator the size of the spill
// area is has available.
constantInt("rESERVED_C_STACK_BYTES", RESERVED_C_STACK_BYTES);
// The amount of (Haskell) stack to leave free for saving registers when
// returning to the scheduler.
constantInt("rESERVED_STACK_WORDS", RESERVED_STACK_WORDS);
// Continuations that need more than this amount of stack should do their
// own stack check (see bug #1466).
constantInt("aP_STACK_SPLIM", AP_STACK_SPLIM);
switch (mode) {
case Gen_Haskell_Type:
printf(" } deriving (Read, Show)\n");
......
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