Add some LDV_* constants to platformConstants
authorIan Lynagh <ian@well-typed.com>
Tue, 18 Sep 2012 23:15:15 +0000 (00:15 +0100)
committerIan Lynagh <ian@well-typed.com>
Tue, 18 Sep 2012 23:15:15 +0000 (00:15 +0100)
compiler/codeGen/CgProf.hs
compiler/codeGen/StgCmmProf.hs
includes/mkDerivedConstants.c

index 9848d34..b21ae26 100644 (file)
@@ -25,9 +25,6 @@ module CgProf (
 #include "HsVersions.h"
 #include "../includes/MachDeps.h"
  -- For WORD_SIZE_IN_BITS only.
-#include "../includes/rts/Constants.h"
-        -- For LDV_CREATE_MASK, LDV_STATE_USE
-        -- which are StgWords
 #include "../includes/dist-derivedconstants/header/DerivedConstants.h"
         -- For REP_xxx constants, which are MachReps
 
@@ -265,7 +262,7 @@ staticLdvInit = zeroCLit
 dynLdvInit :: DynFlags -> CmmExpr
 dynLdvInit dflags =     -- (era << LDV_SHIFT) | LDV_STATE_CREATE
   CmmMachOp (mo_wordOr dflags) [
-      CmmMachOp (mo_wordShl dflags) [loadEra dflags, mkIntExpr dflags lDV_SHIFT ],
+      CmmMachOp (mo_wordShl dflags) [loadEra dflags, mkIntExpr dflags (lDV_SHIFT dflags)],
       CmmLit (mkWordCLit dflags (lDV_STATE_CREATE dflags))
   ]
 
@@ -316,17 +313,10 @@ ldvWord :: DynFlags -> CmmExpr -> CmmExpr
 ldvWord dflags closure_ptr
     = cmmOffsetB dflags closure_ptr (oFFSET_StgHeader_ldvw dflags)
 
--- LDV constants, from ghc/includes/Constants.h
-lDV_SHIFT :: Int
-lDV_SHIFT = LDV_SHIFT
---lDV_STATE_MASK :: StgWord
---lDV_STATE_MASK   = LDV_STATE_MASK
 lDV_CREATE_MASK :: DynFlags -> StgWord
-lDV_CREATE_MASK dflags = toStgWord dflags LDV_CREATE_MASK
---lDV_LAST_MASK    :: StgWord
---lDV_LAST_MASK    = LDV_LAST_MASK
+lDV_CREATE_MASK dflags = toStgWord dflags (iLDV_CREATE_MASK dflags)
 lDV_STATE_CREATE :: DynFlags -> StgWord
-lDV_STATE_CREATE dflags = toStgWord dflags LDV_STATE_CREATE
+lDV_STATE_CREATE dflags = toStgWord dflags (iLDV_STATE_CREATE dflags)
 lDV_STATE_USE :: DynFlags -> StgWord
-lDV_STATE_USE dflags = toStgWord dflags LDV_STATE_USE
+lDV_STATE_USE dflags = toStgWord dflags (iLDV_STATE_USE dflags)
 
index 30ced9a..56c182d 100644 (file)
@@ -33,9 +33,6 @@ module StgCmmProf (
 #include "HsVersions.h"
 #include "../includes/MachDeps.h"
  -- For WORD_SIZE_IN_BITS only.
-#include "../includes/rts/Constants.h"
-       -- For LDV_CREATE_MASK, LDV_STATE_USE
-       -- which are StgWords
 #include "../includes/dist-derivedconstants/header/DerivedConstants.h"
        -- For REP_xxx constants, which are MachReps
 
@@ -328,7 +325,7 @@ staticLdvInit = zeroCLit
 dynLdvInit :: DynFlags -> CmmExpr
 dynLdvInit dflags =     -- (era << LDV_SHIFT) | LDV_STATE_CREATE  
   CmmMachOp (mo_wordOr dflags) [
-      CmmMachOp (mo_wordShl dflags) [loadEra dflags, mkIntExpr dflags lDV_SHIFT ],
+      CmmMachOp (mo_wordShl dflags) [loadEra dflags, mkIntExpr dflags (lDV_SHIFT dflags)],
       CmmLit (mkWordCLit dflags (lDV_STATE_CREATE dflags))
   ]
         
@@ -379,17 +376,10 @@ ldvWord :: DynFlags -> CmmExpr -> CmmExpr
 ldvWord dflags closure_ptr
     = cmmOffsetB dflags closure_ptr (oFFSET_StgHeader_ldvw dflags)
 
--- LDV constants, from ghc/includes/Constants.h
-lDV_SHIFT :: Int
-lDV_SHIFT = LDV_SHIFT
---lDV_STATE_MASK :: StgWord
---lDV_STATE_MASK   = LDV_STATE_MASK
 lDV_CREATE_MASK :: DynFlags -> StgWord
-lDV_CREATE_MASK dflags = toStgWord dflags LDV_CREATE_MASK
---lDV_LAST_MASK :: StgWord
---lDV_LAST_MASK    = LDV_LAST_MASK
+lDV_CREATE_MASK dflags = toStgWord dflags (iLDV_CREATE_MASK dflags)
 lDV_STATE_CREATE :: DynFlags -> StgWord
-lDV_STATE_CREATE dflags = toStgWord dflags LDV_STATE_CREATE
+lDV_STATE_CREATE dflags = toStgWord dflags (iLDV_STATE_CREATE dflags)
 lDV_STATE_USE :: DynFlags -> StgWord
-lDV_STATE_USE dflags = toStgWord dflags LDV_STATE_USE
+lDV_STATE_USE dflags = toStgWord dflags (iLDV_STATE_USE dflags)
 
index c732332..62c5ae8 100644 (file)
@@ -314,30 +314,17 @@ void constantBool(char *haskellName, int 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
-       rather than Int so that cross-compiling between 32bit and 64bit
-       platforms works. */
-    if (val > 268435456) {
-        printf("Value too large for constantInt: %" PRIdPTR "\n", val);
-        exit(1);
-    }
-    if (val < -268435456) {
-        printf("Value too small for constantInt: %" PRIdPTR "\n", val);
-        exit(1);
-    }
-
+void constantIntegralC(char *haskellType, char *cName, char *haskellName,
+                       intptr_t val) {
     switch (mode) {
     case Gen_Haskell_Type:
-        printf("    , pc_%s :: Int\n", haskellName);
+        printf("    , pc_%s :: %s\n", haskellName, haskellType);
         break;
     case Gen_Haskell_Value:
         printf("    , pc_%s = %" PRIdPTR "\n", haskellName, val);
         break;
     case Gen_Haskell_Wrappers:
-        printf("%s :: DynFlags -> Int\n", haskellName);
+        printf("%s :: DynFlags -> %s\n", haskellName, haskellType);
         printf("%s dflags = pc_%s (sPlatformConstants (settings dflags))\n",
                haskellName, haskellName);
         break;
@@ -352,8 +339,30 @@ void constantIntC(char *cName, char *haskellName, 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
+       rather than Int so that cross-compiling between 32bit and 64bit
+       platforms works. */
+    if (val > 268435456) {
+        printf("Value too large for constantInt: %" PRIdPTR "\n", val);
+        exit(1);
+    }
+    if (val < -268435456) {
+        printf("Value too small for constantInt: %" PRIdPTR "\n", val);
+        exit(1);
+    }
+
+    constantIntegralC("Int", cName, haskellName, val);
+}
+
 void constantInt(char *name, intptr_t val) {
-    constantIntC (NULL, name, val);
+    constantIntC(NULL, name, val);
+}
+
+void constantInteger(char *name, intptr_t val) {
+    constantIntegralC("Integer", NULL, name, val);
 }
 
 int
@@ -729,6 +738,11 @@ main(int argc, char *argv[])
 #endif
                                          );
 
+    constantInt("lDV_SHIFT", LDV_SHIFT);
+    constantInteger("iLDV_CREATE_MASK",  LDV_CREATE_MASK);
+    constantInteger("iLDV_STATE_CREATE", LDV_STATE_CREATE);
+    constantInteger("iLDV_STATE_USE",    LDV_STATE_USE);
+
     switch (mode) {
     case Gen_Haskell_Type:
         printf("  } deriving (Read, Show)\n");