summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/cmm/SMRep.lhs4
-rw-r--r--compiler/codeGen/CgForeignCall.hs2
-rw-r--r--compiler/codeGen/CgHeapery.lhs22
-rw-r--r--compiler/codeGen/StgCmmForeign.hs2
-rw-r--r--compiler/main/DynFlags.hs6
-rw-r--r--includes/HaskellConstants.hs20
-rw-r--r--includes/mkDerivedConstants.c43
7 files changed, 46 insertions, 53 deletions
diff --git a/compiler/cmm/SMRep.lhs b/compiler/cmm/SMRep.lhs
index 95a5d38194..79e19105a9 100644
--- a/compiler/cmm/SMRep.lhs
+++ b/compiler/cmm/SMRep.lhs
@@ -219,13 +219,13 @@ isStaticNoCafCon _ = False
-- | Size of a closure header (StgHeader in includes/rts/storage/Closures.h)
fixedHdrSize :: DynFlags -> WordOff
-fixedHdrSize dflags = sTD_HDR_SIZE + profHdrSize dflags
+fixedHdrSize dflags = sTD_HDR_SIZE dflags + profHdrSize dflags
-- | Size of the profiling part of a closure header
-- (StgProfHeader in includes/rts/storage/Closures.h)
profHdrSize :: DynFlags -> WordOff
profHdrSize dflags
- | dopt Opt_SccProfilingOn dflags = pROF_HDR_SIZE
+ | dopt Opt_SccProfilingOn dflags = pROF_HDR_SIZE dflags
| otherwise = 0
-- | The garbage collector requires that every closure is at least as
diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index 977c4e1583..0afa3c6915 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -267,7 +267,7 @@ emitOpenNursery =
(CmmMachOp (mo_wordMul dflags) [
CmmMachOp (MO_SS_Conv W32 (wordWidth dflags))
[CmmLoad (nursery_bdescr_blocks dflags) b32],
- mkIntExpr dflags bLOCK_SIZE
+ mkIntExpr dflags (bLOCK_SIZE dflags)
])
(-1)
)
diff --git a/compiler/codeGen/CgHeapery.lhs b/compiler/codeGen/CgHeapery.lhs
index e37783cf11..f3cb7796f4 100644
--- a/compiler/codeGen/CgHeapery.lhs
+++ b/compiler/codeGen/CgHeapery.lhs
@@ -452,20 +452,18 @@ do_checks :: WordOff -- Stack headroom
-> Code
do_checks 0 0 _ _ _ = nopC
-do_checks _ hp _ _ _
- | hp > bLOCKS_PER_MBLOCK * bLOCK_SIZE_W
- = sorry (unlines [
- "Trying to allocate more than " ++ show (bLOCKS_PER_MBLOCK * bLOCK_SIZE) ++ " bytes.",
- "",
- "See: http://hackage.haskell.org/trac/ghc/ticket/4505",
- "Suggestion: read data from a file instead of having large static data",
- "structures in the code."])
-
do_checks stk hp reg_save_code rts_lbl live
= do dflags <- getDynFlags
- do_checks' (mkIntExpr dflags (stk*wORD_SIZE))
- (mkIntExpr dflags (hp*wORD_SIZE))
- (stk /= 0) (hp /= 0) reg_save_code rts_lbl live
+ if hp > bLOCKS_PER_MBLOCK dflags * bLOCK_SIZE_W dflags
+ then sorry (unlines [
+ "Trying to allocate more than " ++ show (bLOCKS_PER_MBLOCK dflags * bLOCK_SIZE dflags) ++ " bytes.",
+ "",
+ "See: http://hackage.haskell.org/trac/ghc/ticket/4505",
+ "Suggestion: read data from a file instead of having large static data",
+ "structures in the code."])
+ else do_checks' (mkIntExpr dflags (stk * wORD_SIZE))
+ (mkIntExpr dflags (hp * wORD_SIZE))
+ (stk /= 0) (hp /= 0) reg_save_code rts_lbl live
-- The offsets are now in *bytes*
do_checks' :: CmmExpr -> CmmExpr -> Bool -> Bool -> CmmStmts -> CmmExpr
diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs
index 9523a11b1c..499c22b552 100644
--- a/compiler/codeGen/StgCmmForeign.hs
+++ b/compiler/codeGen/StgCmmForeign.hs
@@ -340,7 +340,7 @@ openNursery dflags = catAGraphs [
(CmmMachOp (mo_wordMul dflags) [
CmmMachOp (MO_SS_Conv W32 (wordWidth dflags))
[CmmLoad (nursery_bdescr_blocks dflags) b32],
- mkIntExpr dflags bLOCK_SIZE
+ mkIntExpr dflags (bLOCK_SIZE dflags)
])
(-1)
)
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 15ef065d53..6cb99f87c7 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -118,6 +118,7 @@ module DynFlags (
tracingDynFlags,
#include "../includes/dist-derivedconstants/header/GHCConstantsHaskellExports.hs"
+ bLOCK_SIZE_W,
) where
#include "HsVersions.h"
@@ -130,7 +131,7 @@ import {-# SOURCE #-} Packages (PackageState)
import DriverPhases ( Phase(..), phaseInputExt )
import Config
import CmdLineParser
-import Constants ( mAX_CONTEXT_REDUCTION_DEPTH )
+import Constants
import Panic
import Util
import Maybes ( orElse )
@@ -3145,3 +3146,6 @@ compilerInfo dflags
#include "../includes/dist-derivedconstants/header/GHCConstantsHaskellType.hs"
#include "../includes/dist-derivedconstants/header/GHCConstantsHaskellWrappers.hs"
+bLOCK_SIZE_W :: DynFlags -> Int
+bLOCK_SIZE_W dflags = bLOCK_SIZE dflags `quot` wORD_SIZE
+
diff --git a/includes/HaskellConstants.hs b/includes/HaskellConstants.hs
index c9d417349e..a0b9d76c19 100644
--- a/includes/HaskellConstants.hs
+++ b/includes/HaskellConstants.hs
@@ -34,14 +34,6 @@ mAX_CONTEXT_REDUCTION_DEPTH :: Int
mAX_CONTEXT_REDUCTION_DEPTH = 200
-- Increase to 200; see Trac #5395
--- Closure header sizes.
-
-sTD_HDR_SIZE :: Int
-sTD_HDR_SIZE = STD_HDR_SIZE
-
-pROF_HDR_SIZE :: Int
-pROF_HDR_SIZE = PROF_HDR_SIZE
-
-- Size of a double in StgWords.
dOUBLE_SIZE :: Int
@@ -118,18 +110,6 @@ cLONG_SIZE = SIZEOF_LONG
cLONG_LONG_SIZE :: Int
cLONG_LONG_SIZE = SIZEOF_LONG_LONG
--- Size of a storage manager block (in bytes).
-
-bLOCK_SIZE :: Int
-bLOCK_SIZE = BLOCK_SIZE
-bLOCK_SIZE_W :: Int
-bLOCK_SIZE_W = bLOCK_SIZE `quot` wORD_SIZE
-
--- blocks that fit in an MBlock, leaving space for the block descriptors
-
-bLOCKS_PER_MBLOCK :: Int
-bLOCKS_PER_MBLOCK = BLOCKS_PER_MBLOCK
-
-- Number of bits to shift a bitfield left by in an info table.
bITMAP_BITS_SHIFT :: Int
diff --git a/includes/mkDerivedConstants.c b/includes/mkDerivedConstants.c
index 5b71a1b900..a9485815d9 100644
--- a/includes/mkDerivedConstants.c
+++ b/includes/mkDerivedConstants.c
@@ -293,7 +293,7 @@ enum Mode { Gen_Haskell_Type, Gen_Haskell_Value, Gen_Haskell_Wrappers, Gen_Haske
#define FUN_OFFSET(sym) (OFFSET(Capability,f.sym) - OFFSET(Capability,r))
-void constantInt(char *name, intptr_t val) {
+void constantIntC(char *cName, char *haskellName, intptr_t val) {
/* If the value is larger than 2^28 or smaller than -2^28, then fail.
This test is a bit conservative, but if any constants are roughly
maxBoun or minBound then we probably need them to be Integer
@@ -310,24 +310,31 @@ void constantInt(char *name, intptr_t val) {
switch (mode) {
case Gen_Haskell_Type:
- printf(" , pc_%s :: Int\n", name);
+ printf(" , pc_%s :: Int\n", haskellName);
break;
case Gen_Haskell_Value:
- printf(" , pc_%s = %" PRIdPTR "\n", name, val);
+ printf(" , pc_%s = %" PRIdPTR "\n", haskellName, val);
break;
case Gen_Haskell_Wrappers:
- printf("%s :: DynFlags -> Int\n", name);
+ printf("%s :: DynFlags -> Int\n", haskellName);
printf("%s dflags = pc_%s (sPlatformConstants (settings dflags))\n",
- name, name);
+ haskellName, haskellName);
break;
case Gen_Haskell_Exports:
- printf(" %s,\n", name);
+ printf(" %s,\n", haskellName);
break;
case Gen_Header:
+ if (cName != NULL) {
+ printf("#define %s %" PRIdPTR "\n", cName, val);
+ }
break;
}
}
+void constantInt(char *name, intptr_t val) {
+ constantIntC (NULL, name, val);
+}
+
int
main(int argc, char *argv[])
{
@@ -374,19 +381,23 @@ main(int argc, char *argv[])
case Gen_Header:
printf("/* This file is created automatically. Do not edit by hand.*/\n\n");
- printf("#define STD_HDR_SIZE %" FMT_SizeT "\n", (size_t)sizeofW(StgHeader) - sizeofW(StgProfHeader));
- /* grrr.. PROFILING is on so we need to subtract sizeofW(StgProfHeader) */
- printf("#define PROF_HDR_SIZE %" FMT_SizeT "\n", (size_t)sizeofW(StgProfHeader));
-
- printf("#define BLOCK_SIZE %u\n", BLOCK_SIZE);
- printf("#define MBLOCK_SIZE %u\n", MBLOCK_SIZE);
- printf("#define BLOCKS_PER_MBLOCK %" FMT_Word "\n", (W_)BLOCKS_PER_MBLOCK);
- // could be derived, but better to save doing the calculation twice
-
- printf("\n\n");
break;
}
+ // Closure header sizes.
+ constantIntC("STD_HDR_SIZE", "sTD_HDR_SIZE",
+ sizeofW(StgHeader) - sizeofW(StgProfHeader));
+ /* grrr.. PROFILING is on so we need to subtract sizeofW(StgProfHeader) */
+ constantIntC("PROF_HDR_SIZE", "pROF_HDR_SIZE", sizeofW(StgProfHeader));
+
+ // Size of a storage manager block (in bytes).
+ constantIntC("BLOCK_SIZE", "bLOCK_SIZE", BLOCK_SIZE);
+ constantIntC("MBLOCK_SIZE", "mBLOCK_SIZE", MBLOCK_SIZE);
+ // blocks that fit in an MBlock, leaving space for the block descriptors
+ constantIntC("BLOCKS_PER_MBLOCK", "bLOCKS_PER_MBLOCK", BLOCKS_PER_MBLOCK);
+ // could be derived, but better to save doing the calculation twice
+
+
field_offset(StgRegTable, rR1);
field_offset(StgRegTable, rR2);
field_offset(StgRegTable, rR3);
View Lorry Controller Status