diff options
Diffstat (limited to 'includes/mkDerivedConstants.c')
| -rw-r--r-- | includes/mkDerivedConstants.c | 426 |
1 files changed, 332 insertions, 94 deletions
diff --git a/includes/mkDerivedConstants.c b/includes/mkDerivedConstants.c index 3fcf12849f..558d709f94 100644 --- a/includes/mkDerivedConstants.c +++ b/includes/mkDerivedConstants.c @@ -26,7 +26,11 @@ #include "Stable.h" #include "Capability.h" +#include <inttypes.h> #include <stdio.h> +#include <string.h> + +enum Mode { Gen_Haskell_Type, Gen_Haskell_Value, Gen_Haskell_Wrappers, Gen_Haskell_Exports, Gen_Header } mode; #define str(a,b) #a "_" #b @@ -36,38 +40,69 @@ #pragma GCC poison sizeof -#if defined(GEN_HASKELL) -#define def_offset(str, offset) \ - printf("oFFSET_" str " :: Int\n"); \ - printf("oFFSET_" str " = %" FMT_SizeT "\n", (size_t)offset); -#else -#define def_offset(str, offset) \ - printf("#define OFFSET_" str " %" FMT_SizeT "\n", (size_t)offset); -#endif +#define def_offset(str, offset) \ + switch (mode) { \ + case Gen_Haskell_Type: \ + printf(" , pc_OFFSET_" str " :: Int\n"); \ + break; \ + case Gen_Haskell_Value: \ + printf(" , pc_OFFSET_" str " = %" PRIdPTR "\n", (intptr_t)offset); \ + break; \ + case Gen_Haskell_Wrappers: \ + printf("oFFSET_" str " :: DynFlags -> Int\n"); \ + printf("oFFSET_" str " dflags = pc_OFFSET_" str " (sPlatformConstants (settings dflags))\n"); \ + break; \ + case Gen_Haskell_Exports: \ + printf(" oFFSET_" str ",\n"); \ + break; \ + case Gen_Header: \ + printf("#define OFFSET_" str " %" PRIdPTR "\n", (intptr_t)offset); \ + break; \ + } + +#define ctype(type) \ + switch (mode) { \ + case Gen_Haskell_Type: \ + case Gen_Haskell_Value: \ + case Gen_Haskell_Wrappers: \ + case Gen_Haskell_Exports: \ + break; \ + case Gen_Header: \ + printf("#define SIZEOF_" #type " %" FMT_SizeT "\n", \ + (size_t)TYPE_SIZE(type)); \ + break; \ + } -#if defined(GEN_HASKELL) -#define ctype(type) /* nothing */ -#else -#define ctype(type) \ - printf("#define SIZEOF_" #type " %" FMT_SizeT "\n", (size_t)TYPE_SIZE(type)); -#endif - -#if defined(GEN_HASKELL) -#define field_type_(str, s_type, field) /* nothing */ -#define field_type_gcptr_(str, s_type, field) /* nothing */ -#else /* Defining REP_x to be b32 etc These are both the C-- types used in a load e.g. b32[addr] and the names of the CmmTypes in the compiler b32 :: CmmType */ -#define field_type_(str, s_type, field) \ - printf("#define REP_" str " b"); \ - printf("%" FMT_SizeT "\n", FIELD_SIZE(s_type, field) * 8); -#define field_type_gcptr_(str, s_type, field) \ - printf("#define REP_" str " gcptr\n"); -#endif +#define field_type_(str, s_type, field) \ + switch (mode) { \ + case Gen_Haskell_Type: \ + case Gen_Haskell_Value: \ + case Gen_Haskell_Wrappers: \ + case Gen_Haskell_Exports: \ + break; \ + case Gen_Header: \ + printf("#define REP_" str " b"); \ + printf("%" FMT_SizeT "\n", FIELD_SIZE(s_type, field) * 8); \ + break; \ + } + +#define field_type_gcptr_(str, s_type, field) \ + switch (mode) { \ + case Gen_Haskell_Type: \ + case Gen_Haskell_Value: \ + case Gen_Haskell_Wrappers: \ + case Gen_Haskell_Exports: \ + break; \ + case Gen_Header: \ + printf("#define REP_" str " gcptr\n"); \ + break; \ + } #define field_type(s_type, field) \ field_type_(str(s_type,field),s_type,field); @@ -79,12 +114,17 @@ field_offset_(str(s_type,field),s_type,field); /* An access macro for use in C-- sources. */ -#if defined(GEN_HASKELL) -#define struct_field_macro(str) /* nothing */ -#else -#define struct_field_macro(str) \ - printf("#define " str "(__ptr__) REP_" str "[__ptr__+OFFSET_" str "]\n"); -#endif +#define struct_field_macro(str) \ + switch (mode) { \ + case Gen_Haskell_Type: \ + case Gen_Haskell_Value: \ + case Gen_Haskell_Wrappers: \ + case Gen_Haskell_Exports: \ + break; \ + case Gen_Header: \ + printf("#define " str "(__ptr__) REP_" str "[__ptr__+OFFSET_" str "]\n"); \ + break; \ + } /* Outputs the byte offset and MachRep for a field */ #define struct_field(s_type, field) \ @@ -97,21 +137,37 @@ field_type_(str, s_type, field); \ struct_field_macro(str) -#if defined(GEN_HASKELL) -#define def_size(str, size) \ - printf("sIZEOF_" str " :: Int\n"); \ - printf("sIZEOF_" str " = %" FMT_SizeT "\n", (size_t)size); -#else -#define def_size(str, size) \ - printf("#define SIZEOF_" str " %" FMT_SizeT "\n", (size_t)size); -#endif - -#if defined(GEN_HASKELL) -#define def_closure_size(str, size) /* nothing */ -#else -#define def_closure_size(str, size) \ - printf("#define SIZEOF_" str " (SIZEOF_StgHeader+%" FMT_SizeT ")\n", (size_t)size); -#endif +#define def_size(str, size) \ + switch (mode) { \ + case Gen_Haskell_Type: \ + printf(" , pc_SIZEOF_" str " :: Int\n"); \ + break; \ + case Gen_Haskell_Value: \ + printf(" , pc_SIZEOF_" str " = %" FMT_SizeT "\n", (size_t)size); \ + break; \ + case Gen_Haskell_Wrappers: \ + printf("sIZEOF_" str " :: DynFlags -> Int\n"); \ + printf("sIZEOF_" str " dflags = pc_SIZEOF_" str " (sPlatformConstants (settings dflags))\n"); \ + break; \ + case Gen_Haskell_Exports: \ + printf(" sIZEOF_" str ",\n"); \ + break; \ + case Gen_Header: \ + printf("#define SIZEOF_" str " %" FMT_SizeT "\n", (size_t)size); \ + break; \ + } + +#define def_closure_size(str, size) \ + switch (mode) { \ + case Gen_Haskell_Type: \ + case Gen_Haskell_Value: \ + case Gen_Haskell_Wrappers: \ + case Gen_Haskell_Exports: \ + break; \ + case Gen_Header: \ + printf("#define SIZEOF_" str " (SIZEOF_StgHeader+%" FMT_SizeT ")\n", (size_t)size); \ + break; \ + } #define struct_size(s_type) \ def_size(#s_type, TYPE_SIZE(s_type)); @@ -129,12 +185,17 @@ closure_size(s_type) /* An access macro for use in C-- sources. */ -#if defined(GEN_HASKELL) -#define closure_field_macro(str) /* nothing */ -#else -#define closure_field_macro(str) \ - printf("#define " str "(__ptr__) REP_" str "[__ptr__+SIZEOF_StgHeader+OFFSET_" str "]\n"); -#endif +#define closure_field_macro(str) \ + switch (mode) { \ + case Gen_Haskell_Type: \ + case Gen_Haskell_Value: \ + case Gen_Haskell_Wrappers: \ + case Gen_Haskell_Exports: \ + break; \ + case Gen_Header: \ + printf("#define " str "(__ptr__) REP_" str "[__ptr__+SIZEOF_StgHeader+OFFSET_" str "]\n"); \ + break; \ + } #define closure_field_offset_(str, s_type,field) \ def_offset(str, OFFSET(s_type,field) - TYPE_SIZE(StgHeader)); @@ -142,12 +203,17 @@ #define closure_field_offset(s_type,field) \ closure_field_offset_(str(s_type,field),s_type,field) -#if defined(GEN_HASKELL) -#define closure_payload_macro(str) /* nothing */ -#else -#define closure_payload_macro(str) \ - printf("#define " str "(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_" str " + WDS(__ix__)]\n"); -#endif +#define closure_payload_macro(str) \ + switch (mode) { \ + case Gen_Haskell_Type: \ + case Gen_Haskell_Value: \ + case Gen_Haskell_Wrappers: \ + case Gen_Haskell_Exports: \ + break; \ + case Gen_Header: \ + printf("#define " str "(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_" str " + WDS(__ix__)]\n"); \ + break; \ + } #define closure_payload(s_type,field) \ closure_field_offset_(str(s_type,field),s_type,field); \ @@ -176,60 +242,161 @@ def_offset(str(s_type,field), OFFSET(s_type,field) - TYPE_SIZE(StgHeader) - TYPE_SIZE(StgTSOProfInfo)); /* Full byte offset for a TSO field, for use from Cmm */ -#if defined(GEN_HASKELL) -#define tso_field_offset_macro(str) /* nothing */ -#else -#define tso_field_offset_macro(str) \ - printf("#define TSO_OFFSET_" str " (SIZEOF_StgHeader+SIZEOF_OPT_StgTSOProfInfo+OFFSET_" str ")\n"); -#endif +#define tso_field_offset_macro(str) \ + switch (mode) { \ + case Gen_Haskell_Type: \ + case Gen_Haskell_Value: \ + case Gen_Haskell_Wrappers: \ + case Gen_Haskell_Exports: \ + break; \ + case Gen_Header: \ + printf("#define TSO_OFFSET_" str " (SIZEOF_StgHeader+SIZEOF_OPT_StgTSOProfInfo+OFFSET_" str ")\n"); \ + break; \ + } #define tso_field_offset(s_type, field) \ tso_payload_offset(s_type, field); \ tso_field_offset_macro(str(s_type,field)); -#if defined(GEN_HASKELL) -#define tso_field_macro(str) /* nothing */ -#else -#define tso_field_macro(str) \ - printf("#define " str "(__ptr__) REP_" str "[__ptr__+TSO_OFFSET_" str "]\n") -#endif +#define tso_field_macro(str) \ + switch (mode) { \ + case Gen_Haskell_Type: \ + case Gen_Haskell_Value: \ + case Gen_Haskell_Wrappers: \ + case Gen_Haskell_Exports: \ + break; \ + case Gen_Header: \ + printf("#define " str "(__ptr__) REP_" str "[__ptr__+TSO_OFFSET_" str "]\n") \ + break; \ + } #define tso_field(s_type, field) \ field_type(s_type, field); \ tso_field_offset(s_type,field); \ tso_field_macro(str(s_type,field)) -#if defined(GEN_HASKELL) -#define opt_struct_size(s_type, option) /* nothing */ -#else -#define opt_struct_size(s_type, option) \ - printf("#ifdef " #option "\n"); \ - printf("#define SIZEOF_OPT_" #s_type " SIZEOF_" #s_type "\n"); \ - printf("#else\n"); \ - printf("#define SIZEOF_OPT_" #s_type " 0\n"); \ - printf("#endif\n\n"); -#endif +#define opt_struct_size(s_type, option) \ + switch (mode) { \ + case Gen_Haskell_Type: \ + case Gen_Haskell_Value: \ + case Gen_Haskell_Wrappers: \ + case Gen_Haskell_Exports: \ + break; \ + case Gen_Header: \ + printf("#ifdef " #option "\n"); \ + printf("#define SIZEOF_OPT_" #s_type " SIZEOF_" #s_type "\n"); \ + printf("#else\n"); \ + printf("#define SIZEOF_OPT_" #s_type " 0\n"); \ + printf("#endif\n\n"); \ + break; \ + } #define FUN_OFFSET(sym) (OFFSET(Capability,f.sym) - OFFSET(Capability,r)) +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); + } + + switch (mode) { + case Gen_Haskell_Type: + printf(" , pc_%s :: Int\n", haskellName); + 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 dflags = pc_%s (sPlatformConstants (settings dflags))\n", + haskellName, haskellName); + break; + case Gen_Haskell_Exports: + 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[]) { -#ifndef GEN_HASKELL - 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)); + if (argc == 1) { + mode = Gen_Header; + } + else if (argc == 2) { + if (0 == strcmp("--gen-haskell-type", argv[1])) { + mode = Gen_Haskell_Type; + } + else if (0 == strcmp("--gen-haskell-value", argv[1])) { + mode = Gen_Haskell_Value; + } + else if (0 == strcmp("--gen-haskell-wrappers", argv[1])) { + mode = Gen_Haskell_Wrappers; + } + else if (0 == strcmp("--gen-haskell-exports", argv[1])) { + mode = Gen_Haskell_Exports; + } + else { + printf("Bad args\n"); + exit(1); + } + } + else { + printf("Bad args\n"); + exit(1); + } + + switch (mode) { + case Gen_Haskell_Type: + printf("data PlatformConstants = PlatformConstants {\n"); + /* Now a kludge that allows the real entries to all start with a + comma, which makes life a little easier */ + printf(" pc_platformConstants :: ()\n"); + break; + case Gen_Haskell_Value: + printf("PlatformConstants {\n"); + printf(" pc_platformConstants = ()\n"); + break; + case Gen_Haskell_Wrappers: + case Gen_Haskell_Exports: + break; + case Gen_Header: + printf("/* This file is created automatically. Do not edit by hand.*/\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) */ - printf("#define PROF_HDR_SIZE %" FMT_SizeT "\n", (size_t)sizeofW(StgProfHeader)); + constantIntC("PROF_HDR_SIZE", "pROF_HDR_SIZE", sizeofW(StgProfHeader)); - printf("#define BLOCK_SIZE %u\n", BLOCK_SIZE); - printf("#define MBLOCK_SIZE %u\n", MBLOCK_SIZE); - printf("#define BLOCKS_PER_MBLOCK %" FMT_SizeT "\n", (lnat)BLOCKS_PER_MBLOCK); + // 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 - printf("\n\n"); -#endif field_offset(StgRegTable, rR1); field_offset(StgRegTable, rR2); @@ -469,11 +636,82 @@ main(int argc, char *argv[]) struct_field(snEntry,addr); #ifdef mingw32_HOST_OS - struct_size(StgAsyncIOResult); - struct_field(StgAsyncIOResult, reqID); - struct_field(StgAsyncIOResult, len); - struct_field(StgAsyncIOResult, errCode); + /* Note that this conditional part only affects the C headers. + That's important, as it means we get the same PlatformConstants + type on all platforms. */ + if (mode == Gen_Header) { + struct_size(StgAsyncIOResult); + struct_field(StgAsyncIOResult, reqID); + struct_field(StgAsyncIOResult, len); + struct_field(StgAsyncIOResult, errCode); + } #endif + // pre-compiled thunk types + 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); + + // A section of code-generator-related MAGIC CONSTANTS. + constantInt("mAX_Vanilla_REG", MAX_VANILLA_REG); + constantInt("mAX_Float_REG", MAX_FLOAT_REG); + constantInt("mAX_Double_REG", MAX_DOUBLE_REG); + constantInt("mAX_Long_REG", MAX_LONG_REG); + constantInt("mAX_Real_Vanilla_REG", MAX_REAL_VANILLA_REG); + constantInt("mAX_Real_Float_REG", MAX_REAL_FLOAT_REG); + constantInt("mAX_Real_Double_REG", MAX_REAL_DOUBLE_REG); + constantInt("mAX_Real_Long_REG", MAX_REAL_LONG_REG); + + // This tells the native code generator the size of the spill + // area is has available. + constantInt("rESERVED_C_STACK_BYTES", RESERVED_C_STACK_BYTES); + // The amount of (Haskell) stack to leave free for saving registers when + // returning to the scheduler. + constantInt("rESERVED_STACK_WORDS", RESERVED_STACK_WORDS); + // Continuations that need more than this amount of stack should do their + // own stack check (see bug #1466). + constantInt("aP_STACK_SPLIM", AP_STACK_SPLIM); + + // Size of a word, in bytes + constantInt("wORD_SIZE", SIZEOF_HSWORD); + + // Size of a double in StgWords. + constantInt("dOUBLE_SIZE", SIZEOF_DOUBLE); + + // Size of a C int, in bytes. May be smaller than wORD_SIZE. + constantInt("cINT_SIZE", SIZEOF_INT); + constantInt("cLONG_SIZE", SIZEOF_LONG); + constantInt("cLONG_LONG_SIZE", SIZEOF_LONG_LONG); + + // Number of bits to shift a bitfield left by in an info table. + constantInt("bITMAP_BITS_SHIFT", BITMAP_BITS_SHIFT); + + // Amount of pointer bits used for semi-tagging constructor closures + constantInt("tAG_BITS", TAG_BITS); + + switch (mode) { + case Gen_Haskell_Type: + printf(" } deriving (Read, Show)\n"); + break; + case Gen_Haskell_Value: + printf(" }\n"); + break; + case Gen_Haskell_Wrappers: + case Gen_Haskell_Exports: + case Gen_Header: + break; + } + return 0; } |