Commit 041e832c authored by ian@well-typed.com's avatar ian@well-typed.com
Browse files

Move some more constants fo platformConstants

parent 291da8a0
......@@ -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
......
......@@ -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) }
......
......@@ -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
......
......@@ -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
......
......@@ -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)))
......
......@@ -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
......
......@@ -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
......
......@@ -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");
......
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