Commit 62bb6189 authored by ian@well-typed.com's avatar ian@well-typed.com
Browse files

Add some LDV_* constants to platformConstants

parent 0176c3f2
......@@ -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)
......@@ -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)
......@@ -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");
......
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