Move more constants to platformConstants
authorIan Lynagh <ian@well-typed.com>
Fri, 14 Sep 2012 15:27:51 +0000 (16:27 +0100)
committerIan Lynagh <ian@well-typed.com>
Fri, 14 Sep 2012 15:27:51 +0000 (16:27 +0100)
compiler/cmm/SMRep.lhs
compiler/codeGen/CgForeignCall.hs
compiler/codeGen/CgHeapery.lhs
compiler/codeGen/StgCmmForeign.hs
compiler/main/DynFlags.hs
includes/HaskellConstants.hs
includes/mkDerivedConstants.c

index 95a5d38..79e1910 100644 (file)
@@ -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
index 977c4e1..0afa3c6 100644 (file)
@@ -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)
                 )
index e37783c..f3cb779 100644 (file)
@@ -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
index 9523a11..499c22b 100644 (file)
@@ -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)
                 )
index 15ef065..6cb99f8 100644 (file)
@@ -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
+
index c9d4173..a0b9d76 100644 (file)
@@ -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
index 5b71a1b..a948581 100644 (file)
@@ -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);