Commit f49271c0 authored by ian@well-typed.com's avatar ian@well-typed.com

Replace mkDerivedConstants.c with DeriveConstants.hs

DeriveConstants.hs works in a cross-compilation-friendly way. Rather
than running a C program that prints out the constants, we just compile
a C file which has the constants are encoded in symbol sizes. We then
parse the output of 'nm' to find out what the constants are.

Based on work by Gabor Greif <ggreif@gmail.com>.
parent b78b6b34
......@@ -28,6 +28,16 @@ ifneq "$(BINDIST)" "YES"
compiler/stage1/package-data.mk : compiler/stage1/build/Config.hs
compiler/stage2/package-data.mk : compiler/stage2/build/Config.hs
compiler/stage3/package-data.mk : compiler/stage3/build/Config.hs
compiler/stage1/build/DynFlags.o: $(includes_GHCCONSTANTS_HASKELL_TYPE)
compiler/stage2/build/DynFlags.o: $(includes_GHCCONSTANTS_HASKELL_TYPE)
compiler/stage3/build/DynFlags.o: $(includes_GHCCONSTANTS_HASKELL_TYPE)
compiler/stage1/build/DynFlags.o: $(includes_GHCCONSTANTS_HASKELL_EXPORTS)
compiler/stage2/build/DynFlags.o: $(includes_GHCCONSTANTS_HASKELL_EXPORTS)
compiler/stage3/build/DynFlags.o: $(includes_GHCCONSTANTS_HASKELL_EXPORTS)
compiler/stage1/build/DynFlags.o: $(includes_GHCCONSTANTS_HASKELL_WRAPPERS)
compiler/stage2/build/DynFlags.o: $(includes_GHCCONSTANTS_HASKELL_WRAPPERS)
compiler/stage3/build/DynFlags.o: $(includes_GHCCONSTANTS_HASKELL_WRAPPERS)
endif
compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/.
......
......@@ -1248,7 +1248,7 @@ defaultDynFlags mySettings =
}
defaultWays :: Settings -> [Way]
defaultWays settings = if pc_dYNAMIC_BY_DEFAULT (sPlatformConstants settings)
defaultWays settings = if pc_DYNAMIC_BY_DEFAULT (sPlatformConstants settings)
then [WayDyn]
else []
......@@ -2571,7 +2571,7 @@ defaultFlags settings
++ default_PIC platform
++ (if pc_dYNAMIC_BY_DEFAULT (sPlatformConstants settings)
++ (if pc_DYNAMIC_BY_DEFAULT (sPlatformConstants settings)
then wayGeneralFlags platform WayDyn
else [Opt_Static])
......
......@@ -662,6 +662,7 @@ BUILD_DIRS += \
$(MAYBE_COMPILER) \
$(GHC_HSC2HS_DIR) \
$(GHC_PKG_DIR) \
utils/deriveConstants \
utils/testremove \
$(MAYBE_GHCTAGS) \
utils/ghc-pwd \
......@@ -1294,6 +1295,7 @@ distclean : clean
$(call removeFiles,libraries/unix/include/HsUnixConfig.h)
$(call removeFiles,libraries/old-time/include/HsTimeConfig.h)
$(call removeTrees,utils/ghc-pwd/dist-boot)
$(call removeTrees,includes/dist-derivedconstants)
$(call removeTrees,inplace)
$(call removeTrees,$(patsubst %, libraries/%/autom4te.cache, $(PACKAGES_STAGE1) $(PACKAGES_STAGE2)))
......
......@@ -143,79 +143,45 @@ includes_GHCCONSTANTS_HASKELL_VALUE = includes/dist-derivedconstants/header/plat
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
INSTALL_LIBS += $(includes_GHCCONSTANTS_HASKELL_VALUE)
ifeq "$(PORTING_HOST)-$(AlienScript)" "YES-"
DerivedConstants.h :
@echo "*** Cross-compiling: please copy DerivedConstants.h from the target system"
@exit 1
else
includes_dist-derivedconstants_C_SRCS = mkDerivedConstants.c
includes_dist-derivedconstants_PROG = mkDerivedConstants$(exeext)
includes_dist-derivedconstants_INSTALL_INPLACE = YES
$(eval $(call build-prog,includes,dist-derivedconstants,0))
$(includes_dist-derivedconstants_depfile_c_asm) : $(includes_H_CONFIG) $(includes_H_PLATFORM) $(includes_H_FILES) $$(rts_H_FILES)
includes/dist-derivedconstants/build/mkDerivedConstants.o : $(includes_H_CONFIG) $(includes_H_PLATFORM)
ifneq "$(AlienScript)" ""
$(INPLACE_BIN)/mkDerivedConstants$(exeext): includes/$(includes_dist-derivedconstants_C_SRCS) | $$(dir $$@)/.
$(WhatGccIsCalled) -o $@ $< $(CFLAGS) $(includes_CC_OPTS)
endif
DERIVE_CONSTANTS_FLAGS += --gcc-program "$(WhatGccIsCalled)"
DERIVE_CONSTANTS_FLAGS += $(addprefix --gcc-flag$(space),$(includes_CC_OPTS) -fcommon)
DERIVE_CONSTANTS_FLAGS += --nm-program "$(NM)"
ifneq "$(BINDIST)" "YES"
$(includes_DERIVEDCONSTANTS) : $(INPLACE_BIN)/mkDerivedConstants$(exeext) | $$(dir $$@)/.
ifeq "$(AlienScript)" ""
./$< >$@
else
$(AlienScript) run ./$< >$@
endif
$(includes_DERIVEDCONSTANTS): $$(includes_H_CONFIG) $$(includes_H_PLATFORM) $$(includes_H_FILES) $$(rts_H_FILES)
$(includes_GHCCONSTANTS_HASKELL_VALUE): $$(includes_H_CONFIG) $$(includes_H_PLATFORM) $$(includes_H_FILES) $$(rts_H_FILES)
$(includes_GHCCONSTANTS_HASKELL_TYPE) : $(INPLACE_BIN)/mkDerivedConstants$(exeext) | $$(dir $$@)/.
ifeq "$(AlienScript)" ""
./$< --gen-haskell-type >$@
else
$(AlienScript) run ./$< --gen-haskell-type >$@
endif
$(includes_DERIVEDCONSTANTS): $(INPLACE_BIN)/deriveConstants$(exeext) | $$(dir $$@)/.
$< --gen-header -o $@ --tmpdir $(dir $@) $(DERIVE_CONSTANTS_FLAGS)
$(includes_GHCCONSTANTS_HASKELL_VALUE) : $(INPLACE_BIN)/mkDerivedConstants$(exeext) | $$(dir $$@)/.
ifeq "$(AlienScript)" ""
./$< --gen-haskell-value >$@
else
$(AlienScript) run ./$< --gen-haskell-value >$@
endif
$(includes_GHCCONSTANTS_HASKELL_TYPE): $(INPLACE_BIN)/deriveConstants$(exeext) | $$(dir $$@)/.
$< --gen-haskell-type -o $@ --tmpdir $(dir $@) $(DERIVE_CONSTANTS_FLAGS)
$(includes_GHCCONSTANTS_HASKELL_WRAPPERS) : $(INPLACE_BIN)/mkDerivedConstants$(exeext) | $$(dir $$@)/.
ifeq "$(AlienScript)" ""
./$< --gen-haskell-wrappers >$@
else
$(AlienScript) run ./$< --gen-haskell-wrappers >$@
endif
$(includes_GHCCONSTANTS_HASKELL_VALUE): $(INPLACE_BIN)/deriveConstants$(exeext) | $$(dir $$@)/.
$< --gen-haskell-value -o $@ --tmpdir $(dir $@) $(DERIVE_CONSTANTS_FLAGS)
$(includes_GHCCONSTANTS_HASKELL_EXPORTS) : $(INPLACE_BIN)/mkDerivedConstants$(exeext) | $$(dir $$@)/.
ifeq "$(AlienScript)" ""
./$< --gen-haskell-exports >$@
else
$(AlienScript) run ./$< --gen-haskell-exports >$@
endif
endif
$(includes_GHCCONSTANTS_HASKELL_WRAPPERS): $(INPLACE_BIN)/deriveConstants$(exeext) | $$(dir $$@)/.
$< --gen-haskell-wrappers -o $@ --tmpdir $(dir $@) $(DERIVE_CONSTANTS_FLAGS)
$(includes_GHCCONSTANTS_HASKELL_EXPORTS): $(INPLACE_BIN)/deriveConstants$(exeext) | $$(dir $$@)/.
$< --gen-haskell-exports -o $@ --tmpdir $(dir $@) $(DERIVE_CONSTANTS_FLAGS)
endif
# ---------------------------------------------------------------------------
# Install all header files
$(eval $(call clean-target,includes,,\
$(includes_H_CONFIG) $(includes_H_PLATFORM) \
$(includes_GHCCONSTANTS_HASKELL_TYPE) $(includes_GHCCONSTANTS_HASKELL_VALUE) $(includes_DERIVEDCONSTANTS)))
$(includes_H_CONFIG) $(includes_H_PLATFORM)))
$(eval $(call all-target,includes,,\
$(includes_H_CONFIG) $(includes_H_PLATFORM) \
$(includes_GHCCONSTANTS_HASKELL_TYPE) $(includes_GHCCONSTANTS_HASKELL_VALUE) $(includes_DERIVEDCONSTANTS)))
$(includes_GHCCONSTANTS_HASKELL_TYPE) \
$(includes_GHCCONSTANTS_HASKELL_VALUE) \
$(includes_GHCCONSTANTS_HASKELL_WRAPPERS) \
$(includes_GHCCONSTANTS_HASKELL_EXPORTS) \
$(includes_DERIVEDCONSTANTS)))
install: install_includes
......
/* --------------------------------------------------------------------------
*
* (c) The GHC Team, 1992-2012
*
* mkDerivedConstants.c
*
* Basically this is a C program that extracts information from the C
* declarations in the header files (primarily struct field offsets)
* and generates a header file that can be #included into non-C source
* containing this information.
*
* ------------------------------------------------------------------------*/
#define IN_STG_CODE 0
/*
* We need offsets of profiled things... better be careful that this
* doesn't affect the offsets of anything else.
*/
#define PROFILING
#define THREADED_RTS
#include "PosixSource.h"
#include "Rts.h"
#include "Stable.h"
#include "Capability.h"
#include <inttypes.h>
#include <stdio.h>
#include <string.h>
#if !defined(PRIdPTR)
#if SIZEOF_VOID_P == SIZEOF_INT
/* compiling for 32bit target */
#define PRIdPTR "d"
#elif SIZEOF_VOID_P == SIZEOF_LONG
/* compiling for 64bit target */
#define PRIdPTR "ld"
#else
#error Cannot find definition for PRIdPTR
#endif
#endif
enum Mode { Gen_Haskell_Type, Gen_Haskell_Value, Gen_Haskell_Wrappers, Gen_Haskell_Exports, Gen_Header } mode;
#define str(a,b) #a "_" #b
#define OFFSET(s_type, field) ((size_t)&(((s_type*)0)->field))
#define FIELD_SIZE(s_type, field) ((size_t)sizeof(((s_type*)0)->field))
#define TYPE_SIZE(type) (sizeof(type))
#pragma GCC poison sizeof
#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; \
}
/* 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_(want_haskell, str, s_type, field) \
switch (mode) { \
case Gen_Haskell_Type: \
if (want_haskell) { \
printf(" , pc_REP_" str " :: Int\n"); \
break; \
} \
case Gen_Haskell_Value: \
if (want_haskell) { \
printf(" , pc_REP_" str " = %" PRIdPTR "\n", (intptr_t)(FIELD_SIZE(s_type, field))); \
break; \
} \
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(want_haskell, s_type, field) \
field_type_(want_haskell,str(s_type,field),s_type,field);
#define field_offset_(str, s_type, field) \
def_offset(str, OFFSET(s_type,field));
#define field_offset(s_type, field) \
field_offset_(str(s_type,field),s_type,field);
/* An access macro for use in C-- sources. */
#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_helper(want_haskell, s_type, field) \
field_offset(s_type, field); \
field_type(want_haskell, s_type, field); \
struct_field_macro(str(s_type,field))
#define struct_field(s_type, field) \
struct_field_helper(0, s_type, field)
#define struct_field_h(s_type, field) \
struct_field_helper(1, s_type, field)
#define struct_field_(str, s_type, field) \
field_offset_(str, s_type, field); \
field_type_(0,str, s_type, field); \
struct_field_macro(str)
#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));
/*
* Size of a closure type, minus the header, named SIZEOF_<type>_NoHdr
* Also, we #define SIZEOF_<type> to be the size of the whole closure for .cmm.
*/
#define closure_size(s_type) \
def_size(#s_type "_NoHdr", TYPE_SIZE(s_type) - TYPE_SIZE(StgHeader)); \
def_closure_size(#s_type, TYPE_SIZE(s_type) - TYPE_SIZE(StgHeader));
#define thunk_size(s_type) \
def_size(#s_type "_NoThunkHdr", TYPE_SIZE(s_type) - TYPE_SIZE(StgThunkHeader)); \
closure_size(s_type)
/* An access macro for use in C-- sources. */
#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));
#define closure_field_offset(s_type,field) \
closure_field_offset_(str(s_type,field),s_type,field)
#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); \
closure_payload_macro(str(s_type,field));
/* Byte offset and MachRep for a closure field, minus the header */
#define closure_field_(str, s_type, field) \
closure_field_offset_(str,s_type,field) \
field_type_(0, str, s_type, field); \
closure_field_macro(str)
#define closure_field(s_type, field) \
closure_field_(str(s_type,field),s_type,field)
/* Byte offset and MachRep for a closure field, minus the header */
#define closure_field_gcptr_(str, s_type, field) \
closure_field_offset_(str,s_type,field) \
field_type_gcptr_(str, s_type, field); \
closure_field_macro(str)
#define closure_field_gcptr(s_type, field) \
closure_field_gcptr_(str(s_type,field),s_type,field)
/* Byte offset for a TSO field, minus the header and variable prof bit. */
#define tso_payload_offset(s_type, field) \
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 */
#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));
#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(0, s_type, field); \
tso_field_offset(s_type,field); \
tso_field_macro(str(s_type,field))
#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 constantBool(char *haskellName, int val) {
switch (mode) {
case Gen_Haskell_Type:
printf(" , pc_%s :: Bool\n", haskellName);
break;
case Gen_Haskell_Value:
printf(" , pc_%s = %s\n", haskellName, val ? "True" : "False");
break;
case Gen_Haskell_Wrappers:
printf("%s :: DynFlags -> Bool\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:
break;
}
}
void constantIntegralC(char *haskellType, char *cName, char *haskellName,
intptr_t val) {
switch (mode) {
case Gen_Haskell_Type:
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 -> %s\n", haskellName, haskellType);
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 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);
}
void constantInteger(char *name, intptr_t val) {
constantIntegralC("Integer", NULL, name, val);
}
int
main(int argc, char *argv[])
{
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) */
constantIntC("PROF_HDR_SIZE", "pROF_HDR_SIZE", sizeofW(StgProfHeader));
// Size of a storage manager block (in bytes).
constantIntC("BLOCK_SIZE", "bLOCK_SIZE", BLOCK_SIZE);
if (mode == Gen_Header) {
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);
field_offset(StgRegTable, rR4);
field_offset(StgRegTable, rR5);
field_offset(StgRegTable, rR6);
field_offset(StgRegTable, rR7);
field_offset(StgRegTable, rR8);
field_offset(StgRegTable, rR9);
field_offset(StgRegTable, rR10);
field_offset(StgRegTable, rF1);
field_offset(StgRegTable, rF2);
field_offset(StgRegTable, rF3);
field_offset(StgRegTable, rF4);
field_offset(StgRegTable, rF5);
field_offset(StgRegTable, rF6);
field_offset(StgRegTable, rD1);
field_offset(StgRegTable, rD2);
field_offset(StgRegTable, rD3);
field_offset(StgRegTable, rD4);
field_offset(StgRegTable, rD5);
field_offset(StgRegTable, rD6);
field_offset(StgRegTable, rL1);
field_offset(StgRegTable, rSp);
field_offset(StgRegTable, rSpLim);
field_offset(StgRegTable, rHp);
field_offset(StgRegTable, rHpLim);
field_offset(StgRegTable, rCCCS);
field_offset(StgRegTable, rCurrentTSO);
field_offset(StgRegTable, rCurrentNursery);
field_offset(StgRegTable, rHpAlloc);
if (mode == Gen_Header) {
struct_field(StgRegTable, rRet);
struct_field(StgRegTable, rNursery);
}
def_offset("stgEagerBlackholeInfo", FUN_OFFSET(stgEagerBlackholeInfo));
def_offset("stgGCEnter1", FUN_OFFSET(stgGCEnter1));
def_offset("stgGCFun", FUN_OFFSET(stgGCFun));
field_offset(Capability, r);
if (mode == Gen_Header) {
field_offset(Capability, lock);
struct_field(Capability, no);
struct_field(Capability, mut_lists);
struct_field(Capability, context_switch);
struct_field(Capability, interrupt);
struct_field(Capability, sparks);
}
struct_field(bdescr, start);
struct_field(bdescr, free);
struct_field(bdescr, blocks);
if (mode == Gen_Header) {
struct_field(bdescr, gen_no);
struct_field(bdescr, link);
struct_size(generation);
struct_field(generation, n_new_large_words);
}
struct_size(CostCentreStack);
if (mode == Gen_Header) {
struct_field(CostCentreStack, ccsID);
}
struct_field_h(CostCentreStack, mem_alloc);
struct_field_h(CostCentreStack, scc_count);
if (mode == Gen_Header) {
struct_field(CostCentreStack, prevStack);
struct_field(CostCentre, ccID);
struct_field(CostCentre, link);
struct_field(StgHeader, info);
}
struct_field_("StgHeader_ccs", StgHeader, prof.ccs);
struct_field_("StgHeader_ldvw", StgHeader, prof.hp.ldvw);
struct_size(StgSMPThunkHeader);
if (mode == Gen_Header) {
closure_payload(StgClosure,payload);
}
struct_field_h(StgEntCounter, allocs);
struct_field(StgEntCounter, registeredp);
struct_field(StgEntCounter, link);
struct_field(StgEntCounter, entry_count);
closure_size(StgUpdateFrame);
if (mode == Gen_Header) {
closure_size(StgCatchFrame);
closure_size(StgStopFrame);
}
closure_size(StgMutArrPtrs);
closure_field(StgMutArrPtrs, ptrs);
closure_field(StgMutArrPtrs, size);
closure_size(StgArrWords);
if (mode == Gen_Header) {
closure_field(StgArrWords, bytes);
closure_payload(StgArrWords, payload);
closure_field(StgTSO, _link);
closure_field(StgTSO, global_link);
closure_field(StgTSO, what_next);
closure_field(StgTSO, why_blocked);
closure_field(StgTSO, block_info);
closure_field(StgTSO, blocked_exceptions);
closure_field(StgTSO, id);
closure_field(StgTSO, cap);
closure_field(StgTSO, saved_errno);
closure_field(StgTSO, trec);
closure_field(StgTSO, flags);