diff options
Diffstat (limited to 'includes')
| -rw-r--r-- | includes/HaskellConstants.hs | 149 | ||||
| -rw-r--r-- | includes/ghc.mk | 59 | ||||
| -rw-r--r-- | includes/mkDerivedConstants.c | 426 | ||||
| -rw-r--r-- | includes/rts/Hooks.h | 6 | ||||
| -rw-r--r-- | includes/rts/SpinLock.h | 2 | ||||
| -rw-r--r-- | includes/rts/Threads.h | 8 | ||||
| -rw-r--r-- | includes/rts/Types.h | 6 | ||||
| -rw-r--r-- | includes/rts/storage/Block.h | 4 | ||||
| -rw-r--r-- | includes/rts/storage/ClosureMacros.h | 8 | ||||
| -rw-r--r-- | includes/rts/storage/GC.h | 12 | ||||
| -rw-r--r-- | includes/rts/storage/MBlock.h | 6 | ||||
| -rw-r--r-- | includes/stg/Types.h | 18 |
12 files changed, 391 insertions, 313 deletions
diff --git a/includes/HaskellConstants.hs b/includes/HaskellConstants.hs index 1cf6de5d19..4ad7deef19 100644 --- a/includes/HaskellConstants.hs +++ b/includes/HaskellConstants.hs @@ -1,5 +1,4 @@ -import Data.Bits (shiftL) import Data.Word import Data.Int @@ -34,113 +33,9 @@ mAX_CONTEXT_REDUCTION_DEPTH :: Int mAX_CONTEXT_REDUCTION_DEPTH = 200 -- Increase to 200; see Trac #5395 --- specialised fun/thunk/constr closure types -mAX_SPEC_THUNK_SIZE :: Int -mAX_SPEC_THUNK_SIZE = MAX_SPEC_THUNK_SIZE - -mAX_SPEC_FUN_SIZE :: Int -mAX_SPEC_FUN_SIZE = MAX_SPEC_FUN_SIZE - -mAX_SPEC_CONSTR_SIZE :: Int -mAX_SPEC_CONSTR_SIZE = MAX_SPEC_CONSTR_SIZE - --- pre-compiled thunk types -mAX_SPEC_SELECTEE_SIZE :: Int -mAX_SPEC_SELECTEE_SIZE = MAX_SPEC_SELECTEE_SIZE - -mAX_SPEC_AP_SIZE :: Int -mAX_SPEC_AP_SIZE = MAX_SPEC_AP_SIZE - --- 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 -mAX_Vanilla_REG = MAX_VANILLA_REG - -mAX_Float_REG :: Int -mAX_Float_REG = MAX_FLOAT_REG - -mAX_Double_REG :: Int -mAX_Double_REG = MAX_DOUBLE_REG - -mAX_Long_REG :: Int -mAX_Long_REG = MAX_LONG_REG - -mAX_Real_Vanilla_REG :: Int -mAX_Real_Vanilla_REG = MAX_REAL_VANILLA_REG - -mAX_Real_Float_REG :: Int -mAX_Real_Float_REG = MAX_REAL_FLOAT_REG - -mAX_Real_Double_REG :: Int -mAX_Real_Double_REG = MAX_REAL_DOUBLE_REG - -mAX_Real_Long_REG :: Int -#ifdef MAX_REAL_LONG_REG -mAX_Real_Long_REG = MAX_REAL_LONG_REG -#else -mAX_Real_Long_REG = 0 -#endif - --- 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 -dOUBLE_SIZE = SIZEOF_DOUBLE - wORD64_SIZE :: Int wORD64_SIZE = 8 -iNT64_SIZE :: Int -iNT64_SIZE = wORD64_SIZE - --- This tells the native code generator the size of the spill --- area is has available. - -rESERVED_C_STACK_BYTES :: Int -rESERVED_C_STACK_BYTES = RESERVED_C_STACK_BYTES - --- The amount of (Haskell) stack to leave free for saving registers when --- returning to the scheduler. - -rESERVED_STACK_WORDS :: Int -rESERVED_STACK_WORDS = RESERVED_STACK_WORDS - --- Continuations that need more than this amount of stack should do their --- own stack check (see bug #1466). - -aP_STACK_SPLIM :: Int -aP_STACK_SPLIM = AP_STACK_SPLIM - --- Size of a word, in bytes - -wORD_SIZE :: Int -wORD_SIZE = SIZEOF_HSWORD - -wORD_SIZE_IN_BITS :: Int -wORD_SIZE_IN_BITS = wORD_SIZE * 8 - -- Define a fixed-range integral type equivalent to the target Int/Word #if SIZEOF_HSWORD == 4 @@ -161,47 +56,3 @@ tARGET_MAX_WORD = fromIntegral (maxBound :: TargetWord) tARGET_MAX_CHAR :: Int tARGET_MAX_CHAR = 0x10ffff --- Amount of pointer bits used for semi-tagging constructor closures - -tAG_BITS :: Int -tAG_BITS = TAG_BITS - -tAG_MASK :: Int -tAG_MASK = (1 `shiftL` tAG_BITS) - 1 - -mAX_PTR_TAG :: Int -mAX_PTR_TAG = tAG_MASK - --- Size of a C int, in bytes. May be smaller than wORD_SIZE. - -cINT_SIZE :: Int -cINT_SIZE = SIZEOF_INT - -cLONG_SIZE :: Int -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 -bITMAP_BITS_SHIFT = BITMAP_BITS_SHIFT - --- Constants derived from headers in ghc/includes, generated by the program --- ../includes/mkDerivedConstants.c. - -#include "../includes/dist-ghcconstants/header/GHCConstants.h" - diff --git a/includes/ghc.mk b/includes/ghc.mk index 2cf835de80..065dd0a60b 100644 --- a/includes/ghc.mk +++ b/includes/ghc.mk @@ -131,6 +131,12 @@ endif # Make DerivedConstants.h for the compiler includes_DERIVEDCONSTANTS = includes/dist-derivedconstants/header/DerivedConstants.h +includes_GHCCONSTANTS_HASKELL_TYPE = includes/dist-derivedconstants/header/GHCConstantsHaskellType.hs +includes_GHCCONSTANTS_HASKELL_VALUE = includes/dist-derivedconstants/header/platformConstants +includes_GHCCONSTANTS_HASKELL_WRAPPERS = includes/dist-derivedconstants/header/GHCConstantsHaskellWrappers.hs +includes_GHCCONSTANTS_HASKELL_EXPORTS = includes/dist-derivedconstants/header/GHCConstantsHaskellExports.hs + +INSTALL_LIBS += includes/dist-derivedconstants/header/platformConstants ifeq "$(PORTING_HOST)-$(AlienScript)" "YES-" @@ -160,44 +166,33 @@ ifeq "$(AlienScript)" "" else $(AlienScript) run ./$< >$@ endif -endif +$(includes_GHCCONSTANTS_HASKELL_TYPE) : $(INPLACE_BIN)/mkDerivedConstants$(exeext) | $$(dir $$@)/. +ifeq "$(AlienScript)" "" + ./$< --gen-haskell-type >$@ +else + $(AlienScript) run ./$< --gen-haskell-type >$@ endif -# ----------------------------------------------------------------------------- -# - -includes_GHCCONSTANTS = includes/dist-ghcconstants/header/GHCConstants.h - -ifeq "$(PORTING_HOST)-$(AlienScript)" "YES-" - -$(includes_GHCCONSTANTS) : - @echo "*** Cross-compiling: please copy DerivedConstants.h from the target system" - @exit 1 - +$(includes_GHCCONSTANTS_HASKELL_VALUE) : $(INPLACE_BIN)/mkDerivedConstants$(exeext) | $$(dir $$@)/. +ifeq "$(AlienScript)" "" + ./$< --gen-haskell-value >$@ else + $(AlienScript) run ./$< --gen-haskell-value >$@ +endif -includes_dist-ghcconstants_C_SRCS = mkDerivedConstants.c -includes_dist-ghcconstants_PROG = mkGHCConstants$(exeext) -includes_dist-ghcconstants_CC_OPTS = -DGEN_HASKELL - -$(eval $(call build-prog,includes,dist-ghcconstants,0)) - -ifneq "$(BINDIST)" "YES" -$(includes_dist-ghcconstants_depfile_c_asm) : $(includes_H_CONFIG) $(includes_H_PLATFORM) $(includes_H_FILES) $$(rts_H_FILES) - -includes/dist-ghcconstants/build/mkDerivedConstants.o : $(includes_H_CONFIG) $(includes_H_PLATFORM) - -ifneq "$(AlienScript)" "" -$(INPLACE_BIN)/mkGHCConstants$(exeext): includes/$(includes_dist-ghcconstants_C_SRCS) | $$(dir $$@)/. - $(WhatGccIsCalled) -o $@ $< $(CFLAGS) $(includes_CC_OPTS) $(includes_dist-ghcconstants_CC_OPTS) +$(includes_GHCCONSTANTS_HASKELL_WRAPPERS) : $(INPLACE_BIN)/mkDerivedConstants$(exeext) | $$(dir $$@)/. +ifeq "$(AlienScript)" "" + ./$< --gen-haskell-wrappers >$@ +else + $(AlienScript) run ./$< --gen-haskell-wrappers >$@ endif -$(includes_GHCCONSTANTS) : $(INPLACE_BIN)/mkGHCConstants$(exeext) | $$(dir $$@)/. +$(includes_GHCCONSTANTS_HASKELL_EXPORTS) : $(INPLACE_BIN)/mkDerivedConstants$(exeext) | $$(dir $$@)/. ifeq "$(AlienScript)" "" - ./$< >$@ + ./$< --gen-haskell-exports >$@ else - $(AlienScript) run ./$< >$@ + $(AlienScript) run ./$< --gen-haskell-exports >$@ endif endif @@ -208,11 +203,11 @@ endif $(eval $(call clean-target,includes,,\ $(includes_H_CONFIG) $(includes_H_PLATFORM) \ - $(includes_GHCCONSTANTS) $(includes_DERIVEDCONSTANTS))) + $(includes_GHCCONSTANTS_HASKELL_TYPE) $(includes_GHCCONSTANTS_HASKELL_VALUE) $(includes_DERIVEDCONSTANTS))) $(eval $(call all-target,includes,,\ $(includes_H_CONFIG) $(includes_H_PLATFORM) \ - $(includes_GHCCONSTANTS) $(includes_DERIVEDCONSTANTS))) + $(includes_GHCCONSTANTS_HASKELL_TYPE) $(includes_GHCCONSTANTS_HASKELL_VALUE) $(includes_DERIVEDCONSTANTS))) install: install_includes @@ -223,5 +218,5 @@ install_includes : $(call INSTALL_DIR,"$(DESTDIR)$(ghcheaderdir)/$d") && \ $(call INSTALL_HEADER,$(INSTALL_OPTS),includes/$d/*.h,"$(DESTDIR)$(ghcheaderdir)/$d/") && \ ) true - $(call INSTALL_HEADER,$(INSTALL_OPTS),$(includes_H_CONFIG) $(includes_H_PLATFORM) $(includes_GHCCONSTANTS) $(includes_DERIVEDCONSTANTS),"$(DESTDIR)$(ghcheaderdir)/") + $(call INSTALL_HEADER,$(INSTALL_OPTS),$(includes_H_CONFIG) $(includes_H_PLATFORM) $(includes_DERIVEDCONSTANTS),"$(DESTDIR)$(ghcheaderdir)/") 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; } diff --git a/includes/rts/Hooks.h b/includes/rts/Hooks.h index f409205b87..f536afaa09 100644 --- a/includes/rts/Hooks.h +++ b/includes/rts/Hooks.h @@ -18,9 +18,9 @@ extern char *ghc_rts_opts; extern void OnExitHook (void); extern int NoRunnableThreadsHook (void); -extern void StackOverflowHook (lnat stack_size); -extern void OutOfHeapHook (lnat request_size, lnat heap_size); -extern void MallocFailHook (lnat request_size /* in bytes */, char *msg); +extern void StackOverflowHook (W_ stack_size); +extern void OutOfHeapHook (W_ request_size, W_ heap_size); +extern void MallocFailHook (W_ request_size /* in bytes */, char *msg); extern void defaultsHook (void); #endif /* RTS_HOOKS_H */ diff --git a/includes/rts/SpinLock.h b/includes/rts/SpinLock.h index 8b337de73f..63a9395e18 100644 --- a/includes/rts/SpinLock.h +++ b/includes/rts/SpinLock.h @@ -34,7 +34,7 @@ typedef struct SpinLock_ typedef StgWord SpinLock; #endif -typedef lnat SpinLockCount; +typedef StgWord SpinLockCount; #if defined(PROF_SPIN) diff --git a/includes/rts/Threads.h b/includes/rts/Threads.h index 5db5cb7bd8..60d9bc45a1 100644 --- a/includes/rts/Threads.h +++ b/includes/rts/Threads.h @@ -22,17 +22,17 @@ // // Creating threads // -StgTSO *createThread (Capability *cap, nat stack_size); +StgTSO *createThread (Capability *cap, W_ stack_size); void scheduleWaitThread (/* in */ StgTSO *tso, /* out */ HaskellObj* ret, /* inout */ Capability **cap); -StgTSO *createGenThread (Capability *cap, nat stack_size, +StgTSO *createGenThread (Capability *cap, W_ stack_size, StgClosure *closure); -StgTSO *createIOThread (Capability *cap, nat stack_size, +StgTSO *createIOThread (Capability *cap, W_ stack_size, StgClosure *closure); -StgTSO *createStrictIOThread (Capability *cap, nat stack_size, +StgTSO *createStrictIOThread (Capability *cap, W_ stack_size, StgClosure *closure); // Suspending/resuming threads around foreign calls diff --git a/includes/rts/Types.h b/includes/rts/Types.h index ff42cdab1f..aacbfdc0b8 100644 --- a/includes/rts/Types.h +++ b/includes/rts/Types.h @@ -16,8 +16,10 @@ #include <stddef.h> -typedef unsigned int nat; /* at least 32 bits (like int) */ -typedef size_t lnat; /* at least 32 bits */ +typedef unsigned int nat; /* at least 32 bits (like int) */ + +// Deprecated; just use StgWord instead +typedef StgWord lnat; /* ullong (64|128-bit) type: only include if needed (not ANSI) */ #if defined(__GNUC__) diff --git a/includes/rts/storage/Block.h b/includes/rts/storage/Block.h index c73c9af90a..0a9b12b874 100644 --- a/includes/rts/storage/Block.h +++ b/includes/rts/storage/Block.h @@ -244,11 +244,11 @@ extern void initBlockAllocator(void); /* Allocation -------------------------------------------------------------- */ -bdescr *allocGroup(nat n); +bdescr *allocGroup(W_ n); bdescr *allocBlock(void); // versions that take the storage manager lock for you: -bdescr *allocGroup_lock(nat n); +bdescr *allocGroup_lock(W_ n); bdescr *allocBlock_lock(void); /* De-Allocation ----------------------------------------------------------- */ diff --git a/includes/rts/storage/ClosureMacros.h b/includes/rts/storage/ClosureMacros.h index c6b29aa5b8..146564a17f 100644 --- a/includes/rts/storage/ClosureMacros.h +++ b/includes/rts/storage/ClosureMacros.h @@ -429,20 +429,20 @@ EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame ) -------------------------------------------------------------------------- */ // The number of card bytes needed -INLINE_HEADER lnat mutArrPtrsCards (lnat elems) +INLINE_HEADER W_ mutArrPtrsCards (W_ elems) { - return (lnat)((elems + (1 << MUT_ARR_PTRS_CARD_BITS) - 1) + return (W_)((elems + (1 << MUT_ARR_PTRS_CARD_BITS) - 1) >> MUT_ARR_PTRS_CARD_BITS); } // The number of words in the card table -INLINE_HEADER lnat mutArrPtrsCardTableSize (lnat elems) +INLINE_HEADER W_ mutArrPtrsCardTableSize (W_ elems) { return ROUNDUP_BYTES_TO_WDS(mutArrPtrsCards(elems)); } // The address of the card for a particular card number -INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, lnat n) +INLINE_HEADER StgWord8 *mutArrPtrsCard (StgMutArrPtrs *a, W_ n) { return ((StgWord8 *)&(a->payload[a->ptrs]) + n); } diff --git a/includes/rts/storage/GC.h b/includes/rts/storage/GC.h index 5de8b2be4a..fadaa8c1a4 100644 --- a/includes/rts/storage/GC.h +++ b/includes/rts/storage/GC.h @@ -124,13 +124,13 @@ extern generation * oldest_gen; /* ----------------------------------------------------------------------------- Generic allocation - StgPtr allocate(Capability *cap, nat n) + StgPtr allocate(Capability *cap, W_ n) Allocates memory from the nursery in the current Capability. This can be done without taking a global lock, unlike allocate(). - StgPtr allocatePinned(Capability *cap, nat n) + StgPtr allocatePinned(Capability *cap, W_ n) Allocates a chunk of contiguous store n words long, which is at a fixed address (won't be moved by GC). @@ -149,15 +149,15 @@ extern generation * oldest_gen; -------------------------------------------------------------------------- */ -StgPtr allocate ( Capability *cap, lnat n ); -StgPtr allocatePinned ( Capability *cap, lnat n ); +StgPtr allocate ( Capability *cap, W_ n ); +StgPtr allocatePinned ( Capability *cap, W_ n ); /* memory allocator for executable memory */ -void * allocateExec(unsigned int len, void **exec_addr); +void * allocateExec(W_ len, void **exec_addr); void freeExec (void *p); // Used by GC checks in external .cmm code: -extern nat large_alloc_lim; +extern W_ large_alloc_lim; /* ----------------------------------------------------------------------------- Performing Garbage Collection diff --git a/includes/rts/storage/MBlock.h b/includes/rts/storage/MBlock.h index 69b3742514..7a5eb22cc9 100644 --- a/includes/rts/storage/MBlock.h +++ b/includes/rts/storage/MBlock.h @@ -12,8 +12,8 @@ #ifndef RTS_STORAGE_MBLOCK_H #define RTS_STORAGE_MBLOCK_H -extern lnat peak_mblocks_allocated; -extern lnat mblocks_allocated; +extern W_ peak_mblocks_allocated; +extern W_ mblocks_allocated; extern void initMBlocks(void); extern void * getMBlock(void); @@ -156,7 +156,7 @@ typedef struct { MBlockMapLine lines[MBLOCK_MAP_ENTRIES]; } MBlockMap; -extern lnat mpc_misses; +extern W_ mpc_misses; StgBool HEAP_ALLOCED_miss(StgWord mblock, void *p); diff --git a/includes/stg/Types.h b/includes/stg/Types.h index 839c0641c0..d6bdc9042b 100644 --- a/includes/stg/Types.h +++ b/includes/stg/Types.h @@ -43,9 +43,6 @@ /* * First, platform-dependent definitions of size-specific integers. - * Assume for now that the int type is 32 bits. - * NOTE: Synch the following definitions with MachDeps.h! - * ToDo: move these into a platform-dependent file. */ typedef signed char StgInt8; @@ -89,12 +86,6 @@ typedef unsigned long long int StgWord64; /* * Define the standard word size we'll use on this machine: make it * big enough to hold a pointer. - * - * It's useful if StgInt/StgWord are always the same as long, so that - * we can use a consistent printf format specifier without warnings on - * any platform. Fortunately this works at the moement; if it breaks - * in the future we'll have to start using macros for format - * specifiers (c.f. FMT_StgWord64 in Rts.h). */ #if SIZEOF_VOID_P == 8 @@ -138,10 +129,11 @@ typedef void* StgStablePtr; typedef StgWord8* StgByteArray; /* - Types for the generated C functions - take no arguments - return a pointer to the next function to be called - use: Ptr to Fun that returns a Ptr to Fun which returns Ptr to void + Types for generated C functions when compiling via C. + + The C functions take no arguments, and return a pointer to the next + function to be called use: Ptr to Fun that returns a Ptr to Fun + which returns Ptr to void Note: Neither StgFunPtr not StgFun is quite right (that is, StgFunPtr != StgFun*). So, the functions we define all have type |