summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorIan Lynagh <ian@well-typed.com>2012-09-14 13:57:48 +0100
committerIan Lynagh <ian@well-typed.com>2012-09-14 13:57:48 +0100
commit041e832cf0ef490dd0d4fd24d56a2f7f1adb5c9c (patch)
treed22a1cbf361f5cdf60cd35205638e2419c0db6f3
parent291da8a0624d3844d30931d0e89f51e3daf03a61 (diff)
downloadhaskell-041e832cf0ef490dd0d4fd24d56a2f7f1adb5c9c.tar.gz
Move some more constants fo platformConstants
-rw-r--r--compiler/cmm/SMRep.lhs2
-rw-r--r--compiler/codeGen/CgCon.lhs9
-rw-r--r--compiler/codeGen/CgPrimOp.hs4
-rw-r--r--compiler/codeGen/StgCmmCon.hs13
-rw-r--r--compiler/codeGen/StgCmmPrim.hs6
-rw-r--r--compiler/ghci/ByteCodeItbls.lhs6
-rw-r--r--includes/HaskellConstants.hs15
-rw-r--r--includes/mkDerivedConstants.c12
8 files changed, 31 insertions, 36 deletions
diff --git a/compiler/cmm/SMRep.lhs b/compiler/cmm/SMRep.lhs
index 68effd7cb3..95a5d38194 100644
--- a/compiler/cmm/SMRep.lhs
+++ b/compiler/cmm/SMRep.lhs
@@ -231,7 +231,7 @@ profHdrSize dflags
-- | The garbage collector requires that every closure is at least as
-- big as this.
minClosureSize :: DynFlags -> WordOff
-minClosureSize dflags = fixedHdrSize dflags + mIN_PAYLOAD_SIZE
+minClosureSize dflags = fixedHdrSize dflags + mIN_PAYLOAD_SIZE dflags
arrWordsHdrSize :: DynFlags -> ByteOff
arrWordsHdrSize dflags
diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs
index 57fd10d4e4..8afbc8f64e 100644
--- a/compiler/codeGen/CgCon.lhs
+++ b/compiler/codeGen/CgCon.lhs
@@ -36,7 +36,6 @@ import OldCmmUtils
import OldCmm
import SMRep
import CostCentre
-import Constants
import TyCon
import DataCon
import Id
@@ -189,9 +188,9 @@ buildDynCon' dflags platform binder _ con [arg_amode]
, platformOS platform /= OSMinGW32 || not (dopt Opt_PIC dflags)
, (_, CmmLit (CmmInt val _)) <- arg_amode
, let val_int = (fromIntegral val) :: Int
- , val_int <= mAX_INTLIKE && val_int >= mIN_INTLIKE
+ , val_int <= mAX_INTLIKE dflags && val_int >= mIN_INTLIKE dflags
= do { let intlike_lbl = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_INTLIKE_closure")
- offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize dflags + 1)
+ offsetW = (val_int - mIN_INTLIKE dflags) * (fixedHdrSize dflags + 1)
-- INTLIKE closures consist of a header and one word payload
intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW)
; returnFC (taggedStableIdInfo binder intlike_amode (mkConLFInfo con) con) }
@@ -201,9 +200,9 @@ buildDynCon' dflags platform binder _ con [arg_amode]
, platformOS platform /= OSMinGW32 || not (dopt Opt_PIC dflags)
, (_, CmmLit (CmmInt val _)) <- arg_amode
, let val_int = (fromIntegral val) :: Int
- , val_int <= mAX_CHARLIKE && val_int >= mIN_CHARLIKE
+ , val_int <= mAX_CHARLIKE dflags && val_int >= mIN_CHARLIKE dflags
= do { let charlike_lbl = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_CHARLIKE_closure")
- offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize dflags + 1)
+ offsetW = (val_int - mIN_CHARLIKE dflags) * (fixedHdrSize dflags + 1)
-- CHARLIKE closures consist of a header and one word payload
charlike_amode = CmmLit (cmmLabelOffW charlike_lbl offsetW)
; returnFC (taggedStableIdInfo binder charlike_amode (mkConLFInfo con) con) }
diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs
index 76ee148ef7..d77784dcf4 100644
--- a/compiler/codeGen/CgPrimOp.hs
+++ b/compiler/codeGen/CgPrimOp.hs
@@ -1079,11 +1079,11 @@ emitSetCards dst_start dst_cards_start n live = do
-- Convert an element index to a card index
card :: DynFlags -> CmmExpr -> CmmExpr
-card dflags i = cmmUShrWord dflags i (CmmLit (mkIntCLit dflags mUT_ARR_PTRS_CARD_BITS))
+card dflags i = cmmUShrWord dflags i (CmmLit (mkIntCLit dflags (mUT_ARR_PTRS_CARD_BITS dflags)))
-- Convert a number of elements to a number of cards, rounding up
cardRoundUp :: DynFlags -> CmmExpr -> CmmExpr
-cardRoundUp dflags i = card dflags (cmmAddWord dflags i (CmmLit (mkIntCLit dflags ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS) - 1))))
+cardRoundUp dflags i = card dflags (cmmAddWord dflags i (CmmLit (mkIntCLit dflags ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS dflags) - 1))))
bytesToWordsRoundUp :: DynFlags -> CmmExpr -> CmmExpr
bytesToWordsRoundUp dflags e
diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs
index 15686a8c9a..0e0f2f13f8 100644
--- a/compiler/codeGen/StgCmmCon.hs
+++ b/compiler/codeGen/StgCmmCon.hs
@@ -31,7 +31,6 @@ import MkGraph
import SMRep
import CostCentre
import Module
-import Constants
import DataCon
import DynFlags
import FastString
@@ -184,11 +183,11 @@ buildDynCon' dflags platform binder _cc con [arg]
| maybeIntLikeCon con
, platformOS platform /= OSMinGW32 || not (dopt Opt_PIC dflags)
, StgLitArg (MachInt val) <- arg
- , val <= fromIntegral mAX_INTLIKE -- Comparisons at type Integer!
- , val >= fromIntegral mIN_INTLIKE -- ...ditto...
+ , val <= fromIntegral (mAX_INTLIKE dflags) -- Comparisons at type Integer!
+ , val >= fromIntegral (mIN_INTLIKE dflags) -- ...ditto...
= do { let intlike_lbl = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_INTLIKE_closure")
val_int = fromIntegral val :: Int
- offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize dflags + 1)
+ offsetW = (val_int - mIN_INTLIKE dflags) * (fixedHdrSize dflags + 1)
-- INTLIKE closures consist of a header and one word payload
intlike_amode = cmmLabelOffW intlike_lbl offsetW
; return ( litIdInfo dflags binder (mkConLFInfo con) intlike_amode
@@ -199,10 +198,10 @@ buildDynCon' dflags platform binder _cc con [arg]
, platformOS platform /= OSMinGW32 || not (dopt Opt_PIC dflags)
, StgLitArg (MachChar val) <- arg
, let val_int = ord val :: Int
- , val_int <= mAX_CHARLIKE
- , val_int >= mIN_CHARLIKE
+ , val_int <= mAX_CHARLIKE dflags
+ , val_int >= mIN_CHARLIKE dflags
= do { let charlike_lbl = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_CHARLIKE_closure")
- offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize dflags + 1)
+ offsetW = (val_int - mIN_CHARLIKE dflags) * (fixedHdrSize dflags + 1)
-- CHARLIKE closures consist of a header and one word payload
charlike_amode = cmmLabelOffW charlike_lbl offsetW
; return ( litIdInfo dflags binder (mkConLFInfo con) charlike_amode
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index c1692b5056..cae14f30c5 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -914,7 +914,7 @@ doWritePtrArrayOp addr idx val
(cmmOffsetExprW dflags (cmmOffsetB dflags addr (arrPtrsHdrSize dflags))
(loadArrPtrsSize dflags addr))
(CmmMachOp (mo_wordUShr dflags) [idx,
- mkIntExpr dflags mUT_ARR_PTRS_CARD_BITS])
+ mkIntExpr dflags (mUT_ARR_PTRS_CARD_BITS dflags)])
) (CmmLit (CmmInt 1 W8))
loadArrPtrsSize :: DynFlags -> CmmExpr -> CmmExpr
@@ -1150,11 +1150,11 @@ emitSetCards dst_start dst_cards_start n = do
-- Convert an element index to a card index
card :: DynFlags -> CmmExpr -> CmmExpr
-card dflags i = cmmUShrWord dflags i (mkIntExpr dflags mUT_ARR_PTRS_CARD_BITS)
+card dflags i = cmmUShrWord dflags i (mkIntExpr dflags (mUT_ARR_PTRS_CARD_BITS dflags))
-- Convert a number of elements to a number of cards, rounding up
cardRoundUp :: DynFlags -> CmmExpr -> CmmExpr
-cardRoundUp dflags i = card dflags (cmmAddWord dflags i (mkIntExpr dflags ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS) - 1)))
+cardRoundUp dflags i = card dflags (cmmAddWord dflags i (mkIntExpr dflags ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS dflags) - 1)))
bytesToWordsRoundUp :: DynFlags -> CmmExpr -> CmmExpr
bytesToWordsRoundUp dflags e = cmmQuotWord dflags (cmmAddWord dflags e (mkIntExpr dflags (wORD_SIZE - 1)))
diff --git a/compiler/ghci/ByteCodeItbls.lhs b/compiler/ghci/ByteCodeItbls.lhs
index 9b22ec8cd6..b88c81226a 100644
--- a/compiler/ghci/ByteCodeItbls.lhs
+++ b/compiler/ghci/ByteCodeItbls.lhs
@@ -27,7 +27,7 @@ import ClosureInfo
import DataCon ( DataCon, dataConRepArgTys, dataConIdentity )
import TyCon ( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons )
import Type ( flattenRepType, repType )
-import Constants ( mIN_PAYLOAD_SIZE, wORD_SIZE )
+import Constants ( wORD_SIZE )
import CgHeapery ( mkVirtHeapOffsets )
import Util
@@ -106,8 +106,8 @@ make_constr_itbls dflags cons
ptrs' = ptr_wds
nptrs' = tot_wds - ptr_wds
nptrs_really
- | ptrs' + nptrs' >= mIN_PAYLOAD_SIZE = nptrs'
- | otherwise = mIN_PAYLOAD_SIZE - ptrs'
+ | ptrs' + nptrs' >= mIN_PAYLOAD_SIZE dflags = nptrs'
+ | otherwise = mIN_PAYLOAD_SIZE dflags - ptrs'
code' = mkJumpToAddr entry_addr
itbl = StgInfoTable {
#ifndef GHCI_TABLES_NEXT_TO_CODE
diff --git a/includes/HaskellConstants.hs b/includes/HaskellConstants.hs
index f2a5b22ca3..6dc04dc7e1 100644
--- a/includes/HaskellConstants.hs
+++ b/includes/HaskellConstants.hs
@@ -34,21 +34,6 @@ mAX_CONTEXT_REDUCTION_DEPTH :: Int
mAX_CONTEXT_REDUCTION_DEPTH = 200
-- Increase to 200; see Trac #5395
--- closure sizes: these do NOT include the header (see below for header sizes)
-mIN_PAYLOAD_SIZE ::Int
-mIN_PAYLOAD_SIZE = MIN_PAYLOAD_SIZE
-
-mIN_INTLIKE, mAX_INTLIKE :: Int
-mIN_INTLIKE = MIN_INTLIKE
-mAX_INTLIKE = MAX_INTLIKE
-
-mIN_CHARLIKE, mAX_CHARLIKE :: Int
-mIN_CHARLIKE = MIN_CHARLIKE
-mAX_CHARLIKE = MAX_CHARLIKE
-
-mUT_ARR_PTRS_CARD_BITS :: Int
-mUT_ARR_PTRS_CARD_BITS = MUT_ARR_PTRS_CARD_BITS
-
-- A section of code-generator-related MAGIC CONSTANTS.
mAX_Vanilla_REG :: Int
diff --git a/includes/mkDerivedConstants.c b/includes/mkDerivedConstants.c
index 28377efa90..799ba422d2 100644
--- a/includes/mkDerivedConstants.c
+++ b/includes/mkDerivedConstants.c
@@ -640,6 +640,18 @@ main(int argc, char *argv[])
constantInt("mAX_SPEC_SELECTEE_SIZE", MAX_SPEC_SELECTEE_SIZE);
constantInt("mAX_SPEC_AP_SIZE", MAX_SPEC_AP_SIZE);
+ // closure sizes: these do NOT include the header (see below for
+ // header sizes)
+ constantInt("mIN_PAYLOAD_SIZE", MIN_PAYLOAD_SIZE);
+
+ constantInt("mIN_INTLIKE", MIN_INTLIKE);
+ constantInt("mAX_INTLIKE", MAX_INTLIKE);
+
+ constantInt("mIN_CHARLIKE", MIN_CHARLIKE);
+ constantInt("mAX_CHARLIKE", MAX_CHARLIKE);
+
+ constantInt("mUT_ARR_PTRS_CARD_BITS", MUT_ARR_PTRS_CARD_BITS);
+
switch (mode) {
case Gen_Haskell_Type:
printf(" } deriving (Read, Show)\n");