diff options
author | Ian Lynagh <ian@well-typed.com> | 2012-09-14 13:57:48 +0100 |
---|---|---|
committer | Ian Lynagh <ian@well-typed.com> | 2012-09-14 13:57:48 +0100 |
commit | 041e832cf0ef490dd0d4fd24d56a2f7f1adb5c9c (patch) | |
tree | d22a1cbf361f5cdf60cd35205638e2419c0db6f3 | |
parent | 291da8a0624d3844d30931d0e89f51e3daf03a61 (diff) | |
download | haskell-041e832cf0ef490dd0d4fd24d56a2f7f1adb5c9c.tar.gz |
Move some more constants fo platformConstants
-rw-r--r-- | compiler/cmm/SMRep.lhs | 2 | ||||
-rw-r--r-- | compiler/codeGen/CgCon.lhs | 9 | ||||
-rw-r--r-- | compiler/codeGen/CgPrimOp.hs | 4 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmCon.hs | 13 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmPrim.hs | 6 | ||||
-rw-r--r-- | compiler/ghci/ByteCodeItbls.lhs | 6 | ||||
-rw-r--r-- | includes/HaskellConstants.hs | 15 | ||||
-rw-r--r-- | includes/mkDerivedConstants.c | 12 |
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"); |