summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/codeGen/CgForeignCall.hs2
-rw-r--r--compiler/codeGen/StgCmmForeign.hs2
-rw-r--r--compiler/nativeGen/AsmCodeGen.lhs6
-rw-r--r--compiler/nativeGen/Instruction.hs5
-rw-r--r--compiler/nativeGen/PPC/Instr.hs29
-rw-r--r--compiler/nativeGen/RegAlloc/Graph/Main.hs2
-rw-r--r--compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs15
-rw-r--r--compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs4
-rw-r--r--compiler/nativeGen/RegAlloc/Linear/Main.hs5
-rw-r--r--compiler/nativeGen/RegAlloc/Linear/StackMap.hs6
-rw-r--r--compiler/nativeGen/RegAlloc/Linear/State.hs8
-rw-r--r--compiler/nativeGen/RegAlloc/Liveness.hs15
-rw-r--r--compiler/nativeGen/SPARC/Base.hs6
-rw-r--r--compiler/nativeGen/SPARC/Instr.hs17
-rw-r--r--compiler/nativeGen/SPARC/Stack.hs15
-rw-r--r--compiler/nativeGen/X86/Instr.hs41
-rw-r--r--includes/HaskellConstants.hs18
-rw-r--r--includes/mkDerivedConstants.c10
18 files changed, 105 insertions, 101 deletions
diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index 0afa3c6915..435fbb0558 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -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
diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs
index 499c22b552..ca5f49794b 100644
--- a/compiler/codeGen/StgCmmForeign.hs
+++ b/compiler/codeGen/StgCmmForeign.hs
@@ -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
diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 1493a40a6b..8c608f1bf1 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -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
diff --git a/compiler/nativeGen/Instruction.hs b/compiler/nativeGen/Instruction.hs
index 292cf82f6a..64ba32c6dc 100644
--- a/compiler/nativeGen/Instruction.hs
+++ b/compiler/nativeGen/Instruction.hs
@@ -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
diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs
index 1af08a6076..464a88a08b 100644
--- a/compiler/nativeGen/PPC/Instr.hs
+++ b/compiler/nativeGen/PPC/Instr.hs
@@ -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))
--------------------------------------------------------------------------------
diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs
index 32b5e41402..1611a710fb 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs
@@ -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 =
diff --git a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
index 4a5af75ce8..fffdef761b 100644
--- a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
@@ -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"
diff --git a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
index 69bd8a7a0e..6294743c48 100644
--- a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs
@@ -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
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index 8b8afd05af..3f92ed975b 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -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)
diff --git a/compiler/nativeGen/RegAlloc/Linear/StackMap.hs b/compiler/nativeGen/RegAlloc/Linear/StackMap.hs
index ea05cf0d0f..b1fc3c169e 100644
--- a/compiler/nativeGen/RegAlloc/Linear/StackMap.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/StackMap.hs
@@ -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,
diff --git a/compiler/nativeGen/RegAlloc/Linear/State.hs b/compiler/nativeGen/RegAlloc/Linear/State.hs
index 81b97ead9c..a608a947e7 100644
--- a/compiler/nativeGen/RegAlloc/Linear/State.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/State.hs
@@ -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} ->
diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index 2483e12213..ac58944f1c 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -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
diff --git a/compiler/nativeGen/SPARC/Base.hs b/compiler/nativeGen/SPARC/Base.hs
index de11b9f77c..aa7b057e69 100644
--- a/compiler/nativeGen/SPARC/Base.hs
+++ b/compiler/nativeGen/SPARC/Base.hs
@@ -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
diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs
index 021b2fb772..9404badea6 100644
--- a/compiler/nativeGen/SPARC/Instr.hs
+++ b/compiler/nativeGen/SPARC/Instr.hs
@@ -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
diff --git a/compiler/nativeGen/SPARC/Stack.hs b/compiler/nativeGen/SPARC/Stack.hs
index 7f75693889..65dfef0e25 100644
--- a/compiler/nativeGen/SPARC/Stack.hs
+++ b/compiler/nativeGen/SPARC/Stack.hs
@@ -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
diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs
index a2263b3116..50f5b4c874 100644
--- a/compiler/nativeGen/X86/Instr.hs
+++ b/compiler/nativeGen/X86/Instr.hs
@@ -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))
--------------------------------------------------------------------------------
diff --git a/includes/HaskellConstants.hs b/includes/HaskellConstants.hs
index a0b9d76c19..cda719204d 100644
--- a/includes/HaskellConstants.hs
+++ b/includes/HaskellConstants.hs
@@ -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
diff --git a/includes/mkDerivedConstants.c b/includes/mkDerivedConstants.c
index a9485815d9..609c7aed31 100644
--- a/includes/mkDerivedConstants.c
+++ b/includes/mkDerivedConstants.c
@@ -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");
View Lorry Controller Status