diff options
Diffstat (limited to 'includes')
49 files changed, 10937 insertions, 0 deletions
diff --git a/includes/Block.h b/includes/Block.h new file mode 100644 index 0000000000..d1705ad686 --- /dev/null +++ b/includes/Block.h @@ -0,0 +1,202 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-1999 + * + * Block structure for the storage manager + * + * ---------------------------------------------------------------------------*/ + +#ifndef BLOCK_H +#define BLOCK_H + +/* The actual block and megablock-size constants are defined in + * includes/Constants.h, all constants here are derived from these. + */ + +/* Block related constants (BLOCK_SHIFT is defined in Constants.h) */ + +#define BLOCK_SIZE (1<<BLOCK_SHIFT) +#define BLOCK_SIZE_W (BLOCK_SIZE/sizeof(W_)) +#define BLOCK_MASK (BLOCK_SIZE-1) + +#define BLOCK_ROUND_UP(p) ((void *) (((W_)(p)+BLOCK_SIZE-1) & ~BLOCK_MASK)) +#define BLOCK_ROUND_DOWN(p) ((void *) ((W_)(p) & ~BLOCK_MASK)) + +/* Megablock related constants (MBLOCK_SHIFT is defined in Constants.h) */ + +#define MBLOCK_SIZE (1<<MBLOCK_SHIFT) +#define MBLOCK_SIZE_W (MBLOCK_SIZE/sizeof(W_)) +#define MBLOCK_MASK (MBLOCK_SIZE-1) + +#define MBLOCK_ROUND_UP(p) ((void *)(((W_)(p)+MBLOCK_SIZE-1) & ~MBLOCK_MASK)) +#define MBLOCK_ROUND_DOWN(p) ((void *)((W_)(p) & ~MBLOCK_MASK )) + +/* The largest size an object can be before we give it a block of its + * own and treat it as an immovable object during GC, expressed as a + * fraction of BLOCK_SIZE. + */ +#define LARGE_OBJECT_THRESHOLD ((nat)(BLOCK_SIZE * 8 / 10)) + +/* ----------------------------------------------------------------------------- + * Block descriptor. This structure *must* be the right length, so we + * can do pointer arithmetic on pointers to it. + */ + +/* The block descriptor is 64 bytes on a 64-bit machine, and 32-bytes + * on a 32-bit machine. + */ + +#ifndef CMINUSMINUS +typedef struct bdescr_ { + StgPtr start; /* start addr of memory */ + StgPtr free; /* first free byte of memory */ + struct bdescr_ *link; /* used for chaining blocks together */ + union { + struct bdescr_ *back; /* used (occasionally) for doubly-linked lists*/ + StgWord *bitmap; + } u; + unsigned int gen_no; /* generation */ + struct step_ *step; /* step */ + StgWord32 blocks; /* no. of blocks (if grp head, 0 otherwise) */ + StgWord32 flags; /* block is in to-space */ +#if SIZEOF_VOID_P == 8 + StgWord32 _padding[2]; +#else + StgWord32 _padding[0]; +#endif +} bdescr; +#endif + +#if SIZEOF_VOID_P == 8 +#define BDESCR_SIZE 0x40 +#define BDESCR_MASK 0x3f +#define BDESCR_SHIFT 6 +#else +#define BDESCR_SIZE 0x20 +#define BDESCR_MASK 0x1f +#define BDESCR_SHIFT 5 +#endif + +/* Block contains objects evacuated during this GC */ +#define BF_EVACUATED 1 +/* Block is a large object */ +#define BF_LARGE 2 +/* Block is pinned */ +#define BF_PINNED 4 +/* Block is part of a compacted generation */ +#define BF_COMPACTED 8 +/* Block is free, and on the free list */ +#define BF_FREE 16 + +/* Finding the block descriptor for a given block -------------------------- */ + +#ifdef CMINUSMINUS + +#define Bdescr(p) \ + ((((p) & MBLOCK_MASK & ~BLOCK_MASK) >> (BLOCK_SHIFT-BDESCR_SHIFT)) \ + | ((p) & ~MBLOCK_MASK)) + +#else + +INLINE_HEADER bdescr *Bdescr(StgPtr p) +{ + return (bdescr *) + ((((W_)p & MBLOCK_MASK & ~BLOCK_MASK) >> (BLOCK_SHIFT-BDESCR_SHIFT)) + | ((W_)p & ~MBLOCK_MASK) + ); +} + +#endif + +/* Useful Macros ------------------------------------------------------------ */ + +/* Offset of first real data block in a megablock */ + +#define FIRST_BLOCK_OFF \ + ((W_)BLOCK_ROUND_UP(BDESCR_SIZE * (MBLOCK_SIZE / BLOCK_SIZE))) + +/* First data block in a given megablock */ + +#define FIRST_BLOCK(m) ((void *)(FIRST_BLOCK_OFF + (W_)(m))) + +/* Last data block in a given megablock */ + +#define LAST_BLOCK(m) ((void *)(MBLOCK_SIZE-BLOCK_SIZE + (W_)(m))) + +/* First real block descriptor in a megablock */ + +#define FIRST_BDESCR(m) \ + ((bdescr *)((FIRST_BLOCK_OFF>>(BLOCK_SHIFT-BDESCR_SHIFT)) + (W_)(m))) + +/* Number of usable blocks in a megablock */ + +#define BLOCKS_PER_MBLOCK ((MBLOCK_SIZE - FIRST_BLOCK_OFF) / BLOCK_SIZE) + +/* How many blocks in this megablock group */ + +#define MBLOCK_GROUP_BLOCKS(n) \ + (BLOCKS_PER_MBLOCK + (n-1) * (MBLOCK_SIZE / BLOCK_SIZE)) + +/* Compute the required size of a megablock group */ + +#define BLOCKS_TO_MBLOCKS(n) \ + (1 + (W_)MBLOCK_ROUND_UP((n-BLOCKS_PER_MBLOCK) * BLOCK_SIZE) / MBLOCK_SIZE) + + +#ifndef CMINUSMINUS +/* to the end... */ + +/* Double-linked block lists: --------------------------------------------- */ + +INLINE_HEADER void +dbl_link_onto(bdescr *bd, bdescr **list) +{ + bd->link = *list; + bd->u.back = NULL; + if (*list) { + (*list)->u.back = bd; /* double-link the list */ + } + *list = bd; +} + +/* Initialisation ---------------------------------------------------------- */ + +extern void initBlockAllocator(void); + +/* Allocation -------------------------------------------------------------- */ + +bdescr *allocGroup(nat n); +bdescr *allocBlock(void); + +// versions that take the storage manager lock for you: +bdescr *allocGroup_lock(nat n); +bdescr *allocBlock_lock(void); + +/* De-Allocation ----------------------------------------------------------- */ + +void freeGroup(bdescr *p); +void freeChain(bdescr *p); + +// versions that take the storage manager lock for you: +void freeGroup_lock(bdescr *p); +void freeChain_lock(bdescr *p); + +/* Round a value to megablocks --------------------------------------------- */ + +#define WORDS_PER_MBLOCK (BLOCKS_PER_MBLOCK * BLOCK_SIZE_W) + +INLINE_HEADER nat +round_to_mblocks(nat words) +{ + if (words > WORDS_PER_MBLOCK) { + if ((words % WORDS_PER_MBLOCK) < (WORDS_PER_MBLOCK / 2)) { + words = (words / WORDS_PER_MBLOCK) * WORDS_PER_MBLOCK; + } else { + words = ((words / WORDS_PER_MBLOCK) + 1) * WORDS_PER_MBLOCK; + } + } + return words; +} + +#endif /* !CMINUSMINUS */ +#endif /* BLOCK_H */ diff --git a/includes/Bytecodes.h b/includes/Bytecodes.h new file mode 100644 index 0000000000..73003a3002 --- /dev/null +++ b/includes/Bytecodes.h @@ -0,0 +1,86 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2002 + * + * Bytecode definitions. + * + * ---------------------------------------------------------------------------*/ + +/* -------------------------------------------------------------------------- + * Instructions + * + * Notes: + * o CASEFAIL is generated by the compiler whenever it tests an "irrefutable" + * pattern which fails. If we don't see too many of these, we could + * optimise out the redundant test. + * ------------------------------------------------------------------------*/ + +/* NOTE: + + THIS FILE IS INCLUDED IN HASKELL SOURCES (ghc/compiler/ghci/ByteCodeGen.lhs). + DO NOT PUT C-SPECIFIC STUFF IN HERE! + + I hope that's clear :-) +*/ + +#define bci_STKCHECK 1 +#define bci_PUSH_L 2 +#define bci_PUSH_LL 3 +#define bci_PUSH_LLL 4 +#define bci_PUSH_G 5 +#define bci_PUSH_ALTS 6 +#define bci_PUSH_ALTS_P 7 +#define bci_PUSH_ALTS_N 8 +#define bci_PUSH_ALTS_F 9 +#define bci_PUSH_ALTS_D 10 +#define bci_PUSH_ALTS_L 11 +#define bci_PUSH_ALTS_V 12 +#define bci_PUSH_UBX 13 +#define bci_PUSH_APPLY_N 14 +#define bci_PUSH_APPLY_F 15 +#define bci_PUSH_APPLY_D 16 +#define bci_PUSH_APPLY_L 17 +#define bci_PUSH_APPLY_V 18 +#define bci_PUSH_APPLY_P 19 +#define bci_PUSH_APPLY_PP 20 +#define bci_PUSH_APPLY_PPP 21 +#define bci_PUSH_APPLY_PPPP 22 +#define bci_PUSH_APPLY_PPPPP 23 +#define bci_PUSH_APPLY_PPPPPP 24 +/* #define bci_PUSH_APPLY_PPPPPPP 25 */ +#define bci_SLIDE 26 +#define bci_ALLOC_AP 27 +#define bci_ALLOC_PAP 28 +#define bci_MKAP 29 +#define bci_MKPAP 30 +#define bci_UNPACK 31 +#define bci_PACK 32 +#define bci_TESTLT_I 33 +#define bci_TESTEQ_I 34 +#define bci_TESTLT_F 35 +#define bci_TESTEQ_F 36 +#define bci_TESTLT_D 37 +#define bci_TESTEQ_D 38 +#define bci_TESTLT_P 39 +#define bci_TESTEQ_P 40 +#define bci_CASEFAIL 41 +#define bci_JMP 42 +#define bci_CCALL 43 +#define bci_SWIZZLE 44 +#define bci_ENTER 45 +#define bci_RETURN 46 +#define bci_RETURN_P 47 +#define bci_RETURN_N 48 +#define bci_RETURN_F 49 +#define bci_RETURN_D 50 +#define bci_RETURN_L 51 +#define bci_RETURN_V 52 + +/* If a BCO definitely requires less than this many words of stack, + don't include an explicit STKCHECK insn in it. The interpreter + will check for this many words of stack before running each BCO, + rendering an explicit check unnecessary in the majority of + cases. */ +#define INTERP_STACK_CHECK_THRESH 50 + +/*-------------------------------------------------------------------------*/ diff --git a/includes/ClosureMacros.h b/includes/ClosureMacros.h new file mode 100644 index 0000000000..f40f6aace6 --- /dev/null +++ b/includes/ClosureMacros.h @@ -0,0 +1,198 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Macros for building and manipulating closures + * + * -------------------------------------------------------------------------- */ + +#ifndef CLOSUREMACROS_H +#define CLOSUREMACROS_H + +/* Say whether the code comes before the heap; on mingwin this may not be the + case, not because of another random MS pathology, but because the static + program may reside in a DLL +*/ + +/* ----------------------------------------------------------------------------- + Info tables are slammed up against the entry code, and the label + for the info table is at the *end* of the table itself. This + inline function adjusts an info pointer to point to the beginning + of the table, so we can use standard C structure indexing on it. + + Note: this works for SRT info tables as long as you don't want to + access the SRT, since they are laid out the same with the SRT + pointer as the first word in the table. + + NOTES ABOUT MANGLED C VS. MINI-INTERPRETER: + + A couple of definitions: + + "info pointer" The first word of the closure. Might point + to either the end or the beginning of the + info table, depending on whether we're using + the mini interpretter or not. GET_INFO(c) + retrieves the info pointer of a closure. + + "info table" The info table structure associated with a + closure. This is always a pointer to the + beginning of the structure, so we can + use standard C structure indexing to pull out + the fields. get_itbl(c) returns a pointer to + the info table for closure c. + + An address of the form xxxx_info points to the end of the info + table or the beginning of the info table depending on whether we're + mangling or not respectively. So, + + c->header.info = xxx_info + + makes absolute sense, whether mangling or not. + + -------------------------------------------------------------------------- */ + +#define SET_INFO(c,i) ((c)->header.info = (i)) +#define GET_INFO(c) ((c)->header.info) +#define GET_ENTRY(c) (ENTRY_CODE(GET_INFO(c))) + +#define get_itbl(c) (INFO_PTR_TO_STRUCT((c)->header.info)) +#define get_ret_itbl(c) (RET_INFO_PTR_TO_STRUCT((c)->header.info)) +#define get_fun_itbl(c) (FUN_INFO_PTR_TO_STRUCT((c)->header.info)) +#define get_thunk_itbl(c) (THUNK_INFO_PTR_TO_STRUCT((c)->header.info)) + +#define GET_TAG(con) (get_itbl(con)->srt_bitmap) + +#ifdef TABLES_NEXT_TO_CODE +#define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1) +#define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)(info) - 1) +#define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)(info) - 1) +#define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)(info) - 1) +#define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(((StgInfoTable *)(i) + 1)) - 1) +#define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(((StgInfoTable *)(i) + 1)) - 1) +#define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(((StgInfoTable *)(i) + 1)) - 1) +#else +#define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)info) +#define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)info) +#define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)info) +#define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)info) +#define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(i)) +#define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(i)) +#define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(i)) +#endif + +/* ----------------------------------------------------------------------------- + Macros for building closures + -------------------------------------------------------------------------- */ + +#ifdef PROFILING +#ifdef DEBUG_RETAINER +/* + For the sake of debugging, we take the safest way for the moment. Actually, this + is useful to check the sanity of heap before beginning retainer profiling. + flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h. + Note: change those functions building Haskell objects from C datatypes, i.e., + all rts_mk???() functions in RtsAPI.c, as well. + */ +#define SET_PROF_HDR(c,ccs_) \ + ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip)) +#else +/* + For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to + NULL | flip (flip is defined in RetainerProfile.c) because even when flip + is 1, rs is invalid and will be initialized to NULL | flip later when + the closure *c is visited. + */ +/* +#define SET_PROF_HDR(c,ccs_) \ + ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL) + */ +/* + The following macro works for both retainer profiling and LDV profiling: + for retainer profiling, ldvTime remains 0, so rs fields are initialized to 0. + See the invariants on ldvTime. + */ +#define SET_PROF_HDR(c,ccs_) \ + ((c)->header.prof.ccs = ccs_, \ + LDV_RECORD_CREATE((c))) +#endif /* DEBUG_RETAINER */ +#define SET_STATIC_PROF_HDR(ccs_) \ + prof : { ccs : (CostCentreStack *)ccs_, hp : { rs : NULL } }, +#else +#define SET_PROF_HDR(c,ccs) +#define SET_STATIC_PROF_HDR(ccs) +#endif + +#ifdef GRAN +#define SET_GRAN_HDR(c,pe) (c)->header.gran.procs = pe +#define SET_STATIC_GRAN_HDR gran : { procs : Everywhere }, +#else +#define SET_GRAN_HDR(c,pe) +#define SET_STATIC_GRAN_HDR +#endif + +#ifdef PAR +#define SET_PAR_HDR(c,stuff) +#define SET_STATIC_PAR_HDR(stuff) +#else +#define SET_PAR_HDR(c,stuff) +#define SET_STATIC_PAR_HDR(stuff) +#endif + +#ifdef TICKY_TICKY +#define SET_TICKY_HDR(c,stuff) /* old: (c)->header.ticky.updated = stuff */ +#define SET_STATIC_TICKY_HDR(stuff) /* old: ticky : { updated : stuff } */ +#else +#define SET_TICKY_HDR(c,stuff) +#define SET_STATIC_TICKY_HDR(stuff) +#endif + +#define SET_HDR(c,_info,ccs) \ + { \ + (c)->header.info = _info; \ + SET_GRAN_HDR((StgClosure *)(c),ThisPE); \ + SET_PAR_HDR((StgClosure *)(c),LOCAL_GA); \ + SET_PROF_HDR((StgClosure *)(c),ccs); \ + SET_TICKY_HDR((StgClosure *)(c),0); \ + } + +#define SET_ARR_HDR(c,info,costCentreStack,n_words) \ + SET_HDR(c,info,costCentreStack); \ + (c)->words = n_words; + +/* ----------------------------------------------------------------------------- + How to get hold of the static link field for a static closure. + -------------------------------------------------------------------------- */ + +/* These are hard-coded. */ +#define FUN_STATIC_LINK(p) (&(p)->payload[0]) +#define THUNK_STATIC_LINK(p) (&(p)->payload[1]) +#define IND_STATIC_LINK(p) (&(p)->payload[1]) + +INLINE_HEADER StgClosure ** +STATIC_LINK(const StgInfoTable *info, StgClosure *p) +{ + switch (info->type) { + case THUNK_STATIC: + return THUNK_STATIC_LINK(p); + case FUN_STATIC: + return FUN_STATIC_LINK(p); + case IND_STATIC: + return IND_STATIC_LINK(p); + default: + return &(p)->payload[info->layout.payload.ptrs + + info->layout.payload.nptrs]; + } +} + +#define STATIC_LINK2(info,p) \ + (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs + \ + info->layout.payload.nptrs + 1]))) + +/* ----------------------------------------------------------------------------- + INTLIKE and CHARLIKE closures. + -------------------------------------------------------------------------- */ + +#define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE]) +#define INTLIKE_CLOSURE(n) ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE]) + +#endif /* CLOSUREMACROS_H */ diff --git a/includes/ClosureTypes.h b/includes/ClosureTypes.h new file mode 100644 index 0000000000..f8840264f3 --- /dev/null +++ b/includes/ClosureTypes.h @@ -0,0 +1,99 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2005 + * + * Closure Type Constants: out here because the native code generator + * needs to get at them. + * + * -------------------------------------------------------------------------- */ + +#ifndef CLOSURETYPES_H +#define CLOSURETYPES_H + +/* + * WARNING WARNING WARNING + * + * Keep the closure tags contiguous: rts/ClosureFlags.c relies on + * this. + * + * If you add or delete any closure types, don't forget to update + * the closure flags table in rts/ClosureFlags.c. + */ + +/* Object tag 0 raises an internal error */ +#define INVALID_OBJECT 0 +#define CONSTR 1 +#define CONSTR_1_0 2 +#define CONSTR_0_1 3 +#define CONSTR_2_0 4 +#define CONSTR_1_1 5 +#define CONSTR_0_2 6 +#define CONSTR_INTLIKE 7 +#define CONSTR_CHARLIKE 8 +#define CONSTR_STATIC 9 +#define CONSTR_NOCAF_STATIC 10 +#define FUN 11 +#define FUN_1_0 12 +#define FUN_0_1 13 +#define FUN_2_0 14 +#define FUN_1_1 15 +#define FUN_0_2 16 +#define FUN_STATIC 17 +#define THUNK 18 +#define THUNK_1_0 19 +#define THUNK_0_1 20 +#define THUNK_2_0 21 +#define THUNK_1_1 22 +#define THUNK_0_2 23 +#define THUNK_STATIC 24 +#define THUNK_SELECTOR 25 +#define BCO 26 +#define AP 27 +#define PAP 28 +#define AP_STACK 29 +#define IND 30 +#define IND_OLDGEN 31 +#define IND_PERM 32 +#define IND_OLDGEN_PERM 33 +#define IND_STATIC 34 +#define RET_BCO 35 +#define RET_SMALL 36 +#define RET_VEC_SMALL 37 +#define RET_BIG 38 +#define RET_VEC_BIG 39 +#define RET_DYN 40 +#define RET_FUN 41 +#define UPDATE_FRAME 42 +#define CATCH_FRAME 43 +#define STOP_FRAME 44 +#define CAF_BLACKHOLE 45 +#define BLACKHOLE 46 +#define SE_BLACKHOLE 47 +#define SE_CAF_BLACKHOLE 48 +#define MVAR 49 +#define ARR_WORDS 50 +#define MUT_ARR_PTRS_CLEAN 51 +#define MUT_ARR_PTRS_DIRTY 52 +#define MUT_ARR_PTRS_FROZEN0 53 +#define MUT_ARR_PTRS_FROZEN 54 +#define MUT_VAR_CLEAN 55 +#define MUT_VAR_DIRTY 56 +#define WEAK 57 +#define STABLE_NAME 58 +#define TSO 59 +#define BLOCKED_FETCH 60 +#define FETCH_ME 61 +#define FETCH_ME_BQ 62 +#define RBH 63 +#define EVACUATED 64 +#define REMOTE_REF 65 +#define TVAR_WAIT_QUEUE 66 +#define TVAR 67 +#define TREC_CHUNK 68 +#define TREC_HEADER 69 +#define ATOMICALLY_FRAME 70 +#define CATCH_RETRY_FRAME 71 +#define CATCH_STM_FRAME 72 +#define N_CLOSURE_TYPES 73 + +#endif /* CLOSURETYPES_H */ diff --git a/includes/Closures.h b/includes/Closures.h new file mode 100644 index 0000000000..3df208cd09 --- /dev/null +++ b/includes/Closures.h @@ -0,0 +1,480 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Closures + * + * -------------------------------------------------------------------------- */ + +#ifndef CLOSURES_H +#define CLOSURES_H + +/* + * The Layout of a closure header depends on which kind of system we're + * compiling for: profiling, parallel, ticky, etc. + */ + +/* ----------------------------------------------------------------------------- + The profiling header + -------------------------------------------------------------------------- */ + +typedef struct { + CostCentreStack *ccs; + union { + struct _RetainerSet *rs; /* Retainer Set */ + StgWord ldvw; /* Lag/Drag/Void Word */ + } hp; +} StgProfHeader; + +/* ----------------------------------------------------------------------------- + The GranSim header + -------------------------------------------------------------------------- */ + +typedef struct { + StgWord procs; /* bitmask indicating on which PEs this closure resides */ +} StgGranHeader; + +/* ----------------------------------------------------------------------------- + The SMP header + + A thunk has a padding word to take the updated value. This is so + that the update doesn't overwrite the payload, so we can avoid + needing to lock the thunk during entry and update. + + Note: this doesn't apply to THUNK_STATICs, which have no payload. + + Note: we leave this padding word in all ways, rather than just SMP, + so that we don't have to recompile all our libraries for SMP. + -------------------------------------------------------------------------- */ + +typedef struct { + StgWord pad; +} StgSMPThunkHeader; + +/* ----------------------------------------------------------------------------- + The full fixed-size closure header + + The size of the fixed header is the sum of the optional parts plus a single + word for the entry code pointer. + -------------------------------------------------------------------------- */ + +typedef struct { + const struct _StgInfoTable* info; +#ifdef PROFILING + StgProfHeader prof; +#endif +#ifdef GRAN + StgGranHeader gran; +#endif +} StgHeader; + +typedef struct { + const struct _StgInfoTable* info; +#ifdef PROFILING + StgProfHeader prof; +#endif +#ifdef GRAN + StgGranHeader gran; +#endif + StgSMPThunkHeader smp; +} StgThunkHeader; + +#define THUNK_EXTRA_HEADER_W (sizeofW(StgThunkHeader)-sizeofW(StgHeader)) + +/* ----------------------------------------------------------------------------- + Closure Types + + For any given closure type (defined in InfoTables.h), there is a + corresponding structure defined below. The name of the structure + is obtained by concatenating the closure type with '_closure' + -------------------------------------------------------------------------- */ + +/* All closures follow the generic format */ + +struct StgClosure_ { + StgHeader header; + struct StgClosure_ *payload[FLEXIBLE_ARRAY]; +}; + +typedef struct { + StgThunkHeader header; + struct StgClosure_ *payload[FLEXIBLE_ARRAY]; +} StgThunk; + +typedef struct { + StgThunkHeader header; + StgClosure *selectee; +} StgSelector; + +typedef struct { + StgHeader header; + StgHalfWord arity; /* zero if it is an AP */ + StgHalfWord n_args; + StgClosure *fun; /* really points to a fun */ + StgClosure *payload[FLEXIBLE_ARRAY]; +} StgPAP; + +typedef struct { + StgThunkHeader header; + StgHalfWord arity; /* zero if it is an AP */ + StgHalfWord n_args; + StgClosure *fun; /* really points to a fun */ + StgClosure *payload[FLEXIBLE_ARRAY]; +} StgAP; + +typedef struct { + StgThunkHeader header; + StgWord size; /* number of words in payload */ + StgClosure *fun; + StgClosure *payload[FLEXIBLE_ARRAY]; /* contains a chunk of *stack* */ +} StgAP_STACK; + +typedef struct { + StgHeader header; + StgClosure *indirectee; +} StgInd; + +typedef struct { + StgHeader header; + StgClosure *indirectee; + StgClosure *static_link; + struct _StgInfoTable *saved_info; +} StgIndStatic; + +typedef struct { + StgHeader header; + StgWord words; + StgWord payload[FLEXIBLE_ARRAY]; +} StgArrWords; + +typedef struct { + StgHeader header; + StgWord ptrs; + StgClosure *payload[FLEXIBLE_ARRAY]; +} StgMutArrPtrs; + +typedef struct { + StgHeader header; + StgClosure *var; +} StgMutVar; + +typedef struct _StgUpdateFrame { + StgHeader header; + StgClosure *updatee; +} StgUpdateFrame; + +typedef struct { + StgHeader header; + StgInt exceptions_blocked; + StgClosure *handler; +} StgCatchFrame; + +typedef struct { + StgHeader header; +} StgStopFrame; + +typedef struct { + StgHeader header; + StgClosure *evacuee; +} StgEvacuated; + +typedef struct { + StgHeader header; + StgWord data; +} StgIntCharlikeClosure; + +/* statically allocated */ +typedef struct { + StgHeader header; +} StgRetry; + +typedef struct _StgStableName { + StgHeader header; + StgWord sn; +} StgStableName; + +typedef struct _StgWeak { /* Weak v */ + StgHeader header; + StgClosure *key; + StgClosure *value; /* v */ + StgClosure *finalizer; + struct _StgWeak *link; +} StgWeak; + +typedef struct _StgDeadWeak { /* Weak v */ + StgHeader header; + struct _StgWeak *link; +} StgDeadWeak; + +/* Byte code objects. These are fixed size objects with pointers to + * four arrays, designed so that a BCO can be easily "re-linked" to + * other BCOs, to facilitate GHC's intelligent recompilation. The + * array of instructions is static and not re-generated when the BCO + * is re-linked, but the other 3 arrays will be regenerated. + * + * A BCO represents either a function or a stack frame. In each case, + * it needs a bitmap to describe to the garbage collector the + * pointerhood of its arguments/free variables respectively, and in + * the case of a function it also needs an arity. These are stored + * directly in the BCO, rather than in the instrs array, for two + * reasons: + * (a) speed: we need to get at the bitmap info quickly when + * the GC is examining APs and PAPs that point to this BCO + * (b) a subtle interaction with the compacting GC. In compacting + * GC, the info that describes the size/layout of a closure + * cannot be in an object more than one level of indirection + * away from the current object, because of the order in + * which pointers are updated to point to their new locations. + */ + +typedef struct { + StgHeader header; + StgArrWords *instrs; /* a pointer to an ArrWords */ + StgArrWords *literals; /* a pointer to an ArrWords */ + StgMutArrPtrs *ptrs; /* a pointer to a MutArrPtrs */ + StgArrWords *itbls; /* a pointer to an ArrWords */ + StgHalfWord arity; /* arity of this BCO */ + StgHalfWord size; /* size of this BCO (in words) */ + StgWord bitmap[FLEXIBLE_ARRAY]; /* an StgLargeBitmap */ +} StgBCO; + +#define BCO_BITMAP(bco) ((StgLargeBitmap *)((StgBCO *)(bco))->bitmap) +#define BCO_BITMAP_SIZE(bco) (BCO_BITMAP(bco)->size) +#define BCO_BITMAP_BITS(bco) (BCO_BITMAP(bco)->bitmap) +#define BCO_BITMAP_SIZEW(bco) ((BCO_BITMAP_SIZE(bco) + BITS_IN(StgWord) - 1) \ + / BITS_IN(StgWord)) + +/* ----------------------------------------------------------------------------- + Dynamic stack frames for generic heap checks. + + These generic heap checks are slow, but have the advantage of being + usable in a variety of situations. + + The one restriction is that any relevant SRTs must already be pointed + to from the stack. The return address doesn't need to have an info + table attached: hence it can be any old code pointer. + + The liveness mask contains a 1 at bit n, if register Rn contains a + non-pointer. The contents of all 8 vanilla registers are always saved + on the stack; the liveness mask tells the GC which ones contain + pointers. + + Good places to use a generic heap check: + + - case alternatives (the return address with an SRT is already + on the stack). + + - primitives (no SRT required). + + The stack frame layout for a RET_DYN is like this: + + some pointers |-- RET_DYN_PTRS(liveness) words + some nonpointers |-- RET_DYN_NONPTRS(liveness) words + + L1 \ + D1-2 |-- RET_DYN_NONPTR_REGS_SIZE words + F1-4 / + + R1-8 |-- RET_DYN_BITMAP_SIZE words + + return address \ + liveness mask |-- StgRetDyn structure + stg_gen_chk_info / + + we assume that the size of a double is always 2 pointers (wasting a + word when it is only one pointer, but avoiding lots of #ifdefs). + + See Liveness.h for the macros (RET_DYN_PTRS() etc.). + + NOTE: if you change the layout of RET_DYN stack frames, then you + might also need to adjust the value of RESERVED_STACK_WORDS in + Constants.h. + -------------------------------------------------------------------------- */ + +typedef struct { + const struct _StgInfoTable* info; + StgWord liveness; + StgWord ret_addr; + StgClosure * payload[FLEXIBLE_ARRAY]; +} StgRetDyn; + +/* A function return stack frame: used when saving the state for a + * garbage collection at a function entry point. The function + * arguments are on the stack, and we also save the function (its + * info table describes the pointerhood of the arguments). + * + * The stack frame size is also cached in the frame for convenience. + */ +typedef struct { + const struct _StgInfoTable* info; + StgWord size; + StgClosure * fun; + StgClosure * payload[FLEXIBLE_ARRAY]; +} StgRetFun; + +/* Concurrent communication objects */ + +typedef struct { + StgHeader header; + struct StgTSO_ *head; + struct StgTSO_ *tail; + StgClosure* value; +} StgMVar; + + +/* STM data structures + * + * StgTVar defines the only type that can be updated through the STM + * interface. + * + * Note that various optimisations may be possible in order to use less + * space for these data structures at the cost of more complexity in the + * implementation: + * + * - In StgTVar, current_value and first_wait_queue_entry could be held in + * the same field: if any thread is waiting then its expected_value for + * the tvar is the current value. + * + * - In StgTRecHeader, it might be worthwhile having separate chunks + * of read-only and read-write locations. This would save a + * new_value field in the read-only locations. + * + * - In StgAtomicallyFrame, we could combine the waiting bit into + * the header (maybe a different info tbl for a waiting transaction). + * This means we can specialise the code for the atomically frame + * (it immediately switches on frame->waiting anyway). + */ + +typedef struct StgTVarWaitQueue_ { + StgHeader header; + struct StgTSO_ *waiting_tso; + struct StgTVarWaitQueue_ *next_queue_entry; + struct StgTVarWaitQueue_ *prev_queue_entry; +} StgTVarWaitQueue; + +typedef struct { + StgHeader header; + StgClosure *volatile current_value; + StgTVarWaitQueue *volatile first_wait_queue_entry; +#if defined(THREADED_RTS) + StgInt volatile num_updates; +#endif +} StgTVar; + +/* new_value == expected_value for read-only accesses */ +/* new_value is a StgTVarWaitQueue entry when trec in state TREC_WAITING */ +typedef struct { + StgTVar *tvar; + StgClosure *expected_value; + StgClosure *new_value; +#if defined(THREADED_RTS) + StgInt num_updates; +#endif +} TRecEntry; + +#define TREC_CHUNK_NUM_ENTRIES 16 + +typedef struct StgTRecChunk_ { + StgHeader header; + struct StgTRecChunk_ *prev_chunk; + StgWord next_entry_idx; + TRecEntry entries[TREC_CHUNK_NUM_ENTRIES]; +} StgTRecChunk; + +typedef enum { + TREC_ACTIVE, /* Transaction in progress, outcome undecided */ + TREC_CONDEMNED, /* Transaction in progress, inconsistent / out of date reads */ + TREC_COMMITTED, /* Transaction has committed, now updating tvars */ + TREC_ABORTED, /* Transaction has aborted, now reverting tvars */ + TREC_WAITING, /* Transaction currently waiting */ +} TRecState; + +typedef struct StgTRecHeader_ { + StgHeader header; + TRecState state; + struct StgTRecHeader_ *enclosing_trec; + StgTRecChunk *current_chunk; +} StgTRecHeader; + +typedef struct { + StgHeader header; + StgClosure *code; +} StgAtomicallyFrame; + +typedef struct { + StgHeader header; + StgClosure *handler; +} StgCatchSTMFrame; + +typedef struct { + StgHeader header; + StgBool running_alt_code; + StgClosure *first_code; + StgClosure *alt_code; + StgTRecHeader *first_code_trec; +} StgCatchRetryFrame; + +#if defined(PAR) || defined(GRAN) +/* + StgBlockingQueueElement is a ``collective type'' representing the types + of closures that can be found on a blocking queue: StgTSO, StgRBHSave, + StgBlockedFetch. (StgRBHSave can only appear at the end of a blocking + queue). Logically, this is a union type, but defining another struct + with a common layout is easier to handle in the code. + Note that in the standard setup only StgTSOs can be on a blocking queue. + This is one of the main reasons for slightly different code in files + such as Schedule.c. +*/ +typedef struct StgBlockingQueueElement_ { + StgHeader header; + struct StgBlockingQueueElement_ *link; /* next elem in BQ */ + struct StgClosure_ *payload[FLEXIBLE_ARRAY];/* contents of the closure */ +} StgBlockingQueueElement; + +/* only difference to std code is type of the elem in the BQ */ +typedef struct StgBlockingQueue_ { + StgHeader header; + struct StgBlockingQueueElement_ *blocking_queue; /* start of the BQ */ +} StgBlockingQueue; + +/* this closure is hanging at the end of a blocking queue in (see RBH.c) */ +typedef struct StgRBHSave_ { + StgHeader header; + StgClosure *payload[FLEXIBLE_ARRAY]; /* 2 words ripped out of the guts of the */ +} StgRBHSave; /* closure holding the blocking queue */ + +typedef struct StgRBH_ { + StgHeader header; + struct StgBlockingQueueElement_ *blocking_queue; /* start of the BQ */ +} StgRBH; + +#endif + +#if defined(PAR) +/* global indirections aka FETCH_ME closures */ +typedef struct StgFetchMe_ { + StgHeader header; + globalAddr *ga; /* ptr to unique id for a closure */ +} StgFetchMe; + +/* same contents as an ordinary StgBlockingQueue */ +typedef struct StgFetchMeBlockingQueue_ { + StgHeader header; + struct StgBlockingQueueElement_ *blocking_queue; /* start of the BQ */ +} StgFetchMeBlockingQueue; + +/* This is an entry in a blocking queue. It indicates a fetch request from a + TSO on another PE demanding the value of this closur. Note that a + StgBlockedFetch can only occur in a BQ. Once the node is evaluated and + updated with the result, the result will be sent back (the PE is encoded + in the globalAddr) and the StgBlockedFetch closure will be nuked. +*/ +typedef struct StgBlockedFetch_ { + StgHeader header; + struct StgBlockingQueueElement_ *link; /* next elem in the BQ */ + StgClosure *node; /* node to fetch */ + globalAddr ga; /* where to send the result to */ +} StgBlockedFetch; /* NB: not just a ptr to a GA */ +#endif + +#endif /* CLOSURES_H */ diff --git a/includes/Cmm.h b/includes/Cmm.h new file mode 100644 index 0000000000..783b0e41bb --- /dev/null +++ b/includes/Cmm.h @@ -0,0 +1,517 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The University of Glasgow 2004 + * + * This file is included at the top of all .cmm source files (and + * *only* .cmm files). It defines a collection of useful macros for + * making .cmm code a bit less error-prone to write, and a bit easier + * on the eye for the reader. + * + * For the syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y. + * + * If you're used to the old HC file syntax, here's a quick cheat sheet + * for converting HC code: + * + * - Remove FB_/FE_ + * - Remove all type casts + * - Remove '&' + * - STGFUN(foo) { ... } ==> foo { ... } + * - FN_(foo) { ... } ==> foo { ... } + * - JMP_(e) ==> jump e; + * - Remove EXTFUN(foo) + * - Sp[n] ==> Sp(n) + * - Hp[n] ==> Hp(n) + * - Sp += n ==> Sp_adj(n) + * - Hp += n ==> Hp_adj(n) + * - R1.i ==> R1 (similarly for R1.w, R1.cl etc.) + * - You need to explicitly dereference variables; eg. + * context_switch ==> CInt[context_switch] + * - convert all word offsets into byte offsets: + * - e ==> WDS(e) + * - sizeofW(StgFoo) ==> SIZEOF_StgFoo + * - ENTRY_CODE(e) ==> %ENTRY_CODE(e) + * - get_itbl(c) ==> %GET_STD_INFO(c) + * - Change liveness masks in STK_CHK_GEN, HP_CHK_GEN: + * R1_PTR | R2_PTR ==> R1_PTR & R2_PTR + * (NOTE: | becomes &) + * - Declarations like 'StgPtr p;' become just 'W_ p;' + * - e->payload[n] ==> PAYLOAD(e,n) + * - Be very careful with comparisons: the infix versions (>, >=, etc.) + * are unsigned, so use %lt(a,b) to get signed less-than for example. + * + * Accessing fields of structures defined in the RTS header files is + * done via automatically-generated macros in DerivedConstants.h. For + * example, where previously we used + * + * CurrentTSO->what_next = x + * + * in C-- we now use + * + * StgTSO_what_next(CurrentTSO) = x + * + * where the StgTSO_what_next() macro is automatically generated by + * mkDerivedConstnants.c. If you need to access a field that doesn't + * already have a macro, edit that file (it's pretty self-explanatory). + * + * -------------------------------------------------------------------------- */ + +#ifndef CMM_H +#define CMM_H + +/* + * In files that are included into both C and C-- (and perhaps + * Haskell) sources, we sometimes need to conditionally compile bits + * depending on the language. CMINUSMINUS==1 in .cmm sources: + */ +#define CMINUSMINUS 1 + +#include "ghcconfig.h" +#include "RtsConfig.h" + +/* ----------------------------------------------------------------------------- + Types + + The following synonyms for C-- types are declared here: + + I8, I16, I32, I64 MachRep-style names for convenience + + W_ is shorthand for the word type (== StgWord) + F_ shorthand for float (F_ == StgFloat == C's float) + D_ shorthand for double (D_ == StgDouble == C's double) + + CInt has the same size as an int in C on this platform + CLong has the same size as a long in C on this platform + + --------------------------------------------------------------------------- */ + +#define I8 bits8 +#define I16 bits16 +#define I32 bits32 +#define I64 bits64 + +#if SIZEOF_VOID_P == 4 +#define W_ bits32 +#elif SIZEOF_VOID_P == 8 +#define W_ bits64 +#else +#error Unknown word size +#endif + +#if SIZEOF_INT == 4 +#define CInt bits32 +#elif SIZEOF_INT == 8 +#define CInt bits64 +#else +#error Unknown int size +#endif + +#if SIZEOF_LONG == 4 +#define CLong bits32 +#elif SIZEOF_LONG == 8 +#define CLong bits64 +#else +#error Unknown long size +#endif + +#define F_ float32 +#define D_ float64 +#define L_ bits64 + +#define SIZEOF_StgDouble 8 +#define SIZEOF_StgWord64 8 + +/* ----------------------------------------------------------------------------- + Misc useful stuff + -------------------------------------------------------------------------- */ + +#define NULL (0::W_) + +#define STRING(name,str) \ + section "rodata" { \ + name : bits8[] str; \ + } \ + +/* ----------------------------------------------------------------------------- + Byte/word macros + + Everything in C-- is in byte offsets (well, most things). We use + some macros to allow us to express offsets in words and to try to + avoid byte/word confusion. + -------------------------------------------------------------------------- */ + +#define SIZEOF_W SIZEOF_VOID_P +#define W_MASK (SIZEOF_W-1) + +#if SIZEOF_W == 4 +#define W_SHIFT 2 +#elif SIZEOF_W == 8 +#define W_SHIFT 4 +#endif + +/* Converting quantities of words to bytes */ +#define WDS(n) ((n)*SIZEOF_W) + +/* + * Converting quantities of bytes to words + * NB. these work on *unsigned* values only + */ +#define BYTES_TO_WDS(n) ((n) / SIZEOF_W) +#define ROUNDUP_BYTES_TO_WDS(n) (((n) + SIZEOF_W - 1) / SIZEOF_W) + +/* TO_W_(n) converts n to W_ type from a smaller type */ +#if SIZEOF_W == 4 +#define TO_W_(x) %sx32(x) +#define HALF_W_(x) %lobits16(x) +#elif SIZEOF_W == 8 +#define TO_W_(x) %sx64(x) +#define HALF_W_(x) %lobits32(x) +#endif + +#if SIZEOF_INT == 4 && SIZEOF_W == 8 +#define W_TO_INT(x) %lobits32(x) +#elif SIZEOF_INT == SIZEOF_W +#define W_TO_INT(x) (x) +#endif + +/* ----------------------------------------------------------------------------- + Heap/stack access, and adjusting the heap/stack pointers. + -------------------------------------------------------------------------- */ + +#define Sp(n) W_[Sp + WDS(n)] +#define Hp(n) W_[Hp + WDS(n)] + +#define Sp_adj(n) Sp = Sp + WDS(n) +#define Hp_adj(n) Hp = Hp + WDS(n) + +/* ----------------------------------------------------------------------------- + Assertions and Debuggery + -------------------------------------------------------------------------- */ + +#ifdef DEBUG +#define ASSERT(predicate) \ + if (predicate) { \ + /*null*/; \ + } else { \ + foreign "C" _assertFail(NULL, __LINE__); \ + } +#else +#define ASSERT(p) /* nothing */ +#endif + +#ifdef DEBUG +#define DEBUG_ONLY(s) s +#else +#define DEBUG_ONLY(s) /* nothing */ +#endif + +/* + * The IF_DEBUG macro is useful for debug messages that depend on one + * of the RTS debug options. For example: + * + * IF_DEBUG(RtsFlags_DebugFlags_apply, + * foreign "C" fprintf(stderr, stg_ap_0_ret_str)); + * + * Note the syntax is slightly different to the C version of this macro. + */ +#ifdef DEBUG +#define IF_DEBUG(c,s) if (RtsFlags_DebugFlags_##c(RtsFlags)) { s; } +#else +#define IF_DEBUG(c,s) /* nothing */ +#endif + +/* ----------------------------------------------------------------------------- + Entering + + It isn't safe to "enter" every closure. Functions in particular + have no entry code as such; their entry point contains the code to + apply the function. + + ToDo: range should end in N_CLOSURE_TYPES-1, not N_CLOSURE_TYPES, + but switch doesn't allow us to use exprs there yet. + -------------------------------------------------------------------------- */ + +#define ENTER() \ + again: \ + W_ info; \ + info = %INFO_PTR(R1); \ + switch [INVALID_OBJECT .. N_CLOSURE_TYPES] \ + (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) { \ + case \ + IND, \ + IND_OLDGEN, \ + IND_PERM, \ + IND_OLDGEN_PERM, \ + IND_STATIC: \ + { \ + R1 = StgInd_indirectee(R1); \ + goto again; \ + } \ + case \ + BCO, \ + FUN, \ + FUN_1_0, \ + FUN_0_1, \ + FUN_2_0, \ + FUN_1_1, \ + FUN_0_2, \ + FUN_STATIC, \ + PAP: \ + { \ + jump %ENTRY_CODE(Sp(0)); \ + } \ + default: \ + { \ + jump %ENTRY_CODE(info); \ + } \ + } + +/* ----------------------------------------------------------------------------- + Constants. + -------------------------------------------------------------------------- */ + +#include "Constants.h" +#include "DerivedConstants.h" +#include "ClosureTypes.h" +#include "StgFun.h" + +/* + * Need MachRegs, because some of the RTS code is conditionally + * compiled based on REG_R1, REG_R2, etc. + */ +#define STOLEN_X86_REGS 4 +#include "MachRegs.h" + +#include "Liveness.h" +#include "StgLdvProf.h" + +#undef BLOCK_SIZE +#undef MBLOCK_SIZE +#include "Block.h" /* For Bdescr() */ + + +/* Can't think of a better place to put this. */ +#if SIZEOF_mp_limb_t != SIZEOF_VOID_P +#error mp_limb_t != StgWord: assumptions in PrimOps.cmm are now false +#endif + +#define MyCapability() (BaseReg - OFFSET_Capability_r) + +/* ------------------------------------------------------------------------- + Allocation and garbage collection + ------------------------------------------------------------------------- */ + +/* + * ALLOC_PRIM is for allocating memory on the heap for a primitive + * object. It is used all over PrimOps.cmm. + * + * We make the simplifying assumption that the "admin" part of a + * primitive closure is just the header when calculating sizes for + * ticky-ticky. It's not clear whether eg. the size field of an array + * should be counted as "admin", or the various fields of a BCO. + */ +#define ALLOC_PRIM(bytes,liveness,reentry) \ + HP_CHK_GEN_TICKY(bytes,liveness,reentry); \ + TICK_ALLOC_PRIM(SIZEOF_StgHeader,bytes-SIZEOF_StgHeader,0); \ + CCCS_ALLOC(bytes); + +/* CCS_ALLOC wants the size in words, because ccs->mem_alloc is in words */ +#define CCCS_ALLOC(__alloc) CCS_ALLOC(BYTES_TO_WDS(__alloc), W_[CCCS]) + +#define HP_CHK_GEN_TICKY(alloc,liveness,reentry) \ + HP_CHK_GEN(alloc,liveness,reentry); \ + TICK_ALLOC_HEAP_NOCTR(alloc); + +// allocateLocal() allocates from the nursery, so we check to see +// whether the nursery is nearly empty in any function that uses +// allocateLocal() - this includes many of the primops. +#define MAYBE_GC(liveness,reentry) \ + if (bdescr_link(CurrentNursery) == NULL || CInt[alloc_blocks] >= CInt[alloc_blocks_lim]) { \ + R9 = liveness; \ + R10 = reentry; \ + jump stg_gc_gen_hp; \ + } + +/* ----------------------------------------------------------------------------- + Closure headers + -------------------------------------------------------------------------- */ + +/* + * This is really ugly, since we don't do the rest of StgHeader this + * way. The problem is that values from DerivedConstants.h cannot be + * dependent on the way (SMP, PROF etc.). For SIZEOF_StgHeader we get + * the value from GHC, but it seems like too much trouble to do that + * for StgThunkHeader. + */ +#define SIZEOF_StgThunkHeader SIZEOF_StgHeader+SIZEOF_StgSMPThunkHeader + +#define StgThunk_payload(__ptr__,__ix__) \ + W_[__ptr__+SIZEOF_StgThunkHeader+ WDS(__ix__)] + +/* ----------------------------------------------------------------------------- + Closures + -------------------------------------------------------------------------- */ + +/* The offset of the payload of an array */ +#define BYTE_ARR_CTS(arr) ((arr) + SIZEOF_StgArrWords) + +/* Getting/setting the info pointer of a closure */ +#define SET_INFO(p,info) StgHeader_info(p) = info +#define GET_INFO(p) StgHeader_info(p) + +/* Determine the size of an ordinary closure from its info table */ +#define sizeW_fromITBL(itbl) \ + SIZEOF_StgHeader + WDS(%INFO_PTRS(itbl)) + WDS(%INFO_NPTRS(itbl)) + +/* NB. duplicated from InfoTables.h! */ +#define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK) +#define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT) + +/* Debugging macros */ +#define LOOKS_LIKE_INFO_PTR(p) \ + ((p) != NULL && \ + (TO_W_(%INFO_TYPE(%STD_INFO(p))) != INVALID_OBJECT) && \ + (TO_W_(%INFO_TYPE(%STD_INFO(p))) < N_CLOSURE_TYPES)) + +#define LOOKS_LIKE_CLOSURE_PTR(p) (LOOKS_LIKE_INFO_PTR(GET_INFO(p))) + +/* + * The layout of the StgFunInfoExtra part of an info table changes + * depending on TABLES_NEXT_TO_CODE. So we define field access + * macros which use the appropriate version here: + */ +#ifdef TABLES_NEXT_TO_CODE +/* + * when TABLES_NEXT_TO_CODE, slow_apply is stored as an offset + * instead of the normal pointer. + */ + +#define StgFunInfoExtra_slow_apply(fun_info) \ + (TO_W_(StgFunInfoExtraRev_slow_apply_offset(fun_info)) \ + + (fun_info) + SIZEOF_StgFunInfoExtraRev + SIZEOF_StgInfoTable) + +#define StgFunInfoExtra_fun_type(i) StgFunInfoExtraRev_fun_type(i) +#define StgFunInfoExtra_arity(i) StgFunInfoExtraRev_arity(i) +#define StgFunInfoExtra_bitmap(i) StgFunInfoExtraRev_bitmap(i) +#else +#define StgFunInfoExtra_slow_apply(i) StgFunInfoExtraFwd_slow_apply(i) +#define StgFunInfoExtra_fun_type(i) StgFunInfoExtraFwd_fun_type(i) +#define StgFunInfoExtra_arity(i) StgFunInfoExtraFwd_arity(i) +#define StgFunInfoExtra_bitmap(i) StgFunInfoExtraFwd_bitmap(i) +#endif + +/* ----------------------------------------------------------------------------- + Voluntary Yields/Blocks + + We only have a generic version of this at the moment - if it turns + out to be slowing us down we can make specialised ones. + -------------------------------------------------------------------------- */ + +#define YIELD(liveness,reentry) \ + R9 = liveness; \ + R10 = reentry; \ + jump stg_gen_yield; + +#define BLOCK(liveness,reentry) \ + R9 = liveness; \ + R10 = reentry; \ + jump stg_gen_block; + +/* ----------------------------------------------------------------------------- + Ticky macros + -------------------------------------------------------------------------- */ + +#ifdef TICKY_TICKY +#define TICK_BUMP_BY(ctr,n) CLong[ctr] = CLong[ctr] + n +#else +#define TICK_BUMP_BY(ctr,n) /* nothing */ +#endif + +#define TICK_BUMP(ctr) TICK_BUMP_BY(ctr,1) + +#define TICK_ENT_DYN_IND() TICK_BUMP(ENT_DYN_IND_ctr) +#define TICK_ENT_DYN_THK() TICK_BUMP(ENT_DYN_THK_ctr) +#define TICK_ENT_VIA_NODE() TICK_BUMP(ENT_VIA_NODE_ctr) +#define TICK_ENT_STATIC_IND() TICK_BUMP(ENT_STATIC_IND_ctr) +#define TICK_ENT_PERM_IND() TICK_BUMP(ENT_PERM_IND_ctr) +#define TICK_ENT_PAP() TICK_BUMP(ENT_PAP_ctr) +#define TICK_ENT_AP() TICK_BUMP(ENT_AP_ctr) +#define TICK_ENT_AP_STACK() TICK_BUMP(ENT_AP_STACK_ctr) +#define TICK_ENT_BH() TICK_BUMP(ENT_BH_ctr) +#define TICK_UNKNOWN_CALL() TICK_BUMP(UNKNOWN_CALL_ctr) +#define TICK_UPDF_PUSHED() TICK_BUMP(UPDF_PUSHED_ctr) +#define TICK_CATCHF_PUSHED() TICK_BUMP(CATCHF_PUSHED_ctr) +#define TICK_UPDF_OMITTED() TICK_BUMP(UPDF_OMITTED_ctr) +#define TICK_UPD_NEW_IND() TICK_BUMP(UPD_NEW_IND_ctr) +#define TICK_UPD_NEW_PERM_IND() TICK_BUMP(UPD_NEW_PERM_IND_ctr) +#define TICK_UPD_OLD_IND() TICK_BUMP(UPD_OLD_IND_ctr) +#define TICK_UPD_OLD_PERM_IND() TICK_BUMP(UPD_OLD_PERM_IND_ctr) + +#define TICK_SLOW_CALL_FUN_TOO_FEW() TICK_BUMP(SLOW_CALL_FUN_TOO_FEW_ctr) +#define TICK_SLOW_CALL_FUN_CORRECT() TICK_BUMP(SLOW_CALL_FUN_CORRECT_ctr) +#define TICK_SLOW_CALL_FUN_TOO_MANY() TICK_BUMP(SLOW_CALL_FUN_TOO_MANY_ctr) +#define TICK_SLOW_CALL_PAP_TOO_FEW() TICK_BUMP(SLOW_CALL_PAP_TOO_FEW_ctr) +#define TICK_SLOW_CALL_PAP_CORRECT() TICK_BUMP(SLOW_CALL_PAP_CORRECT_ctr) +#define TICK_SLOW_CALL_PAP_TOO_MANY() TICK_BUMP(SLOW_CALL_PAP_TOO_MANY_ctr) + +#define TICK_SLOW_CALL_v() TICK_BUMP(SLOW_CALL_v_ctr) +#define TICK_SLOW_CALL_p() TICK_BUMP(SLOW_CALL_p_ctr) +#define TICK_SLOW_CALL_pv() TICK_BUMP(SLOW_CALL_pv_ctr) +#define TICK_SLOW_CALL_pp() TICK_BUMP(SLOW_CALL_pp_ctr) +#define TICK_SLOW_CALL_ppp() TICK_BUMP(SLOW_CALL_ppp_ctr) +#define TICK_SLOW_CALL_pppp() TICK_BUMP(SLOW_CALL_pppp_ctr) +#define TICK_SLOW_CALL_ppppp() TICK_BUMP(SLOW_CALL_ppppp_ctr) +#define TICK_SLOW_CALL_pppppp() TICK_BUMP(SLOW_CALL_pppppp_ctr) + +#ifdef TICKY_TICKY +#define TICK_HISTO_BY(histo,n,i) \ + W_ __idx; \ + __idx = (n); \ + if (__idx > 8) { \ + __idx = 8; \ + } \ + CLong[histo##_hst + _idx*SIZEOF_LONG] \ + = histo##_hst + __idx*SIZEOF_LONG] + i; +#else +#define TICK_HISTO_BY(histo,n,i) /* nothing */ +#endif + +#define TICK_HISTO(histo,n) TICK_HISTO_BY(histo,n,1) + +/* An unboxed tuple with n components. */ +#define TICK_RET_UNBOXED_TUP(n) \ + TICK_BUMP(RET_UNBOXED_TUP_ctr++); \ + TICK_HISTO(RET_UNBOXED_TUP,n) + +/* + * A slow call with n arguments. In the unevald case, this call has + * already been counted once, so don't count it again. + */ +#define TICK_SLOW_CALL(n) \ + TICK_BUMP(SLOW_CALL_ctr); \ + TICK_HISTO(SLOW_CALL,n) + +/* + * This slow call was found to be to an unevaluated function; undo the + * ticks we did in TICK_SLOW_CALL. + */ +#define TICK_SLOW_CALL_UNEVALD(n) \ + TICK_BUMP(SLOW_CALL_UNEVALD_ctr); \ + TICK_BUMP_BY(SLOW_CALL_ctr,-1); \ + TICK_HISTO_BY(SLOW_CALL,n,-1); + +/* Updating a closure with a new CON */ +#define TICK_UPD_CON_IN_NEW(n) \ + TICK_BUMP(UPD_CON_IN_NEW_ctr); \ + TICK_HISTO(UPD_CON_IN_NEW,n) + +#define TICK_ALLOC_HEAP_NOCTR(n) \ + TICK_BUMP(ALLOC_HEAP_ctr); \ + TICK_BUMP_BY(ALLOC_HEAP_tot,n) + +/* ----------------------------------------------------------------------------- + Misc junk + -------------------------------------------------------------------------- */ + +#define TICK_MILLISECS (1000/TICK_FREQUENCY) /* ms per tick */ + +#endif /* CMM_H */ diff --git a/includes/Constants.h b/includes/Constants.h new file mode 100644 index 0000000000..4f3c35b744 --- /dev/null +++ b/includes/Constants.h @@ -0,0 +1,258 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2002 + * + * Constants + * + * NOTE: this information is used by both the compiler and the RTS. + * Some of it is tweakable, and some of it must be kept up to date + * with various other parts of the system. + * + * Constants which are derived automatically from other definitions in + * the system (eg. structure sizes) are generated into the file + * DerivedConstants.h by a C program (mkDerivedConstantsHdr). + * + * -------------------------------------------------------------------------- */ + +#ifndef CONSTANTS_H +#define CONSTANTS_H + +/* ----------------------------------------------------------------------------- + Minimum closure sizes + + This is the minimum number of words in the payload of a + heap-allocated closure, so that the closure has enough room to be + overwritten with a forwarding pointer during garbage collection. + -------------------------------------------------------------------------- */ + +#define MIN_PAYLOAD_SIZE 1 + +/* ----------------------------------------------------------------------------- + Constants to do with specialised closure types. + -------------------------------------------------------------------------- */ + +/* We have some pre-compiled selector thunks defined in rts/StgStdThunks.hc. + * This constant defines the highest selectee index that we can replace with a + * reference to the pre-compiled code. + */ + +#define MAX_SPEC_SELECTEE_SIZE 15 + +/* Vector-apply thunks. These thunks just push their free variables + * on the stack and enter the first one. They're a bit like PAPs, but + * don't have a dynamic size. We've pre-compiled a few to save + * space. + */ + +#define MAX_SPEC_AP_SIZE 7 + +/* Specialised FUN/THUNK/CONSTR closure types */ + +#define MAX_SPEC_THUNK_SIZE 2 +#define MAX_SPEC_FUN_SIZE 2 +#define MAX_SPEC_CONSTR_SIZE 2 + +/* Range of built-in table of static small int-like and char-like closures. + * + * NB. This corresponds with the number of actual INTLIKE/CHARLIKE + * closures defined in rts/StgMiscClosures.cmm. + */ +#define MAX_INTLIKE 16 +#define MIN_INTLIKE (-16) + +#define MAX_CHARLIKE 255 +#define MIN_CHARLIKE 0 + +/* ----------------------------------------------------------------------------- + STG Registers. + + Note that in MachRegs.h we define how many of these registers are + *real* machine registers, and not just offsets in the Register Table. + -------------------------------------------------------------------------- */ + +#define MAX_VANILLA_REG 8 +#define MAX_FLOAT_REG 4 +#define MAX_DOUBLE_REG 2 +#define MAX_LONG_REG 1 + +/* ----------------------------------------------------------------------------- + * Maximum number of constructors in a data type for direct-returns. + * + * NB. There are various places that assume the value of this + * constant, such as the polymorphic return frames for updates + * (stg_upd_frame_info) and catch frames (stg_catch_frame_info). + * -------------------------------------------------------------------------- */ + +#define MAX_VECTORED_RTN 8 + +/* ----------------------------------------------------------------------------- + Semi-Tagging constants + + Old Comments about this stuff: + + Tags for indirection nodes and ``other'' (probably unevaluated) nodes; + normal-form values of algebraic data types will have tags 0, 1, ... + + @INFO_IND_TAG@ is different from @INFO_OTHER_TAG@ just so we can count + how often we bang into indirection nodes; that's all. (WDP 95/11) + + ToDo: find out if we need any of this. + -------------------------------------------------------------------------- */ + +#define INFO_OTHER_TAG (-1) +#define INFO_IND_TAG (-2) +#define INFO_FIRST_TAG 0 + +/* ----------------------------------------------------------------------------- + How much C stack to reserve for local temporaries when in the STG + world. Used in StgCRun.c. + -------------------------------------------------------------------------- */ + +#define RESERVED_C_STACK_BYTES (2048 * SIZEOF_LONG) + +/* ----------------------------------------------------------------------------- + How much Haskell stack space to reserve for the saving of registers + etc. in the case of a stack/heap overflow. + + This must be large enough to accomodate the largest stack frame + pushed in one of the heap check fragments in HeapStackCheck.hc + (ie. currently the generic heap checks - 3 words for StgRetDyn, + 18 words for the saved registers, see StgMacros.h). + + In the event of an unboxed tuple or let-no-escape stack/heap check + failure, there will be other words on the stack which are covered + by the RET_DYN frame. These will have been accounted for by stack + checks however, so we don't need to allow for them here. + -------------------------------------------------------------------------- */ + +#define RESERVED_STACK_WORDS 21 + +/* ----------------------------------------------------------------------------- + Storage manager constants + -------------------------------------------------------------------------- */ + +/* The size of a block (2^BLOCK_SHIFT bytes) */ +#define BLOCK_SHIFT 12 + +/* The size of a megablock (2^MBLOCK_SHIFT bytes) */ +#define MBLOCK_SHIFT 20 + +/* ----------------------------------------------------------------------------- + Bitmap/size fields (used in info tables) + -------------------------------------------------------------------------- */ + +/* In a 32-bit bitmap field, we use 5 bits for the size, and 27 bits + * for the bitmap. If the bitmap requires more than 27 bits, then we + * store it in a separate array, and leave a pointer in the bitmap + * field. On a 64-bit machine, the sizes are extended accordingly. + */ +#if SIZEOF_VOID_P == 4 +#define BITMAP_SIZE_MASK 0x1f +#define BITMAP_BITS_SHIFT 5 +#elif SIZEOF_VOID_P == 8 +#define BITMAP_SIZE_MASK 0x3f +#define BITMAP_BITS_SHIFT 6 +#else +#error unknown SIZEOF_VOID_P +#endif + +/* ----------------------------------------------------------------------------- + Lag/Drag/Void constants + -------------------------------------------------------------------------- */ + +/* + An LDV word is divided into 3 parts: state bits (LDV_STATE_MASK), creation + time bits (LDV_CREATE_MASK), and last use time bits (LDV_LAST_MASK). + */ +#if SIZEOF_VOID_P == 8 +#define LDV_SHIFT 30 +#define LDV_STATE_MASK 0x1000000000000000 +#define LDV_CREATE_MASK 0x0FFFFFFFC0000000 +#define LDV_LAST_MASK 0x000000003FFFFFFF +#define LDV_STATE_CREATE 0x0000000000000000 +#define LDV_STATE_USE 0x1000000000000000 +#else +#define LDV_SHIFT 15 +#define LDV_STATE_MASK 0x40000000 +#define LDV_CREATE_MASK 0x3FFF8000 +#define LDV_LAST_MASK 0x00007FFF +#define LDV_STATE_CREATE 0x00000000 +#define LDV_STATE_USE 0x40000000 +#endif /* SIZEOF_VOID_P */ + +/* ----------------------------------------------------------------------------- + TSO related constants + -------------------------------------------------------------------------- */ + +/* + * Constants for the what_next field of a TSO, which indicates how it + * is to be run. + */ +#define ThreadRunGHC 1 /* return to address on top of stack */ +#define ThreadInterpret 2 /* interpret this thread */ +#define ThreadKilled 3 /* thread has died, don't run it */ +#define ThreadRelocated 4 /* thread has moved, link points to new locn */ +#define ThreadComplete 5 /* thread has finished */ + +/* + * Constants for the why_blocked field of a TSO + */ +#define NotBlocked 0 +#define BlockedOnMVar 1 +#define BlockedOnBlackHole 2 +#define BlockedOnException 3 +#define BlockedOnRead 4 +#define BlockedOnWrite 5 +#define BlockedOnDelay 6 +#define BlockedOnSTM 7 + +/* Win32 only: */ +#define BlockedOnDoProc 8 + +/* Only relevant for PAR: */ + /* blocked on a remote closure represented by a Global Address: */ +#define BlockedOnGA 9 + /* same as above but without sending a Fetch message */ +#define BlockedOnGA_NoSend 10 +/* Only relevant for THREADED_RTS: */ +#define BlockedOnCCall 11 +#define BlockedOnCCall_NoUnblockExc 12 + /* same as above but don't unblock async exceptions in resumeThread() */ + +/* + * These constants are returned to the scheduler by a thread that has + * stopped for one reason or another. See typedef StgThreadReturnCode + * in TSO.h. + */ +#define HeapOverflow 1 /* might also be StackOverflow */ +#define StackOverflow 2 +#define ThreadYielding 3 +#define ThreadBlocked 4 +#define ThreadFinished 5 + +/* ----------------------------------------------------------------------------- + RET_DYN stack frames + -------------------------------------------------------------------------- */ + +/* VERY MAGIC CONSTANTS! + * must agree with code in HeapStackCheck.c, stg_gen_chk, and + * RESERVED_STACK_WORDS in Constants.h. + */ +#define RET_DYN_BITMAP_SIZE 8 +#define RET_DYN_NONPTR_REGS_SIZE 10 + +/* Sanity check that RESERVED_STACK_WORDS is reasonable. We can't + * just derive RESERVED_STACK_WORDS because it's used in Haskell code + * too. + */ +#if RESERVED_STACK_WORDS != (3 + RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE) +#error RESERVED_STACK_WORDS may be wrong! +#endif + +/* ----------------------------------------------------------------------------- + How often our context-switch timer ticks + -------------------------------------------------------------------------- */ + +#define TICK_FREQUENCY 50 /* ticks per second */ + +#endif /* CONSTANTS_H */ diff --git a/includes/DNInvoke.h b/includes/DNInvoke.h new file mode 100644 index 0000000000..410bd640e1 --- /dev/null +++ b/includes/DNInvoke.h @@ -0,0 +1,55 @@ +/* + * C callable bridge to the .NET object model + * + * (c) 2003, sof. + * + */ +#ifndef __DNINVOKE_H__ +#define __DNINVOKE_H__ +#include "Dotnet.h" + +extern char* DN_invokeStatic ( char *assemName, + char *methName, + DotnetArg *args, + int n_args, + DotnetType resultTy, + void *res); +extern char* DN_getStatic ( char *assemName, + char *fieldClsName, + DotnetArg *args, + int n_args, + DotnetType resultTy, + void *res); +extern char* DN_setStatic ( char *assemName, + char *fieldClsName, + DotnetArg *args, + int n_args, + DotnetType resultTy, + void *res); +extern char* DN_createObject ( char *assemName, + char *methName, + DotnetArg *args, + int n_args, + DotnetType resultTy, + void *res); + +extern char* DN_invokeMethod ( char *methName, + DotnetArg *args, + int n_args, + DotnetType resultTy, + void *res); + +extern char* DN_getField ( char *methName, + DotnetArg *args, + int n_args, + DotnetType resultTy, + void *res); +extern char* DN_setField ( char *clsAndMethName, + DotnetArg *args, + int n_args, + DotnetType resultTy, + void *res); + +extern void stopDotnetBridge(void); + +#endif /* __DNINVOKE_H__ */ diff --git a/includes/Dotnet.h b/includes/Dotnet.h new file mode 100644 index 0000000000..89dace2ced --- /dev/null +++ b/includes/Dotnet.h @@ -0,0 +1,64 @@ +/* + * Types and definitions to support GHC .NET interop. + * + * (c) 2003, sof. + * + */ +#ifndef __DOTNET_H__ +#define __DOTNET_H__ + +typedef enum { + Dotnet_Byte = 0, + Dotnet_Boolean, + Dotnet_Char, + Dotnet_Double, + Dotnet_Float, + Dotnet_Int, + Dotnet_Int8, + Dotnet_Int16, + Dotnet_Int32, + Dotnet_Int64, + Dotnet_Word8, + Dotnet_Word16, + Dotnet_Word32, + Dotnet_Word64, + Dotnet_Ptr, + Dotnet_Unit, + Dotnet_Object, + Dotnet_String +} DotnetType; + +typedef union { + unsigned char arg_byte; + unsigned int arg_bool; + unsigned char arg_char; + int arg_int; + signed char arg_int8; + signed short arg_int16; + signed int arg_int32; +#if defined(_MSC_VER) + signed __int64 arg_int64; +#else + signed long long arg_int64; +#endif + float arg_float; + double arg_double; + unsigned char arg_word8; + unsigned short arg_word16; + unsigned int arg_word32; +#if defined(_MSC_VER) + unsigned __int64 arg_word64; +#else + unsigned long long arg_word64; +#endif + void* arg_ptr; + void* arg_obj; + void* arg_str; +} DotnetArgVal; + +typedef struct { + DotnetArgVal arg; + DotnetType arg_type; +} DotnetArg; + +#endif /* __DOTNET_H__ */ diff --git a/includes/GranSim.h b/includes/GranSim.h new file mode 100644 index 0000000000..be5aa83a52 --- /dev/null +++ b/includes/GranSim.h @@ -0,0 +1,331 @@ +/* + Headers for GranSim specific objects. + + Note that in GranSim we have one run-queue and blocking-queue for each + processor. Therefore, this header file redefines variables like + run_queue_hd to be relative to CurrentProc. The main arrays of runnable + and blocking queues are defined in Schedule.c. The important STG-called + GranSim macros (e.g. for fetching nodes) are at the end of this + file. Usually they are just wrappers to proper C functions in GranSim.c. +*/ + +#ifndef GRANSIM_H +#define GRANSIM_H + +#if !defined(GRAN) + +/* Dummy definitions for basic GranSim macros called from STG land */ +#define DO_GRAN_ALLOCATE(n) /* nothing */ +#define DO_GRAN_UNALLOCATE(n) /* nothing */ +#define DO_GRAN_FETCH(node) /* nothing */ +#define DO_GRAN_EXEC(arith,branch,load,store,floats) /* nothing */ +#define GRAN_FETCH_AND_RESCHEDULE(liveness_mask,reenter) /* nothing */ +#define GRAN_RESCHEDULE(liveness_mask,reenter) /* nothing */ + +#endif + +#if defined(GRAN) /* whole file */ + +extern StgTSO *CurrentTSO; + +/* + * @node Headers for GranSim specific objects, , , + * @section Headers for GranSim specific objects + * + * @menu + * * Externs and prototypes:: + * * Run and blocking queues:: + * * Spark queues:: + * * Processor related stuff:: + * * GranSim costs:: + * * STG called GranSim functions:: + * * STG-called routines:: + * @end menu + * + * @node Externs and prototypes, Run and blocking queues, Includes, Headers for GranSim specific objects + * @subsection Externs and prototypes + */ + +/* Global constants */ +extern char *gran_event_names[]; +extern char *proc_status_names[]; +extern char *event_names[]; + +/* Vars checked from within STG land */ +extern rtsBool NeedToReSchedule, IgnoreEvents, IgnoreYields; +; +extern rtsTime TimeOfNextEvent, TimeOfLastEvent, EndOfTimeSlice; + +/* costs for basic operations (copied from RTS flags) */ +extern nat gran_arith_cost, gran_branch_cost, gran_load_cost, gran_store_cost, gran_float_cost; + +extern nat SparksAvail; /* How many sparks are available */ +extern nat SurplusThreads; /* How many excess threads are there */ +extern nat sparksIgnored, sparksCreated; + +/* + * @node Run and blocking queues, Spark queues, Externs and prototypes, Headers for GranSim specific objects + * @subsection Run and blocking queues + */ + +/* declared in Schedule.c */ +extern StgTSO *run_queue_hds[], *run_queue_tls[]; +extern StgTSO *blocked_queue_hds[], *blocked_queue_tls[]; +extern StgTSO *ccalling_threadss[]; + +#define run_queue_hd run_queue_hds[CurrentProc] +#define run_queue_tl run_queue_tls[CurrentProc] +#define blocked_queue_hd blocked_queue_hds[CurrentProc] +#define blocked_queue_tl blocked_queue_tls[CurrentProc] +#define pending_sparks_hd pending_sparks_hds[CurrentProc] +#define pending_sparks_tl pending_sparks_tls[CurrentProc] +#define ccalling_threads ccalling_threadss[CurrentProc] + +/* + * @node Spark queues, Processor related stuff, Run and blocking queues, Headers for GranSim specific objects + * @subsection Spark queues + */ + +/* + In GranSim we use a double linked list to represent spark queues. + + This is more flexible, but slower, than the array of pointers + representation used in GUM. We use the flexibility to define new fields in + the rtsSpark structure, representing e.g. granularity info (see HWL's PhD + thesis), or info about the parent of a spark. +*/ + +/* Sparks and spark queues */ +typedef struct rtsSpark_ +{ + StgClosure *node; + nat name, global; + nat gran_info; /* for granularity improvement mechanisms */ + PEs creator; /* PE that created this spark (unused) */ + struct rtsSpark_ *prev, *next; +} rtsSpark; +typedef rtsSpark *rtsSparkQ; + +/* The spark queues, proper */ +/* In GranSim this is a globally visible array of spark queues */ +extern rtsSparkQ pending_sparks_hds[]; +extern rtsSparkQ pending_sparks_tls[]; + +/* Prototypes of those spark routines visible to compiler generated .hc */ +/* Routines only used inside the RTS are defined in rts/parallel GranSimRts.h */ +rtsSpark *newSpark(StgClosure *node, + nat name, nat gran_info, nat size_info, + nat par_info, nat local); +/* void add_to_spark_queue(rtsSpark *spark); */ + +/* + * @node Processor related stuff, GranSim costs, Spark queues, Headers for GranSim specific objects + * @subsection Processor related stuff + */ + +extern PEs CurrentProc; +extern rtsTime CurrentTime[]; + +/* Maximum number of PEs that can be simulated */ +#define MAX_PROC 32 /* (BITS_IN(StgWord)) */ /* ToDo: fix this!! */ +/* +#if MAX_PROC==16 +#else +#error MAX_PROC should be 32 on this architecture +#endif +*/ + +/* #define CurrentTSO CurrentTSOs[CurrentProc] */ + +/* Processor numbers to bitmasks and vice-versa */ +#define MainProc 0 /* Id of main processor */ +#define NO_PRI 0 /* dummy priority */ +#define MAX_PRI 10000 /* max possible priority */ +#define MAIN_PRI MAX_PRI /* priority of main thread */ + +/* GrAnSim uses IdleProcs as bitmask to indicate which procs are idle */ +#define PE_NUMBER(n) (1l << (long)n) +#define ThisPE PE_NUMBER(CurrentProc) +#define MainPE PE_NUMBER(MainProc) +#define Everywhere (~0l) +#define Nowhere (0l) +#define Now CurrentTime[CurrentProc] + +#define IS_LOCAL_TO(ga,proc) ((1l << (PEs) proc) & ga) + +#define GRAN_TIME_SLICE 1000 /* max time between 2 ReSchedules */ + +/* + * @node GranSim costs, STG called GranSim functions, Processor related stuff, Headers for GranSim specific objects + * @subsection GranSim costs + */ + +/* Default constants for communication (see RtsFlags on how to change them) */ + +#define LATENCY 1000 /* Latency for single packet */ +#define ADDITIONAL_LATENCY 100 /* Latency for additional packets */ +#define BASICBLOCKTIME 10 +#define FETCHTIME (LATENCY*2+MSGUNPACKTIME) +#define LOCALUNBLOCKTIME 10 +#define GLOBALUNBLOCKTIME (LATENCY+MSGUNPACKTIME) + +#define MSGPACKTIME 0 /* Cost of creating a packet */ +#define MSGUNPACKTIME 0 /* Cost of receiving a packet */ +#define MSGTIDYTIME 0 /* Cost of cleaning up after send */ + +/* How much to increase GrAnSims internal packet size if an overflow + occurs. + NB: This is a GrAnSim internal variable and is independent of the + simulated packet buffer size. +*/ + +#define GRANSIM_DEFAULT_PACK_BUFFER_SIZE 400 +#define REALLOC_SZ 200 + +/* extern W_ gran_mpacktime, gran_mtidytime, gran_munpacktime; */ + +/* Thread cost model */ +#define THREADCREATETIME (25+THREADSCHEDULETIME) +#define THREADQUEUETIME 12 /* Cost of adding a thread to the running/runnable queue */ +#define THREADDESCHEDULETIME 75 /* Cost of descheduling a thread */ +#define THREADSCHEDULETIME 75 /* Cost of scheduling a thread */ +#define THREADCONTEXTSWITCHTIME (THREADDESCHEDULETIME+THREADSCHEDULETIME) + +/* Instruction Cost model (SPARC, including cache misses) */ +#define ARITH_COST 1 +#define BRANCH_COST 2 +#define LOAD_COST 4 +#define STORE_COST 4 +#define FLOAT_COST 1 /* ? */ + +#define HEAPALLOC_COST 11 + +#define PRI_SPARK_OVERHEAD 5 +#define PRI_SCHED_OVERHEAD 5 + +/* + * @node STG called GranSim functions, STG-called routines, GranSim costs, Headers for GranSim specific objects + * @subsection STG called GranSim functions + */ + +/* STG called GranSim functions */ +void GranSimAllocate(StgInt n); +void GranSimUnallocate(StgInt n); +void GranSimExec(StgWord ariths, StgWord branches, StgWord loads, StgWord stores, StgWord floats); +StgInt GranSimFetch(StgClosure *node); +void GranSimSpark(StgInt local, StgClosure *node); +void GranSimSparkAt(rtsSpark *spark, StgClosure *where,StgInt identifier); +void GranSimSparkAtAbs(rtsSpark *spark, PEs proc, StgInt identifier); +void GranSimBlock(StgTSO *tso, PEs proc, StgClosure *node); + + +/* + * @node STG-called routines, , STG called GranSim functions, Headers for GranSim specific objects + * @subsection STG-called routines + */ + +/* Wrapped version of calls to GranSim-specific STG routines */ + +/* +#define DO_PERFORM_RESCHEDULE(liveness, always_reenter_node) PerformReschedule_wrapper(liveness, always_reenter_node) +*/ +#define DO_GRAN_ALLOCATE(n) STGCALL1(GranSimAllocate, n) +#define DO_GRAN_UNALLOCATE(n) STGCALL1(GranSimUnallocate, n) +#define DO_GRAN_FETCH(node) STGCALL1(GranSimFetch, node) +#define DO_GRAN_EXEC(arith,branch,load,store,floats) GranSimExec(arith,branch,load,store,floats) + +/* + ToDo: Clean up this mess of GRAN macros!!! -- HWL +*/ +/* DO_GRAN_FETCH((StgClosure*)R1.p); */ +#define GRAN_FETCH() /* nothing */ + +#define GRAN_FETCH_AND_RESCHEDULE(liveness,reenter) \ + DO_GRAN_FETCH((StgClosure*)R1.p); \ + DO_GRAN_YIELD(liveness,ENTRY_CODE((D_)(*R1.p))); +/* RESTORE_EVERYTHING is done implicitly before entering threaded world again */ + +/* + This is the only macro currently enabled; + It should check whether it is time for the current thread to yield + (e.g. if there is a more recent event in the queue) and it should check + whether node is local, via a call to GranSimFetch. + ToDo: split this in 2 routines: + - GRAN_YIELD (as it is below) + - GRAN_FETCH (the rest of this macro) + emit only these 2 macros based on node's liveness + node alive: emit both macros + node not alive: do only a GRAN_YIELD + + replace gran_yield_? with gran_block_? (they really block the current + thread) +*/ +#define GRAN_RESCHEDULE(liveness,ptrs) \ + if (RET_STGCALL1(StgInt, GranSimFetch, (StgClosure*)R1.p)) {\ + EXTFUN_RTS(gran_block_##ptrs); \ + JMP_(gran_block_##ptrs); \ + } else { \ + if (TimeOfLastEvent < CurrentTime[CurrentProc] && \ + HEAP_ALLOCED((StgClosure *)R1.p) && \ + LOOKS_LIKE_GHC_INFO(get_itbl((StgClosure *)R1.p))) { \ + EXTFUN_RTS(gran_yield_##ptrs); \ + JMP_(gran_yield_##ptrs); \ + } \ + /* GRAN_YIELD(ptrs) */ \ + } + + +/* YIELD(liveness,reenter) */ + +/* GRAN_YIELD(liveness_mask); */ + +/* GRAN_FETCH_AND_RESCHEDULE(liveness_mask,reenter) */ + +#define THREAD_CONTEXT_SWITCH(liveness_mask,reenter) \ + do { \ + if (context_switch /* OR_INTERVAL_EXPIRED */) { \ + GRAN_RESCHEDULE(liveness_mask,reenter); \ + } }while(0) + +#define GRAN_EXEC(arith,branch,load,store,floats) \ + { \ + W_ cost = gran_arith_cost*arith + \ + gran_branch_cost*branch + \ + gran_load_cost*load + \ + gran_store_cost*store + \ + gran_float_cost*floats; \ + CurrentTSO->gran.exectime += cost; \ + CurrentTime[CurrentProc] += cost; \ + } + +/* In GranSim we first check whether there is an event to handle; only if + this is the case (or the time slice is over in case of fair scheduling) + we do a yield, which is very similar to that in the concurrent world + ToDo: check whether gran_yield_? can be merged with other yielding codes +*/ + +#define DO_GRAN_YIELD(ptrs) if (!IgnoreYields && \ + TimeOfLastEvent < CurrentTime[CurrentProc] && \ + HEAP_ALLOCED((StgClosure *)R1.p) && \ + LOOKS_LIKE_GHC_INFO(get_itbl((StgClosure *)R1.p))) { \ + EXTFUN_RTS(gran_yield_##ptrs); \ + JMP_(gran_yield_##ptrs); \ + } + +#define GRAN_YIELD(ptrs) \ + { \ + extern int context_switch; \ + if ( (CurrentTime[CurrentProc]>=EndOfTimeSlice) || \ + ((CurrentTime[CurrentProc]>=TimeOfNextEvent) && \ + (TimeOfNextEvent!=0) && !IgnoreEvents )) { \ + /* context_switch = 1; */ \ + DO_GRAN_YIELD(ptrs); \ + } \ + } + +#define ADD_TO_SPARK_QUEUE(spark) \ + STGCALL1(add_to_spark_queue,spark) \ + +#endif /* GRAN */ + +#endif /* GRANSIM_H */ diff --git a/includes/Hooks.h b/includes/Hooks.h new file mode 100644 index 0000000000..38014cc8f7 --- /dev/null +++ b/includes/Hooks.h @@ -0,0 +1,20 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-1999 + * + * User-overridable RTS hooks. + * + * ---------------------------------------------------------------------------*/ + +extern char *ghc_rts_opts; + +extern void OnExitHook (void); +extern int NoRunnableThreadsHook (void); +extern void StackOverflowHook (unsigned long stack_size); +extern void OutOfHeapHook (unsigned long request_size, unsigned long heap_size); +extern void MallocFailHook (unsigned long request_size /* in bytes */, char *msg); +extern void defaultsHook (void); +#if defined(PAR) +extern void InitEachPEHook (void); +extern void ShutdownEachPEHook (void); +#endif diff --git a/includes/HsFFI.h b/includes/HsFFI.h new file mode 100644 index 0000000000..70891a2dc2 --- /dev/null +++ b/includes/HsFFI.h @@ -0,0 +1,167 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2000 + * + * A mapping for Haskell types to C types, including the corresponding bounds. + * Intended to be used in conjuction with the FFI. + * + * WARNING: Keep this file and StgTypes.h in synch! + * + * ---------------------------------------------------------------------------*/ + +#ifndef HSFFI_H +#define HSFFI_H + +#ifdef __cplusplus +extern "C" { +#endif + +/* get types from GHC's runtime system */ +#include "ghcconfig.h" +#include "RtsConfig.h" +#include "StgTypes.h" + +/* get limits for integral types */ +#ifdef HAVE_STDINT_H +/* ISO C 99 says: + * "C++ implementations should define these macros only when + * __STDC_LIMIT_MACROS is defined before <stdint.h> is included." + */ +#define __STDC_LIMIT_MACROS +#include <stdint.h> +#elif defined(HAVE_INTTYPES_H) +#include <inttypes.h> +#else +/* second best guess (e.g. on Solaris) */ +#include <limits.h> +#endif + +#ifdef INT8_MIN +#define __INT8_MIN INT8_MIN +#define __INT16_MIN INT16_MIN +#define __INT32_MIN INT32_MIN +#define __INT64_MIN INT64_MIN +#define __INT8_MAX INT8_MAX +#define __INT16_MAX INT16_MAX +#define __INT32_MAX INT32_MAX +#define __INT64_MAX INT64_MAX +#define __UINT8_MAX UINT8_MAX +#define __UINT16_MAX UINT16_MAX +#define __UINT32_MAX UINT32_MAX +#define __UINT64_MAX UINT64_MAX +#else +/* if we had no luck, let's do it for ourselves (assuming 64bit long longs) */ +#define __INT8_MIN (-128) +#define __INT16_MIN (-32767-1) +#define __INT32_MIN (-2147483647-1) +#define __INT64_MIN (-9223372036854775807LL-1) +#define __INT8_MAX (127) +#define __INT16_MAX (32767) +#define __INT32_MAX (2147483647) +#define __INT64_MAX (9223372036854775807LL) +#define __UINT8_MAX (255U) +#define __UINT16_MAX (65535U) +#define __UINT32_MAX (4294967295U) +#define __UINT64_MAX (18446744073709551615ULL) +#endif + +/* get limits for floating point types */ +#include <float.h> + +typedef StgChar HsChar; +typedef StgInt HsInt; +typedef StgInt8 HsInt8; +typedef StgInt16 HsInt16; +typedef StgInt32 HsInt32; +typedef StgInt64 HsInt64; +typedef StgWord HsWord; +typedef StgWord8 HsWord8; +typedef StgWord16 HsWord16; +typedef StgWord32 HsWord32; +typedef StgWord64 HsWord64; +typedef StgFloat HsFloat; +typedef StgDouble HsDouble; +typedef StgBool HsBool; +typedef void* HsPtr; /* this should better match StgAddr */ +typedef void (*HsFunPtr)(void); /* this should better match StgAddr */ +typedef void* HsForeignPtr; /* ... and this StgForeignPtr */ +typedef void* HsStablePtr; +typedef void* HsAddr; /* DEPRECATED */ +typedef void* HsForeignObj; /* DEPRECATED */ + +/* this should correspond to the type of StgChar in StgTypes.h */ +#define HS_CHAR_MIN 0 +#define HS_CHAR_MAX 0x10FFFF + +/* is it true or not? */ +#define HS_BOOL_FALSE 0 +#define HS_BOOL_TRUE 1 + +#define HS_BOOL_MIN HS_BOOL_FALSE +#define HS_BOOL_MAX HS_BOOL_TRUE + +/* this mirrors the distinction of cases in StgTypes.h */ +#if SIZEOF_VOID_P == 8 +#define HS_INT_MIN __INT64_MIN +#define HS_INT_MAX __INT64_MAX +#elif SIZEOF_VOID_P == 4 +#define HS_INT_MIN __INT32_MIN +#define HS_INT_MAX __INT32_MAX +#else +#error GHC untested on this architecture: sizeof(void *) != 4 or 8 +#endif + +#define HS_INT8_MIN __INT8_MIN +#define HS_INT8_MAX __INT8_MAX +#define HS_INT16_MIN __INT16_MIN +#define HS_INT16_MAX __INT16_MAX +#define HS_INT32_MIN __INT32_MIN +#define HS_INT32_MAX __INT32_MAX +#define HS_INT64_MIN __INT64_MIN +#define HS_INT64_MAX __INT64_MAX +#define HS_WORD8_MAX __UINT8_MAX +#define HS_WORD16_MAX __UINT16_MAX +#define HS_WORD32_MAX __UINT32_MAX +#define HS_WORD64_MAX __UINT64_MAX + +#define HS_FLOAT_RADIX FLT_RADIX +#define HS_FLOAT_ROUNDS FLT_ROUNDS +#define HS_FLOAT_EPSILON FLT_EPSILON +#define HS_FLOAT_DIG FLT_DIG +#define HS_FLOAT_MANT_DIG FLT_MANT_DIG +#define HS_FLOAT_MIN FLT_MIN +#define HS_FLOAT_MIN_EXP FLT_MIN_EXP +#define HS_FLOAT_MIN_10_EXP FLT_MIN_10_EXP +#define HS_FLOAT_MAX FLT_MAX +#define HS_FLOAT_MAX_EXP FLT_MAX_EXP +#define HS_FLOAT_MAX_10_EXP FLT_MAX_10_EXP + +#define HS_DOUBLE_RADIX DBL_RADIX +#define HS_DOUBLE_ROUNDS DBL_ROUNDS +#define HS_DOUBLE_EPSILON DBL_EPSILON +#define HS_DOUBLE_DIG DBL_DIG +#define HS_DOUBLE_MANT_DIG DBL_MANT_DIG +#define HS_DOUBLE_MIN DBL_MIN +#define HS_DOUBLE_MIN_EXP DBL_MIN_EXP +#define HS_DOUBLE_MIN_10_EXP DBL_MIN_10_EXP +#define HS_DOUBLE_MAX DBL_MAX +#define HS_DOUBLE_MAX_EXP DBL_MAX_EXP +#define HS_DOUBLE_MAX_10_EXP DBL_MAX_10_EXP + +extern void hs_init (int *argc, char **argv[]); +extern void hs_exit (void); +extern void hs_set_argv (int argc, char *argv[]); +extern void hs_add_root (void (*init_root)(void)); + +extern void hs_perform_gc (void); + +extern void hs_free_stable_ptr (HsStablePtr sp); +extern void hs_free_fun_ptr (HsFunPtr fp); + +/* -------------------------------------------------------------------------- */ + +#ifdef __cplusplus +} +#endif + +#endif /* HSFFI_H */ diff --git a/includes/InfoTables.h b/includes/InfoTables.h new file mode 100644 index 0000000000..8fa699a097 --- /dev/null +++ b/includes/InfoTables.h @@ -0,0 +1,423 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2002 + * + * Info Tables + * + * -------------------------------------------------------------------------- */ + +#ifndef INFOTABLES_H +#define INFOTABLES_H + +/* ----------------------------------------------------------------------------- + Profiling info + -------------------------------------------------------------------------- */ + +typedef struct { + char *closure_type; + char *closure_desc; +} StgProfInfo; + +/* ----------------------------------------------------------------------------- + Parallelism info + -------------------------------------------------------------------------- */ + +#if 0 && (defined(PAR) || defined(GRAN)) + +/* CURRENTLY UNUSED + ToDo: use this in StgInfoTable (mutually recursive) -- HWL */ + +typedef struct { + StgInfoTable *rbh_infoptr; /* infoptr to the RBH */ +} StgParInfo; + +#endif /* 0 */ + +/* + Copied from ghc-0.29; ToDo: check this code -- HWL + + In the parallel system, all updatable closures have corresponding + revertible black holes. When we are assembly-mangling, we guarantee + that the revertible black hole code precedes the normal entry code, so + that the RBH info table resides at a fixed offset from the normal info + table. Otherwise, we add the RBH info table pointer to the end of the + normal info table and vice versa. + + Currently has to use a !RBH_MAGIC_OFFSET setting. + Still todo: init of par.infoptr field in all infotables!! +*/ + +#if defined(PAR) || defined(GRAN) + +# ifdef RBH_MAGIC_OFFSET + +# error magic offset not yet implemented + +# define RBH_INFO_WORDS 0 +# define INCLUDE_RBH_INFO(infoptr) + +# define RBH_INFOPTR(infoptr) (((P_)infoptr) - RBH_MAGIC_OFFSET) +# define REVERT_INFOPTR(infoptr) (((P_)infoptr) + RBH_MAGIC_OFFSET) + +# else + +# define RBH_INFO_WORDS 1 +# define INCLUDE_RBH_INFO(info) rbh_infoptr : &(info) + +# define RBH_INFOPTR(infoptr) (((StgInfoTable *)(infoptr))->rbh_infoptr) +# define REVERT_INFOPTR(infoptr) (((StgInfoTable *)(infoptr))->rbh_infoptr) + +# endif + +/* see ParallelRts.h */ +/* +EXTFUN(RBH_entry); +StgClosure *convertToRBH(StgClosure *closure); +#if defined(GRAN) +void convertFromRBH(StgClosure *closure); +#elif defined(PAR) +void convertToFetchMe(StgPtr closure, globalAddr *ga); +#endif +*/ + +#endif + +/* ----------------------------------------------------------------------------- + Ticky info + + There is no ticky-specific stuff in an info table at this time. + -------------------------------------------------------------------------- */ + +/* ----------------------------------------------------------------------------- + Debugging info + -------------------------------------------------------------------------- */ + +#ifdef DEBUG_CLOSURE + +typedef struct { + ... whatever ... +} StgDebugInfo; + +#else /* !DEBUG_CLOSURE */ + +/* There is no DEBUG-specific stuff in an info table at this time. */ + +#endif /* DEBUG_CLOSURE */ + +/* ----------------------------------------------------------------------------- + Closure flags + -------------------------------------------------------------------------- */ + +/* The type flags provide quick access to certain properties of a closure. */ + +#define _HNF (1<<0) /* head normal form? */ +#define _BTM (1<<1) /* bitmap-style layout? */ +#define _NS (1<<2) /* non-sparkable */ +#define _STA (1<<3) /* static? */ +#define _THU (1<<4) /* thunk? */ +#define _MUT (1<<5) /* mutable? */ +#define _UPT (1<<6) /* unpointed? */ +#define _SRT (1<<7) /* has an SRT? */ +#define _IND (1<<8) /* is an indirection? */ + +#define isSTATIC(flags) ((flags) &_STA) +#define isMUTABLE(flags) ((flags) &_MUT) +#define isBITMAP(flags) ((flags) &_BTM) +#define isTHUNK(flags) ((flags) &_THU) +#define isUNPOINTED(flags) ((flags) &_UPT) +#define hasSRT(flags) ((flags) &_SRT) + +extern StgWord16 closure_flags[]; + +#define closureFlags(c) (closure_flags[get_itbl(c)->type]) + +#define closure_HNF(c) ( closureFlags(c) & _HNF) +#define closure_BITMAP(c) ( closureFlags(c) & _BTM) +#define closure_NON_SPARK(c) ( (closureFlags(c) & _NS)) +#define closure_SHOULD_SPARK(c) (!(closureFlags(c) & _NS)) +#define closure_STATIC(c) ( closureFlags(c) & _STA) +#define closure_THUNK(c) ( closureFlags(c) & _THU) +#define closure_MUTABLE(c) ( closureFlags(c) & _MUT) +#define closure_UNPOINTED(c) ( closureFlags(c) & _UPT) +#define closure_SRT(c) ( closureFlags(c) & _SRT) +#define closure_IND(c) ( closureFlags(c) & _IND) + +/* same as above but for info-ptr rather than closure */ +#define ipFlags(ip) (closure_flags[ip->type]) + +#define ip_HNF(ip) ( ipFlags(ip) & _HNF) +#define ip_BITMAP(ip) ( ipFlags(ip) & _BTM) +#define ip_SHOULD_SPARK(ip) (!(ipFlags(ip) & _NS)) +#define ip_STATIC(ip) ( ipFlags(ip) & _STA) +#define ip_THUNK(ip) ( ipFlags(ip) & _THU) +#define ip_MUTABLE(ip) ( ipFlags(ip) & _MUT) +#define ip_UNPOINTED(ip) ( ipFlags(ip) & _UPT) +#define ip_SRT(ip) ( ipFlags(ip) & _SRT) +#define ip_IND(ip) ( ipFlags(ip) & _IND) + +/* ----------------------------------------------------------------------------- + Bitmaps + + These are used to describe the pointerhood of a sequence of words + (usually on the stack) to the garbage collector. The two primary + uses are for stack frames, and functions (where we need to describe + the layout of a PAP to the GC). + + In these bitmaps: 0 == ptr, 1 == non-ptr. + -------------------------------------------------------------------------- */ + +/* + * Small bitmaps: for a small bitmap, we store the size and bitmap in + * the same word, using the following macros. If the bitmap doesn't + * fit in a single word, we use a pointer to an StgLargeBitmap below. + */ +#define MK_SMALL_BITMAP(size,bits) (((bits)<<BITMAP_BITS_SHIFT) | (size)) + +#define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK) +#define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT) + +/* + * A large bitmap. + */ +typedef struct { + StgWord size; + StgWord bitmap[FLEXIBLE_ARRAY]; +} StgLargeBitmap; + +/* ----------------------------------------------------------------------------- + SRTs (Static Reference Tables) + + These tables are used to keep track of the static objects referred + to by the code for a closure or stack frame, so that we can follow + static data references from code and thus accurately + garbage-collect CAFs. + -------------------------------------------------------------------------- */ + +/* An SRT is just an array of closure pointers: */ +typedef StgClosure* StgSRT[]; + +/* + * Each info table refers to some subset of the closure pointers in an + * SRT. It does this using a pair of an StgSRT pointer and a + * half-word bitmap. If the half-word bitmap isn't large enough, then + * we fall back to a large SRT, including an unbounded bitmap. If the + * half-word bitmap is set to all ones (0xffff), then the StgSRT + * pointer instead points to an StgLargeSRT: + */ +typedef struct StgLargeSRT_ { + StgSRT *srt; + StgLargeBitmap l; +} StgLargeSRT; + +/* ---------------------------------------------------------------------------- + Relative pointers + + Several pointer fields in info tables are expressed as offsets + relative to the info pointer, so that we can generate + position-independent code. + + There is a complication on the x86_64 platform, where pointeres are + 64 bits, but the tools don't support 64-bit relative relocations. + However, the default memory model (small) ensures that all symbols + have values in the lower 2Gb of the address space, so offsets all + fit in 32 bits. Hence we can use 32-bit offset fields. + ------------------------------------------------------------------------- */ + +#if x86_64_TARGET_ARCH +#define OFFSET_FIELD(n) StgHalfInt n; StgHalfWord __pad_##n; +#else +#define OFFSET_FIELD(n) StgInt n; +#endif + +/* ---------------------------------------------------------------------------- + Info Tables + ------------------------------------------------------------------------- */ + +/* + * Stuff describing the closure layout. Well, actually, it might + * contain the selector index for a THUNK_SELECTOR. This union is one + * word long. + */ +typedef union { + struct { /* Heap closure payload layout: */ + StgHalfWord ptrs; /* number of pointers */ + StgHalfWord nptrs; /* number of non-pointers */ + } payload; + + StgWord bitmap; /* word-sized bit pattern describing */ + /* a stack frame: see below */ + +#ifndef TABLES_NEXT_TO_CODE + StgLargeBitmap* large_bitmap; /* pointer to large bitmap structure */ +#else + OFFSET_FIELD( large_bitmap_offset ); /* offset from info table to large bitmap structure */ +#endif + + StgWord selector_offset; /* used in THUNK_SELECTORs */ + +} StgClosureInfo; + + +/* + * The "standard" part of an info table. Every info table has this bit. + */ +typedef struct _StgInfoTable { + +#ifndef TABLES_NEXT_TO_CODE + StgFunPtr entry; /* pointer to the entry code */ +#endif + +#if defined(PAR) || defined(GRAN) + struct _StgInfoTable *rbh_infoptr; +#endif +#ifdef PROFILING + StgProfInfo prof; +#endif +#ifdef TICKY + /* Ticky-specific stuff would go here. */ +#endif +#ifdef DEBUG_CLOSURE + /* Debug-specific stuff would go here. */ +#endif + + StgClosureInfo layout; /* closure layout info (one word) */ + + StgHalfWord type; /* closure type */ + StgHalfWord srt_bitmap; /* number of entries in SRT (or constructor tag) */ + +#ifdef TABLES_NEXT_TO_CODE + StgCode code[FLEXIBLE_ARRAY]; +#endif +} StgInfoTable; + + +/* ----------------------------------------------------------------------------- + Function info tables + + This is the general form of function info tables. The compiler + will omit some of the fields in common cases: + + - If fun_type is not ARG_GEN or ARG_GEN_BIG, then the slow_apply + and bitmap fields may be left out (they are at the end, so omitting + them doesn't affect the layout). + + - If srt_bitmap (in the std info table part) is zero, then the srt + field may be omitted. This only applies if the slow_apply and + bitmap fields have also been omitted. + -------------------------------------------------------------------------- */ + +typedef struct _StgFunInfoExtraRev { + OFFSET_FIELD ( slow_apply_offset ); /* apply to args on the stack */ + union { + StgWord bitmap; + OFFSET_FIELD ( bitmap_offset ); /* arg ptr/nonptr bitmap */ + } b; + OFFSET_FIELD ( srt_offset ); /* pointer to the SRT table */ + StgHalfWord fun_type; /* function type */ + StgHalfWord arity; /* function arity */ +} StgFunInfoExtraRev; + +typedef struct _StgFunInfoExtraFwd { + StgHalfWord fun_type; /* function type */ + StgHalfWord arity; /* function arity */ + StgSRT *srt; /* pointer to the SRT table */ + union { /* union for compat. with TABLES_NEXT_TO_CODE version */ + StgWord bitmap; /* arg ptr/nonptr bitmap */ + } b; + StgFun *slow_apply; /* apply to args on the stack */ +} StgFunInfoExtraFwd; + +typedef struct { +#if defined(TABLES_NEXT_TO_CODE) + StgFunInfoExtraRev f; + StgInfoTable i; +#else + StgInfoTable i; + StgFunInfoExtraFwd f; +#endif +} StgFunInfoTable; + +/* ----------------------------------------------------------------------------- + Return info tables + -------------------------------------------------------------------------- */ + +/* + * When info tables are laid out backwards, we can omit the SRT + * pointer iff srt_bitmap is zero. + */ + +typedef struct { +#if defined(TABLES_NEXT_TO_CODE) + OFFSET_FIELD( srt_offset ); /* offset to the SRT table */ + StgInfoTable i; +#else + StgInfoTable i; + StgSRT *srt; /* pointer to the SRT table */ + StgFunPtr vector[FLEXIBLE_ARRAY]; +#endif +} StgRetInfoTable; + +/* ----------------------------------------------------------------------------- + Thunk info tables + -------------------------------------------------------------------------- */ + +/* + * When info tables are laid out backwards, we can omit the SRT + * pointer iff srt_bitmap is zero. + */ + +typedef struct _StgThunkInfoTable { +#if !defined(TABLES_NEXT_TO_CODE) + StgInfoTable i; +#endif +#if defined(TABLES_NEXT_TO_CODE) + OFFSET_FIELD( srt_offset ); /* offset to the SRT table */ +#else + StgSRT *srt; /* pointer to the SRT table */ +#endif +#if defined(TABLES_NEXT_TO_CODE) + StgInfoTable i; +#endif +} StgThunkInfoTable; + + +/* ----------------------------------------------------------------------------- + Accessor macros for fields that might be offsets (C version) + -------------------------------------------------------------------------- */ + +/* + * GET_SRT(info) + * info must be a Stg[Ret|Thunk]InfoTable* (an info table that has a SRT) + */ +#ifdef TABLES_NEXT_TO_CODE +#define GET_SRT(info) ((StgSRT*) (((StgWord) ((info)+1)) + (info)->srt_offset)) +#else +#define GET_SRT(info) ((info)->srt) +#endif + +/* + * GET_FUN_SRT(info) + * info must be a StgFunInfoTable* + */ +#ifdef TABLES_NEXT_TO_CODE +#define GET_FUN_SRT(info) ((StgSRT*) (((StgWord) ((info)+1)) + (info)->f.srt_offset)) +#else +#define GET_FUN_SRT(info) ((info)->f.srt) +#endif + +#ifdef TABLES_NEXT_TO_CODE +#define GET_LARGE_BITMAP(info) ((StgLargeBitmap*) (((StgWord) ((info)+1)) \ + + (info)->layout.large_bitmap_offset)) +#else +#define GET_LARGE_BITMAP(info) ((info)->layout.large_bitmap) +#endif + +#ifdef TABLES_NEXT_TO_CODE +#define GET_FUN_LARGE_BITMAP(info) ((StgLargeBitmap*) (((StgWord) ((info)+1)) \ + + (info)->f.b.bitmap_offset)) +#else +#define GET_FUN_LARGE_BITMAP(info) ((StgLargeBitmap*) ((info)->f.b.bitmap)) +#endif + + +#endif /* INFOTABLES_H */ diff --git a/includes/Linker.h b/includes/Linker.h new file mode 100644 index 0000000000..bb1a4c251f --- /dev/null +++ b/includes/Linker.h @@ -0,0 +1,30 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2000 + * + * RTS Object Linker + * + * ---------------------------------------------------------------------------*/ + +#ifndef LINKER_H +#define LINKER_H + +/* initialize the object linker */ +void initLinker( void ); + +/* lookup a symbol in the hash table */ +void *lookupSymbol( char *lbl ); + +/* delete an object from the pool */ +HsInt unloadObj( char *path ); + +/* add an obj (populate the global symbol table, but don't resolve yet) */ +HsInt loadObj( char *path ); + +/* resolve all the currently unlinked objects in memory */ +HsInt resolveObjs( void ); + +/* load a dynamic library */ +char *addDLL( char* dll_name ); + +#endif /* LINKER_H */ diff --git a/includes/Liveness.h b/includes/Liveness.h new file mode 100644 index 0000000000..cc93cae34f --- /dev/null +++ b/includes/Liveness.h @@ -0,0 +1,34 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The University of Glasgow 2004 + * + * Building liveness masks for RET_DYN stack frames. + * A few macros that are used in both .cmm and .c sources. + * + * A liveness mask is constructed like so: + * + * R1_PTR & R2_PTR & R3_PTR + * + * -------------------------------------------------------------------------- */ + +#ifndef LIVENESS_H +#define LIVENESS_H + +#define NO_PTRS 0xff +#define R1_PTR (NO_PTRS ^ (1<<0)) +#define R2_PTR (NO_PTRS ^ (1<<1)) +#define R3_PTR (NO_PTRS ^ (1<<2)) +#define R4_PTR (NO_PTRS ^ (1<<3)) +#define R5_PTR (NO_PTRS ^ (1<<4)) +#define R6_PTR (NO_PTRS ^ (1<<5)) +#define R7_PTR (NO_PTRS ^ (1<<6)) +#define R8_PTR (NO_PTRS ^ (1<<7)) + +#define N_NONPTRS(n) ((n)<<16) +#define N_PTRS(n) ((n)<<24) + +#define RET_DYN_NONPTRS(l) ((l)>>16 & 0xff) +#define RET_DYN_PTRS(l) ((l)>>24 & 0xff) +#define RET_DYN_LIVENESS(l) ((l) & 0xffff) + +#endif /* LIVENESS_H */ diff --git a/includes/MachDeps.h b/includes/MachDeps.h new file mode 100644 index 0000000000..abe4405d5e --- /dev/null +++ b/includes/MachDeps.h @@ -0,0 +1,108 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The University of Glasgow 2002 + * + * Definitions that characterise machine specific properties of basic + * types (C & Haskell). + * + * NB: Keep in sync with HsFFI.h and StgTypes.h. + * NB: THIS FILE IS INCLUDED IN HASKELL SOURCE! + * ---------------------------------------------------------------------------*/ + +#ifndef MACHDEPS_H +#define MACHDEPS_H + +/* Sizes of C types come from here... */ +#include "ghcautoconf.h" + +/* Sizes of Haskell types follow. These sizes correspond to: + * - the number of bytes in the primitive type (eg. Int#) + * - the number of bytes in the external representation (eg. HsInt) + * - the scale offset used by writeFooOffAddr# + * + * In the heap, the type may take up more space: eg. SIZEOF_INT8 == 1, + * but it takes up SIZEOF_HSWORD (4 or 8) bytes in the heap. + */ + +/* First, check some assumptions.. */ +#if SIZEOF_CHAR != 1 +#error GHC untested on this architecture: sizeof(char) != 1 +#endif + +#if SIZEOF_SHORT != 2 +#error GHC untested on this architecture: sizeof(short) != 2 +#endif + +#if SIZEOF_UNSIGNED_INT != 4 +#error GHC untested on this architecture: sizeof(unsigned int) != 4 +#endif + +#define SIZEOF_HSCHAR SIZEOF_WORD32 +#define ALIGNMENT_HSCHAR ALIGNMENT_WORD32 + +#define SIZEOF_HSINT SIZEOF_VOID_P +#define ALIGNMENT_HSINT ALIGNMENT_VOID_P + +#define SIZEOF_HSWORD SIZEOF_VOID_P +#define ALIGNMENT_HSWORD ALIGNMENT_VOID_P + +#define SIZEOF_HSDOUBLE SIZEOF_DOUBLE +#define ALIGNMENT_HSDOUBLE ALIGNMENT_DOUBLE + +#define SIZEOF_HSFLOAT SIZEOF_FLOAT +#define ALIGNMENT_HSFLOAT ALIGNMENT_FLOAT + +#define SIZEOF_HSPTR SIZEOF_VOID_P +#define ALIGNMENT_HSPTR ALIGNMENT_VOID_P + +#define SIZEOF_HSFUNPTR SIZEOF_VOID_P +#define ALIGNMENT_HSFUNPTR ALIGNMENT_VOID_P + +#define SIZEOF_HSFOREIGNPTR SIZEOF_VOID_P +#define ALIGNMENT_HSFOREIGNPTR ALIGNMENT_VOID_P + +#define SIZEOF_HSSTABLEPTR SIZEOF_VOID_P +#define ALIGNMENT_HSSTABLEPTR ALIGNMENT_VOID_P + +#define SIZEOF_INT8 SIZEOF_CHAR +#define ALIGNMENT_INT8 ALIGNMENT_CHAR + +#define SIZEOF_WORD8 SIZEOF_UNSIGNED_CHAR +#define ALIGNMENT_WORD8 ALIGNMENT_UNSIGNED_CHAR + +#define SIZEOF_INT16 SIZEOF_SHORT +#define ALIGNMENT_INT16 ALIGNMENT_SHORT + +#define SIZEOF_WORD16 SIZEOF_UNSIGNED_SHORT +#define ALIGNMENT_WORD16 ALIGNMENT_UNSIGNED_SHORT + +#define SIZEOF_INT32 SIZEOF_INT +#define ALIGNMENT_INT32 ALIGNMENT_INT + +#define SIZEOF_WORD32 SIZEOF_UNSIGNED_INT +#define ALIGNMENT_WORD32 ALIGNMENT_UNSIGNED_INT + +#if HAVE_LONG_LONG && SIZEOF_VOID_P < 8 +/* assume long long is 64 bits */ +#define SIZEOF_INT64 SIZEOF_LONG_LONG +#define ALIGNMENT_INT64 ALIGNMENT_LONG_LONG +#define SIZEOF_WORD64 SIZEOF_UNSIGNED_LONG_LONG +#define ALIGNMENT_WORD64 ALIGNMENT_UNSIGNED_LONG_LONG +#elif SIZEOF_LONG == 8 +#define SIZEOF_INT64 SIZEOF_LONG +#define ALIGNMENT_INT64 ALIGNMENT_LONG +#define SIZEOF_WORD64 SIZEOF_UNSIGNED_LONG +#define ALIGNMENT_WORD64 ALIGNMENT_UNSIGNED_LONG +#else +#error GHC untested on this architecture: sizeof(void *) < 8 and no long longs. +#endif + +#ifndef WORD_SIZE_IN_BITS +#if SIZEOF_HSWORD == 4 +#define WORD_SIZE_IN_BITS 32 +#else +#define WORD_SIZE_IN_BITS 64 +#endif +#endif + +#endif /* MACHDEPS_H */ diff --git a/includes/MachRegs.h b/includes/MachRegs.h new file mode 100644 index 0000000000..92944e1467 --- /dev/null +++ b/includes/MachRegs.h @@ -0,0 +1,732 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-1999 + * + * Registers used in STG code. Might or might not correspond to + * actual machine registers. + * + * ---------------------------------------------------------------------------*/ + +#ifndef MACHREGS_H +#define MACHREGS_H + +/* This file is #included into Haskell code in the compiler: #defines + * only in here please. + */ + +/* + * Defining NO_REGS causes no global registers to be used. NO_REGS is + * typically defined by GHC, via a command-line option passed to gcc, + * when the -funregisterised flag is given. + * + * NB. When NO_REGS is on, calling & return conventions may be + * different. For example, all function arguments will be passed on + * the stack, and components of an unboxed tuple will be returned on + * the stack rather than in registers. + */ +#ifndef NO_REGS + +/* NOTE: when testing the platform in this file we must test either + * *_HOST_ARCH and *_TARGET_ARCH, depending on whether COMPILING_GHC + * is set. This is because when we're compiling the RTS and HC code, + * the platform we're running on is the HOST, but when compiling GHC + * we want to know about the register mapping on the TARGET platform. + */ +#ifdef COMPILING_GHC +#define alpha_REGS alpha_TARGET_ARCH +#define hppa1_1_REGS hppa1_1_TARGET_ARCH +#define i386_REGS i386_TARGET_ARCH +#define x86_64_REGS x86_64_TARGET_ARCH +#define m68k_REGS m68k_TARGET_ARCH +#define mips_REGS (mipsel_TARGET_ARCH || mipseb_TARGET_ARCH) +#define powerpc_REGS (powerpc_TARGET_ARCH || powerpc64_TARGET_ARCH || rs6000_TARGET_ARCH) +#define ia64_REGS ia64_TARGET_ARCH +#define sparc_REGS sparc_TARGET_ARCH +#define darwin_REGS darwin_TARGET_OS +#else +#define alpha_REGS alpha_HOST_ARCH +#define hppa1_1_REGS hppa1_1_HOST_ARCH +#define i386_REGS i386_HOST_ARCH +#define x86_64_REGS x86_64_HOST_ARCH +#define m68k_REGS m68k_HOST_ARCH +#define mips_REGS (mipsel_HOST_ARCH || mipseb_HOST_ARCH) +#define powerpc_REGS (powerpc_HOST_ARCH || powerpc64_HOST_ARCH || rs6000_HOST_ARCH) +#define ia64_REGS ia64_HOST_ARCH +#define sparc_REGS sparc_HOST_ARCH +#define darwin_REGS darwin_HOST_OS +#endif + +/* ---------------------------------------------------------------------------- + Caller saves and callee-saves regs. + + Caller-saves regs have to be saved around C-calls made from STG + land, so this file defines CALLER_SAVES_<reg> for each <reg> that + is designated caller-saves in that machine's C calling convention. + -------------------------------------------------------------------------- */ + +/* ----------------------------------------------------------------------------- + The DEC Alpha register mapping + + Alpha registers + \tr{$9}--\tr{$14} are our ``prize'' callee-save registers. + \tr{$15} is the frame pointer, and \tr{$16}--\tr{$21} are argument + registers. (These are off-limits.) We can steal some of the \tr{$22}-and-up + caller-save registers provided we do the appropriate save/restore stuff. + + \tr{$f2}--\tr{$f9} are some callee-save floating-point registers. + + We cannot use \tr{$23} (aka t9), \tr{$24} (aka t10), \tr{$25} (aka + t11), \tr{$27} (aka pv), or \tr{$28} (aka at), because they are + occasionally required by the assembler to handle non-primitive + instructions (e.g. ldb, remq). Sigh! + + Cheat sheet for GDB: + + GDB here Main map + === ==== ======== + s5 $14 R1 + t1 $2 R2 + t2 $3 R3 + t3 $4 R4 + t4 $5 R5 + t5 $6 R6 + t6 $7 R7 + t7 $8 R8 + s0 $9 Sp + s2 $11 SpLim + s3 $12 Hp + s4 $13 HpLim + t8 $22 NCG_reserved + t12 $27 NCG_reserved + -------------------------------------------------------------------------- */ + +#if alpha_REGS +# define REG(x) __asm__("$" #x) + +# define CALLER_SAVES_R2 +# define CALLER_SAVES_R3 +# define CALLER_SAVES_R4 +# define CALLER_SAVES_R5 +# define CALLER_SAVES_R6 +# define CALLER_SAVES_R7 +# define CALLER_SAVES_R8 + +# define CALLER_SAVES_USER + +# define REG_R1 14 +# define REG_R2 2 +# define REG_R3 3 +# define REG_R4 4 +# define REG_R5 5 +# define REG_R6 6 +# define REG_R7 7 +# define REG_R8 8 + +# define REG_F1 f2 +# define REG_F2 f3 +# define REG_F3 f4 +# define REG_F4 f5 + +# define REG_D1 f6 +# define REG_D2 f7 + +# define REG_Sp 9 +# define REG_SpLim 11 + +# define REG_Hp 12 +# define REG_HpLim 13 + +# define NCG_Reserved_I1 22 +# define NCG_Reserved_I2 27 +# define NCG_Reserved_F1 f29 +# define NCG_Reserved_F2 f30 + +#endif /* alpha_REGS */ + +/* ----------------------------------------------------------------------------- + The HP-PA register mapping + + We cater for HP-PA 1.1. + + \tr{%r0}--\tr{%r1} are special. + \tr{%r2} is the return pointer. + \tr{%r3} is the frame pointer. + \tr{%r4}--\tr{%r18} are callee-save registers. + \tr{%r19} is a linkage table register for HPUX 8.0 shared libraries. + \tr{%r20}--\tr{%r22} are caller-save registers. + \tr{%r23}--\tr{%r26} are parameter registers. + \tr{%r27} is a global data pointer. + \tr{%r28}--\tr{%r29} are temporaries. + \tr{%r30} is the stack pointer. + \tr{%r31} is a temporary. + + \tr{%fr12}--\tr{%fr15} are some callee-save floating-point registers. + \tr{%fr8}--\tr{%fr11} are some available caller-save fl-pt registers. + -------------------------------------------------------------------------- */ + +#if hppa1_1_REGS + +#define REG(x) __asm__("%" #x) + +#define REG_R1 r11 +#define REG_R2 r12 +#define REG_R3 r13 +#define REG_R4 r14 +#define REG_R5 r15 +#define REG_R6 r16 +#define REG_R7 r17 +#define REG_R8 r18 + +#define REG_F1 fr12 +#define REG_F2 fr12R +#define REG_F3 fr13 +#define REG_F4 fr13R + +#define REG_D1 fr20 /* L & R */ +#define REG_D2 fr21 /* L & R */ + +#define REG_Sp r4 +#define REG_SpLim r6 + +#define REG_Hp r7 +#define REG_HpLim r8 + +#define NCG_Reserved_I1 r28 +#define NCG_Reserved_I2 r29 +#define NCG_Reserved_F1 fr8 +#define NCG_Reserved_F2 fr8R +#define NCG_Reserved_D1 fr10 +#define NCG_Reserved_D2 fr11 + +#endif /* hppa */ + +/* ----------------------------------------------------------------------------- + The x86 register mapping + + Ok, we've only got 6 general purpose registers, a frame pointer and a + stack pointer. \tr{%eax} and \tr{%edx} are return values from C functions, + hence they get trashed across ccalls and are caller saves. \tr{%ebx}, + \tr{%esi}, \tr{%edi}, \tr{%ebp} are all callee-saves. + + Reg STG-Reg + --------------- + ebx Base + ebp Sp + esi R1 + edi Hp + + Leaving SpLim, and HpLim out of the picture. + -------------------------------------------------------------------------- */ + + +#if i386_REGS + +#define REG(x) __asm__("%" #x) + +#ifndef not_doing_dynamic_linking +#define REG_Base ebx +#endif +#define REG_Sp ebp + +#ifndef STOLEN_X86_REGS +#define STOLEN_X86_REGS 4 +#endif + +#if STOLEN_X86_REGS >= 3 +# define REG_R1 esi +#endif + +#if STOLEN_X86_REGS >= 4 +# define REG_Hp edi +#endif + +#define MAX_REAL_VANILLA_REG 1 /* always, since it defines the entry conv */ +#define MAX_REAL_FLOAT_REG 0 +#define MAX_REAL_DOUBLE_REG 0 +#define MAX_REAL_LONG_REG 0 + +#endif /* iX86 */ + +/* ----------------------------------------------------------------------------- + The x86-64 register mapping + + %rax caller-saves, don't steal this one + %rbx YES + %rcx arg reg, caller-saves + %rdx arg reg, caller-saves + %rsi arg reg, caller-saves + %rdi arg reg, caller-saves + %rbp YES (our *prime* register) + %rsp (unavailable - stack pointer) + %r8 arg reg, caller-saves + %r9 arg reg, caller-saves + %r10 caller-saves + %r11 caller-saves + %r12 YES + %r13 YES + %r14 YES + %r15 YES + + %xmm0-7 arg regs, caller-saves + %xmm8-15 caller-saves + + Use the caller-saves regs for Rn, because we don't always have to + save those (as opposed to Sp/Hp/SpLim etc. which always have to be + saved). + + --------------------------------------------------------------------------- */ + +#if x86_64_REGS + +#define REG(x) __asm__("%" #x) + +#define REG_Base r13 +#define REG_Sp rbp +#define REG_Hp r12 +#define REG_R1 rbx +#define REG_R2 rsi +#define REG_R3 rdi +#define REG_R4 r8 +#define REG_R5 r9 +#define REG_SpLim r14 +#define REG_HpLim r15 + +#define REG_F1 xmm1 +#define REG_F2 xmm2 +#define REG_F3 xmm3 +#define REG_F4 xmm4 + +#define REG_D1 xmm5 +#define REG_D2 xmm6 + +#define CALLER_SAVES_R2 +#define CALLER_SAVES_R3 +#define CALLER_SAVES_R4 +#define CALLER_SAVES_R5 + +#define CALLER_SAVES_F1 +#define CALLER_SAVES_F2 +#define CALLER_SAVES_F3 +#define CALLER_SAVES_F4 + +#define CALLER_SAVES_D1 +#define CALLER_SAVES_D2 + +#define MAX_REAL_VANILLA_REG 5 +#define MAX_REAL_FLOAT_REG 4 +#define MAX_REAL_DOUBLE_REG 2 +#define MAX_REAL_LONG_REG 0 + +#endif /* x86_64 */ + +/* ----------------------------------------------------------------------------- + The Motorola 680x0 register mapping + + A Sun3 (mc680x0) has eight address registers, \tr{a0} to \tr{a7}, and + eight data registers, \tr{d0} to \tr{d7}. Address operations have to + be done through address registers; data registers are used for + comparison values and data. + + Here's the register-usage picture for m68k boxes with GCC. + + \begin{tabular}{ll} + a0 & used directly by GCC \\ + a1 & used directly by GCC \\ + \\ + a2..a5 & callee-saved: available for STG registers \\ + & (a5 may be special, ``global'' register for PIC?) \\ + \\ + a6 & C-stack frame pointer \\ + a7 & C-stack pointer \\ + \\ + d0 & used directly by GCC \\ + d1 & used directly by GCC \\ + d2 & really needed for local optimisation by GCC \\ + \\ + d3..d7 & callee-saved: available for STG registers + \\ + fp0 & call-clobbered \\ + fp1 & call-clobbered \\ + fp2..fp7 & callee-saved: available for STG registers + \end{tabular} + -------------------------------------------------------------------------- */ + +#if m68k_REGS + +#define REG(x) __asm__(#x) + +#define REG_Base a2 + +#define REG_Sp a3 +#define REG_SpLim d3 + +#define REG_Hp d4 +#define REG_HpLim d5 + +#define REG_R1 a5 +#define REG_R2 d6 +#define MAX_REAL_VANILLA_REG 2 + +#define REG_Ret d7 + +#define REG_F1 fp2 +#define REG_F2 fp3 +#define REG_F3 fp4 +#define REG_F4 fp5 + +#define REG_D1 fp6 +#define REG_D2 fp7 + +#endif /* m68k */ + +/* ----------------------------------------------------------------------------- + The DECstation (MIPS) register mapping + + Here's at least some simple stuff about registers on a MIPS. + + \tr{s0}--\tr{s7} are callee-save integer registers; they are our + ``prize'' stolen registers. There is also a wad of callee-save + floating-point registers, \tr{$f20}--\tr{$f31}; we'll use some of + those. + + \tr{t0}--\tr{t9} are caller-save (``temporary?'') integer registers. + We can steal some, but we might have to save/restore around ccalls. + -------------------------------------------------------------------------- */ + +#if mips_REGS + +#define REG(x) __asm__("$" #x) + +#define CALLER_SAVES_R1 +#define CALLER_SAVES_R2 +#define CALLER_SAVES_R3 +#define CALLER_SAVES_R4 +#define CALLER_SAVES_R5 +#define CALLER_SAVES_R6 +#define CALLER_SAVES_R7 +#define CALLER_SAVES_R8 + +#define CALLER_SAVES_USER + +#define REG_R1 9 +#define REG_R2 10 +#define REG_R3 11 +#define REG_R4 12 +#define REG_R5 13 +#define REG_R6 14 +#define REG_R7 15 +#define REG_R8 24 + +#define REG_F1 f20 +#define REG_F2 f22 +#define REG_F3 f24 +#define REG_F4 f26 + +#define REG_D1 f28 +#define REG_D2 f30 + +#define REG_Sp 16 +#define REG_SpLim 18 + +#define REG_Hp 19 +#define REG_HpLim 20 + +#endif /* mipse[lb] */ + +/* ----------------------------------------------------------------------------- + The PowerPC register mapping + + 0 system glue? (caller-save, volatile) + 1 SP (callee-save, non-volatile) + 2 AIX, powerpc64-linux: + RTOC (a strange special case) + darwin: + (caller-save, volatile) + powerpc32-linux: + reserved for use by system + + 3-10 args/return (caller-save, volatile) + 11,12 system glue? (caller-save, volatile) + 13 on 64-bit: reserved for thread state pointer + on 32-bit: (callee-save, non-volatile) + 14-31 (callee-save, non-volatile) + + f0 (caller-save, volatile) + f1-f13 args/return (caller-save, volatile) + f14-f31 (callee-save, non-volatile) + + \tr{14}--\tr{31} are wonderful callee-save registers on all ppc OSes. + \tr{0}--\tr{12} are caller-save registers. + + \tr{%f14}--\tr{%f31} are callee-save floating-point registers. + + We can do the Whole Business with callee-save registers only! + -------------------------------------------------------------------------- */ + +#if powerpc_REGS + +#define REG(x) __asm__(#x) + +#define REG_R1 r14 +#define REG_R2 r15 +#define REG_R3 r16 +#define REG_R4 r17 +#define REG_R5 r18 +#define REG_R6 r19 +#define REG_R7 r20 +#define REG_R8 r21 + +#if darwin_REGS + +#define REG_F1 f14 +#define REG_F2 f15 +#define REG_F3 f16 +#define REG_F4 f17 + +#define REG_D1 f18 +#define REG_D2 f19 + +#else + +#define REG_F1 fr14 +#define REG_F2 fr15 +#define REG_F3 fr16 +#define REG_F4 fr17 + +#define REG_D1 fr18 +#define REG_D2 fr19 + +#endif + +#define REG_Sp r22 +#define REG_SpLim r24 + +#define REG_Hp r25 +#define REG_HpLim r26 + +#define REG_Base r27 + +#endif /* powerpc */ + +/* ----------------------------------------------------------------------------- + The IA64 register mapping + + We place the general registers in the locals area of the register stack, + so that the call mechanism takes care of saving them for us. We reserve + the first 16 for gcc's use - since gcc uses the highest used register to + determine the register stack frame size, this gives us a constant size + register stack frame. + + \tr{f16-f32} are the callee-saved floating point registers. + -------------------------------------------------------------------------- */ + +#if ia64_REGS + +#define REG(x) __asm__(#x) + +#define REG_R1 loc16 +#define REG_R2 loc17 +#define REG_R3 loc18 +#define REG_R4 loc19 +#define REG_R5 loc20 +#define REG_R6 loc21 +#define REG_R7 loc22 +#define REG_R8 loc23 + +#define REG_F1 f16 +#define REG_F2 f17 +#define REG_F3 f18 +#define REG_F4 f19 + +#define REG_D1 f20 +#define REG_D2 f21 + +#define REG_Sp loc24 +#define REG_SpLim loc26 + +#define REG_Hp loc27 +#define REG_HpLim loc28 + +#endif /* ia64 */ + +/* ----------------------------------------------------------------------------- + The Sun SPARC register mapping + + The SPARC register (window) story: Remember, within the Haskell + Threaded World, we essentially ``shut down'' the register-window + mechanism---the window doesn't move at all while in this World. It + *does* move, of course, if we call out to arbitrary~C... + + The %i, %l, and %o registers (8 each) are the input, local, and + output registers visible in one register window. The 8 %g (global) + registers are visible all the time. + + %o0..%o7 not available; can be zapped by callee + (%o6 is C-stack ptr; %o7 hold ret addrs) + %i0..%i7 available (except %i6 is used as frame ptr) + (and %i7 tends to have ret-addr-ish things) + %l0..%l7 available + %g0..%g4 not available; prone to stomping by division, etc. + %g5..%g7 not available; reserved for the OS + + Note: %g3 is *definitely* clobbered in the builtin divide code (and + our save/restore machinery is NOT GOOD ENOUGH for that); discretion + being the better part of valor, we also don't take %g4. + + The paired nature of the floating point registers causes complications for + the native code generator. For convenience, we pretend that the first 22 + fp regs %f0 .. %f21 are actually 11 double regs, and the remaining 10 are + float (single) regs. The NCG acts accordingly. That means that the + following FP assignment is rather fragile, and should only be changed + with extreme care. The current scheme is: + + %f0 /%f1 FP return from C + %f2 /%f3 D1 + %f4 /%f5 D2 + %f6 /%f7 ncg double spill tmp #1 + %f8 /%f9 ncg double spill tmp #2 + %f10/%f11 allocatable + %f12/%f13 allocatable + %f14/%f15 allocatable + %f16/%f17 allocatable + %f18/%f19 allocatable + %f20/%f21 allocatable + + %f22 F1 + %f23 F2 + %f24 F3 + %f25 F4 + %f26 ncg single spill tmp #1 + %f27 ncg single spill tmp #2 + %f28 allocatable + %f29 allocatable + %f30 allocatable + %f31 allocatable + + -------------------------------------------------------------------------- */ + +#if sparc_REGS + +#define REG(x) __asm__("%" #x) + +#define CALLER_SAVES_USER + +#define CALLER_SAVES_F1 +#define CALLER_SAVES_F2 +#define CALLER_SAVES_F3 +#define CALLER_SAVES_F4 +#define CALLER_SAVES_D1 +#define CALLER_SAVES_D2 + +#define REG_R1 l1 +#define REG_R2 l2 +#define REG_R3 l3 +#define REG_R4 l4 +#define REG_R5 l5 +#define REG_R6 i5 + +#define REG_F1 f22 +#define REG_F2 f23 +#define REG_F3 f24 +#define REG_F4 f25 +#define REG_D1 f2 +#define REG_D2 f4 + +#define REG_Sp i0 +#define REG_SpLim i2 + +#define REG_Hp i3 +#define REG_HpLim i4 + +#define NCG_SpillTmp_I1 g1 +#define NCG_SpillTmp_I2 g2 +#define NCG_SpillTmp_F1 f26 +#define NCG_SpillTmp_F2 f27 +#define NCG_SpillTmp_D1 f6 +#define NCG_SpillTmp_D2 f8 + +#define NCG_FirstFloatReg f22 + +#endif /* sparc */ + +#endif /* NO_REGS */ + +/* ----------------------------------------------------------------------------- + * These constants define how many stg registers will be used for + * passing arguments (and results, in the case of an unboxed-tuple + * return). + * + * We usually set MAX_REAL_VANILLA_REG and co. to be the number of the + * highest STG register to occupy a real machine register, otherwise + * the calling conventions will needlessly shuffle data between the + * stack and memory-resident STG registers. We might occasionally + * set these macros to other values for testing, though. + * + * Registers above these values might still be used, for instance to + * communicate with PrimOps and RTS functions. + */ + +#ifndef MAX_REAL_VANILLA_REG +# if defined(REG_R8) +# define MAX_REAL_VANILLA_REG 8 +# elif defined(REG_R7) +# define MAX_REAL_VANILLA_REG 7 +# elif defined(REG_R6) +# define MAX_REAL_VANILLA_REG 6 +# elif defined(REG_R5) +# define MAX_REAL_VANILLA_REG 5 +# elif defined(REG_R4) +# define MAX_REAL_VANILLA_REG 4 +# elif defined(REG_R3) +# define MAX_REAL_VANILLA_REG 3 +# elif defined(REG_R2) +# define MAX_REAL_VANILLA_REG 2 +# elif defined(REG_R1) +# define MAX_REAL_VANILLA_REG 1 +# else +# define MAX_REAL_VANILLA_REG 0 +# endif +#endif + +#ifndef MAX_REAL_FLOAT_REG +# if defined(REG_F4) +# define MAX_REAL_FLOAT_REG 4 +# elif defined(REG_F3) +# define MAX_REAL_FLOAT_REG 3 +# elif defined(REG_F2) +# define MAX_REAL_FLOAT_REG 2 +# elif defined(REG_F1) +# define MAX_REAL_FLOAT_REG 1 +# else +# define MAX_REAL_FLOAT_REG 0 +# endif +#endif + +#ifndef MAX_REAL_DOUBLE_REG +# if defined(REG_D2) +# define MAX_REAL_DOUBLE_REG 2 +# elif defined(REG_D1) +# define MAX_REAL_DOUBLE_REG 1 +# else +# define MAX_REAL_DOUBLE_REG 0 +# endif +#endif + +#ifndef MAX_REAL_LONG_REG +# if defined(REG_L1) +# define MAX_REAL_LONG_REG 1 +# else +# define MAX_REAL_LONG_REG 0 +# endif +#endif + +/* define NO_ARG_REGS if we have no argument registers at all (we can + * optimise certain code paths using this predicate). + */ +#if MAX_REAL_VANILLA_REG < 2 +#define NO_ARG_REGS +#else +#undef NO_ARG_REGS +#endif + +#endif /* MACHREGS_H */ diff --git a/includes/Makefile b/includes/Makefile new file mode 100644 index 0000000000..83b74d49a7 --- /dev/null +++ b/includes/Makefile @@ -0,0 +1,181 @@ +# ----------------------------------------------------------------------------- + +TOP = .. +include $(TOP)/mk/boilerplate.mk + +# +# All header files +# +H_FILES = $(filter-out gmp.h,$(wildcard *.h)) gmp.h + +# +# Options -- if we're building unregisterised, add a couple of -D's +# +ifeq "$(GhcUnregisterised)" "YES" +SRC_CC_OPTS += -DNO_REGS -DUSE_MINIINTERPRETER +endif + +SRC_CC_OPTS += -I. -I../rts + +# +# Header file built from the configure script's findings +# +H_CONFIG = ghcautoconf.h +H_PLATFORM = ghcplatform.h + +boot :: gmp.h + +all :: $(H_CONFIG) $(H_PLATFORM) + +# gmp.h is copied from the GMP directory +gmp.h : $(FPTOOLS_TOP)/rts/gmp/gmp.h + $(CP) $< $@ + +# The fptools configure script creates the configuration header file and puts it +# in fptools/mk/config.h. We copy it down to here (without any PACKAGE_FOO +# definitions to avoid clashes), prepending some make variables specifying cpp +# platform variables. + +ifneq "$(TARGETPLATFORM)" "$(HOSTPLATFORM)" + +$(H_CONFIG) : + @echo "*** Cross-compiling: please copy $(H_CONFIG) from the target system" + @exit 1 + +else + +$(H_CONFIG) : $(FPTOOLS_TOP)/mk/config.h $(FPTOOLS_TOP)/mk/config.mk + +$(H_CONFIG) : Makefile + @echo "#ifndef __GHCAUTOCONF_H__" >$@ + @echo "#define __GHCAUTOCONF_H__" >>$@ +# Turn '#define PACKAGE_FOO "blah"' into '/* #undef PACKAGE_FOO */'. + @sed 's,^\([ ]*\)#[ ]*define[ ][ ]*\(PACKAGE_[A-Z]*\)[ ][ ]*".*".*$$,\1/* #undef \2 */,' $(FPTOOLS_TOP)/mk/config.h >> $@ + @echo "#endif /* __GHCAUTOCONF_H__ */" >> $@ + @echo "Done." + +endif + +$(H_PLATFORM) : Makefile + @echo "Creating $@..." + @$(RM) $@ + @echo "#ifndef __GHCPLATFORM_H__" >$@ + @echo "#define __GHCPLATFORM_H__" >>$@ + @echo >> $@ + @echo "#define BuildPlatform_TYPE $(HostPlatform_CPP)" >> $@ + @echo "#define HostPlatform_TYPE $(TargetPlatform_CPP)" >> $@ + @echo >> $@ + @echo "#define $(HostPlatform_CPP)_BUILD 1" >> $@ + @echo "#define $(TargetPlatform_CPP)_HOST 1" >> $@ + @echo >> $@ + @echo "#define $(HostArch_CPP)_BUILD_ARCH 1" >> $@ + @echo "#define $(TargetArch_CPP)_HOST_ARCH 1" >> $@ + @echo "#define BUILD_ARCH \"$(HostArch_CPP)\"" >> $@ + @echo "#define HOST_ARCH \"$(TargetArch_CPP)\"" >> $@ + @echo >> $@ + @echo "#define $(HostOS_CPP)_BUILD_OS 1" >> $@ + @echo "#define $(TargetOS_CPP)_HOST_OS 1" >> $@ + @echo "#define BUILD_OS \"$(HostOS_CPP)\"" >> $@ + @echo "#define HOST_OS \"$(TargetOS_CPP)\"" >> $@ +ifeq "$(HostOS_CPP)" "irix" + @echo "#ifndef $(IRIX_MAJOR)_HOST_OS" >> $@ + @echo "#define $(IRIX_MAJOR)_HOST_OS 1" >> $@ + @echo "#endif" >> $@ +endif + @echo >> $@ + @echo "#define $(HostVendor_CPP)_BUILD_VENDOR 1" >> $@ + @echo "#define $(TargetVendor_CPP)_HOST_VENDOR 1" >> $@ + @echo "#define BUILD_VENDOR \"$(HostVendor_CPP)\"" >> $@ + @echo "#define HOST_VENDOR \"$(TargetVendor_CPP)\"" >> $@ + @echo >> $@ + @echo "/* These TARGET macros are for backwards compatibily... DO NOT USE! */" >> $@ + @echo "#define TargetPlatform_TYPE $(TargetPlatform_CPP)" >> $@ + @echo "#define $(TargetPlatform_CPP)_TARGET 1" >> $@ + @echo "#define $(TargetArch_CPP)_TARGET_ARCH 1" >> $@ + @echo "#define TARGET_ARCH \"$(TargetArch_CPP)\"" >> $@ + @echo "#define $(TargetOS_CPP)_TARGET_OS 1" >> $@ + @echo "#define TARGET_OS \"$(TargetOS_CPP)\"" >> $@ + @echo "#define $(TargetVendor_CPP)_TARGET_VENDOR 1" >> $@ + @echo >> $@ + @echo "#endif /* __GHCPLATFORM_H__ */" >> $@ + @echo "Done." + +# --------------------------------------------------------------------------- +# Make DerivedConstants.h for the compiler + +all :: DerivedConstants.h + +ifneq "$(TARGETPLATFORM)" "$(HOSTPLATFORM)" + +DerivedConstants.h : + @echo "*** Cross-compiling: please copy DerivedConstants.h from the target system" + @exit 1 + +else + +mkDerivedConstants.c : $(H_CONFIG) $(H_PLATFORM) + +mkDerivedConstantsHdr : mkDerivedConstants.o + $(CC) -o $@ $(CC_OPTS) $(LD_OPTS) mkDerivedConstants.o + +DerivedConstants.h : mkDerivedConstantsHdr + ./mkDerivedConstantsHdr >$@ + +endif + +CLEAN_FILES += mkDerivedConstantsHdr$(exeext) DerivedConstants.h + +# ----------------------------------------------------------------------------- +# + +all :: GHCConstants.h + +ifneq "$(TARGETPLATFORM)" "$(HOSTPLATFORM)" + +GHCConstants.h : + @echo "*** Cross-compiling: please copy DerivedConstants.h from the target system" + @exit 1 + +else + +mkGHCConstants : mkGHCConstants.o + $(CC) -o $@ $(CC_OPTS) $(LD_OPTS) mkGHCConstants.o + +mkGHCConstants.o : mkDerivedConstants.c + $(CC) -o $@ $(CC_OPTS) -c $< -DGEN_HASKELL + +GHCConstants.h : mkGHCConstants + ./mkGHCConstants >$@ + +endif + +CLEAN_FILES += mkGHCConstants$(exeext) GHCConstants.h + +# --------------------------------------------------------------------------- +# boot setup: +# +# Need config.h to make dependencies in the runtime system source. +# +boot :: all + +# +# Install all header files +# +# Hackily set the install destination here: +# +# Note: we keep per-platform copies of all the include files +# (ditto for interface files). This is not *really* needed, but +# it gives (perhaps) a cleaner binary dist structure..might change. +# +override datadir:=$(libdir)/include +INSTALL_DATAS += $(H_FILES) $(H_CONFIG) $(H_PLATFORM) + +# +# `make clean' settings: +# +CLEAN_FILES += $(H_CONFIG) $(H_PLATFORM) + +# +# Finally, slurp in the standard targets. +# +include $(TOP)/mk/target.mk diff --git a/includes/OSThreads.h b/includes/OSThreads.h new file mode 100644 index 0000000000..90431445b7 --- /dev/null +++ b/includes/OSThreads.h @@ -0,0 +1,180 @@ +/* --------------------------------------------------------------------------- + * + * (c) The GHC Team, 2001-2005 + * + * Accessing OS threads functionality in a (mostly) OS-independent + * manner. + * + * --------------------------------------------------------------------------*/ + +#ifndef __OSTHREADS_H__ +#define __OSTHREADS_H__ + +#if defined(THREADED_RTS) /* to the end */ + +# if defined(HAVE_PTHREAD_H) && !defined(WANT_NATIVE_WIN32_THREADS) + +#include <pthread.h> + +typedef pthread_cond_t Condition; +typedef pthread_mutex_t Mutex; +typedef pthread_t OSThreadId; +typedef pthread_key_t ThreadLocalKey; + +#define OSThreadProcAttr /* nothing */ + +#define INIT_COND_VAR PTHREAD_COND_INITIALIZER + +#ifdef LOCK_DEBUG + +#define ACQUIRE_LOCK(mutex) \ + debugBelch("ACQUIRE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); \ + pthread_mutex_lock(mutex) +#define RELEASE_LOCK(mutex) \ + debugBelch("RELEASE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); \ + pthread_mutex_unlock(mutex) +#define ASSERT_LOCK_HELD(mutex) /* nothing */ + +#elif defined(DEBUG) && defined(linux_HOST_OS) +#include <errno.h> +/* + * On Linux, we can use extensions to determine whether we already + * hold a lock or not, which is useful for debugging. + */ +#define ACQUIRE_LOCK(mutex) \ + if (pthread_mutex_lock(mutex) == EDEADLK) { \ + barf("multiple ACQUIRE_LOCK: %s %d", __FILE__,__LINE__); \ + } +#define RELEASE_LOCK(mutex) \ + if (pthread_mutex_unlock(mutex) != 0) { \ + barf("RELEASE_LOCK: I do not own this lock: %s %d", __FILE__,__LINE__); \ + } + +#define ASSERT_LOCK_HELD(mutex) ASSERT(pthread_mutex_lock(mutex) == EDEADLK) + +#define ASSERT_LOCK_NOTHELD(mutex) \ + if (pthread_mutex_lock(mutex) != EDEADLK) { \ + pthread_mutex_unlock(mutex); \ + } else { \ + ASSERT(0); \ + } + + +#else + +#define ACQUIRE_LOCK(mutex) pthread_mutex_lock(mutex) +#define RELEASE_LOCK(mutex) pthread_mutex_unlock(mutex) +#define ASSERT_LOCK_HELD(mutex) /* nothing */ + +#endif + +# elif defined(HAVE_WINDOWS_H) +#include <windows.h> + +typedef HANDLE Condition; +typedef DWORD OSThreadId; +typedef DWORD ThreadLocalKey; + +#define OSThreadProcAttr __stdcall + +#define INIT_COND_VAR 0 + +// We have a choice for implementing Mutexes on Windows. Standard +// Mutexes are kernel objects that require kernel calls to +// acquire/release, whereas CriticalSections are spin-locks that block +// in the kernel after spinning for a configurable number of times. +// CriticalSections are *much* faster, so we use those. The Mutex +// implementation is left here for posterity. +#define USE_CRITICAL_SECTIONS 1 + +#if USE_CRITICAL_SECTIONS + +typedef CRITICAL_SECTION Mutex; + +#ifdef LOCK_DEBUG + +#define ACQUIRE_LOCK(mutex) \ + debugBelch("ACQUIRE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); \ + EnterCriticalSection(mutex) +#define RELEASE_LOCK(mutex) \ + debugBelch("RELEASE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); \ + LeaveCriticalSection(mutex) +#define ASSERT_LOCK_HELD(mutex) /* nothing */ + +#else + +#define ACQUIRE_LOCK(mutex) EnterCriticalSection(mutex) +#define RELEASE_LOCK(mutex) LeaveCriticalSection(mutex) + +// I don't know how to do this. TryEnterCriticalSection() doesn't do +// the right thing. +#define ASSERT_LOCK_HELD(mutex) /* nothing */ + +#endif + +#else + +typedef HANDLE Mutex; + +// casting to (Mutex *) here required due to use in .cmm files where +// the argument has (void *) type. +#define ACQUIRE_LOCK(mutex) \ + if (WaitForSingleObject(*((Mutex *)mutex),INFINITE) == WAIT_FAILED) { \ + barf("WaitForSingleObject: %d", GetLastError()); \ + } + +#define RELEASE_LOCK(mutex) \ + if (ReleaseMutex(*((Mutex *)mutex)) == 0) { \ + barf("ReleaseMutex: %d", GetLastError()); \ + } + +#define ASSERT_LOCK_HELD(mutex) /* nothing */ +#endif + +# else +# error "Threads not supported" +# endif + +// +// General thread operations +// +extern OSThreadId osThreadId ( void ); +extern void shutdownThread ( void ); +extern void yieldThread ( void ); + +typedef void OSThreadProcAttr OSThreadProc(void *); + +extern int createOSThread ( OSThreadId* tid, + OSThreadProc *startProc, void *param); + +// +// Condition Variables +// +extern void initCondition ( Condition* pCond ); +extern void closeCondition ( Condition* pCond ); +extern rtsBool broadcastCondition ( Condition* pCond ); +extern rtsBool signalCondition ( Condition* pCond ); +extern rtsBool waitCondition ( Condition* pCond, + Mutex* pMut ); + +// +// Mutexes +// +extern void initMutex ( Mutex* pMut ); + +// +// Thread-local storage +// +void newThreadLocalKey (ThreadLocalKey *key); +void *getThreadLocalVar (ThreadLocalKey *key); +void setThreadLocalVar (ThreadLocalKey *key, void *value); + +#else + +#define ACQUIRE_LOCK(l) +#define RELEASE_LOCK(l) +#define ASSERT_LOCK_HELD(l) + +#endif /* defined(THREADED_RTS) */ + +#endif /* __OSTHREADS_H__ */ diff --git a/includes/Parallel.h b/includes/Parallel.h new file mode 100644 index 0000000000..e18fbe9b2c --- /dev/null +++ b/includes/Parallel.h @@ -0,0 +1,360 @@ +/* + Definitions for GUM i.e. running on a parallel machine. + + This section contains definitions applicable only to programs compiled + to run on a parallel machine, i.e. on GUM. Some of these definitions + are also used when simulating parallel execution, i.e. on GranSim. +*/ + +#ifndef PARALLEL_H +#define PARALLEL_H + +#if defined(PAR) || defined(GRAN) /* whole file */ + +/* + * @node Parallel definitions, End of File + * @section Parallel definitions + * + * @menu + * * Basic definitions:: + * * GUM:: + * * GranSim:: + * @end menu + * + * @node Basic definitions, GUM, Parallel definitions, Parallel definitions + * @subsection Basic definitions + */ + +/* This clashes with TICKY, but currently TICKY and PAR hate each other anyway */ +#define _HS sizeofW(StgHeader) + +/* SET_PAR_HDR and SET_STATIC_PAR_HDR now live in ClosureMacros.h */ + +/* Needed for dumping routines */ +#if defined(PAR) +# define NODE_STR_LEN 20 +# define TIME_STR_LEN 120 +# define TIME rtsTime +# define CURRENT_TIME (msTime() - startTime) +# define TIME_ON_PROC(p) (msTime() - startTime) +# define CURRENT_PROC thisPE +# define BINARY_STATS RtsFlags.ParFlags.ParStats.Binary +#elif defined(GRAN) +# define NODE_STR_LEN 20 +# define TIME_STR_LEN 120 +# define TIME rtsTime +# define CURRENT_TIME CurrentTime[CurrentProc] +# define TIME_ON_PROC(p) CurrentTime[p] +# define CURRENT_PROC CurrentProc +# define BINARY_STATS RtsFlags.GranFlags.GranSimStats.Binary +#endif + +#if defined(PAR) +# define MAX_PES 256 /* Maximum number of processors */ + /* MAX_PES is enforced by SysMan, which does not + allow more than this many "processors". + This is important because PackGA [GlobAddr.lc] + **assumes** that a PE# can fit in 8+ bits. + */ + +# define SPARK_POOLS 2 /* no. of spark pools */ +# define REQUIRED_POOL 0 /* idx of pool of mandatory sparks (concurrency) */ +# define ADVISORY_POOL 1 /* idx of pool of advisory sparks (parallelism) */ +#endif + +/* + * @menu + * * GUM:: + * * GranSim:: + * @end menu + * + * @node GUM, GranSim, Basic definitions, Parallel definitions + * @subsection GUM + */ + +#if defined(PAR) +/* + Symbolic constants for the packing code. + + This constant defines how many words of data we can pack into a single + packet in the parallel (GUM) system. +*/ + +/* + * @menu + * * Types:: + * * Externs:: + * * Prototypes:: + * * Macros:: + * @end menu + * + * @node Types, Externs, GUM, GUM + * @subsubsection Types + */ + +/* Sparks and spark queues */ +typedef StgClosure *rtsSpark; +typedef rtsSpark *rtsSparkQ; + +typedef struct rtsPackBuffer_ { + StgInt /* nat */ id; + StgInt /* nat */ size; + StgInt /* nat */ unpacked_size; + StgTSO *tso; + StgWord *buffer[0]; +} rtsPackBuffer; + +#define PACK_BUFFER_HDR_SIZE 4 + +/* + * @node Externs, Prototypes, Types, GUM + * @subsubsection Externs + */ + +/* extern rtsBool do_sp_profile; */ + +extern globalAddr theGlobalFromGA, theGlobalToGA; +extern StgBlockedFetch *PendingFetches; +extern GlobalTaskId *allPEs; + +extern rtsBool IAmMainThread, GlobalStopPending; +/*extern rtsBool fishing; */ +extern rtsTime last_fish_arrived_at; +extern nat outstandingFishes; +extern GlobalTaskId SysManTask; +extern int seed; /* pseudo-random-number generator seed: */ + /* Initialised in ParInit */ +extern StgInt threadId; /* Number of Threads that have existed on a PE */ +extern GlobalTaskId mytid; + +extern GlobalTaskId *allPEs; +extern nat nPEs; +extern nat sparksIgnored, sparksCreated, threadsIgnored, threadsCreated; +extern nat advisory_thread_count; + +extern rtsBool InGlobalGC; /* Are we in the midst of performing global GC */ + +extern ullong startTime; /* start of comp; in RtsStartup.c */ + +/* the spark pools proper */ +extern rtsSpark *pending_sparks_hd[]; /* ptr to start of a spark pool */ +extern rtsSpark *pending_sparks_tl[]; /* ptr to end of a spark pool */ +extern rtsSpark *pending_sparks_lim[]; +extern rtsSpark *pending_sparks_base[]; +extern nat spark_limit[]; + +extern rtsPackBuffer *PackBuffer; /* size: can be set via option */ +extern rtsPackBuffer *buffer; +extern rtsPackBuffer *freeBuffer; +extern rtsPackBuffer *packBuffer; +extern rtsPackBuffer *gumPackBuffer; + +extern nat thisPE; + +/* From Global.c +extern GALA *freeGALAList; +extern GALA *freeIndirections; +extern GALA *liveIndirections; +extern GALA *liveRemoteGAs; +*/ + +/* + * @node Prototypes, Macros, Externs, GUM + * @subsubsection Prototypes + */ + +/* From ParInit.c */ +void initParallelSystem(void); +void SynchroniseSystem(void); +void par_exit(StgInt n); + +PEs taskIDtoPE (GlobalTaskId gtid); +void registerTask (GlobalTaskId gtid); +globalAddr *LAGAlookup (StgClosure *addr); +StgClosure *GALAlookup (globalAddr *ga); +/*static GALA *allocIndirection (StgPtr addr); */ +globalAddr *makeGlobal (StgClosure *addr, rtsBool preferred); +globalAddr *setRemoteGA (StgClosure *addr, globalAddr *ga, rtsBool preferred); +void splitWeight (globalAddr *to, globalAddr *from); +globalAddr *addWeight (globalAddr *ga); +void initGAtables (void); +void RebuildLAGAtable (void); +StgWord PackGA (StgWord pe, int slot); + +# if defined(DEBUG) +/* from Global.c */ +/* highest_slot breaks the abstraction of the slot counter for GAs; it is + only used for sanity checking and should used nowhere else */ +StgInt highest_slot (void); +# endif + +/* + * @node Macros, , Prototypes, GUM + * @subsubsection Macros + */ + +/* delay (in us) between dying fish returning and sending out a new fish */ +#define FISH_DELAY 1000 +/* max no. of outstanding spark steals */ +#define MAX_FISHES 1 + +/* ToDo: check which of these is actually needed! */ + +# define PACK_HEAP_REQUIRED ((RtsFlags.ParFlags.packBufferSize - PACK_HDR_SIZE) / (PACK_GA_SIZE + _HS) * (MIN_UPD_SIZE + 2)) + +# define MAX_GAS (RtsFlags.ParFlags.packBufferSize / PACK_GA_SIZE) + + +# define PACK_GA_SIZE 3 /* Size of a packed GA in words */ + /* Size of a packed fetch-me in words */ +# define PACK_FETCHME_SIZE (PACK_GA_SIZE + _HS) + +# define PACK_HDR_SIZE 1 /* Words of header in a packet */ + +# define PACK_PLC_SIZE 2 /* Size of a packed PLC in words */ + +/* + Definitions relating to the entire parallel-only fixed-header field. + + On GUM, the global addresses for each local closure are stored in a + separate hash table, rather then with the closure in the heap. We call + @getGA@ to look up the global address associated with a local closure (0 + is returned for local closures that have no global address), and @setGA@ + to store a new global address for a local closure which did not + previously have one. */ + +# define GA_HDR_SIZE 0 + +# define GA(closure) getGA(closure) + +# define SET_GA(closure, ga) setGA(closure,ga) +# define SET_STATIC_GA(closure) +# define SET_GRAN_HDR(closure,pe) +# define SET_STATIC_PROCS(closure) + +# define MAX_GA_WEIGHT 0 /* Treat as 2^n */ + +/* At the moment, there is no activity profiling for GUM. This may change. */ +# define SET_TASK_ACTIVITY(act) /* nothing */ + +/* + The following macros are only needed for sanity checking (see Sanity.c). +*/ + +/* NB: this is PVM specific and should be updated for MPI etc + in PVM a task id (tid) is split into 2 parts: the id for the + physical processor it is running on and an index of tasks running + on a processor; PVM_PE_MASK indicates which part of a tid holds the + id of the physical processor (the other part of the word holds the + index on that processor) + MAX_PVM_PES and MAX_PVM_TIDS are maximal values for these 2 components + in GUM we have an upper bound for the total number of PVM PEs allowed: + it's MAX_PE defined in Parallel.h + to check the slot field of a GA we call a fct highest_slot which just + returns the internal counter +*/ +#define PVM_PE_MASK 0xfffc0000 +#define MAX_PVM_PES MAX_PES +#define MAX_PVM_TIDS MAX_PES + +#if 0 +#define LOOKS_LIKE_TID(tid) (((tid & PVM_PE_MASK) != 0) && \ + (((tid & PVM_PE_MASK) + (tid & ~PVM_PE_MASK)) < MAX_PVM_TIDS)) +#define LOOKS_LIKE_SLOT(slot) (slot<=highest_slot()) + +#define LOOKS_LIKE_GA(ga) (LOOKS_LIKE_TID((ga)->payload.gc.gtid) && \ + LOOKS_LIKE_SLOT((ga)->payload.gc.slot)) +#else +rtsBool looks_like_tid(StgInt tid); +rtsBool looks_like_slot(StgInt slot); +rtsBool looks_like_ga(globalAddr *ga); +#define LOOKS_LIKE_TID(tid) looks_like_tid(tid) +#define LOOKS_LIKE_GA(ga) looks_like_ga(ga) +#endif /* 0 */ + +#endif /* PAR */ + +/* + * @node GranSim, , GUM, Parallel definitions + * @subsection GranSim + */ + +#if defined(GRAN) +/* ToDo: Check which of the PAR routines are needed in GranSim -- HWL */ + +/* + * @menu + * * Types:: + * * Prototypes:: + * * Macros:: + * @end menu + * + * @node Types, Prototypes, GranSim, GranSim + * @subsubsection Types + */ + +typedef StgWord *StgBuffer; +typedef struct rtsPackBuffer_ { + StgInt /* nat */ id; + StgInt /* nat */ size; + StgInt /* nat */ unpacked_size; + StgTSO *tso; + StgWord *buffer; +} rtsPackBuffer; + +/* + * @node Macros, , Prototypes, GranSim + * @subsubsection Macros + */ + +/* max no. of outstanding spark steals */ +#define MAX_FISHES 1 + +/* These are needed in the packing code to get the size of the packet + right. The closures itself are never built in GrAnSim. */ +# define FETCHME_VHS IND_VHS +# define FETCHME_HS IND_HS + +# define FETCHME_GA_LOCN FETCHME_HS + +# define FETCHME_CLOSURE_SIZE(closure) IND_CLOSURE_SIZE(closure) +# define FETCHME_CLOSURE_NoPTRS(closure) 0L +# define FETCHME_CLOSURE_NoNONPTRS(closure) (IND_CLOSURE_SIZE(closure)-IND_VHS) + +# define MAX_GAS (RtsFlags.GranFlags.packBufferSize / PACK_GA_SIZE) +# define PACK_GA_SIZE 3 /* Size of a packed GA in words */ + /* Size of a packed fetch-me in words */ +# define PACK_FETCHME_SIZE (PACK_GA_SIZE + _HS) +# define PACK_HDR_SIZE 4 /* Words of header in a packet */ + +# define PACK_HEAP_REQUIRED \ + (RtsFlags.GranFlags.packBufferSize * sizeofW(StgClosure*) + \ + 2 * sizeofW(StgInt) + sizeofW(StgTSO*)) + +# define PACK_FLAG_LOCN 0 +# define PACK_TSO_LOCN 1 +# define PACK_UNPACKED_SIZE_LOCN 2 +# define PACK_SIZE_LOCN 3 +# define MAGIC_PACK_FLAG 0xfabc + +# define GA_HDR_SIZE 1 + +# define PROCS_HDR_POSN PAR_HDR_POSN +# define PROCS_HDR_SIZE 1 + +/* Accessing components of the field */ +# define PROCS(closure) ((closure)->header.gran.procs) +/* SET_PROCS is now SET_GRAN_HEADER in ClosureMacros.h. */ + +#endif /* GRAN */ + +/* + * @node End of File, , Parallel definitions + * @section End of File + */ + +#endif /* defined(PAR) || defined(GRAN) whole file */ + +#endif /* Parallel_H */ + + diff --git a/includes/README b/includes/README new file mode 100644 index 0000000000..aae99bf20b --- /dev/null +++ b/includes/README @@ -0,0 +1,114 @@ +----------------------------------------------------------------------------- +The External API to the GHC Runtime System. +----------------------------------------------------------------------------- + +The header files in this directory form the external API for the +runtime. The header files are used in the following scenarios: + + 1. Included into the RTS source code itself. + In this case we include "Rts.h", which includes everything + else in the appropriate order. + + Pretty much everything falls into this category. + + 2. Included into a .hc file generated by the compiler. + In this case we include Stg.h, which includes a + subset of the headers, in the appropriate order and + with the appropriate settings (e.g. global register variables + turned on). + + Includes everything below Stg.h in the hierarchy (see below). + + 3. Included into external C source code. + The following headers are designed to be included into + external C code (i.e. C code compiled using a GHC installation, + not part of GHC itself or the RTS): + + HsFFI.h + RtsAPI.h + SchedAPI.h + RtsFlags.h + Linker.h + + These interfaces are intended to be relatively stable. + + Also Rts.h can be included to get hold of everything else, including + definitions of heap objects, info tables, the storage manager interface + and so on. But be warned: none of this is guaranteed to remain stable + from one GHC release to the next. + + 4. Included into non-C source code, including Haskell (GHC itself) + and C-- code in the RTS. + + The following headers are #included into non-C source, so + cannot contain any C code or declarations: + config.h + RtsConfig.h + Constants.h + DerivedConstants.h + ClosureTypes.h + StgFun.h + MachRegs.h + Liveness.h + StgLdvProf.h + +Here is a rough hierarchy of the header files by dependency. + +Rts.h + Stg.h + ghcconfig.h /* configuration info derived by the configure script. */ + RtsConfig.h /* settings for Rts things (eg. eager vs. lazy BH) */ + MachDeps.h /* sizes of various basic types */ + StgTypes.h /* basic types specific to the virtual machine */ + TailCalls.h /* tail calls in .hc code */ + StgDLL.h /* stuff related to Windows DLLs */ + MachRegs.h /* global register assignments for this arch */ + Regs.h /* "registers" in the virtual machine */ + StgProf.h /* profiling gubbins */ + StgMiscClosures.h /* decls for closures & info tables in the RTS */ + RtsExternal.h /* decls for RTS things required by .hc code */ + (RtsAPI.h) + (HsFFI.h) + + RtsTypes.h /* types used in the RTS */ + + Constants.h /* build-time constants */ + StgLdvProf.h + StgFun.h + Closures.h + Liveness.h /* macros for constructing RET_DYN liveness masks */ + ClosureMacros.h + ClosureTypes.h + InfoTables.h + TSO.h + Updates.h /* macros for performing updates */ + GranSim.h + Parallel.h + SMP.h + Block.h + StgTicky.h + Stable.h + Hooks.h + Signals.h + DNInvoke.h + Dotnet.h + +Cmm.h /* included into .cmm source only */ + DerivedConstants.h /* generated by mkDerivedConstants.c from other */ + /* .h files. */ + (Constants.h) + (ClosureTypes.h) + (StgFun.h) + (MachRegs.h) + (Liveness.h) + (Block.h) + +Bytecodes.h /* Bytecode definitions for the interpreter */ +Linker.h /* External API to the linker */ +RtsFlags.h /* External API to the RTS runtime flags */ +SchedAPI.h /* External API to the RTS scheduler */ +ieee-flpt.h /* ToDo: needed? */ + +RtsAPI.h /* The top-level interface to the RTS (rts_evalIO(), etc.) */ +HsFFI.h /* The external FFI api */ + diff --git a/includes/Regs.h b/includes/Regs.h new file mode 100644 index 0000000000..b6e29217eb --- /dev/null +++ b/includes/Regs.h @@ -0,0 +1,787 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Registers in the STG machine. + * + * The STG machine has a collection of "registers", each one of which + * may or may not correspond to an actual machine register when + * running code. + * + * The register set is backed by a table in memory (struct + * StgRegTable). If a particular STG register is not mapped to a + * machine register, then the apprpriate slot in this table is used + * instead. + * + * This table is itself pointed to by another register, BaseReg. If + * BaseReg is not in a machine register, then the register table is + * used from an absolute location (MainCapability). + * + * ---------------------------------------------------------------------------*/ + +#ifndef REGS_H +#define REGS_H + +#include "gmp.h" // Needs MP_INT definition + +/* + * Spark pools: used to store pending sparks + * (THREADED_RTS & PARALLEL_HASKELL only) + * This is a circular buffer. Invariants: + * - base <= hd < lim + * - base <= tl < lim + * - if hd==tl, then the pool is empty. + * - if hd == tl+1, then the pool is full. + * Adding to the pool is done by assigning to *tl++ (wrapping round as + * necessary). When adding to a full pool, we have the option of + * throwing away either the oldest (hd++) or the most recent (tl--) entry. + */ +typedef struct StgSparkPool_ { + StgClosure **base; + StgClosure **lim; + StgClosure **hd; + StgClosure **tl; +} StgSparkPool; + +#define ASSERT_SPARK_POOL_INVARIANTS(p) \ + ASSERT((p)->base <= (p)->hd); \ + ASSERT((p)->hd < (p)->lim); \ + ASSERT((p)->base <= (p)->tl); \ + ASSERT((p)->tl < (p)->lim); + +typedef struct { + StgFunPtr stgGCEnter1; + StgFunPtr stgGCFun; +} StgFunTable; + +/* + * Vanilla registers are given this union type, which is purely so + * that we can cast the vanilla reg to a variety of types with the + * minimum of syntax. eg. R1.w instead of (StgWord)R1. + */ +typedef union { + StgWord w; + StgAddr a; + StgChar c; + StgInt8 i8; + StgFloat f; + StgInt i; + StgPtr p; + StgClosurePtr cl; + StgStackOffset offset; /* unused? */ + StgByteArray b; + StgTSOPtr t; +} StgUnion; + +/* + * This is the table that holds shadow-locations for all the STG + * registers. The shadow locations are used when: + * + * 1) the particular register isn't mapped to a real machine + * register, probably because there's a shortage of real registers. + * 2) caller-saves registers are saved across a CCall + */ +typedef struct StgRegTable_ { + StgUnion rR1; + StgUnion rR2; + StgUnion rR3; + StgUnion rR4; + StgUnion rR5; + StgUnion rR6; + StgUnion rR7; + StgUnion rR8; + StgUnion rR9; /* used occasionally by heap/stack checks */ + StgUnion rR10; /* used occasionally by heap/stack checks */ + StgFloat rF1; + StgFloat rF2; + StgFloat rF3; + StgFloat rF4; + StgDouble rD1; + StgDouble rD2; + StgWord64 rL1; + StgPtr rSp; + StgPtr rSpLim; + StgPtr rHp; + StgPtr rHpLim; + struct StgTSO_ *rCurrentTSO; + struct step_ *rNursery; + struct bdescr_ *rCurrentNursery; /* Hp/HpLim point into this block */ + struct bdescr_ *rCurrentAlloc; /* for allocation using allocate() */ + StgWord rHpAlloc; /* number of *bytes* being allocated in heap */ + // rmp_tmp1..rmp_result2 are only used in THREADED_RTS builds to + // avoid per-thread temps in bss, but currently always incldue here + // so we just run mkDerivedConstants once + StgInt rmp_tmp_w; + MP_INT rmp_tmp1; + MP_INT rmp_tmp2; + MP_INT rmp_result1; + MP_INT rmp_result2; + StgWord rRet; // holds the return code of the thread +#if defined(THREADED_RTS) || defined(PAR) + StgSparkPool rSparks; /* per-task spark pool */ +#endif +} StgRegTable; + +#if IN_STG_CODE + +/* + * Registers Hp and HpLim are global across the entire system, and are + * copied into the RegTable before executing a thread. + * + * Registers Sp and SpLim are saved in the TSO for the + * thread, but are copied into the RegTable before executing a thread. + * + * All other registers are "general purpose", and are used for passing + * arguments to functions, and returning values. The code generator + * knows how many of these are in real registers, and avoids + * generating code that uses non-real registers. General purpose + * registers are never saved when returning to the scheduler, instead + * we save whatever is live at the time on the stack, and restore it + * later. This should reduce the context switch time, amongst other + * things. + * + * For argument passing, the stack will be used in preference to + * pseudo-registers if the architecture has too few general purpose + * registers. + * + * Some special RTS functions like newArray and the Integer primitives + * expect their arguments to be in registers R1-Rn, so we use these + * (pseudo-)registers in those cases. + */ + +/* + * Locations for saving per-thread registers. + */ + +#define SAVE_Sp (CurrentTSO->sp) +#define SAVE_SpLim (CurrentTSO->splim) + +#define SAVE_Hp (BaseReg->rHp) +#define SAVE_HpLim (BaseReg->rHpLim) + +#define SAVE_CurrentTSO (BaseReg->rCurrentTSO) +#define SAVE_CurrentNursery (BaseReg->rCurrentNursery) +#define SAVE_HpAlloc (BaseReg->rHpAlloc) +#define SAVE_SparkHd (BaseReg->rSparks.hd) +#define SAVE_SparkTl (BaseReg->rSparks.tl) +#define SAVE_SparkBase (BaseReg->rSparks.base) +#define SAVE_SparkLim (BaseReg->rSparks.lim) + +/* We sometimes need to save registers across a C-call, eg. if they + * are clobbered in the standard calling convention. We define the + * save locations for all registers in the register table. + */ + +#define SAVE_R1 (BaseReg->rR1) +#define SAVE_R2 (BaseReg->rR2) +#define SAVE_R3 (BaseReg->rR3) +#define SAVE_R4 (BaseReg->rR4) +#define SAVE_R5 (BaseReg->rR5) +#define SAVE_R6 (BaseReg->rR6) +#define SAVE_R7 (BaseReg->rR7) +#define SAVE_R8 (BaseReg->rR8) + +#define SAVE_F1 (BaseReg->rF1) +#define SAVE_F2 (BaseReg->rF2) +#define SAVE_F3 (BaseReg->rF3) +#define SAVE_F4 (BaseReg->rF4) + +#define SAVE_D1 (BaseReg->rD1) +#define SAVE_D2 (BaseReg->rD2) + +#define SAVE_L1 (BaseReg->rL1) + +/* ----------------------------------------------------------------------------- + * Emit the GCC-specific register declarations for each machine + * register being used. If any STG register isn't mapped to a machine + * register, then map it to an offset from BaseReg. + * + * First, the general purpose registers. The idea is, if a particular + * general-purpose STG register can't be mapped to a real machine + * register, it won't be used at all. Instead, we'll use the stack. + * + * This is an improvement on the way things used to be done, when all + * registers were mapped to locations in the register table, and stuff + * was being shifted from the stack to the register table and back + * again for no good reason (on register-poor architectures). + */ + +/* define NO_REGS to omit register declarations - used in RTS C code + * that needs all the STG definitions but not the global register + * settings. + */ +#define GLOBAL_REG_DECL(type,name,reg) register type name REG(reg); + +#if defined(REG_R1) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(StgUnion,R1,REG_R1) +#else +# define R1 (BaseReg->rR1) +#endif + +#if defined(REG_R2) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(StgUnion,R2,REG_R2) +#else +# define R2 (BaseReg->rR2) +#endif + +#if defined(REG_R3) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(StgUnion,R3,REG_R3) +#else +# define R3 (BaseReg->rR3) +#endif + +#if defined(REG_R4) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(StgUnion,R4,REG_R4) +#else +# define R4 (BaseReg->rR4) +#endif + +#if defined(REG_R5) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(StgUnion,R5,REG_R5) +#else +# define R5 (BaseReg->rR5) +#endif + +#if defined(REG_R6) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(StgUnion,R6,REG_R6) +#else +# define R6 (BaseReg->rR6) +#endif + +#if defined(REG_R7) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(StgUnion,R7,REG_R7) +#else +# define R7 (BaseReg->rR7) +#endif + +#if defined(REG_R8) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(StgUnion,R8,REG_R8) +#else +# define R8 (BaseReg->rR8) +#endif + +#if defined(REG_R9) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(StgUnion,R9,REG_R9) +#else +# define R9 (BaseReg->rR9) +#endif + +#if defined(REG_R10) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(StgUnion,R10,REG_R10) +#else +# define R10 (BaseReg->rR10) +#endif + +#if defined(REG_F1) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(StgFloat,F1,REG_F1) +#else +#define F1 (BaseReg->rF1) +#endif + +#if defined(REG_F2) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(StgFloat,F2,REG_F2) +#else +#define F2 (BaseReg->rF2) +#endif + +#if defined(REG_F3) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(StgFloat,F3,REG_F3) +#else +#define F3 (BaseReg->rF3) +#endif + +#if defined(REG_F4) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(StgFloat,F4,REG_F4) +#else +#define F4 (BaseReg->rF4) +#endif + +#if defined(REG_D1) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(StgDouble,D1,REG_D1) +#else +#define D1 (BaseReg->rD1) +#endif + +#if defined(REG_D2) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(StgDouble,D2,REG_D2) +#else +#define D2 (BaseReg->rD2) +#endif + +#if defined(REG_L1) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(StgWord64,L1,REG_L1) +#else +#define L1 (BaseReg->rL1) +#endif + +/* + * If BaseReg isn't mapped to a machine register, just use the global + * address of the current register table (CurrentRegTable in + * concurrent Haskell, MainRegTable otherwise). + */ + +/* A capability is a combination of a FunTable and a RegTable. In STG + * code, BaseReg normally points to the RegTable portion of this + * structure, so that we can index both forwards and backwards to take + * advantage of shorter instruction forms on some archs (eg. x86). + * This is a cut-down version of the Capability structure; the full + * version is defined in Capability.h. + */ +struct PartCapability_ { + StgFunTable f; + StgRegTable r; +}; + +/* No such thing as a MainCapability under THREADED_RTS - each thread must have + * its own Capability. + */ +#if IN_STG_CODE && !defined(THREADED_RTS) +extern W_ MainCapability[]; +#endif + +/* + * Assigning to BaseReg (the ASSIGN_BaseReg macro): this happens on + * return from a "safe" foreign call, when the thread might be running + * on a new Capability. Obviously if BaseReg is not a register, then + * we are restricted to a single Capability (this invariant is enforced + * in Capability.c:initCapabilities), and assigning to BaseReg can be omitted. + */ + +#if defined(REG_Base) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(StgRegTable *,BaseReg,REG_Base) +#define ASSIGN_BaseReg(e) (BaseReg = (e)) +#else +#ifdef THREADED_RTS +#error BaseReg must be in a register for THREADED_RTS +#endif +#define BaseReg (&((struct PartCapability_ *)MainCapability)->r) +#define ASSIGN_BaseReg(e) (e) +#endif + +#if defined(REG_Sp) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(P_,Sp,REG_Sp) +#else +#define Sp (BaseReg->rSp) +#endif + +#if defined(REG_SpLim) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(P_,SpLim,REG_SpLim) +#else +#define SpLim (BaseReg->rSpLim) +#endif + +#if defined(REG_Hp) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(P_,Hp,REG_Hp) +#else +#define Hp (BaseReg->rHp) +#endif + +#if defined(REG_HpLim) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(P_,HpLim,REG_HpLim) +#else +#define HpLim (BaseReg->rHpLim) +#endif + +#if defined(REG_CurrentTSO) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(struct _StgTSO *,CurrentTSO,REG_CurrentTSO) +#else +#define CurrentTSO (BaseReg->rCurrentTSO) +#endif + +#if defined(REG_CurrentNursery) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(bdescr *,CurrentNursery,REG_CurrentNursery) +#else +#define CurrentNursery (BaseReg->rCurrentNursery) +#endif + +#if defined(REG_HpAlloc) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(bdescr *,HpAlloc,REG_HpAlloc) +#else +#define HpAlloc (BaseReg->rHpAlloc) +#endif + +#if defined(REG_SparkHd) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(bdescr *,SparkHd,REG_SparkHd) +#else +#define SparkHd (BaseReg->rSparks.hd) +#endif + +#if defined(REG_SparkTl) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(bdescr *,SparkTl,REG_SparkTl) +#else +#define SparkTl (BaseReg->rSparks.tl) +#endif + +#if defined(REG_SparkBase) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(bdescr *,SparkBase,REG_SparkBase) +#else +#define SparkBase (BaseReg->rSparks.base) +#endif + +#if defined(REG_SparkLim) && !defined(NO_GLOBAL_REG_DECLS) +GLOBAL_REG_DECL(bdescr *,SparkLim,REG_SparkLim) +#else +#define SparkLim (BaseReg->rSparks.lim) +#endif + +/* ----------------------------------------------------------------------------- + Get absolute function pointers from the register table, to save + code space. On x86, + + jmp *-12(%ebx) + + is shorter than + + jmp absolute_address + + as long as the offset is within the range of a signed byte + (-128..+127). So we pick some common absolute_addresses and put + them in the register table. As a bonus, linking time should also + be reduced. + + Other possible candidates in order of importance: + + stg_upd_frame_info + stg_CAF_BLACKHOLE_info + stg_IND_STATIC_info + + anything else probably isn't worth the effort. + + -------------------------------------------------------------------------- */ + + +#define FunReg ((StgFunTable *)((void *)BaseReg - sizeof(StgFunTable))) + +#define stg_gc_enter_1 (FunReg->stgGCEnter1) +#define stg_gc_fun (FunReg->stgGCFun) + +/* ----------------------------------------------------------------------------- + For any registers which are denoted "caller-saves" by the C calling + convention, we have to emit code to save and restore them across C + calls. + -------------------------------------------------------------------------- */ + +#ifdef CALLER_SAVES_R1 +#define CALLER_SAVE_R1 SAVE_R1 = R1; +#define CALLER_RESTORE_R1 R1 = SAVE_R1; +#else +#define CALLER_SAVE_R1 /* nothing */ +#define CALLER_RESTORE_R1 /* nothing */ +#endif + +#ifdef CALLER_SAVES_R2 +#define CALLER_SAVE_R2 SAVE_R2 = R2; +#define CALLER_RESTORE_R2 R2 = SAVE_R2; +#else +#define CALLER_SAVE_R2 /* nothing */ +#define CALLER_RESTORE_R2 /* nothing */ +#endif + +#ifdef CALLER_SAVES_R3 +#define CALLER_SAVE_R3 SAVE_R3 = R3; +#define CALLER_RESTORE_R3 R3 = SAVE_R3; +#else +#define CALLER_SAVE_R3 /* nothing */ +#define CALLER_RESTORE_R3 /* nothing */ +#endif + +#ifdef CALLER_SAVES_R4 +#define CALLER_SAVE_R4 SAVE_R4 = R4; +#define CALLER_RESTORE_R4 R4 = SAVE_R4; +#else +#define CALLER_SAVE_R4 /* nothing */ +#define CALLER_RESTORE_R4 /* nothing */ +#endif + +#ifdef CALLER_SAVES_R5 +#define CALLER_SAVE_R5 SAVE_R5 = R5; +#define CALLER_RESTORE_R5 R5 = SAVE_R5; +#else +#define CALLER_SAVE_R5 /* nothing */ +#define CALLER_RESTORE_R5 /* nothing */ +#endif + +#ifdef CALLER_SAVES_R6 +#define CALLER_SAVE_R6 SAVE_R6 = R6; +#define CALLER_RESTORE_R6 R6 = SAVE_R6; +#else +#define CALLER_SAVE_R6 /* nothing */ +#define CALLER_RESTORE_R6 /* nothing */ +#endif + +#ifdef CALLER_SAVES_R7 +#define CALLER_SAVE_R7 SAVE_R7 = R7; +#define CALLER_RESTORE_R7 R7 = SAVE_R7; +#else +#define CALLER_SAVE_R7 /* nothing */ +#define CALLER_RESTORE_R7 /* nothing */ +#endif + +#ifdef CALLER_SAVES_R8 +#define CALLER_SAVE_R8 SAVE_R8 = R8; +#define CALLER_RESTORE_R8 R8 = SAVE_R8; +#else +#define CALLER_SAVE_R8 /* nothing */ +#define CALLER_RESTORE_R8 /* nothing */ +#endif + +#ifdef CALLER_SAVES_R9 +#define CALLER_SAVE_R9 SAVE_R9 = R9; +#define CALLER_RESTORE_R9 R9 = SAVE_R9; +#else +#define CALLER_SAVE_R9 /* nothing */ +#define CALLER_RESTORE_R9 /* nothing */ +#endif + +#ifdef CALLER_SAVES_R10 +#define CALLER_SAVE_R10 SAVE_R10 = R10; +#define CALLER_RESTORE_R10 R10 = SAVE_R10; +#else +#define CALLER_SAVE_R10 /* nothing */ +#define CALLER_RESTORE_R10 /* nothing */ +#endif + +#ifdef CALLER_SAVES_F1 +#define CALLER_SAVE_F1 SAVE_F1 = F1; +#define CALLER_RESTORE_F1 F1 = SAVE_F1; +#else +#define CALLER_SAVE_F1 /* nothing */ +#define CALLER_RESTORE_F1 /* nothing */ +#endif + +#ifdef CALLER_SAVES_F2 +#define CALLER_SAVE_F2 SAVE_F2 = F2; +#define CALLER_RESTORE_F2 F2 = SAVE_F2; +#else +#define CALLER_SAVE_F2 /* nothing */ +#define CALLER_RESTORE_F2 /* nothing */ +#endif + +#ifdef CALLER_SAVES_F3 +#define CALLER_SAVE_F3 SAVE_F3 = F3; +#define CALLER_RESTORE_F3 F3 = SAVE_F3; +#else +#define CALLER_SAVE_F3 /* nothing */ +#define CALLER_RESTORE_F3 /* nothing */ +#endif + +#ifdef CALLER_SAVES_F4 +#define CALLER_SAVE_F4 SAVE_F4 = F4; +#define CALLER_RESTORE_F4 F4 = SAVE_F4; +#else +#define CALLER_SAVE_F4 /* nothing */ +#define CALLER_RESTORE_F4 /* nothing */ +#endif + +#ifdef CALLER_SAVES_D1 +#define CALLER_SAVE_D1 SAVE_D1 = D1; +#define CALLER_RESTORE_D1 D1 = SAVE_D1; +#else +#define CALLER_SAVE_D1 /* nothing */ +#define CALLER_RESTORE_D1 /* nothing */ +#endif + +#ifdef CALLER_SAVES_D2 +#define CALLER_SAVE_D2 SAVE_D2 = D2; +#define CALLER_RESTORE_D2 D2 = SAVE_D2; +#else +#define CALLER_SAVE_D2 /* nothing */ +#define CALLER_RESTORE_D2 /* nothing */ +#endif + +#ifdef CALLER_SAVES_L1 +#define CALLER_SAVE_L1 SAVE_L1 = L1; +#define CALLER_RESTORE_L1 L1 = SAVE_L1; +#else +#define CALLER_SAVE_L1 /* nothing */ +#define CALLER_RESTORE_L1 /* nothing */ +#endif + +#ifdef CALLER_SAVES_Sp +#define CALLER_SAVE_Sp SAVE_Sp = Sp; +#define CALLER_RESTORE_Sp Sp = SAVE_Sp; +#else +#define CALLER_SAVE_Sp /* nothing */ +#define CALLER_RESTORE_Sp /* nothing */ +#endif + +#ifdef CALLER_SAVES_SpLim +#define CALLER_SAVE_SpLim SAVE_SpLim = SpLim; +#define CALLER_RESTORE_SpLim SpLim = SAVE_SpLim; +#else +#define CALLER_SAVE_SpLim /* nothing */ +#define CALLER_RESTORE_SpLim /* nothing */ +#endif + +#ifdef CALLER_SAVES_Hp +#define CALLER_SAVE_Hp SAVE_Hp = Hp; +#define CALLER_RESTORE_Hp Hp = SAVE_Hp; +#else +#define CALLER_SAVE_Hp /* nothing */ +#define CALLER_RESTORE_Hp /* nothing */ +#endif + +#ifdef CALLER_SAVES_HpLim +#define CALLER_SAVE_HpLim SAVE_HpLim = HpLim; +#define CALLER_RESTORE_HpLim HpLim = SAVE_HpLim; +#else +#define CALLER_SAVE_HpLim /* nothing */ +#define CALLER_RESTORE_HpLim /* nothing */ +#endif + +#ifdef CALLER_SAVES_Base +#ifdef THREADED_RTS +#error "Can't have caller-saved BaseReg with THREADED_RTS" +#endif +#define CALLER_SAVE_Base /* nothing */ +#define CALLER_RESTORE_Base BaseReg = &MainRegTable; +#else +#define CALLER_SAVE_Base /* nothing */ +#define CALLER_RESTORE_Base /* nothing */ +#endif + +#ifdef CALLER_SAVES_CurrentTSO +#define CALLER_SAVE_CurrentTSO SAVE_CurrentTSO = CurrentTSO; +#define CALLER_RESTORE_CurrentTSO CurrentTSO = SAVE_CurrentTSO; +#else +#define CALLER_SAVE_CurrentTSO /* nothing */ +#define CALLER_RESTORE_CurrentTSO /* nothing */ +#endif + +#ifdef CALLER_SAVES_CurrentNursery +#define CALLER_SAVE_CurrentNursery SAVE_CurrentNursery = CurrentNursery; +#define CALLER_RESTORE_CurrentNursery CurrentNursery = SAVE_CurrentNursery; +#else +#define CALLER_SAVE_CurrentNursery /* nothing */ +#define CALLER_RESTORE_CurrentNursery /* nothing */ +#endif + +#ifdef CALLER_SAVES_HpAlloc +#define CALLER_SAVE_HpAlloc SAVE_HpAlloc = HpAlloc; +#define CALLER_RESTORE_HpAlloc HpAlloc = SAVE_HpAlloc; +#else +#define CALLER_SAVE_HpAlloc /* nothing */ +#define CALLER_RESTORE_HpAlloc /* nothing */ +#endif + +#ifdef CALLER_SAVES_SparkHd +#define CALLER_SAVE_SparkHd SAVE_SparkHd = SparkHd; +#define CALLER_RESTORE_SparkHd SparkHd = SAVE_SparkHd; +#else +#define CALLER_SAVE_SparkHd /* nothing */ +#define CALLER_RESTORE_SparkHd /* nothing */ +#endif + +#ifdef CALLER_SAVES_SparkTl +#define CALLER_SAVE_SparkTl SAVE_SparkTl = SparkTl; +#define CALLER_RESTORE_SparkTl SparkTl = SAVE_SparkTl; +#else +#define CALLER_SAVE_SparkTl /* nothing */ +#define CALLER_RESTORE_SparkTl /* nothing */ +#endif + +#ifdef CALLER_SAVES_SparkBase +#define CALLER_SAVE_SparkBase SAVE_SparkBase = SparkBase; +#define CALLER_RESTORE_SparkBase SparkBase = SAVE_SparkBase; +#else +#define CALLER_SAVE_SparkBase /* nothing */ +#define CALLER_RESTORE_SparkBase /* nothing */ +#endif + +#ifdef CALLER_SAVES_SparkLim +#define CALLER_SAVE_SparkLim SAVE_SparkLim = SparkLim; +#define CALLER_RESTORE_SparkLim SparkLim = SAVE_SparkLim; +#else +#define CALLER_SAVE_SparkLim /* nothing */ +#define CALLER_RESTORE_SparkLim /* nothing */ +#endif + +#endif /* IN_STG_CODE */ + +/* ---------------------------------------------------------------------------- + Handy bunches of saves/restores + ------------------------------------------------------------------------ */ + +#if IN_STG_CODE + +#define CALLER_SAVE_USER \ + CALLER_SAVE_R1 \ + CALLER_SAVE_R2 \ + CALLER_SAVE_R3 \ + CALLER_SAVE_R4 \ + CALLER_SAVE_R5 \ + CALLER_SAVE_R6 \ + CALLER_SAVE_R7 \ + CALLER_SAVE_R8 \ + CALLER_SAVE_F1 \ + CALLER_SAVE_F2 \ + CALLER_SAVE_F3 \ + CALLER_SAVE_F4 \ + CALLER_SAVE_D1 \ + CALLER_SAVE_D2 \ + CALLER_SAVE_L1 + + /* Save Base last, since the others may + be addressed relative to it */ +#define CALLER_SAVE_SYSTEM \ + CALLER_SAVE_Sp \ + CALLER_SAVE_SpLim \ + CALLER_SAVE_Hp \ + CALLER_SAVE_HpLim \ + CALLER_SAVE_CurrentTSO \ + CALLER_SAVE_CurrentNursery \ + CALLER_SAVE_SparkHd \ + CALLER_SAVE_SparkTl \ + CALLER_SAVE_SparkBase \ + CALLER_SAVE_SparkLim \ + CALLER_SAVE_Base + +#define CALLER_RESTORE_USER \ + CALLER_RESTORE_R1 \ + CALLER_RESTORE_R2 \ + CALLER_RESTORE_R3 \ + CALLER_RESTORE_R4 \ + CALLER_RESTORE_R5 \ + CALLER_RESTORE_R6 \ + CALLER_RESTORE_R7 \ + CALLER_RESTORE_R8 \ + CALLER_RESTORE_F1 \ + CALLER_RESTORE_F2 \ + CALLER_RESTORE_F3 \ + CALLER_RESTORE_F4 \ + CALLER_RESTORE_D1 \ + CALLER_RESTORE_D2 \ + CALLER_RESTORE_L1 + + /* Restore Base first, since the others may + be addressed relative to it */ +#define CALLER_RESTORE_SYSTEM \ + CALLER_RESTORE_Base \ + CALLER_RESTORE_Sp \ + CALLER_RESTORE_SpLim \ + CALLER_RESTORE_Hp \ + CALLER_RESTORE_HpLim \ + CALLER_RESTORE_CurrentTSO \ + CALLER_RESTORE_CurrentNursery \ + CALLER_RESTORE_SparkHd \ + CALLER_RESTORE_SparkTl \ + CALLER_RESTORE_SparkBase \ + CALLER_RESTORE_SparkLim + +#else /* not IN_STG_CODE */ + +#define CALLER_SAVE_USER /* nothing */ +#define CALLER_SAVE_SYSTEM /* nothing */ +#define CALLER_RESTORE_USER /* nothing */ +#define CALLER_RESTORE_SYSTEM /* nothing */ + +#endif /* IN_STG_CODE */ +#define CALLER_SAVE_ALL \ + CALLER_SAVE_SYSTEM \ + CALLER_SAVE_USER + +#define CALLER_RESTORE_ALL \ + CALLER_RESTORE_SYSTEM \ + CALLER_RESTORE_USER + +#endif /* REGS_H */ diff --git a/includes/Rts.h b/includes/Rts.h new file mode 100644 index 0000000000..3ca0d9a913 --- /dev/null +++ b/includes/Rts.h @@ -0,0 +1,238 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Top-level include file for the RTS itself + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTS_H +#define RTS_H + +#ifdef __cplusplus +extern "C" { +#endif + +#ifndef IN_STG_CODE +#define IN_STG_CODE 0 +#endif +#include "Stg.h" + +#include "RtsTypes.h" + +#if __GNUC__ >= 3 +/* Assume that a flexible array member at the end of a struct + * can be defined thus: T arr[]; */ +#define FLEXIBLE_ARRAY +#else +/* Assume that it must be defined thus: T arr[0]; */ +#define FLEXIBLE_ARRAY 0 +#endif + +/* Fix for mingw stat problem (done here so it's early enough) */ +#ifdef mingw32_HOST_OS +#define __MSVCRT__ 1 +#endif + +/* + * We often want to know the size of something in units of an + * StgWord... (rounded up, of course!) + */ +#define sizeofW(t) ((sizeof(t)+sizeof(W_)-1)/sizeof(W_)) + +/* + * It's nice to be able to grep for casts + */ +#define stgCast(ty,e) ((ty)(e)) + +/* ----------------------------------------------------------------------------- + Assertions and Debuggery + -------------------------------------------------------------------------- */ + +#ifndef DEBUG +#define ASSERT(predicate) /* nothing */ +#else + +extern void _assertFail (char *, unsigned int); + +#define ASSERT(predicate) \ + if (predicate) \ + /*null*/; \ + else \ + _assertFail(__FILE__, __LINE__) +#endif /* DEBUG */ + +/* + * Use this on the RHS of macros which expand to nothing + * to make sure that the macro can be used in a context which + * demands a non-empty statement. + */ + +#define doNothing() do { } while (0) + +#ifdef DEBUG +#define USED_IF_DEBUG +#define USED_IF_NOT_DEBUG STG_UNUSED +#else +#define USED_IF_DEBUG STG_UNUSED +#define USED_IF_NOT_DEBUG +#endif + +#ifdef THREADED_RTS +#define USED_IF_THREADS +#define USED_IF_NOT_THREADS STG_UNUSED +#else +#define USED_IF_THREADS STG_UNUSED +#define USED_IF_NOT_THREADS +#endif + +/* ----------------------------------------------------------------------------- + Include everything STG-ish + -------------------------------------------------------------------------- */ + +/* System headers: stdlib.h is eeded so that we can use NULL. It must + * come after MachRegs.h, because stdlib.h might define some inline + * functions which may only be defined after register variables have + * been declared. + */ +#include <stdlib.h> + +/* Global constaints */ +#include "Constants.h" + +/* Profiling information */ +#include "StgProf.h" +#include "StgLdvProf.h" + +/* Storage format definitions */ +#include "StgFun.h" +#include "Closures.h" +#include "Liveness.h" +#include "ClosureTypes.h" +#include "InfoTables.h" +#include "TSO.h" + +/* Info tables, closures & code fragments defined in the RTS */ +#include "StgMiscClosures.h" + +/* Simulated-parallel information */ +#include "GranSim.h" + +/* Parallel information */ +#include "Parallel.h" +#include "OSThreads.h" +#include "SMP.h" + +/* STG/Optimised-C related stuff */ +#include "Block.h" + +/* GNU mp library */ +#include "gmp.h" + +/* Macros for STG/C code */ +#include "ClosureMacros.h" +#include "StgTicky.h" +#include "Stable.h" + +/* Runtime-system hooks */ +#include "Hooks.h" +#include "RtsMessages.h" + +#include "ieee-flpt.h" + +#include "Signals.h" + +/* Misc stuff without a home */ +DLL_IMPORT_RTS extern char **prog_argv; /* so we can get at these from Haskell */ +DLL_IMPORT_RTS extern int prog_argc; +DLL_IMPORT_RTS extern char *prog_name; + +extern void stackOverflow(void); + +extern void __decodeDouble (MP_INT *man, I_ *_exp, StgDouble dbl); +extern void __decodeFloat (MP_INT *man, I_ *_exp, StgFloat flt); + +#if defined(WANT_DOTNET_SUPPORT) +#include "DNInvoke.h" +#endif + +/* Initialising the whole adjustor thunk machinery. */ +extern void initAdjustor(void); + +extern void stg_exit(int n) GNU_ATTRIBUTE(__noreturn__); + +/* ----------------------------------------------------------------------------- + RTS Exit codes + -------------------------------------------------------------------------- */ + +/* 255 is allegedly used by dynamic linkers to report linking failure */ +#define EXIT_INTERNAL_ERROR 254 +#define EXIT_DEADLOCK 253 +#define EXIT_INTERRUPTED 252 +#define EXIT_HEAPOVERFLOW 251 +#define EXIT_KILLED 250 + +/* ----------------------------------------------------------------------------- + Miscellaneous garbage + -------------------------------------------------------------------------- */ + +/* declarations for runtime flags/values */ +#define MAX_RTS_ARGS 32 + +/* ----------------------------------------------------------------------------- + Assertions and Debuggery + -------------------------------------------------------------------------- */ + +#define IF_RTSFLAGS(c,s) if (RtsFlags.c) { s; } + +/* ----------------------------------------------------------------------------- + Assertions and Debuggery + -------------------------------------------------------------------------- */ + +#ifdef DEBUG +#define IF_DEBUG(c,s) if (RtsFlags.DebugFlags.c) { s; } +#else +#define IF_DEBUG(c,s) doNothing() +#endif + +#ifdef DEBUG +#define DEBUG_ONLY(s) s +#else +#define DEBUG_ONLY(s) doNothing() +#endif + +#if defined(GRAN) && defined(DEBUG) +#define IF_GRAN_DEBUG(c,s) if (RtsFlags.GranFlags.Debug.c) { s; } +#else +#define IF_GRAN_DEBUG(c,s) doNothing() +#endif + +#if defined(PAR) && defined(DEBUG) +#define IF_PAR_DEBUG(c,s) if (RtsFlags.ParFlags.Debug.c) { s; } +#else +#define IF_PAR_DEBUG(c,s) doNothing() +#endif + +/* ----------------------------------------------------------------------------- + Useful macros and inline functions + -------------------------------------------------------------------------- */ + +#if defined(__GNUC__) +#define SUPPORTS_TYPEOF +#endif + +#if defined(SUPPORTS_TYPEOF) +#define stg_min(a,b) ({typeof(a) _a = (a), _b = (b); _a <= _b ? _a : _b; }) +#define stg_max(a,b) ({typeof(a) _a = (a), _b = (b); _a <= _b ? _b : _a; }) +#else +#define stg_min(a,b) ((a) <= (b) ? (a) : (b)) +#define stg_max(a,b) ((a) <= (b) ? (b) : (a)) +#endif + +/* -------------------------------------------------------------------------- */ + +#ifdef __cplusplus +} +#endif + +#endif /* RTS_H */ diff --git a/includes/RtsAPI.h b/includes/RtsAPI.h new file mode 100644 index 0000000000..1b66789059 --- /dev/null +++ b/includes/RtsAPI.h @@ -0,0 +1,155 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * API for invoking Haskell functions via the RTS + * + * --------------------------------------------------------------------------*/ + +#ifndef RTSAPI_H +#define RTSAPI_H + +#ifdef __cplusplus +extern "C" { +#endif + +#include "HsFFI.h" + +/* + * Running the scheduler + */ +typedef enum { + NoStatus, /* not finished yet */ + Success, /* completed successfully */ + Killed, /* uncaught exception */ + Interrupted /* stopped in response to a call to interruptStgRts */ +} SchedulerStatus; + +typedef StgClosure *HaskellObj; + +/* + * An abstract type representing the token returned by rts_lock() and + * used when allocating objects and threads in the RTS. + */ +typedef struct Capability_ Capability; + +/* ---------------------------------------------------------------------------- + Starting up and shutting down the Haskell RTS. + ------------------------------------------------------------------------- */ +extern void startupHaskell ( int argc, char *argv[], + void (*init_root)(void) ); +extern void shutdownHaskell ( void ); +extern void shutdownHaskellAndExit ( int exitCode ); +extern void getProgArgv ( int *argc, char **argv[] ); +extern void setProgArgv ( int argc, char *argv[] ); + + +/* ---------------------------------------------------------------------------- + Locking. + + You have to surround all access to the RtsAPI with these calls. + ------------------------------------------------------------------------- */ + +// acquires a token which may be used to create new objects and +// evaluate them. +Capability *rts_lock (void); + +// releases the token acquired with rts_lock(). +void rts_unlock (Capability *token); + +/* ---------------------------------------------------------------------------- + Building Haskell objects from C datatypes. + ------------------------------------------------------------------------- */ +HaskellObj rts_mkChar ( Capability *, HsChar c ); +HaskellObj rts_mkInt ( Capability *, HsInt i ); +HaskellObj rts_mkInt8 ( Capability *, HsInt8 i ); +HaskellObj rts_mkInt16 ( Capability *, HsInt16 i ); +HaskellObj rts_mkInt32 ( Capability *, HsInt32 i ); +HaskellObj rts_mkInt64 ( Capability *, HsInt64 i ); +HaskellObj rts_mkWord ( Capability *, HsWord w ); +HaskellObj rts_mkWord8 ( Capability *, HsWord8 w ); +HaskellObj rts_mkWord16 ( Capability *, HsWord16 w ); +HaskellObj rts_mkWord32 ( Capability *, HsWord32 w ); +HaskellObj rts_mkWord64 ( Capability *, HsWord64 w ); +HaskellObj rts_mkPtr ( Capability *, HsPtr a ); +HaskellObj rts_mkFunPtr ( Capability *, HsFunPtr a ); +HaskellObj rts_mkFloat ( Capability *, HsFloat f ); +HaskellObj rts_mkDouble ( Capability *, HsDouble f ); +HaskellObj rts_mkStablePtr ( Capability *, HsStablePtr s ); +HaskellObj rts_mkBool ( Capability *, HsBool b ); +HaskellObj rts_mkString ( Capability *, char *s ); + +HaskellObj rts_apply ( Capability *, HaskellObj, HaskellObj ); + +/* ---------------------------------------------------------------------------- + Deconstructing Haskell objects + ------------------------------------------------------------------------- */ +HsChar rts_getChar ( HaskellObj ); +HsInt rts_getInt ( HaskellObj ); +HsInt8 rts_getInt8 ( HaskellObj ); +HsInt16 rts_getInt16 ( HaskellObj ); +HsInt32 rts_getInt32 ( HaskellObj ); +HsInt64 rts_getInt64 ( HaskellObj ); +HsWord rts_getWord ( HaskellObj ); +HsWord8 rts_getWord8 ( HaskellObj ); +HsWord16 rts_getWord16 ( HaskellObj ); +HsWord32 rts_getWord32 ( HaskellObj ); +HsWord64 rts_getWord64 ( HaskellObj ); +HsPtr rts_getPtr ( HaskellObj ); +HsFunPtr rts_getFunPtr ( HaskellObj ); +HsFloat rts_getFloat ( HaskellObj ); +HsDouble rts_getDouble ( HaskellObj ); +HsStablePtr rts_getStablePtr ( HaskellObj ); +HsBool rts_getBool ( HaskellObj ); + +/* ---------------------------------------------------------------------------- + Evaluating Haskell expressions + + The versions ending in '_' allow you to specify an initial stack size. + Note that these calls may cause Garbage Collection, so all HaskellObj + references are rendered invalid by these calls. + ------------------------------------------------------------------------- */ +Capability * +rts_eval (Capability *, HaskellObj p, /*out*/HaskellObj *ret); + +Capability * +rts_eval_ (Capability *, HaskellObj p, unsigned int stack_size, + /*out*/HaskellObj *ret); + +Capability * +rts_evalIO (Capability *, HaskellObj p, /*out*/HaskellObj *ret); + +Capability * +rts_evalStableIO (Capability *, HsStablePtr s, /*out*/HsStablePtr *ret); + +Capability * +rts_evalLazyIO (Capability *, HaskellObj p, /*out*/HaskellObj *ret); + +Capability * +rts_evalLazyIO_ (Capability *, HaskellObj p, unsigned int stack_size, + /*out*/HaskellObj *ret); + +void +rts_checkSchedStatus (char* site, Capability *); + +SchedulerStatus +rts_getSchedStatus (Capability *cap); + +/* -------------------------------------------------------------------------- + Wrapper closures + + These are used by foreign export and foreign import "wrapper" stubs. + ----------------------------------------------------------------------- */ + +extern StgWord GHCziTopHandler_runIO_closure[]; +extern StgWord GHCziTopHandler_runNonIO_closure[]; +#define runIO_closure GHCziTopHandler_runIO_closure +#define runNonIO_closure GHCziTopHandler_runNonIO_closure + +/* ------------------------------------------------------------------------ */ + +#ifdef __cplusplus +} +#endif + +#endif /* RTSAPI_H */ diff --git a/includes/RtsConfig.h b/includes/RtsConfig.h new file mode 100644 index 0000000000..8590ccd7cc --- /dev/null +++ b/includes/RtsConfig.h @@ -0,0 +1,89 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Rts settings. + * + * NOTE: assumes #include "ghcconfig.h" + * + * NB: THIS FILE IS INCLUDED IN NON-C CODE AND DATA! #defines only please. + * ---------------------------------------------------------------------------*/ + +#ifndef RTSCONFIG_H +#define RTSCONFIG_H + +/* + * SUPPORT_LONG_LONGS controls whether we need to support long longs on a + * particular platform. On 64-bit platforms, we don't need to support + * long longs since regular machine words will do just fine. + */ +#if HAVE_LONG_LONG && SIZEOF_VOID_P < 8 +#define SUPPORT_LONG_LONGS 1 +#endif + +/* + * Whether the runtime system will use libbfd for debugging purposes. + */ +#if defined(DEBUG) && defined(HAVE_BFD_H) && !defined(_WIN32) && !defined(PAR) && !defined(GRAN) +#define USING_LIBBFD 1 +#endif + +/* Turn lazy blackholing and eager blackholing on/off. + * + * Using eager blackholing makes things easier to debug because + * the blackholes are more predictable - but it's slower and less sexy. + * + * For now, do lazy and not eager. + */ + +/* TICKY_TICKY needs EAGER_BLACKHOLING to verify no double-entries of + * single-entry thunks. + */ +/* #if defined(TICKY_TICKY) || defined(THREADED_RTS) */ +#if defined(TICKY_TICKY) +# define EAGER_BLACKHOLING +#else +# define LAZY_BLACKHOLING +#endif + +/* TABLES_NEXT_TO_CODE says whether to assume that info tables are + * assumed to reside just before the code for a function. + * + * UNDEFINING THIS WON'T WORK ON ITS OWN. You have been warned. + */ +#if !defined(USE_MINIINTERPRETER) && !defined(ia64_HOST_ARCH) && !defined (powerpc64_HOST_ARCH) +#define TABLES_NEXT_TO_CODE +#endif + +/* ----------------------------------------------------------------------------- + Labels - entry labels & info labels point to the same place in + TABLES_NEXT_TO_CODE, so we only generate the _info label. Jumps + must therefore be directed to foo_info rather than foo_entry when + TABLES_NEXT_TO_CODE is on. + + This isn't a good place for these macros, but they need to be + available to .cmm sources as well as C and we don't have a better + place. + -------------------------------------------------------------------------- */ + +#ifdef TABLES_NEXT_TO_CODE +#define ENTRY_LBL(f) f##_info +#else +#define ENTRY_LBL(f) f##_entry +#endif + +#ifdef TABLES_NEXT_TO_CODE +#define RET_LBL(f) f##_info +#else +#define RET_LBL(f) f##_ret +#endif + +/* ----------------------------------------------------------------------------- + Signals - supported on non-PAR versions of the runtime. See RtsSignals.h. + -------------------------------------------------------------------------- */ + +#if !defined(PAR) +#define RTS_USER_SIGNALS 1 +#endif + +#endif /* RTSCONFIG_H */ diff --git a/includes/RtsExternal.h b/includes/RtsExternal.h new file mode 100644 index 0000000000..61a920b0ab --- /dev/null +++ b/includes/RtsExternal.h @@ -0,0 +1,96 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Things visible externally to the RTS + * + * -------------------------------------------------------------------------- */ + +#ifndef RTSEXTERNAL_H +#define RTSEXTERNAL_H + +/* The RTS public interface. */ +#include "RtsAPI.h" + +/* The standard FFI interface */ +#include "HsFFI.h" + +/* ----------------------------------------------------------------------------- + Functions exported by the RTS for use in Stg code + -------------------------------------------------------------------------- */ + +#if IN_STG_CODE +extern void newCAF(void*); +#else +extern void newCAF(StgClosure*); +#endif + +/* ToDo: remove? */ +extern I_ genSymZh(void); +extern I_ resetGenSymZh(void); + +/* Alternate to raise(3) for threaded rts, for OpenBSD */ +extern int genericRaise(int sig); + +/* Concurrency/Exception PrimOps. */ +extern int cmp_thread(StgPtr tso1, StgPtr tso2); +extern int rts_getThreadId(StgPtr tso); +extern int forkOS_createThread ( HsStablePtr entry ); +extern StgInt forkProcess(HsStablePtr *entry); +extern StgBool rtsSupportsBoundThreads(void); + +/* grimy low-level support functions defined in StgPrimFloat.c */ +extern StgDouble __encodeDouble (I_ size, StgByteArray arr, I_ e); +extern StgDouble __int_encodeDouble (I_ j, I_ e); +extern StgFloat __encodeFloat (I_ size, StgByteArray arr, I_ e); +extern StgFloat __int_encodeFloat (I_ j, I_ e); +extern StgInt isDoubleNaN(StgDouble d); +extern StgInt isDoubleInfinite(StgDouble d); +extern StgInt isDoubleDenormalized(StgDouble d); +extern StgInt isDoubleNegativeZero(StgDouble d); +extern StgInt isFloatNaN(StgFloat f); +extern StgInt isFloatInfinite(StgFloat f); +extern StgInt isFloatDenormalized(StgFloat f); +extern StgInt isFloatNegativeZero(StgFloat f); + +/* Suspending/resuming threads around foreign calls */ +extern void * suspendThread ( StgRegTable * ); +extern StgRegTable * resumeThread ( void * ); + +/* scheduler stuff */ +extern void stg_scheduleThread (StgRegTable *reg, struct StgTSO_ *tso); + +/* Creating and destroying an adjustor thunk */ +extern void* createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr, + char *typeString); +extern void freeHaskellFunctionPtr(void* ptr); + +#if defined(mingw32_HOST_OS) +extern int rts_InstallConsoleEvent ( int action, StgStablePtr *handler ); +extern void rts_ConsoleHandlerDone ( int ev ); +#else +extern int stg_sig_install (int, int, StgStablePtr *, void *); +#endif + +#if !defined(mingw32_HOST_OS) +extern StgInt *signal_handlers; +#endif +extern void setIOManagerPipe (int fd); + +extern void* stgMallocBytesRWX(int len); + +/* ----------------------------------------------------------------------------- + Storage manager stuff exported + -------------------------------------------------------------------------- */ + +/* Prototype for an evacuate-like function */ +typedef void (*evac_fn)(StgClosure **); + +extern void performGC(void); +extern void performMajorGC(void); +extern void performGCWithRoots(void (*get_roots)(evac_fn)); +extern HsInt64 getAllocations( void ); +extern void revertCAFs( void ); +extern void dirty_MUT_VAR(StgRegTable *reg, StgClosure *p); + +#endif /* RTSEXTERNAL_H */ diff --git a/includes/RtsFlags.h b/includes/RtsFlags.h new file mode 100644 index 0000000000..17d23638e7 --- /dev/null +++ b/includes/RtsFlags.h @@ -0,0 +1,357 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-1999 + * + * Datatypes that holds the command-line flag settings. + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTSFLAGS_H +#define RTSFLAGS_H + +#include <stdio.h> + +/* For defaults, see the @initRtsFlagsDefaults@ routine. */ + +struct GC_FLAGS { + FILE *statsFile; + nat giveStats; +#define NO_GC_STATS 0 +#define COLLECT_GC_STATS 1 +#define ONELINE_GC_STATS 2 +#define SUMMARY_GC_STATS 3 +#define VERBOSE_GC_STATS 4 + + nat maxStkSize; /* in *words* */ + nat initialStkSize; /* in *words* */ + + nat maxHeapSize; /* in *blocks* */ + nat minAllocAreaSize; /* in *blocks* */ + nat minOldGenSize; /* in *blocks* */ + nat heapSizeSuggestion; /* in *blocks* */ + double oldGenFactor; + double pcFreeHeap; + + nat generations; + nat steps; + rtsBool squeezeUpdFrames; + + rtsBool compact; /* True <=> "compact all the time" */ + double compactThreshold; + + rtsBool ringBell; + rtsBool frontpanel; + + int idleGCDelayTicks; /* in milliseconds */ +}; + +struct DEBUG_FLAGS { + /* flags to control debugging output & extra checking in various subsystems */ + rtsBool scheduler; /* 's' */ + rtsBool interpreter; /* 'i' */ + rtsBool codegen; /* 'c' */ + rtsBool weak; /* 'w' */ + rtsBool gccafs; /* 'G' */ + rtsBool gc; /* 'g' */ + rtsBool block_alloc; /* 'b' */ + rtsBool sanity; /* 'S' warning: might be expensive! */ + rtsBool stable; /* 't' */ + rtsBool prof; /* 'p' */ + rtsBool gran; /* 'r' */ + rtsBool par; /* 'P' */ + rtsBool linker; /* 'l' the object linker */ + rtsBool apply; /* 'a' */ + rtsBool stm; /* 'm' */ + rtsBool squeeze; /* 'z' stack squeezing & lazy blackholing */ +}; + +struct COST_CENTRE_FLAGS { + unsigned int doCostCentres; +# define COST_CENTRES_SUMMARY 1 +# define COST_CENTRES_VERBOSE 2 /* incl. serial time profile */ +# define COST_CENTRES_ALL 3 +# define COST_CENTRES_XML 4 + + int profilerTicks; /* derived */ + int msecsPerTick; /* derived */ +}; + +struct PROFILING_FLAGS { + unsigned int doHeapProfile; +# define NO_HEAP_PROFILING 0 /* N.B. Used as indexes into arrays */ +# define HEAP_BY_CCS 1 +# define HEAP_BY_MOD 2 +# define HEAP_BY_DESCR 4 +# define HEAP_BY_TYPE 5 +# define HEAP_BY_RETAINER 6 +# define HEAP_BY_LDV 7 + +# define HEAP_BY_INFOPTR 1 /* DEBUG only */ +# define HEAP_BY_CLOSURE_TYPE 2 /* DEBUG only */ + + nat profileInterval; /* delta between samples (in ms) */ + nat profileIntervalTicks; /* delta between samples (in 'ticks') */ + rtsBool includeTSOs; + + + rtsBool showCCSOnException; + + nat maxRetainerSetSize; + + char* modSelector; + char* descrSelector; + char* typeSelector; + char* ccSelector; + char* ccsSelector; + char* retainerSelector; + char* bioSelector; + +}; + +struct CONCURRENT_FLAGS { + int ctxtSwitchTime; /* in milliseconds */ + int ctxtSwitchTicks; /* derived */ +}; + +#ifdef PAR +/* currently the same as GRAN_STATS_FLAGS */ +struct PAR_STATS_FLAGS { + rtsBool Full; /* Full .gr profile (rtsTrue) or only END events? */ + rtsBool Suppressed; /* No .gr profile at all */ + rtsBool Binary; /* Binary profile? (not yet implemented) */ + rtsBool Sparks; /* Info on sparks in profile? */ + rtsBool Heap; /* Info on heap allocs in profile? */ + rtsBool NewLogfile; /* Use new log-file format? (not yet implemented) */ + rtsBool Global; /* Global statistics? (printed on shutdown; no log file) */ +}; + +struct PAR_DEBUG_FLAGS { + /* flags to control debugging output in various subsystems */ + rtsBool verbose : 1; /* 1 */ + rtsBool bq : 1; /* 2 */ + rtsBool schedule : 1; /* 4 */ + rtsBool free : 1; /* 8 */ + rtsBool resume : 1; /* 16 */ + rtsBool weight : 1; /* 32 */ + rtsBool fetch : 1; /* 64 */ + rtsBool fish : 1; /* 128 */ + rtsBool tables : 1; /* 256 */ + rtsBool packet : 1; /* 512 */ + rtsBool pack : 1; /* 1024 */ + rtsBool paranoia : 1; /* 2048 */ +}; + +#define MAX_PAR_DEBUG_OPTION 11 +#define PAR_DEBUG_MASK(n) ((nat)(ldexp(1,n))) +#define MAX_PAR_DEBUG_MASK ((nat)(ldexp(1,(MAX_PAR_DEBUG_OPTION+1))-1)) + +struct PAR_FLAGS { + struct PAR_STATS_FLAGS ParStats; /* profile and stats output */ + struct PAR_DEBUG_FLAGS Debug; /* debugging options */ + rtsBool outputDisabled; /* Disable output for performance purposes */ + rtsBool doFairScheduling; /* Fair-ish scheduling (round robin; no time-slices) */ + nat packBufferSize; + nat thunksToPack; /* number of thunks in packet + 1 */ + nat globalising; /* globalisation scheme */ + nat maxLocalSparks; /* spark pool size */ + nat maxThreads; /* thread pool size */ + nat maxFishes; /* max number of active fishes */ + rtsTime fishDelay; /* delay before sending a new fish */ + long wait; +}; +#endif /* PAR */ + +#ifdef THREADED_RTS +struct PAR_FLAGS { + nat nNodes; /* number of threads to run simultaneously */ + rtsBool migrate; /* migrate threads between capabilities */ + rtsBool wakeupMigrate; /* migrate a thread on wakeup */ + unsigned int maxLocalSparks; +}; +#endif /* THREADED_RTS */ + +#ifdef GRAN +struct GRAN_STATS_FLAGS { + rtsBool Full; /* Full .gr profile (rtsTrue) or only END events? */ + rtsBool Suppressed; /* No .gr profile at all */ + rtsBool Binary; /* Binary profile? (not yet implemented) */ + rtsBool Sparks; /* Info on sparks in profile? */ + rtsBool Heap; /* Info on heap allocs in profile? */ + rtsBool NewLogfile; /* Use new log-file format? (not yet implemented) */ + rtsBool Global; /* Global statistics? (printed on shutdown; no log file) */ +}; + +struct GRAN_COST_FLAGS { + /* Communication Cost Variables -- set in main program */ + nat latency; /* Latency for single packet */ + nat additional_latency; /* Latency for additional packets */ + nat fetchtime; + nat lunblocktime; /* Time for local unblock */ + nat gunblocktime; /* Time for global unblock */ + nat mpacktime; /* Cost of creating a packet */ + nat munpacktime; /* Cost of receiving a packet */ + nat mtidytime; /* Cost of cleaning up after send */ + + nat threadcreatetime; /* Thread creation costs */ + nat threadqueuetime; /* Cost of adding a thread to the running/runnable queue */ + nat threaddescheduletime; /* Cost of descheduling a thread */ + nat threadscheduletime; /* Cost of scheduling a thread */ + nat threadcontextswitchtime; /* Cost of context switch */ + + /* Instruction Costs */ + nat arith_cost; /* arithmetic instructions (+,i,< etc) */ + nat branch_cost; /* branch instructions */ + nat load_cost; /* load into register */ + nat store_cost; /* store into memory */ + nat float_cost; /* floating point operations */ + + nat heapalloc_cost; /* heap allocation costs */ + + /* Overhead for granularity control mechanisms */ + /* overhead per elem of spark queue */ + nat pri_spark_overhead; + /* overhead per elem of thread queue */ + nat pri_sched_overhead; +}; + +struct GRAN_DEBUG_FLAGS { + /* flags to control debugging output in various subsystems */ + rtsBool event_trace : 1; /* 1 */ + rtsBool event_stats : 1; /* 2 */ + rtsBool bq : 1; /* 4 */ + rtsBool pack : 1; /* 8 */ + rtsBool checkSparkQ : 1; /* 16 */ + rtsBool thunkStealing : 1; /* 32 */ + rtsBool randomSteal : 1; /* 64 */ + rtsBool findWork : 1; /* 128 */ + rtsBool unused : 1; /* 256 */ + rtsBool pri : 1; /* 512 */ + rtsBool checkLight : 1; /* 1024 */ + rtsBool sortedQ : 1; /* 2048 */ + rtsBool blockOnFetch : 1; /* 4096 */ + rtsBool packBuffer : 1; /* 8192 */ + rtsBool blockOnFetch_sanity : 1; /* 16384 */ +}; + +#define MAX_GRAN_DEBUG_OPTION 14 +#define GRAN_DEBUG_MASK(n) ((nat)(ldexp(1,n))) +#define MAX_GRAN_DEBUG_MASK ((nat)(ldexp(1,(MAX_GRAN_DEBUG_OPTION+1))-1)) + +struct GRAN_FLAGS { + struct GRAN_STATS_FLAGS GranSimStats; /* profile and stats output */ + struct GRAN_COST_FLAGS Costs; /* cost metric for simulation */ + struct GRAN_DEBUG_FLAGS Debug; /* debugging options */ + + nat maxThreads; /* ToDo: share with THREADED_RTS and GUM */ + /* rtsBool labelling; */ + nat packBufferSize; + nat packBufferSize_internal; + + PEs proc; /* number of processors */ + rtsBool Fishing; /* Simulate GUM style fishing mechanism? */ + nat maxFishes; /* max number of spark or thread steals */ + rtsTime time_slice; /* max time slice of one reduction thread */ + + /* GrAnSim-Light: This version puts no bound on the number of + processors but in exchange doesn't model communication costs + (all communication is 0 cost). Mainly intended to show maximal + degree of parallelism in the program (*not* to simulate the + execution on a real machine). */ + + rtsBool Light; + + rtsBool DoFairSchedule ; /* fair scheduling alg? default: unfair */ + rtsBool DoAsyncFetch; /* async. communication? */ + rtsBool DoStealThreadsFirst; /* prefer threads over sparks when stealing */ + rtsBool DoAlwaysCreateThreads; /* eager thread creation */ + rtsBool DoBulkFetching; /* bulk fetching */ + rtsBool DoThreadMigration; /* allow to move threads */ + nat FetchStrategy; /* what to do when waiting for data */ + rtsBool PreferSparksOfLocalNodes; /* prefer local over global sparks */ + rtsBool DoPrioritySparking; /* sparks sorted by priorities */ + rtsBool DoPriorityScheduling; /* threads sorted by priorities */ + nat SparkPriority; /* threshold for cut-off mechanism */ + nat SparkPriority2; + rtsBool RandomPriorities; + rtsBool InversePriorities; + rtsBool IgnorePriorities; + nat ThunksToPack; /* number of thunks in packet + 1 */ + rtsBool RandomSteal; /* steal spark/thread from random proc */ + rtsBool NoForward; /* no forwarding of fetch messages */ + + /* unsigned int debug; */ + /* rtsBool event_trace; */ + /* rtsBool event_trace_all; */ +}; +#endif /* GRAN */ + +struct TICKY_FLAGS { + rtsBool showTickyStats; + FILE *tickyFile; +}; + + +/* Put them together: */ + +typedef struct _RTS_FLAGS { + /* The first portion of RTS_FLAGS is invariant. */ + struct GC_FLAGS GcFlags; + struct CONCURRENT_FLAGS ConcFlags; + struct DEBUG_FLAGS DebugFlags; + struct COST_CENTRE_FLAGS CcFlags; + struct PROFILING_FLAGS ProfFlags; + struct TICKY_FLAGS TickyFlags; + +#if defined(THREADED_RTS) || defined(PAR) + struct PAR_FLAGS ParFlags; +#endif +#ifdef GRAN + struct GRAN_FLAGS GranFlags; +#endif +} RTS_FLAGS; + +#ifdef COMPILING_RTS_MAIN +extern DLLIMPORT RTS_FLAGS RtsFlags; +#elif IN_STG_CODE +/* Hack because the C code generator can't generate '&label'. */ +extern RTS_FLAGS RtsFlags[]; +#else +extern RTS_FLAGS RtsFlags; +#endif + +/* Routines that operate-on/to-do-with RTS flags: */ + +extern void initRtsFlagsDefaults(void); +extern void setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[]); +extern void setProgName(char *argv[]); + + +/* + * The printf formats are here, so we are less likely to make + * overly-long filenames (with disastrous results). No more than 128 + * chars, please! + */ + +#define STATS_FILENAME_MAXLEN 128 + +#define GR_FILENAME_FMT "%0.124s.gr" +#define GR_FILENAME_FMT_GUM "%0.120s.%03d.%s" +#define HP_FILENAME_FMT "%0.124s.hp" +#define LIFE_FILENAME_FMT "%0.122s.life" +#define PROF_FILENAME_FMT "%0.122s.prof" +#define PROF_FILENAME_FMT_GUM "%0.118s.%03d.prof" +#define QP_FILENAME_FMT "%0.124s.qp" +#define STAT_FILENAME_FMT "%0.122s.stat" +#define TICKY_FILENAME_FMT "%0.121s.ticky" +#define TIME_FILENAME_FMT "%0.122s.time" +#define TIME_FILENAME_FMT_GUM "%0.118s.%03d.time" + +/* an "int" so as to match normal "argc" */ +/* Now defined in Stg.h (lib/std/cbits need these too.) +extern int prog_argc; +extern char **prog_argv; +*/ +extern int rts_argc; /* ditto */ +extern char *rts_argv[]; + +#endif /* RTSFLAGS_H */ diff --git a/includes/RtsMessages.h b/includes/RtsMessages.h new file mode 100644 index 0000000000..3f0da3d7ed --- /dev/null +++ b/includes/RtsMessages.h @@ -0,0 +1,76 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Message API for use inside the RTS. All messages generated by the + * RTS should go through one of the functions declared here, and we + * also provide hooks so that messages from the RTS can be redirected + * as appropriate. + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTSMESSAGES_H +#define RTSMESSAGES_H + +#include <stdarg.h> + +/* ----------------------------------------------------------------------------- + * Message generation + * -------------------------------------------------------------------------- */ + +/* + * A fatal internal error: this is for errors that probably indicate + * bugs in the RTS or compiler. We normally output bug reporting + * instructions along with the error message. + * + * barf() invokes (*fatalInternalErrorFn)(). This function is not + * expected to return. + */ +extern void barf(char *s, ...) + GNUC3_ATTRIBUTE(__noreturn__); + +extern void vbarf(char *s, va_list ap) + GNUC3_ATTRIBUTE(__noreturn__); + +extern void _assertFail(char *filename, unsigned int linenum) + GNUC3_ATTRIBUTE(__noreturn__); + +/* + * An error condition which is caused by and/or can be corrected by + * the user. + * + * errorBelch() invokes (*errorMsgFn)(). + */ +extern void errorBelch(char *s, ...) + GNUC3_ATTRIBUTE(format (printf, 1, 2)); + +extern void verrorBelch(char *s, va_list ap); + +/* + * A debugging message. Debugging messages are generated either as a + * virtue of having DEBUG turned on, or by being explicitly selected + * via RTS options (eg. +RTS -Ds). + * + * debugBelch() invokes (*debugMsgFn)(). + */ +extern void debugBelch(char *s, ...) + GNUC3_ATTRIBUTE(format (printf, 1, 2)); + +extern void vdebugBelch(char *s, va_list ap); + + +/* Hooks for redirecting message generation: */ + +typedef void RtsMsgFunction(char *, va_list); + +extern RtsMsgFunction *fatalInternalErrorFn; +extern RtsMsgFunction *debugMsgFn; +extern RtsMsgFunction *errorMsgFn; + +/* Default stdio implementation of the message hooks: */ + +extern RtsMsgFunction rtsFatalInternalErrorFn; +extern RtsMsgFunction rtsDebugMsgFn; +extern RtsMsgFunction rtsErrorMsgFn; + +#endif /* RTSMESSAGES_H */ diff --git a/includes/RtsTypes.h b/includes/RtsTypes.h new file mode 100644 index 0000000000..9e8c7b847b --- /dev/null +++ b/includes/RtsTypes.h @@ -0,0 +1,88 @@ +/* + Time-stamp: <2005-03-30 12:02:33 simonmar> + + RTS specific types. +*/ + +/* ------------------------------------------------------------------------- + Generally useful typedefs + ------------------------------------------------------------------------- */ + +#ifndef RTS_TYPES_H +#define RTS_TYPES_H + +typedef unsigned int nat; /* at least 32 bits (like int) */ +typedef unsigned long lnat; /* at least 32 bits */ +#ifndef _MSC_VER +typedef unsigned long long ullong; /* at least 32 bits */ +typedef long long llong; +#else +typedef unsigned __int64 ullong; /* at least 32 bits */ +typedef __int64 llong; +#endif + +/* ullong (64|128-bit) type: only include if needed (not ANSI) */ +#if defined(__GNUC__) +#define LL(x) (x##LL) +#else +#define LL(x) (x##L) +#endif + +typedef enum { + rtsFalse = 0, + rtsTrue +} rtsBool; + +/* + Types specific to the parallel runtime system. +*/ + +typedef ullong rtsTime; + +#if defined(PAR) +/* types only needed in the parallel system */ +typedef struct hashtable ParHashTable; +typedef struct hashlist ParHashList; + +/* typedef double REAL_TIME; */ +/* typedef W_ TIME; */ +/* typedef GlobalTaskId Proc; */ +typedef int GlobalTaskId; +typedef GlobalTaskId PEs; +typedef unsigned int rtsWeight; +typedef int rtsPacket; +typedef int OpCode; + +/* Global addresses i.e. unique ids in a parallel setup; needed in Closures.h*/ +typedef struct { + union { + StgPtr plc; + struct { + GlobalTaskId gtid; + int slot; + } gc; + } payload; + rtsWeight weight; +} globalAddr; + +/* (GA, LA) pairs */ +typedef struct gala { + globalAddr ga; + StgPtr la; + struct gala *next; + rtsBool preferred; +} GALA; + +#elif defined(GRAN) + +/* + * GlobalTaskId is dummy in GranSim; + * we define it to have cleaner code in the RTS + */ +typedef int GlobalTaskId; +typedef lnat rtsTime; +typedef StgWord PEs; + +#endif + +#endif /* RTS_TYPES_H */ diff --git a/includes/SMP.h b/includes/SMP.h new file mode 100644 index 0000000000..5974c962ad --- /dev/null +++ b/includes/SMP.h @@ -0,0 +1,160 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 2005 + * + * Macros for THREADED_RTS support + * + * -------------------------------------------------------------------------- */ + +#ifndef SMP_H +#define SMP_H + +/* THREADED_RTS is currently not compatible with the following options: + * + * PROFILING (but only 1 CPU supported) + * TICKY_TICKY + * Unregisterised builds are ok, but only 1 CPU supported. + */ + +#if defined(THREADED_RTS) + +#if defined(TICKY_TICKY) +#error Build options incompatible with THREADED_RTS. +#endif + +/* + * XCHG - the atomic exchange instruction. Used for locking closures + * during updates (see lockClosure() below) and the MVar primops. + * + * NB: the xchg instruction is implicitly locked, so we do not need + * a lock prefix here. + */ +INLINE_HEADER StgWord +xchg(StgPtr p, StgWord w) +{ + StgWord result; +#if i386_HOST_ARCH || x86_64_HOST_ARCH + result = w; + __asm__ __volatile__ ( + "xchg %1,%0" + :"+r" (result), "+m" (*p) + : /* no input-only operands */ + ); +#elif powerpc_HOST_ARCH + __asm__ __volatile__ ( + "1: lwarx %0, 0, %2\n" + " stwcx. %1, 0, %2\n" + " bne- 1b" + :"=r" (result) + :"r" (w), "r" (p) + ); +#else +#error xchg() unimplemented on this architecture +#endif + return result; +} + +/* + * CMPXCHG - the single-word atomic compare-and-exchange instruction. Used + * in the STM implementation. + */ +INLINE_HEADER StgWord +cas(StgVolatilePtr p, StgWord o, StgWord n) +{ +#if i386_HOST_ARCH || x86_64_HOST_ARCH + __asm__ __volatile__ ( + "lock/cmpxchg %3,%1" + :"=a"(o), "=m" (*(volatile unsigned int *)p) + :"0" (o), "r" (n)); + return o; +#elif powerpc_HOST_ARCH + StgWord result; + __asm__ __volatile__ ( + "1: lwarx %0, 0, %3\n" + " cmpw %0, %1\n" + " bne 2f\n" + " stwcx. %2, 0, %3\n" + " bne- 1b\n" + "2:" + :"=r" (result) + :"r" (o), "r" (n), "r" (p) + ); + return result; +#else +#error cas() unimplemented on this architecture +#endif +} + +/* + * Write barrier - ensure that all preceding writes have happened + * before all following writes. + * + * We need to tell both the compiler AND the CPU about the barrier. + * This is a brute force solution; better results might be obtained by + * using volatile type declarations to get fine-grained ordering + * control in C, and optionally a memory barrier instruction on CPUs + * that require it (not x86 or x86_64). + */ +INLINE_HEADER void +wb(void) { +#if i386_HOST_ARCH || x86_64_HOST_ARCH + __asm__ __volatile__ ("" : : : "memory"); +#elif powerpc_HOST_ARCH + __asm__ __volatile__ ("lwsync" : : : "memory"); +#else +#error memory barriers unimplemented on this architecture +#endif +} + +/* + * Locking/unlocking closures + * + * This is used primarily in the implementation of MVars. + */ +#define SPIN_COUNT 4000 + +INLINE_HEADER StgInfoTable * +lockClosure(StgClosure *p) +{ +#if i386_HOST_ARCH || x86_64_HOST_ARCH || powerpc_HOST_ARCH + StgWord info; + do { + nat i = 0; + do { + info = xchg((P_)(void *)&p->header.info, (W_)&stg_WHITEHOLE_info); + if (info != (W_)&stg_WHITEHOLE_info) return (StgInfoTable *)info; + } while (++i < SPIN_COUNT); + yieldThread(); + } while (1); +#else + ACQUIRE_SM_LOCK +#endif +} + +INLINE_HEADER void +unlockClosure(StgClosure *p, StgInfoTable *info) +{ +#if i386_HOST_ARCH || x86_64_HOST_ARCH || powerpc_HOST_ARCH + // This is a strictly ordered write, so we need a wb(): + wb(); + p->header.info = info; +#else + RELEASE_SM_LOCK; +#endif +} + +#else /* !THREADED_RTS */ + +#define wb() /* nothing */ + +INLINE_HEADER StgWord +xchg(StgPtr p, StgWord w) +{ + StgWord old = *p; + *p = w; + return old; +} + +#endif /* !THREADED_RTS */ + +#endif /* SMP_H */ diff --git a/includes/STM.h b/includes/STM.h new file mode 100644 index 0000000000..4c2b109f73 --- /dev/null +++ b/includes/STM.h @@ -0,0 +1,237 @@ +/*---------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * STM interface definition + * + *---------------------------------------------------------------------- + + STM.h defines the C-level interface to the STM. + + The design follows that of the PPoPP 2005 paper "Composable memory + transactions" extended to include fine-grained locking of TVars. + + Three different implementations can be built. In overview: + + STM_UNIPROC -- no locking at all: not safe for concurrent invocations + + STM_CG_LOCK -- coarse-grained locking : a single mutex protects all + TVars + + STM_FG_LOCKS -- per-TVar exclusion : each TVar can be owned by at + most one TRec at any time. This allows dynamically + non-conflicting transactions to commit in parallel. + The implementation treats reads optimisitcally -- + extra versioning information is retained in the + saw_update_by field of the TVars so that they do not + need to be locked for reading. + + STM.C contains more details about the locking schemes used. + +*/ + +#ifndef STM_H +#define STM_H + +#ifdef THREADED_RTS +//#define STM_CG_LOCK +#define STM_FG_LOCKS +#else +#define STM_UNIPROC +#endif + +#ifdef __cplusplus +extern "C" { +#endif + +/*---------------------------------------------------------------------- + + GC interaction + -------------- +*/ + +extern void stmPreGCHook(void); + +/*---------------------------------------------------------------------- + + Transaction context management + ------------------------------ + +*/ + +/* Create and enter a new transaction context */ + +extern StgTRecHeader *stmStartTransaction(Capability *cap, StgTRecHeader *outer); +extern StgTRecHeader *stmStartNestedTransaction(Capability *cap, StgTRecHeader *outer +); + +/* + * Exit the current transaction context, abandoning any read/write + * operations performed within it and removing the thread from any + * tvar wait queues if it was waitin. Note that if nested transactions + * are not fully supported then this may leave the enclosing + * transaction contexts doomed to abort. + */ + +extern void stmAbortTransaction(Capability *cap, StgTRecHeader *trec); + +/* + * Ensure that a subsequent commit / validation will fail. We use this + * in our current handling of transactions that may have become invalid + * and started looping. We strip their stack back to the ATOMICALLY_FRAME, + * and, when the thread is next scheduled, discover it to be invalid and + * re-execute it. However, we need to force the transaction to stay invalid + * in case other threads' updates make it valid in the mean time. + */ + +extern void stmCondemnTransaction(Capability *cap, StgTRecHeader *trec); + +/* + * Return the trec within which the specified trec was created (not + * valid if trec==NO_TREC). + */ + +extern StgTRecHeader *stmGetEnclosingTRec(StgTRecHeader *trec); + +/*---------------------------------------------------------------------- + + Validation + ---------- + + Test whether the specified transaction record, and all those within which + it is nested, are still valid. + + Note: the caller can assume that once stmValidateTransaction has + returned FALSE for a given trec then that transaction will never + again be valid -- we rely on this in Schedule.c when kicking invalid + threads at GC (in case they are stuck looping) +*/ + +extern StgBool stmValidateNestOfTransactions(StgTRecHeader *trec); + +/*---------------------------------------------------------------------- + + Commit/wait/rewait operations + ----------------------------- + + These four operations return boolean results which should be interpreted + as follows: + + true => The transaction record was definitely valid + + false => The transaction record may not have been valid + + Note that, for nested operations, validity here is solely in terms + of the specified trec: it does not say whether those that it may be + nested are themselves valid. Callers can check this with + stmValidateNestOfTransactions. + + The user of the STM should ensure that it is always safe to assume that a + transaction context is not valid when in fact it is (i.e. to return false in + place of true, with side-effects as defined below). This may cause + needless retries of transactions (in the case of validate and commit), or it + may cause needless spinning instead of blocking (in the case of wait and + rewait). + + In defining the behaviour of wait and rewait we distinguish between two + different aspects of a thread's runnability: + + - We say that a thread is "blocked" when it is not running or + runnable as far as the scheduler is concerned. + + - We say that a thread is "waiting" when its StgTRecHeader is linked on an + tvar's wait queue. + + Considering only STM operations, (blocked) => (waiting). The user of the STM + should ensure that they are prepared for threads to be unblocked spuriously + and for wait/reWait to return false even when the previous transaction context + is actually still valid. +*/ + +/* + * Test whether the current transaction context is valid and, if so, + * commit its memory accesses to the heap. stmCommitTransaction must + * unblock any threads which are waiting on tvars that updates have + * been committed to. + */ + +extern StgBool stmCommitTransaction(Capability *cap, StgTRecHeader *trec); +extern StgBool stmCommitNestedTransaction(Capability *cap, StgTRecHeader *trec); + +/* + * Test whether the current transaction context is valid and, if so, + * start the thread waiting for updates to any of the tvars it has + * ready from and mark it as blocked. It is an error to call stmWait + * if the thread is already waiting. + */ + +extern StgBool stmWait(Capability *cap, + StgTSO *tso, + StgTRecHeader *trec); + +extern void stmWaitUnlock(Capability *cap, StgTRecHeader *trec); + +/* + * Test whether the current transaction context is valid and, if so, + * leave the thread waiting and mark it as blocked again. If the + * transaction context is no longer valid then stop the thread waiting + * and leave it as unblocked. It is an error to call stmReWait if the + * thread is not waiting. + */ + +extern StgBool stmReWait(Capability *cap, StgTSO *tso); + +/*---------------------------------------------------------------------- + + TVar management operations + -------------------------- +*/ + +extern StgTVar *stmNewTVar(Capability *cap, + StgClosure *new_value); + +/*---------------------------------------------------------------------- + + Data access operations + ---------------------- +*/ + +/* + * Return the logical contents of 'tvar' within the context of the + * thread's current transaction. + */ + +extern StgClosure *stmReadTVar(Capability *cap, + StgTRecHeader *trec, + StgTVar *tvar); + +/* Update the logical contents of 'tvar' within the context of the + * thread's current transaction. + */ + +extern void stmWriteTVar(Capability *cap, + StgTRecHeader *trec, + StgTVar *tvar, + StgClosure *new_value); + +/*----------------------------------------------------------------------*/ + +/* NULLs */ + +#define END_STM_WAIT_QUEUE ((StgTVarWaitQueue *)(void *)&stg_END_STM_WAIT_QUEUE_closure) +#define END_STM_CHUNK_LIST ((StgTRecChunk *)(void *)&stg_END_STM_CHUNK_LIST_closure) + +#if IN_STG_CODE +#define NO_TREC (stg_NO_TREC_closure) +#else +#define NO_TREC ((StgTRecHeader *)(void *)&stg_NO_TREC_closure) +#endif + +/*----------------------------------------------------------------------*/ + +#ifdef __cplusplus +} +#endif + +#endif /* STM_H */ + diff --git a/includes/SchedAPI.h b/includes/SchedAPI.h new file mode 100644 index 0000000000..8dff6ea63d --- /dev/null +++ b/includes/SchedAPI.h @@ -0,0 +1,36 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 1998-2002 + * + * External API for the scheduler. For most uses, the functions in + * RtsAPI.h should be enough. + * + * ---------------------------------------------------------------------------*/ + +#ifndef SCHEDAPI_H +#define SCHEDAPI_H + +#if defined(GRAN) +/* Dummy def for NO_PRI if not in GranSim */ +#define NO_PRI 0 +#endif + +/* + * Creating threads + */ +#if defined(GRAN) +StgTSO *createThread (Capability *cap, nat stack_size, StgInt pri); +#else +StgTSO *createThread (Capability *cap, nat stack_size); +#endif + +Capability *scheduleWaitThread (StgTSO *tso, /*out*/HaskellObj* ret, + Capability *cap); + +StgTSO *createGenThread (Capability *cap, nat stack_size, + StgClosure *closure); +StgTSO *createIOThread (Capability *cap, nat stack_size, + StgClosure *closure); +StgTSO *createStrictIOThread (Capability *cap, nat stack_size, + StgClosure *closure); +#endif diff --git a/includes/Signals.h b/includes/Signals.h new file mode 100644 index 0000000000..a5907bbee9 --- /dev/null +++ b/includes/Signals.h @@ -0,0 +1,18 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2005 + * + * RTS signal handling + * + * ---------------------------------------------------------------------------*/ + +#ifndef SIGNALS_H +#define SIGNALS_H + +#define STG_SIG_DFL (-1) +#define STG_SIG_IGN (-2) +#define STG_SIG_ERR (-3) +#define STG_SIG_HAN (-4) +#define STG_SIG_RST (-5) + +#endif /* SIGNALS_H */ diff --git a/includes/Stable.h b/includes/Stable.h new file mode 100644 index 0000000000..ca2e72118a --- /dev/null +++ b/includes/Stable.h @@ -0,0 +1,66 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Stable Pointers: A stable pointer is represented as an index into + * the stable pointer table in the low BITS_PER_WORD-8 bits with a + * weight in the upper 8 bits. + * + * SUP: StgStablePtr used to be a synonym for StgWord, but stable pointers + * are guaranteed to be void* on the C-side, so we have to do some occasional + * casting. Size is not a matter, because StgWord is always the same size as + * a void*. + * + * ---------------------------------------------------------------------------*/ + +#ifndef STABLE_H +#define STABLE_H + +/* ----------------------------------------------------------------------------- + External C Interface + -------------------------------------------------------------------------- */ + +extern StgPtr deRefStablePtr(StgStablePtr stable_ptr); +extern void freeStablePtr(StgStablePtr sp); +extern StgStablePtr splitStablePtr(StgStablePtr sp); +extern StgStablePtr getStablePtr(StgPtr p); + +/* ----------------------------------------------------------------------------- + PRIVATE from here. + -------------------------------------------------------------------------- */ + +typedef struct { + StgPtr addr; /* Haskell object, free list, or NULL */ + StgPtr old; /* old Haskell object, used during GC */ + StgWord ref; /* used for reference counting */ + StgClosure *sn_obj; /* the StableName object (or NULL) */ +} snEntry; + +extern DLL_IMPORT_RTS snEntry *stable_ptr_table; + +extern void freeStablePtr(StgStablePtr sp); + +#if defined(__GNUC__) +# ifndef RTS_STABLE_C +extern inline +# endif +StgPtr deRefStablePtr(StgStablePtr sp) +{ + ASSERT(stable_ptr_table[(StgWord)sp].ref > 0); + return stable_ptr_table[(StgWord)sp].addr; +} +#else +/* No support for 'extern inline' */ +extern StgPtr deRefStablePtr(StgStablePtr sp); +#endif + +extern void initStablePtrTable ( void ); +extern void enlargeStablePtrTable ( void ); +extern StgWord lookupStableName ( StgPtr p ); + +extern void markStablePtrTable ( evac_fn evac ); +extern void threadStablePtrTable ( evac_fn evac ); +extern void gcStablePtrTable ( void ); +extern void updateStablePtrTable ( rtsBool full ); + +#endif diff --git a/includes/Stg.h b/includes/Stg.h new file mode 100644 index 0000000000..a63b7ec2d6 --- /dev/null +++ b/includes/Stg.h @@ -0,0 +1,461 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Top-level include file for everything STG-ish. + * + * This file is included *automatically* by all .hc files. + * + * NOTE: always include Stg.h *before* any other headers, because we + * define some register variables which must be done before any inline + * functions are defined (some system headers have been known to + * define the odd inline function). + * + * We generally try to keep as little visible as possible when + * compiling .hc files. So for example the definitions of the + * InfoTable structs, closure structs and other RTS types are not + * visible here. The compiler knows enough about the representations + * of these types to generate code which manipulates them directly + * with pointer arithmetic. + * + * ---------------------------------------------------------------------------*/ + +#ifndef STG_H +#define STG_H + + +/* If we include "Stg.h" directly, we're in STG code, and we therefore + * get all the global register variables, macros etc. that go along + * with that. If "Stg.h" is included via "Rts.h", we're assumed to + * be in vanilla C. + */ +#ifndef IN_STG_CODE +# define IN_STG_CODE 1 +#endif + +#if IN_STG_CODE == 0 +# define NO_GLOBAL_REG_DECLS /* don't define fixed registers */ +#endif + +/* Configuration */ +#include "ghcconfig.h" +#include "RtsConfig.h" + +/* ----------------------------------------------------------------------------- + Useful definitions + -------------------------------------------------------------------------- */ + +/* + * The C backend like to refer to labels by just mentioning their + * names. Howevver, when a symbol is declared as a variable in C, the + * C compiler will implicitly dereference it when it occurs in source. + * So we must subvert this behaviour for .hc files by declaring + * variables as arrays, which eliminates the implicit dereference. + */ +#if IN_STG_CODE +#define RTS_VAR(x) (x)[] +#define RTS_DEREF(x) (*(x)) +#else +#define RTS_VAR(x) x +#define RTS_DEREF(x) x +#endif + +/* bit macros + */ +#define BITS_PER_BYTE 8 +#define BITS_IN(x) (BITS_PER_BYTE * sizeof(x)) + +/* + * 'Portable' inlining + */ +#if defined(__GNUC__) || defined( __INTEL_COMPILER) +# define INLINE_HEADER static inline +# define INLINE_ME inline +# define STATIC_INLINE INLINE_HEADER +#elif defined(_MSC_VER) +# define INLINE_HEADER __inline static +# define INLINE_ME __inline +# define STATIC_INLINE INLINE_HEADER +#else +# error "Don't know how to inline functions with your C compiler." +#endif + +/* + * GCC attributes + */ +#if defined(__GNUC__) +#define GNU_ATTRIBUTE(at) __attribute__((at)) +#else +#define GNU_ATTRIBUTE(at) +#endif + +#if __GNUC__ >= 3 +#define GNUC3_ATTRIBUTE(at) __attribute__((at)) +#else +#define GNUC3_ATTRIBUTE(at) +#endif + +#define STG_UNUSED GNUC3_ATTRIBUTE(__unused__) + +/* ----------------------------------------------------------------------------- + Global type definitions + -------------------------------------------------------------------------- */ + +#include "MachDeps.h" +#include "StgTypes.h" + +/* ----------------------------------------------------------------------------- + Shorthand forms + -------------------------------------------------------------------------- */ + +typedef StgChar C_; +typedef StgWord W_; +typedef StgWord* P_; +typedef P_* PP_; +typedef StgInt I_; +typedef StgAddr A_; +typedef const StgWord* D_; +typedef StgFunPtr F_; +typedef StgByteArray B_; +typedef StgClosurePtr L_; + +typedef StgInt64 LI_; +typedef StgWord64 LW_; + +#define IF_(f) static F_ GNUC3_ATTRIBUTE(used) f(void) +#define FN_(f) F_ f(void) +#define EF_(f) extern F_ f(void) + +typedef StgWord StgWordArray[]; +#define EI_ extern StgWordArray +#define II_ static StgWordArray + +/* ----------------------------------------------------------------------------- + Tail calls + + This needs to be up near the top as the register line on alpha needs + to be before all procedures (inline & out-of-line). + -------------------------------------------------------------------------- */ + +#include "TailCalls.h" + +/* ----------------------------------------------------------------------------- + Other Stg stuff... + -------------------------------------------------------------------------- */ + +#include "StgDLL.h" +#include "MachRegs.h" +#include "Regs.h" +#include "StgProf.h" /* ToDo: separate out RTS-only stuff from here */ + +#if IN_STG_CODE +/* + * This is included later for RTS sources, after definitions of + * StgInfoTable, StgClosure and so on. + */ +#include "StgMiscClosures.h" +#endif + +/* RTS external interface */ +#include "RtsExternal.h" + +/* ----------------------------------------------------------------------------- + Moving Floats and Doubles + + ASSIGN_FLT is for assigning a float to memory (usually the + stack/heap). The memory address is guaranteed to be + StgWord aligned (currently == sizeof(void *)). + + PK_FLT is for pulling a float out of memory. The memory is + guaranteed to be StgWord aligned. + -------------------------------------------------------------------------- */ + +INLINE_HEADER void ASSIGN_FLT (W_ [], StgFloat); +INLINE_HEADER StgFloat PK_FLT (W_ []); + +#if ALIGNMENT_FLOAT <= ALIGNMENT_LONG + +INLINE_HEADER void ASSIGN_FLT(W_ p_dest[], StgFloat src) { *(StgFloat *)p_dest = src; } +INLINE_HEADER StgFloat PK_FLT (W_ p_src[]) { return *(StgFloat *)p_src; } + +#else /* ALIGNMENT_FLOAT > ALIGNMENT_UNSIGNED_INT */ + +INLINE_HEADER void ASSIGN_FLT(W_ p_dest[], StgFloat src) +{ + float_thing y; + y.f = src; + *p_dest = y.fu; +} + +INLINE_HEADER StgFloat PK_FLT(W_ p_src[]) +{ + float_thing y; + y.fu = *p_src; + return(y.f); +} + +#endif /* ALIGNMENT_FLOAT > ALIGNMENT_LONG */ + +#if ALIGNMENT_DOUBLE <= ALIGNMENT_LONG + +INLINE_HEADER void ASSIGN_DBL (W_ [], StgDouble); +INLINE_HEADER StgDouble PK_DBL (W_ []); + +INLINE_HEADER void ASSIGN_DBL(W_ p_dest[], StgDouble src) { *(StgDouble *)p_dest = src; } +INLINE_HEADER StgDouble PK_DBL (W_ p_src[]) { return *(StgDouble *)p_src; } + +#else /* ALIGNMENT_DOUBLE > ALIGNMENT_LONG */ + +/* Sparc uses two floating point registers to hold a double. We can + * write ASSIGN_DBL and PK_DBL by directly accessing the registers + * independently - unfortunately this code isn't writable in C, we + * have to use inline assembler. + */ +#if sparc_HOST_ARCH + +#define ASSIGN_DBL(dst0,src) \ + { StgPtr dst = (StgPtr)(dst0); \ + __asm__("st %2,%0\n\tst %R2,%1" : "=m" (((P_)(dst))[0]), \ + "=m" (((P_)(dst))[1]) : "f" (src)); \ + } + +#define PK_DBL(src0) \ + ( { StgPtr src = (StgPtr)(src0); \ + register double d; \ + __asm__("ld %1,%0\n\tld %2,%R0" : "=f" (d) : \ + "m" (((P_)(src))[0]), "m" (((P_)(src))[1])); d; \ + } ) + +#else /* ! sparc_HOST_ARCH */ + +INLINE_HEADER void ASSIGN_DBL (W_ [], StgDouble); +INLINE_HEADER StgDouble PK_DBL (W_ []); + +typedef struct + { StgWord dhi; + StgWord dlo; + } unpacked_double; + +typedef union + { StgDouble d; + unpacked_double du; + } double_thing; + +INLINE_HEADER void ASSIGN_DBL(W_ p_dest[], StgDouble src) +{ + double_thing y; + y.d = src; + p_dest[0] = y.du.dhi; + p_dest[1] = y.du.dlo; +} + +/* GCC also works with this version, but it generates + the same code as the previous one, and is not ANSI + +#define ASSIGN_DBL( p_dest, src ) \ + *p_dest = ((double_thing) src).du.dhi; \ + *(p_dest+1) = ((double_thing) src).du.dlo \ +*/ + +INLINE_HEADER StgDouble PK_DBL(W_ p_src[]) +{ + double_thing y; + y.du.dhi = p_src[0]; + y.du.dlo = p_src[1]; + return(y.d); +} + +#endif /* ! sparc_HOST_ARCH */ + +#endif /* ALIGNMENT_DOUBLE > ALIGNMENT_UNSIGNED_INT */ + + +/* ----------------------------------------------------------------------------- + Moving 64-bit quantities around + + ASSIGN_Word64 assign an StgWord64/StgInt64 to a memory location + PK_Word64 load an StgWord64/StgInt64 from a amemory location + + In both cases the memory location might not be 64-bit aligned. + -------------------------------------------------------------------------- */ + +#ifdef SUPPORT_LONG_LONGS + +typedef struct + { StgWord dhi; + StgWord dlo; + } unpacked_double_word; + +typedef union + { StgInt64 i; + unpacked_double_word iu; + } int64_thing; + +typedef union + { StgWord64 w; + unpacked_double_word wu; + } word64_thing; + +INLINE_HEADER void ASSIGN_Word64(W_ p_dest[], StgWord64 src) +{ + word64_thing y; + y.w = src; + p_dest[0] = y.wu.dhi; + p_dest[1] = y.wu.dlo; +} + +INLINE_HEADER StgWord64 PK_Word64(W_ p_src[]) +{ + word64_thing y; + y.wu.dhi = p_src[0]; + y.wu.dlo = p_src[1]; + return(y.w); +} + +INLINE_HEADER void ASSIGN_Int64(W_ p_dest[], StgInt64 src) +{ + int64_thing y; + y.i = src; + p_dest[0] = y.iu.dhi; + p_dest[1] = y.iu.dlo; +} + +INLINE_HEADER StgInt64 PK_Int64(W_ p_src[]) +{ + int64_thing y; + y.iu.dhi = p_src[0]; + y.iu.dlo = p_src[1]; + return(y.i); +} + +#elif SIZEOF_VOID_P == 8 + +INLINE_HEADER void ASSIGN_Word64(W_ p_dest[], StgWord64 src) +{ + p_dest[0] = src; +} + +INLINE_HEADER StgWord64 PK_Word64(W_ p_src[]) +{ + return p_src[0]; +} + +INLINE_HEADER void ASSIGN_Int64(W_ p_dest[], StgInt64 src) +{ + p_dest[0] = src; +} + +INLINE_HEADER StgInt64 PK_Int64(W_ p_src[]) +{ + return p_src[0]; +} + +#endif + +/* ----------------------------------------------------------------------------- + Split markers + -------------------------------------------------------------------------- */ + +#if defined(USE_SPLIT_MARKERS) +#if defined(LEADING_UNDERSCORE) +#define __STG_SPLIT_MARKER __asm__("\n___stg_split_marker:"); +#else +#define __STG_SPLIT_MARKER __asm__("\n__stg_split_marker:"); +#endif +#else +#define __STG_SPLIT_MARKER /* nothing */ +#endif + +/* ----------------------------------------------------------------------------- + Write-combining store + -------------------------------------------------------------------------- */ + +INLINE_HEADER void +wcStore (StgPtr p, StgWord w) +{ +#ifdef x86_64_HOST_ARCH + __asm__( + "movnti\t%1, %0" + : "=m" (*p) + : "r" (w) + ); +#else + *p = w; +#endif +} + +/* ----------------------------------------------------------------------------- + Integer multiply with overflow + -------------------------------------------------------------------------- */ + +/* Multiply with overflow checking. + * + * This is tricky - the usual sign rules for add/subtract don't apply. + * + * On 32-bit machines we use gcc's 'long long' types, finding + * overflow with some careful bit-twiddling. + * + * On 64-bit machines where gcc's 'long long' type is also 64-bits, + * we use a crude approximation, testing whether either operand is + * larger than 32-bits; if neither is, then we go ahead with the + * multiplication. + * + * Return non-zero if there is any possibility that the signed multiply + * of a and b might overflow. Return zero only if you are absolutely sure + * that it won't overflow. If in doubt, return non-zero. + */ + +#if SIZEOF_VOID_P == 4 + +#ifdef WORDS_BIGENDIAN +#define RTS_CARRY_IDX__ 0 +#define RTS_REM_IDX__ 1 +#else +#define RTS_CARRY_IDX__ 1 +#define RTS_REM_IDX__ 0 +#endif + +typedef union { + StgInt64 l; + StgInt32 i[2]; +} long_long_u ; + +#define mulIntMayOflo(a,b) \ +({ \ + StgInt32 r, c; \ + long_long_u z; \ + z.l = (StgInt64)a * (StgInt64)b; \ + r = z.i[RTS_REM_IDX__]; \ + c = z.i[RTS_CARRY_IDX__]; \ + if (c == 0 || c == -1) { \ + c = ((StgWord)((a^b) ^ r)) \ + >> (BITS_IN (I_) - 1); \ + } \ + c; \ +}) + +/* Careful: the carry calculation above is extremely delicate. Make sure + * you test it thoroughly after changing it. + */ + +#else + +/* Approximate version when we don't have long arithmetic (on 64-bit archs) */ + +#define HALF_POS_INT (((I_)1) << (BITS_IN (I_) / 2)) +#define HALF_NEG_INT (-HALF_POS_INT) + +#define mulIntMayOflo(a,b) \ +({ \ + I_ c; \ + if ((I_)a <= HALF_NEG_INT || a >= HALF_POS_INT \ + || (I_)b <= HALF_NEG_INT || b >= HALF_POS_INT) {\ + c = 1; \ + } else { \ + c = 0; \ + } \ + c; \ +}) +#endif + +#endif /* STG_H */ diff --git a/includes/StgDLL.h b/includes/StgDLL.h new file mode 100644 index 0000000000..ededcc96b5 --- /dev/null +++ b/includes/StgDLL.h @@ -0,0 +1,48 @@ +#ifndef __STGDLL_H__ +#define __STGDLL_H__ 1 + +#if defined(HAVE_WIN32_DLL_SUPPORT) && !defined(DONT_WANT_WIN32_DLL_SUPPORT) +#define ENABLE_WIN32_DLL_SUPPORT +#endif + +#ifdef ENABLE_WIN32_DLL_SUPPORT +# if __GNUC__ && !defined(__declspec) +# define DLLIMPORT +# else +# define DLLIMPORT __declspec(dllimport) +# define DLLIMPORT_DATA(x) _imp__##x +# endif +#else +# define DLLIMPORT +#endif + +/* The view of the ghc/includes/ header files differ ever so + slightly depending on whether the RTS is being compiled + or not - so we're forced to distinguish between two. + [oh, you want details :) : Data symbols defined by the RTS + have to be accessed through an extra level of indirection + when compiling generated .hc code compared to when the RTS + sources are being processed. This is only the case when + using Win32 DLLs. ] +*/ +#ifdef COMPILING_RTS +#define DLL_IMPORT DLLIMPORT +#define DLL_IMPORT_RTS +#define DLL_IMPORT_DATA_VAR(x) x +#else +#define DLL_IMPORT +#define DLL_IMPORT_RTS DLLIMPORT +# ifdef ENABLE_WIN32_DLL_SUPPORT +# define DLL_IMPORT_DATA_VAR(x) _imp__##x +# else +# define DLL_IMPORT_DATA_VAR(x) x +# endif +#endif + +#ifdef COMPILING_STDLIB +#define DLL_IMPORT_STDLIB +#else +#define DLL_IMPORT_STDLIB DLLIMPORT +#endif + +#endif /* __STGDLL_H__ */ diff --git a/includes/StgFun.h b/includes/StgFun.h new file mode 100644 index 0000000000..e6f9b1fe0e --- /dev/null +++ b/includes/StgFun.h @@ -0,0 +1,52 @@ +/* ----------------------------------------------------------------------------- + * (c) The GHC Team, 2002 + * + * Things for functions. + * ---------------------------------------------------------------------------*/ + +#ifndef STGFUN_H +#define STGFUN_H + +/* generic - function comes with a small bitmap */ +#define ARG_GEN 0 + +/* generic - function comes with a large bitmap */ +#define ARG_GEN_BIG 1 + +/* BCO - function is really a BCO */ +#define ARG_BCO 2 + +/* + * Specialised function types: bitmaps and calling sequences + * for these functions are pre-generated: see ghc/utils/genapply and + * generated code in ghc/rts/AutoApply.cmm. + * + * NOTE: other places to change if you change this table: + * - utils/genapply/GenApply.hs: stackApplyTypes + * - compiler/codeGen/CgCallConv.lhs: stdPattern + */ +#define ARG_NONE 3 +#define ARG_N 4 +#define ARG_P 5 +#define ARG_F 6 +#define ARG_D 7 +#define ARG_L 8 +#define ARG_NN 9 +#define ARG_NP 10 +#define ARG_PN 11 +#define ARG_PP 12 +#define ARG_NNN 13 +#define ARG_NNP 14 +#define ARG_NPN 15 +#define ARG_NPP 16 +#define ARG_PNN 17 +#define ARG_PNP 18 +#define ARG_PPN 19 +#define ARG_PPP 20 +#define ARG_PPPP 21 +#define ARG_PPPPP 22 +#define ARG_PPPPPP 23 +#define ARG_PPPPPPP 24 +#define ARG_PPPPPPPP 25 + +#endif /* STGFUN_H */ diff --git a/includes/StgLdvProf.h b/includes/StgLdvProf.h new file mode 100644 index 0000000000..3c3df1c5fa --- /dev/null +++ b/includes/StgLdvProf.h @@ -0,0 +1,45 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The University of Glasgow, 2004 + * + * Lag/Drag/Void profiling. + * + * ---------------------------------------------------------------------------*/ + +#ifndef STGLDVPROF_H +#define STGLDVPROF_H + +#ifdef PROFILING + +/* retrieves the LDV word from closure c */ +#define LDVW(c) (((StgClosure *)(c))->header.prof.hp.ldvw) + +/* + * Stores the creation time for closure c. + * This macro is called at the very moment of closure creation. + * + * NOTE: this initializes LDVW(c) to zero, which ensures that there + * is no conflict between retainer profiling and LDV profiling, + * because retainer profiling also expects LDVW(c) to be initialised + * to zero. + */ +#ifndef CMINUSMINUS +#define LDV_RECORD_CREATE(c) \ + LDVW((c)) = ((StgWord)RTS_DEREF(era) << LDV_SHIFT) | LDV_STATE_CREATE +#endif + +#ifdef CMINUSMINUS +#define LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(c) \ + foreign "C" LDV_recordDead_FILL_SLOP_DYNAMIC(c "ptr") +#else +#define LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(c) \ + LDV_recordDead_FILL_SLOP_DYNAMIC(c) +#endif + +#else /* !PROFILING */ + +#define LDV_RECORD_CREATE(c) /* nothing */ +#define LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(c) /* nothing */ + +#endif /* PROFILING */ +#endif /* STGLDVPROF_H */ diff --git a/includes/StgMiscClosures.h b/includes/StgMiscClosures.h new file mode 100644 index 0000000000..4a6a7c47c2 --- /dev/null +++ b/includes/StgMiscClosures.h @@ -0,0 +1,606 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Declarations for various symbols exported by the RTS. + * + * ToDo: many of the symbols in here don't need to be exported, but + * our Cmm code generator doesn't know how to generate local symbols + * for the RTS bits (it assumes all RTS symbols are external). + * + * --------------------------------------------------------------------------*/ + +#ifndef STGMISCCLOSURES_H +#define STGMISCCLOSURES_H + +#if IN_STG_CODE +# define RTS_RET_INFO(i) extern W_(i)[] +# define RTS_FUN_INFO(i) extern W_(i)[] +# define RTS_THUNK_INFO(i) extern W_(i)[] +# define RTS_INFO(i) extern W_(i)[] +# define RTS_CLOSURE(i) extern W_(i)[] +# define RTS_FUN(f) extern DLL_IMPORT_RTS StgFunPtr f(void) +#else +# define RTS_RET_INFO(i) extern DLL_IMPORT_RTS const StgRetInfoTable i +# define RTS_FUN_INFO(i) extern DLL_IMPORT_RTS const StgFunInfoTable i +# define RTS_THUNK_INFO(i) extern DLL_IMPORT_RTS const StgThunkInfoTable i +# define RTS_INFO(i) extern DLL_IMPORT_RTS const StgInfoTable i +# define RTS_CLOSURE(i) extern DLL_IMPORT_RTS StgClosure i +# define RTS_FUN(f) extern DLL_IMPORT_RTS StgFunPtr f(void) +#endif + +#ifdef TABLES_NEXT_TO_CODE +# define RTS_ENTRY(f) /* nothing */ +#else +# define RTS_ENTRY(f) RTS_FUN(f) +#endif + +/* Stack frames */ +RTS_RET_INFO(stg_upd_frame_info); +RTS_RET_INFO(stg_marked_upd_frame_info); +RTS_RET_INFO(stg_noupd_frame_info); +RTS_RET_INFO(stg_seq_frame_info); +RTS_RET_INFO(stg_catch_frame_info); +RTS_RET_INFO(stg_catch_retry_frame_info); +RTS_RET_INFO(stg_atomically_frame_info); +RTS_RET_INFO(stg_atomically_waiting_frame_info); +RTS_RET_INFO(stg_catch_stm_frame_info); + +RTS_ENTRY(stg_upd_frame_ret); +RTS_ENTRY(stg_marked_upd_frame_ret); +RTS_ENTRY(stg_seq_frame_ret); + +/* Entry code for constructors created by the bytecode interpreter */ +RTS_FUN(stg_interp_constr_entry); +RTS_FUN(stg_interp_constr1_entry); +RTS_FUN(stg_interp_constr2_entry); +RTS_FUN(stg_interp_constr3_entry); +RTS_FUN(stg_interp_constr4_entry); +RTS_FUN(stg_interp_constr5_entry); +RTS_FUN(stg_interp_constr6_entry); +RTS_FUN(stg_interp_constr7_entry); +RTS_FUN(stg_interp_constr8_entry); + +/* Magic glue code for when compiled code returns a value in R1/F1/D1 + or a VoidRep to the interpreter. */ +RTS_RET_INFO(stg_ctoi_R1p_info); +RTS_RET_INFO(stg_ctoi_R1unpt_info); +RTS_RET_INFO(stg_ctoi_R1n_info); +RTS_RET_INFO(stg_ctoi_F1_info); +RTS_RET_INFO(stg_ctoi_D1_info); +RTS_RET_INFO(stg_ctoi_L1_info); +RTS_RET_INFO(stg_ctoi_V_info); + +RTS_ENTRY(stg_ctoi_R1p_ret); +RTS_ENTRY(stg_ctoi_R1unpt_ret); +RTS_ENTRY(stg_ctoi_R1n_ret); +RTS_ENTRY(stg_ctoi_F1_ret); +RTS_ENTRY(stg_ctoi_D1_ret); +RTS_ENTRY(stg_ctoi_L1_ret); +RTS_ENTRY(stg_ctoi_V_ret); + +RTS_RET_INFO(stg_apply_interp_info); +RTS_ENTRY(stg_apply_interp_ret); + +RTS_INFO(stg_IND_info); +RTS_INFO(stg_IND_direct_info); +RTS_INFO(stg_IND_0_info); +RTS_INFO(stg_IND_1_info); +RTS_INFO(stg_IND_2_info); +RTS_INFO(stg_IND_3_info); +RTS_INFO(stg_IND_4_info); +RTS_INFO(stg_IND_5_info); +RTS_INFO(stg_IND_6_info); +RTS_INFO(stg_IND_7_info); +RTS_INFO(stg_IND_STATIC_info); +RTS_INFO(stg_IND_PERM_info); +RTS_INFO(stg_IND_OLDGEN_info); +RTS_INFO(stg_IND_OLDGEN_PERM_info); +RTS_INFO(stg_CAF_UNENTERED_info); +RTS_INFO(stg_CAF_ENTERED_info); +RTS_INFO(stg_WHITEHOLE_info); +RTS_INFO(stg_BLACKHOLE_info); +RTS_INFO(stg_CAF_BLACKHOLE_info); +#ifdef TICKY_TICKY +RTS_INFO(stg_SE_BLACKHOLE_info); +RTS_INFO(stg_SE_CAF_BLACKHOLE_info); +#endif + +#if defined(PAR) || defined(GRAN) +RTS_INFO(stg_RBH_info); +#endif +#if defined(PAR) +RTS_INFO(stg_FETCH_ME_BQ_info); +#endif +RTS_FUN_INFO(stg_BCO_info); +RTS_INFO(stg_EVACUATED_info); +RTS_INFO(stg_WEAK_info); +RTS_INFO(stg_DEAD_WEAK_info); +RTS_INFO(stg_STABLE_NAME_info); +RTS_INFO(stg_FULL_MVAR_info); +RTS_INFO(stg_EMPTY_MVAR_info); +RTS_INFO(stg_TSO_info); +RTS_INFO(stg_ARR_WORDS_info); +RTS_INFO(stg_MUT_ARR_WORDS_info); +RTS_INFO(stg_MUT_ARR_PTRS_CLEAN_info); +RTS_INFO(stg_MUT_ARR_PTRS_DIRTY_info); +RTS_INFO(stg_MUT_ARR_PTRS_FROZEN_info); +RTS_INFO(stg_MUT_ARR_PTRS_FROZEN0_info); +RTS_INFO(stg_MUT_VAR_CLEAN_info); +RTS_INFO(stg_MUT_VAR_DIRTY_info); +RTS_INFO(stg_END_TSO_QUEUE_info); +RTS_INFO(stg_MUT_CONS_info); +RTS_INFO(stg_catch_info); +RTS_INFO(stg_PAP_info); +RTS_INFO(stg_AP_info); +RTS_INFO(stg_AP_STACK_info); +RTS_INFO(stg_dummy_ret_info); +RTS_INFO(stg_raise_info); +RTS_INFO(stg_TVAR_WAIT_QUEUE_info); +RTS_INFO(stg_TVAR_info); +RTS_INFO(stg_TREC_CHUNK_info); +RTS_INFO(stg_TREC_HEADER_info); +RTS_INFO(stg_END_STM_WAIT_QUEUE_info); +RTS_INFO(stg_END_STM_CHUNK_LIST_info); +RTS_INFO(stg_NO_TREC_info); + +RTS_ENTRY(stg_IND_entry); +RTS_ENTRY(stg_IND_direct_entry); +RTS_ENTRY(stg_IND_0_entry); +RTS_ENTRY(stg_IND_1_entry); +RTS_ENTRY(stg_IND_2_entry); +RTS_ENTRY(stg_IND_3_entry); +RTS_ENTRY(stg_IND_4_entry); +RTS_ENTRY(stg_IND_5_entry); +RTS_ENTRY(stg_IND_6_entry); +RTS_ENTRY(stg_IND_7_entry); +RTS_ENTRY(stg_IND_STATIC_entry); +RTS_ENTRY(stg_IND_PERM_entry); +RTS_ENTRY(stg_IND_OLDGEN_entry); +RTS_ENTRY(stg_IND_OLDGEN_PERM_entry); +RTS_ENTRY(stg_CAF_UNENTERED_entry); +RTS_ENTRY(stg_CAF_ENTERED_entry); +RTS_ENTRY(stg_WHITEHOLE_entry); +RTS_ENTRY(stg_BLACKHOLE_entry); +RTS_ENTRY(stg_CAF_BLACKHOLE_entry); +#ifdef TICKY_TICKY +RTS_ENTRY(stg_SE_BLACKHOLE_entry); +RTS_ENTRY(stg_SE_CAF_BLACKHOLE_entry); +#endif +#if defined(PAR) || defined(GRAN) +RTS_ENTRY(stg_RBH_entry); +#endif +#if defined(PAR) +RTS_ENTRY(stg_FETCH_ME_BQ_entry); +#endif +RTS_ENTRY(stg_BCO_entry); +RTS_ENTRY(stg_EVACUATED_entry); +RTS_ENTRY(stg_WEAK_entry); +RTS_ENTRY(stg_DEAD_WEAK_entry); +RTS_ENTRY(stg_STABLE_NAME_entry); +RTS_ENTRY(stg_FULL_MVAR_entry); +RTS_ENTRY(stg_EMPTY_MVAR_entry); +RTS_ENTRY(stg_TSO_entry); +RTS_ENTRY(stg_ARR_WORDS_entry); +RTS_ENTRY(stg_MUT_ARR_WORDS_entry); +RTS_ENTRY(stg_MUT_ARR_PTRS_CLEAN_entry); +RTS_ENTRY(stg_MUT_ARR_PTRS_DIRTY_entry); +RTS_ENTRY(stg_MUT_ARR_PTRS_FROZEN_entry); +RTS_ENTRY(stg_MUT_ARR_PTRS_FROZEN0_entry); +RTS_ENTRY(stg_MUT_VAR_CLEAN_entry); +RTS_ENTRY(stg_MUT_VAR_DIRTY_entry); +RTS_ENTRY(stg_END_TSO_QUEUE_entry); +RTS_ENTRY(stg_MUT_CONS_entry); +RTS_ENTRY(stg_catch_entry); +RTS_ENTRY(stg_PAP_entry); +RTS_ENTRY(stg_AP_entry); +RTS_ENTRY(stg_AP_STACK_entry); +RTS_ENTRY(stg_dummy_ret_entry); +RTS_ENTRY(stg_raise_entry); +RTS_ENTRY(stg_END_STM_WAIT_QUEUE_entry); +RTS_ENTRY(stg_END_STM_CHUNK_LIST_entry); +RTS_ENTRY(stg_NO_TREC_entry); +RTS_ENTRY(stg_TVAR_entry); +RTS_ENTRY(stg_TVAR_WAIT_QUEUE_entry); +RTS_ENTRY(stg_TREC_CHUNK_entry); +RTS_ENTRY(stg_TREC_HEADER_entry); + + +RTS_ENTRY(stg_unblockAsyncExceptionszh_ret_ret); +RTS_ENTRY(stg_blockAsyncExceptionszh_ret_ret); +RTS_ENTRY(stg_catch_frame_ret); +RTS_ENTRY(stg_catch_retry_frame_ret); +RTS_ENTRY(stg_atomically_frame_ret); +RTS_ENTRY(stg_atomically_waiting_frame_ret); +RTS_ENTRY(stg_catch_stm_frame_ret); +RTS_ENTRY(stg_catch_frame_ret); +RTS_ENTRY(stg_catch_entry); +RTS_ENTRY(stg_raise_entry); + +/* closures */ + +RTS_CLOSURE(stg_END_TSO_QUEUE_closure); +RTS_CLOSURE(stg_NO_FINALIZER_closure); +RTS_CLOSURE(stg_dummy_ret_closure); +RTS_CLOSURE(stg_forceIO_closure); + +RTS_CLOSURE(stg_END_STM_WAIT_QUEUE_closure); +RTS_CLOSURE(stg_END_STM_CHUNK_LIST_closure); +RTS_CLOSURE(stg_NO_TREC_closure); + +RTS_ENTRY(stg_NO_FINALIZER_entry); +RTS_ENTRY(stg_END_EXCEPTION_LIST_entry); +RTS_ENTRY(stg_EXCEPTION_CONS_entry); + +#if IN_STG_CODE +extern DLL_IMPORT_RTS StgWordArray stg_CHARLIKE_closure; +extern DLL_IMPORT_RTS StgWordArray stg_INTLIKE_closure; +#else +extern DLL_IMPORT_RTS StgIntCharlikeClosure stg_CHARLIKE_closure[]; +extern DLL_IMPORT_RTS StgIntCharlikeClosure stg_INTLIKE_closure[]; +#endif + +/* StgStartup */ + +RTS_RET_INFO(stg_forceIO_info); +RTS_ENTRY(stg_forceIO_ret); + +RTS_RET_INFO(stg_noforceIO_info); +RTS_ENTRY(stg_noforceIO_ret); + +/* standard entry points */ + +/* standard selector thunks */ + +RTS_ENTRY(stg_sel_ret_0_upd_ret); +RTS_ENTRY(stg_sel_ret_1_upd_ret); +RTS_ENTRY(stg_sel_ret_2_upd_ret); +RTS_ENTRY(stg_sel_ret_3_upd_ret); +RTS_ENTRY(stg_sel_ret_4_upd_ret); +RTS_ENTRY(stg_sel_ret_5_upd_ret); +RTS_ENTRY(stg_sel_ret_6_upd_ret); +RTS_ENTRY(stg_sel_ret_7_upd_ret); +RTS_ENTRY(stg_sel_ret_8_upd_ret); +RTS_ENTRY(stg_sel_ret_8_upd_ret); +RTS_ENTRY(stg_sel_ret_9_upd_ret); +RTS_ENTRY(stg_sel_ret_10_upd_ret); +RTS_ENTRY(stg_sel_ret_11_upd_ret); +RTS_ENTRY(stg_sel_ret_12_upd_ret); +RTS_ENTRY(stg_sel_ret_13_upd_ret); +RTS_ENTRY(stg_sel_ret_14_upd_ret); +RTS_ENTRY(stg_sel_ret_15_upd_ret); + +RTS_INFO(stg_sel_0_upd_info); +RTS_INFO(stg_sel_1_upd_info); +RTS_INFO(stg_sel_2_upd_info); +RTS_INFO(stg_sel_3_upd_info); +RTS_INFO(stg_sel_4_upd_info); +RTS_INFO(stg_sel_5_upd_info); +RTS_INFO(stg_sel_6_upd_info); +RTS_INFO(stg_sel_7_upd_info); +RTS_INFO(stg_sel_8_upd_info); +RTS_INFO(stg_sel_8_upd_info); +RTS_INFO(stg_sel_9_upd_info); +RTS_INFO(stg_sel_10_upd_info); +RTS_INFO(stg_sel_11_upd_info); +RTS_INFO(stg_sel_12_upd_info); +RTS_INFO(stg_sel_13_upd_info); +RTS_INFO(stg_sel_14_upd_info); +RTS_INFO(stg_sel_15_upd_info); + +RTS_ENTRY(stg_sel_0_upd_entry); +RTS_ENTRY(stg_sel_1_upd_entry); +RTS_ENTRY(stg_sel_2_upd_entry); +RTS_ENTRY(stg_sel_3_upd_entry); +RTS_ENTRY(stg_sel_4_upd_entry); +RTS_ENTRY(stg_sel_5_upd_entry); +RTS_ENTRY(stg_sel_6_upd_entry); +RTS_ENTRY(stg_sel_7_upd_entry); +RTS_ENTRY(stg_sel_8_upd_entry); +RTS_ENTRY(stg_sel_8_upd_entry); +RTS_ENTRY(stg_sel_9_upd_entry); +RTS_ENTRY(stg_sel_10_upd_entry); +RTS_ENTRY(stg_sel_11_upd_entry); +RTS_ENTRY(stg_sel_12_upd_entry); +RTS_ENTRY(stg_sel_13_upd_entry); +RTS_ENTRY(stg_sel_14_upd_entry); +RTS_ENTRY(stg_sel_15_upd_entry); + +RTS_ENTRY(stg_sel_ret_0_noupd_ret); +RTS_ENTRY(stg_sel_ret_1_noupd_ret); +RTS_ENTRY(stg_sel_ret_2_noupd_ret); +RTS_ENTRY(stg_sel_ret_3_noupd_ret); +RTS_ENTRY(stg_sel_ret_4_noupd_ret); +RTS_ENTRY(stg_sel_ret_5_noupd_ret); +RTS_ENTRY(stg_sel_ret_6_noupd_ret); +RTS_ENTRY(stg_sel_ret_7_noupd_ret); +RTS_ENTRY(stg_sel_ret_8_noupd_ret); +RTS_ENTRY(stg_sel_ret_8_noupd_ret); +RTS_ENTRY(stg_sel_ret_9_noupd_ret); +RTS_ENTRY(stg_sel_ret_10_noupd_ret); +RTS_ENTRY(stg_sel_ret_11_noupd_ret); +RTS_ENTRY(stg_sel_ret_12_noupd_ret); +RTS_ENTRY(stg_sel_ret_13_noupd_ret); +RTS_ENTRY(stg_sel_ret_14_noupd_ret); +RTS_ENTRY(stg_sel_ret_15_noupd_ret); + +RTS_INFO(stg_sel_0_noupd_info); +RTS_INFO(stg_sel_1_noupd_info); +RTS_INFO(stg_sel_2_noupd_info); +RTS_INFO(stg_sel_3_noupd_info); +RTS_INFO(stg_sel_4_noupd_info); +RTS_INFO(stg_sel_5_noupd_info); +RTS_INFO(stg_sel_6_noupd_info); +RTS_INFO(stg_sel_7_noupd_info); +RTS_INFO(stg_sel_8_noupd_info); +RTS_INFO(stg_sel_9_noupd_info); +RTS_INFO(stg_sel_10_noupd_info); +RTS_INFO(stg_sel_11_noupd_info); +RTS_INFO(stg_sel_12_noupd_info); +RTS_INFO(stg_sel_13_noupd_info); +RTS_INFO(stg_sel_14_noupd_info); +RTS_INFO(stg_sel_15_noupd_info); + +RTS_ENTRY(stg_sel_0_noupd_entry); +RTS_ENTRY(stg_sel_1_noupd_entry); +RTS_ENTRY(stg_sel_2_noupd_entry); +RTS_ENTRY(stg_sel_3_noupd_entry); +RTS_ENTRY(stg_sel_4_noupd_entry); +RTS_ENTRY(stg_sel_5_noupd_entry); +RTS_ENTRY(stg_sel_6_noupd_entry); +RTS_ENTRY(stg_sel_7_noupd_entry); +RTS_ENTRY(stg_sel_8_noupd_entry); +RTS_ENTRY(stg_sel_9_noupd_entry); +RTS_ENTRY(stg_sel_10_noupd_entry); +RTS_ENTRY(stg_sel_11_noupd_entry); +RTS_ENTRY(stg_sel_12_noupd_entry); +RTS_ENTRY(stg_sel_13_noupd_entry); +RTS_ENTRY(stg_sel_14_noupd_entry); +RTS_ENTRY(stg_sel_15_noupd_entry); + +/* standard ap thunks */ + +RTS_THUNK_INFO(stg_ap_1_upd_info); +RTS_THUNK_INFO(stg_ap_2_upd_info); +RTS_THUNK_INFO(stg_ap_3_upd_info); +RTS_THUNK_INFO(stg_ap_4_upd_info); +RTS_THUNK_INFO(stg_ap_5_upd_info); +RTS_THUNK_INFO(stg_ap_6_upd_info); +RTS_THUNK_INFO(stg_ap_7_upd_info); + +RTS_ENTRY(stg_ap_1_upd_entry); +RTS_ENTRY(stg_ap_2_upd_entry); +RTS_ENTRY(stg_ap_3_upd_entry); +RTS_ENTRY(stg_ap_4_upd_entry); +RTS_ENTRY(stg_ap_5_upd_entry); +RTS_ENTRY(stg_ap_6_upd_entry); +RTS_ENTRY(stg_ap_7_upd_entry); + +/* standard application routines (see also rts/gen_apply.py, + * and compiler/codeGen/CgStackery.lhs). + */ +RTS_RET_INFO(stg_ap_v_info); +RTS_RET_INFO(stg_ap_f_info); +RTS_RET_INFO(stg_ap_d_info); +RTS_RET_INFO(stg_ap_l_info); +RTS_RET_INFO(stg_ap_n_info); +RTS_RET_INFO(stg_ap_p_info); +RTS_RET_INFO(stg_ap_pv_info); +RTS_RET_INFO(stg_ap_pp_info); +RTS_RET_INFO(stg_ap_ppv_info); +RTS_RET_INFO(stg_ap_ppp_info); +RTS_RET_INFO(stg_ap_pppv_info); +RTS_RET_INFO(stg_ap_pppp_info); +RTS_RET_INFO(stg_ap_ppppp_info); +RTS_RET_INFO(stg_ap_pppppp_info); + +RTS_ENTRY(stg_ap_v_ret); +RTS_ENTRY(stg_ap_f_ret); +RTS_ENTRY(stg_ap_d_ret); +RTS_ENTRY(stg_ap_l_ret); +RTS_ENTRY(stg_ap_n_ret); +RTS_ENTRY(stg_ap_p_ret); +RTS_ENTRY(stg_ap_pv_ret); +RTS_ENTRY(stg_ap_pp_ret); +RTS_ENTRY(stg_ap_ppv_ret); +RTS_ENTRY(stg_ap_ppp_ret); +RTS_ENTRY(stg_ap_pppv_ret); +RTS_ENTRY(stg_ap_pppp_ret); +RTS_ENTRY(stg_ap_ppppp_ret); +RTS_ENTRY(stg_ap_pppppp_ret); + +RTS_FUN(stg_ap_0_fast); +RTS_FUN(stg_ap_v_fast); +RTS_FUN(stg_ap_f_fast); +RTS_FUN(stg_ap_d_fast); +RTS_FUN(stg_ap_l_fast); +RTS_FUN(stg_ap_n_fast); +RTS_FUN(stg_ap_p_fast); +RTS_FUN(stg_ap_pv_fast); +RTS_FUN(stg_ap_pp_fast); +RTS_FUN(stg_ap_ppv_fast); +RTS_FUN(stg_ap_ppp_fast); +RTS_FUN(stg_ap_pppv_fast); +RTS_FUN(stg_ap_pppp_fast); +RTS_FUN(stg_ap_ppppp_fast); +RTS_FUN(stg_ap_pppppp_fast); +RTS_FUN(stg_PAP_apply); + +/* standard GC & stack check entry points, all defined in HeapStackCheck.hc */ + +RTS_RET_INFO(stg_enter_info); +RTS_ENTRY(stg_enter_ret); + +RTS_RET_INFO(stg_gc_void_info); +RTS_ENTRY(stg_gc_void_ret); + +RTS_FUN(__stg_gc_enter_1); + +RTS_FUN(stg_gc_noregs); + +RTS_RET_INFO(stg_gc_unpt_r1_info); +RTS_ENTRY(stg_gc_unpt_r1_ret); +RTS_FUN(stg_gc_unpt_r1); + +RTS_RET_INFO(stg_gc_unbx_r1_info); +RTS_ENTRY(stg_gc_unbx_r1_ret); +RTS_FUN(stg_gc_unbx_r1); + +RTS_RET_INFO(stg_gc_f1_info); +RTS_ENTRY(stg_gc_f1_ret); +RTS_FUN(stg_gc_f1); + +RTS_RET_INFO(stg_gc_d1_info); +RTS_ENTRY(stg_gc_d1_ret); +RTS_FUN(stg_gc_d1); + +RTS_RET_INFO(stg_gc_l1_info); +RTS_ENTRY(stg_gc_l1_ret); +RTS_FUN(stg_gc_l1); + +RTS_FUN(__stg_gc_fun); +RTS_RET_INFO(stg_gc_fun_info); +RTS_ENTRY(stg_gc_fun_ret); + +RTS_RET_INFO(stg_gc_gen_info); +RTS_ENTRY(stg_gc_gen_ret); +RTS_FUN(stg_gc_gen); + +RTS_ENTRY(stg_ut_1_0_unreg_ret); +RTS_RET_INFO(stg_ut_1_0_unreg_info); + +RTS_FUN(stg_gc_gen_hp); +RTS_FUN(stg_gc_ut); +RTS_FUN(stg_gen_yield); +RTS_FUN(stg_yield_noregs); +RTS_FUN(stg_yield_to_interpreter); +RTS_FUN(stg_gen_block); +RTS_FUN(stg_block_noregs); +RTS_FUN(stg_block_1); +RTS_FUN(stg_block_blackhole); +RTS_FUN(stg_block_blackhole_finally); +RTS_FUN(stg_block_takemvar); +RTS_ENTRY(stg_block_takemvar_ret); +RTS_FUN(stg_block_putmvar); +RTS_ENTRY(stg_block_putmvar_ret); +#ifdef mingw32_HOST_OS +RTS_FUN(stg_block_async); +RTS_ENTRY(stg_block_async_ret); +RTS_FUN(stg_block_async_void); +RTS_ENTRY(stg_block_async_void_ret); +#endif +RTS_FUN(stg_block_stmwait); + +/* Entry/exit points from StgStartup.cmm */ + +RTS_RET_INFO(stg_stop_thread_info); +RTS_ENTRY(stg_stop_thread_ret); + +RTS_FUN(stg_returnToStackTop); +RTS_FUN(stg_returnToSched); +RTS_FUN(stg_returnToSchedNotPaused); +RTS_FUN(stg_returnToSchedButFirst); + +RTS_FUN(stg_init_finish); +RTS_FUN(stg_init); + +/* ----------------------------------------------------------------------------- + PrimOps + -------------------------------------------------------------------------- */ + +RTS_FUN(plusIntegerzh_fast); +RTS_FUN(minusIntegerzh_fast); +RTS_FUN(timesIntegerzh_fast); +RTS_FUN(gcdIntegerzh_fast); +RTS_FUN(quotRemIntegerzh_fast); +RTS_FUN(quotIntegerzh_fast); +RTS_FUN(remIntegerzh_fast); +RTS_FUN(divExactIntegerzh_fast); +RTS_FUN(divModIntegerzh_fast); + +RTS_FUN(cmpIntegerIntzh_fast); +RTS_FUN(cmpIntegerzh_fast); +RTS_FUN(integer2Intzh_fast); +RTS_FUN(integer2Wordzh_fast); +RTS_FUN(gcdIntegerIntzh_fast); +RTS_FUN(gcdIntzh_fast); + +RTS_FUN(int2Integerzh_fast); +RTS_FUN(word2Integerzh_fast); + +RTS_FUN(decodeFloatzh_fast); +RTS_FUN(decodeDoublezh_fast); + +RTS_FUN(andIntegerzh_fast); +RTS_FUN(orIntegerzh_fast); +RTS_FUN(xorIntegerzh_fast); +RTS_FUN(complementIntegerzh_fast); + +#ifdef SUPPORT_LONG_LONGS + +RTS_FUN(int64ToIntegerzh_fast); +RTS_FUN(word64ToIntegerzh_fast); + +#endif + +RTS_FUN(unsafeThawArrayzh_fast); +RTS_FUN(newByteArrayzh_fast); +RTS_FUN(newPinnedByteArrayzh_fast); +RTS_FUN(newArrayzh_fast); + +RTS_FUN(decodeFloatzh_fast); +RTS_FUN(decodeDoublezh_fast); + +RTS_FUN(newMutVarzh_fast); +RTS_FUN(atomicModifyMutVarzh_fast); + +RTS_FUN(isEmptyMVarzh_fast); +RTS_FUN(newMVarzh_fast); +RTS_FUN(takeMVarzh_fast); +RTS_FUN(putMVarzh_fast); +RTS_FUN(tryTakeMVarzh_fast); +RTS_FUN(tryPutMVarzh_fast); + +RTS_FUN(waitReadzh_fast); +RTS_FUN(waitWritezh_fast); +RTS_FUN(delayzh_fast); +#ifdef mingw32_HOST_OS +RTS_FUN(asyncReadzh_fast); +RTS_FUN(asyncWritezh_fast); +RTS_FUN(asyncDoProczh_fast); +#endif + +RTS_FUN(catchzh_fast); +RTS_FUN(raisezh_fast); +RTS_FUN(raiseIOzh_fast); + +RTS_FUN(makeStableNamezh_fast); +RTS_FUN(makeStablePtrzh_fast); +RTS_FUN(deRefStablePtrzh_fast); + +RTS_FUN(forkzh_fast); +RTS_FUN(forkOnzh_fast); +RTS_FUN(yieldzh_fast); +RTS_FUN(killThreadzh_fast); +RTS_FUN(blockAsyncExceptionszh_fast); +RTS_FUN(unblockAsyncExceptionszh_fast); +RTS_FUN(myThreadIdzh_fast); +RTS_FUN(labelThreadzh_fast); +RTS_FUN(isCurrentThreadBoundzh_fast); + +RTS_FUN(mkWeakzh_fast); +RTS_FUN(finalizzeWeakzh_fast); +RTS_FUN(deRefWeakzh_fast); + +RTS_FUN(newBCOzh_fast); +RTS_FUN(mkApUpd0zh_fast); + +RTS_FUN(retryzh_fast); +RTS_FUN(catchRetryzh_fast); +RTS_FUN(catchSTMzh_fast); +RTS_FUN(atomicallyzh_fast); +RTS_FUN(newTVarzh_fast); +RTS_FUN(readTVarzh_fast); +RTS_FUN(writeTVarzh_fast); + +#endif /* STGMISCCLOSURES_H */ diff --git a/includes/StgProf.h b/includes/StgProf.h new file mode 100644 index 0000000000..9b3ce69a9f --- /dev/null +++ b/includes/StgProf.h @@ -0,0 +1,238 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2004 + * + * Macros for profiling operations in STG code + * + * ---------------------------------------------------------------------------*/ + +#ifndef STGPROF_H +#define STGPROF_H + +/* ----------------------------------------------------------------------------- + * Data Structures + * ---------------------------------------------------------------------------*/ +/* + * NB. be careful to avoid unwanted padding between fields, by + * putting the 8-byte fields on an 8-byte boundary. Padding can + * vary between C compilers, and we don't take into account any + * possible padding when generating CCS and CC decls in the code + * generator (compiler/codeGen/CgProf.hs). + */ + +typedef struct _CostCentre { + StgInt ccID; + + char * label; + char * module; + + /* used for accumulating costs at the end of the run... */ + StgWord time_ticks; + StgWord64 mem_alloc; /* align 8 (see above) */ + + StgInt is_caf; + + struct _CostCentre *link; +} CostCentre; + +typedef struct _CostCentreStack { + StgInt ccsID; + + CostCentre *cc; + struct _CostCentreStack *prevStack; + struct _IndexTable *indexTable; + + StgWord64 scc_count; /* align 8 (see above) */ + StgWord selected; + StgWord time_ticks; + StgWord64 mem_alloc; /* align 8 (see above) */ + StgWord64 inherited_alloc; /* align 8 (see above) */ + StgWord inherited_ticks; + + CostCentre *root; +} CostCentreStack; + + +/* ----------------------------------------------------------------------------- + * The rest is PROFILING only... + * ---------------------------------------------------------------------------*/ + +#if defined(PROFILING) + +/* ----------------------------------------------------------------------------- + * Constants + * ---------------------------------------------------------------------------*/ + +#define EMPTY_STACK NULL +#define EMPTY_TABLE NULL + +/* Constants used to set sumbsumed flag on CostCentres */ + +#define CC_IS_CAF 'c' /* 'c' => *is* a CAF cc */ +#define CC_IS_BORING 'B' /* 'B' => *not* a CAF/sub cc */ + + +/* ----------------------------------------------------------------------------- + * Data Structures + * ---------------------------------------------------------------------------*/ + +typedef struct _IndexTable { + CostCentre *cc; + CostCentreStack *ccs; + struct _IndexTable *next; + unsigned int back_edge; +} IndexTable; + + +/* ----------------------------------------------------------------------------- + Pre-defined cost centres and cost centre stacks + -------------------------------------------------------------------------- */ + +extern CostCentreStack * RTS_VAR(CCCS); /* current CCS */ + +#if IN_STG_CODE + +extern StgWord CC_MAIN[]; +extern StgWord CCS_MAIN[]; /* Top CCS */ + +extern StgWord CC_SYSTEM[]; +extern StgWord CCS_SYSTEM[]; /* RTS costs */ + +extern StgWord CC_GC[]; +extern StgWord CCS_GC[]; /* Garbage collector costs */ + +extern StgWord CC_SUBSUMED[]; +extern StgWord CCS_SUBSUMED[]; /* Costs are subsumed by caller */ + +extern StgWord CC_OVERHEAD[]; +extern StgWord CCS_OVERHEAD[]; /* Profiling overhead */ + +extern StgWord CC_DONT_CARE[]; +extern StgWord CCS_DONT_CARE[]; /* shouldn't ever get set */ + +#else + +extern CostCentre CC_MAIN[]; +extern CostCentreStack CCS_MAIN[]; /* Top CCS */ + +extern CostCentre CC_SYSTEM[]; +extern CostCentreStack CCS_SYSTEM[]; /* RTS costs */ + +extern CostCentre CC_GC[]; +extern CostCentreStack CCS_GC[]; /* Garbage collector costs */ + +extern CostCentre CC_SUBSUMED[]; +extern CostCentreStack CCS_SUBSUMED[]; /* Costs are subsumed by caller */ + +extern CostCentre CC_OVERHEAD[]; +extern CostCentreStack CCS_OVERHEAD[]; /* Profiling overhead */ + +extern CostCentre CC_DONT_CARE[]; +extern CostCentreStack CCS_DONT_CARE[]; /* shouldn't ever get set */ + +#endif /* IN_STG_CODE */ + +extern unsigned int RTS_VAR(CC_ID); /* global ids */ +extern unsigned int RTS_VAR(CCS_ID); +extern unsigned int RTS_VAR(HP_ID); + +extern unsigned int RTS_VAR(era); + +/* ----------------------------------------------------------------------------- + * Functions + * ---------------------------------------------------------------------------*/ + +void EnterFunCCS ( CostCentreStack *ccsfn ); +CostCentreStack *PushCostCentre ( CostCentreStack *, CostCentre * ); +CostCentreStack *AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 ); + +extern unsigned int RTS_VAR(entering_PAP); + +/* ----------------------------------------------------------------------------- + * Registering CCs + + Cost centres are registered at startup by calling a registering + routine in each module. Each module registers its cost centres and + calls the registering routine for all imported modules. The RTS calls + the registering routine for the module Main. This registering must be + done before initialisation since the evaluation required for + initialisation may use the cost centres. + + As the code for each module uses tail calls we use an auxiliary stack + (in the heap) to record imported modules still to be registered. At + the bottom of the stack is NULL which indicates that + @miniInterpretEnd@ should be resumed. + + @START_REGISTER@ and @END_REGISTER@ are special macros used to + delimit the function. @END_REGISTER@ pops the next registering + routine off the stack and jumps to it. @REGISTER_CC@ registers a cost + centre. @REGISTER_IMPORT@ pushes a modules registering routine onto + the register stack. + + -------------------------------------------------------------------------- */ + +extern CostCentre * RTS_VAR(CC_LIST); /* registered CC list */ +extern CostCentreStack * RTS_VAR(CCS_LIST); /* registered CCS list */ + +#define REGISTER_CC(cc) \ + do { \ + extern CostCentre cc[]; \ + if ((cc)->link == (CostCentre *)0) { \ + (cc)->link = CC_LIST; \ + CC_LIST = (cc); \ + (cc)->ccID = CC_ID++; \ + }} while(0) + +#define REGISTER_CCS(ccs) \ + do { \ + extern CostCentreStack ccs[]; \ + if ((ccs)->prevStack == (CostCentreStack *)0) { \ + (ccs)->prevStack = CCS_LIST; \ + CCS_LIST = (ccs); \ + (ccs)->ccsID = CCS_ID++; \ + }} while(0) + +/* ----------------------------------------------------------------------------- + * Declaring Cost Centres & Cost Centre Stacks. + * -------------------------------------------------------------------------- */ + +# define CC_DECLARE(cc_ident,name,module,caf,is_local) \ + is_local CostCentre cc_ident[1] \ + = {{ 0, \ + name, \ + module, \ + 0, \ + 0, \ + caf, \ + 0 }}; + +# define CCS_DECLARE(ccs_ident,cc_ident,is_local) \ + is_local CostCentreStack ccs_ident[1] \ + = {{ ccsID : 0, \ + cc : cc_ident, \ + prevStack : NULL, \ + indexTable : NULL, \ + selected : 0, \ + scc_count : 0, \ + time_ticks : 0, \ + mem_alloc : 0, \ + inherited_ticks : 0, \ + inherited_alloc : 0, \ + root : 0, \ + }}; + +/* ----------------------------------------------------------------------------- + * Time / Allocation Macros + * ---------------------------------------------------------------------------*/ + +/* eliminate profiling overhead from allocation costs */ +#define CCS_ALLOC(ccs, size) (ccs)->mem_alloc += ((size)-sizeofW(StgProfHeader)) + +#else /* !PROFILING */ + +#define CCS_ALLOC(ccs, amount) doNothing() + +#endif /* PROFILING */ + +#endif /* STGPROF_H */ + diff --git a/includes/StgTicky.h b/includes/StgTicky.h new file mode 100644 index 0000000000..27dd24edd9 --- /dev/null +++ b/includes/StgTicky.h @@ -0,0 +1,771 @@ +/* ---------------------------------------------------------------------------- + * + * (c) The AQUA project, Glasgow University, 1994-1997 + * (c) The GHC Team, 1998-1999 + * + * Ticky-ticky profiling macros. + * + * -------------------------------------------------------------------------- */ + +#ifndef TICKY_H +#define TICKY_H + +/* ----------------------------------------------------------------------------- + The StgEntCounter type - needed regardless of TICKY_TICKY + -------------------------------------------------------------------------- */ + +typedef struct _StgEntCounter { + StgWord16 registeredp; /* 0 == no, 1 == yes */ + StgWord16 arity; /* arity (static info) */ + StgWord16 stk_args; /* # of args off stack */ + /* (rest of args are in registers) */ + char *str; /* name of the thing */ + char *arg_kinds; /* info about the args types */ + StgInt entry_count; /* Trips to fast entry code */ + StgInt allocs; /* number of allocations by this fun */ + struct _StgEntCounter *link;/* link to chain them all together */ +} StgEntCounter; + + +#ifdef TICKY_TICKY + +/* ----------------------------------------------------------------------------- + Allocations + -------------------------------------------------------------------------- */ + +/* How many times we do a heap check and move Hp; comparing this with + * the allocations gives an indication of how many things we get per trip + * to the well: + */ +#define TICK_ALLOC_HEAP(n, f_ct) \ + { \ + f_ct.allocs += (n); \ + ALLOC_HEAP_ctr++; \ + ALLOC_HEAP_tot += (n); \ + } + +#define TICK_ALLOC_HEAP_NOCTR(n) \ + { \ + ALLOC_HEAP_ctr++; \ + ALLOC_HEAP_tot += (n); \ + } + +/* We count things every time we allocate something in the dynamic heap. + * For each, we count the number of words of (1) ``admin'' (header), + * (2) good stuff (useful pointers and data), and (3) ``slop'' (extra + * space, to leave room for an old generation indirection for example). + * + * The first five macros are inserted when the compiler generates code + * to allocate something; the categories correspond to the @ClosureClass@ + * datatype (manifest functions, thunks, constructors, big tuples, and + * partial applications). + */ + +#define _HS sizeofW(StgHeader) + +#define TICK_ALLOC_FUN(g,s) \ + ALLOC_FUN_ctr++; ALLOC_FUN_adm += _HS; \ + ALLOC_FUN_gds += (g); ALLOC_FUN_slp += (s); \ + TICK_ALLOC_HISTO(FUN,_HS,g,s) + +#define TICK_ALLOC_UP_THK(g,s) \ + ALLOC_UP_THK_ctr++; ALLOC_THK_adm += _HS; \ + ALLOC_THK_gds += (g); ALLOC_THK_slp += (s); \ + TICK_ALLOC_HISTO(THK,_HS,g,s) + +#define TICK_ALLOC_SE_THK(g,s) \ + ALLOC_SE_THK_ctr++; ALLOC_THK_adm += _HS; \ + ALLOC_THK_gds += (g); ALLOC_THK_slp += (s); \ + TICK_ALLOC_HISTO(THK,_HS,g,s) + +#define TICK_ALLOC_CON(g,s) \ + ALLOC_CON_ctr++; ALLOC_CON_adm += _HS; \ + ALLOC_CON_gds += (g); ALLOC_CON_slp += (s); \ + TICK_ALLOC_HISTO(CON,_HS,g,s) + +#define TICK_ALLOC_TUP(g,s) \ + ALLOC_TUP_ctr++; ALLOC_TUP_adm += _HS; \ + ALLOC_TUP_gds += (g); ALLOC_TUP_slp += (s); \ + TICK_ALLOC_HISTO(TUP,_HS,g,s) + +#define TICK_ALLOC_BH(g,s) \ + ALLOC_BH_ctr++; ALLOC_BH_adm += _HS; \ + ALLOC_BH_gds += (g); ALLOC_BH_slp += (s); \ + TICK_ALLOC_HISTO(BH,_HS,g,s) + +/* + * admin size doesn't take into account the FUN, that is accounted for + * in the "goods". + */ +#define TICK_ALLOC_PAP(g,s) \ + ALLOC_PAP_ctr++; ALLOC_PAP_adm += sizeofW(StgPAP)-1; \ + ALLOC_PAP_gds += (g); ALLOC_PAP_slp += (s); \ + TICK_ALLOC_HISTO(PAP,sizeofW(StgPAP)-1,g,s) + +#define TICK_ALLOC_TSO(g,s) \ + ALLOC_TSO_ctr++; ALLOC_TSO_adm += sizeofW(StgTSO); \ + ALLOC_TSO_gds += (g); ALLOC_TSO_slp += (s); \ + TICK_ALLOC_HISTO(TSO,sizeofW(StgTSO),g,s) + +#ifdef PAR +#define TICK_ALLOC_FMBQ(a,g,s) \ + ALLOC_FMBQ_ctr++; ALLOC_FMBQ_adm += (a); \ + ALLOC_FMBQ_gds += (g); ALLOC_FMBQ_slp += (s); \ + TICK_ALLOC_HISTO(FMBQ,a,g,s) + +#define TICK_ALLOC_FME(a,g,s) \ + ALLOC_FME_ctr++; ALLOC_FME_adm += (a); \ + ALLOC_FME_gds += (g); ALLOC_FME_slp += (s); \ + TICK_ALLOC_HISTO(FME,a,g,s) + +#define TICK_ALLOC_BF(a,g,s) \ + ALLOC_BF_ctr++; ALLOC_BF_adm += (a); \ + ALLOC_BF_gds += (g); ALLOC_BF_slp += (s); \ + TICK_ALLOC_HISTO(BF,a,g,s) +#endif + +/* The histogrammy bit is fairly straightforward; the -2 is: one for + * 0-origin C arrays; the other one because we do no one-word + * allocations, so we would never inc that histogram slot; so we shift + * everything over by one. + */ +#define TICK_ALLOC_HISTO(categ,a,g,s) \ + { I_ __idx; \ + __idx = (a) + (g) + (s) - 2; \ + ALLOC_##categ##_hst[((__idx > 4) ? 4 : __idx)] += 1;} + +/* Some hard-to-account-for words are allocated by/for primitives, + * includes Integer support. ALLOC_PRIM2 tells us about these. We + * count everything as ``goods'', which is not strictly correct. + * (ALLOC_PRIM is the same sort of stuff, but we know the + * admin/goods/slop breakdown.) + */ +#define TICK_ALLOC_PRIM(a,g,s) \ + ALLOC_PRIM_ctr++; ALLOC_PRIM_adm += (a); \ + ALLOC_PRIM_gds += (g); ALLOC_PRIM_slp += (s); \ + TICK_ALLOC_HISTO(PRIM,a,g,s) + +#define TICK_ALLOC_PRIM2(w) ALLOC_PRIM_ctr++; ALLOC_PRIM_gds +=(w); \ + TICK_ALLOC_HISTO(PRIM,0,w,0) + + +/* ----------------------------------------------------------------------------- + Enters + -------------------------------------------------------------------------- */ + +#define TICK_ENT_VIA_NODE() ENT_VIA_NODE_ctr++ + +#define TICK_ENT_STATIC_THK() ENT_STATIC_THK_ctr++ +#define TICK_ENT_DYN_THK() ENT_DYN_THK_ctr++ + +#define TICK_CTR(f_ct, str, arity, args, arg_kinds) \ + static StgEntCounter f_ct \ + = { 0, arity, args, \ + str, arg_kinds, \ + 0, 0, NULL }; + +#define TICK_ENT_FUN_DIRECT_BODY(f_ct) \ + { \ + if ( ! f_ct.registeredp ) { \ + /* hook this one onto the front of the list */ \ + f_ct.link = ticky_entry_ctrs; \ + ticky_entry_ctrs = & (f_ct); \ + /* mark it as "registered" */ \ + f_ct.registeredp = 1; \ + } \ + f_ct.entry_count += 1; \ + } + +#define TICK_ENT_STATIC_FUN_DIRECT(f_ct) \ + TICK_ENT_FUN_DIRECT_BODY(f_ct) \ + ENT_STATIC_FUN_DIRECT_ctr++ /* The static total one */ + +#define TICK_ENT_DYN_FUN_DIRECT(f_ct) \ + TICK_ENT_FUN_DIRECT_BODY(f_ct) \ + ENT_DYN_FUN_DIRECT_ctr++ /* The dynamic total one */ + +extern StgEntCounter top_ct; +extern StgEntCounter *ticky_entry_ctrs; + +#define TICK_ENT_STATIC_CON(n) ENT_STATIC_CON_ctr++ /* enter static constructor */ +#define TICK_ENT_DYN_CON(n) ENT_DYN_CON_ctr++ /* enter dynamic constructor */ +#define TICK_ENT_STATIC_IND(n) ENT_STATIC_IND_ctr++ /* enter static indirection */ +#define TICK_ENT_DYN_IND(n) ENT_DYN_IND_ctr++ /* enter dynamic indirection */ +#define TICK_ENT_PERM_IND(n) ENT_PERM_IND_ctr++ /* enter permanent indirection */ +#define TICK_ENT_PAP(n) ENT_PAP_ctr++ /* enter PAP */ +#define TICK_ENT_AP(n) ENT_AP_ctr++ /* enter AP_UPD */ +#define TICK_ENT_AP_STACK(n) ENT_AP_STACK_ctr++ /* enter AP_STACK_UPD */ +#define TICK_ENT_BH() ENT_BH_ctr++ /* enter BLACKHOLE */ + + +#define TICK_SLOW_HISTO(n) \ + { unsigned __idx; \ + __idx = (n); \ + SLOW_CALL_hst[((__idx > 8) ? 8 : __idx)] += 1; \ + } + +#define UNDO_TICK_SLOW_HISTO(n) \ + { unsigned __idx; \ + __idx = (n); \ + SLOW_CALL_hst[((__idx > 8) ? 8 : __idx)] -= 1; \ + } + +/* + * A slow call with n arguments. In the unevald case, this call has + * already been counted once, so don't count it again. + */ +#define TICK_SLOW_CALL(n) \ + SLOW_CALL_ctr++; \ + TICK_SLOW_HISTO(n) + +/* + * This slow call was found to be to an unevaluated function; undo the + * ticks we did in TICK_SLOW_CALL. + */ +#define TICK_SLOW_CALL_UNEVALD(n) \ + SLOW_CALL_UNEVALD_ctr++; \ + SLOW_CALL_ctr--; \ + UNDO_TICK_SLOW_HISTO(n) + +#define TICK_MULTI_CHUNK_SLOW_CALL(pattern, chunks) \ + fprintf(stderr, "Multi-chunk slow call: %s\n", pattern); \ + MULTI_CHUNK_SLOW_CALL_ctr++; \ + MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr += chunks; + +/* A completely unknown tail-call */ +#define TICK_UNKNOWN_CALL() UNKNOWN_CALL_ctr++ + +/* + * slow call patterns (includes "extra" args to known calls, + * so the total of these will be greater than UNKNOWN_CALL_ctr). + */ +#define TICK_SLOW_CALL_v() SLOW_CALL_v_ctr++ +#define TICK_SLOW_CALL_f() SLOW_CALL_f_ctr++ +#define TICK_SLOW_CALL_d() SLOW_CALL_d_ctr++ +#define TICK_SLOW_CALL_l() SLOW_CALL_l_ctr++ +#define TICK_SLOW_CALL_n() SLOW_CALL_n_ctr++ +#define TICK_SLOW_CALL_p() SLOW_CALL_p_ctr++ +#define TICK_SLOW_CALL_pv() SLOW_CALL_pv_ctr++ +#define TICK_SLOW_CALL_pp() SLOW_CALL_pp_ctr++ +#define TICK_SLOW_CALL_ppv() SLOW_CALL_ppv_ctr++ +#define TICK_SLOW_CALL_ppp() SLOW_CALL_ppp_ctr++ +#define TICK_SLOW_CALL_pppv() SLOW_CALL_pppv_ctr++ +#define TICK_SLOW_CALL_pppp() SLOW_CALL_pppp_ctr++ +#define TICK_SLOW_CALL_ppppp() SLOW_CALL_ppppp_ctr++ +#define TICK_SLOW_CALL_pppppp() SLOW_CALL_pppppp_ctr++ +#define TICK_SLOW_CALL_OTHER(pattern) \ + fprintf(stderr,"slow call: %s\n", pattern); \ + SLOW_CALL_OTHER_ctr++ + +#define TICK_KNOWN_CALL() KNOWN_CALL_ctr++ +#define TICK_KNOWN_CALL_TOO_FEW_ARGS() KNOWN_CALL_TOO_FEW_ARGS_ctr++ +#define TICK_KNOWN_CALL_EXTRA_ARGS() KNOWN_CALL_EXTRA_ARGS_ctr++ + +/* A slow call to a FUN found insufficient arguments, and built a PAP */ +#define TICK_SLOW_CALL_FUN_TOO_FEW() SLOW_CALL_FUN_TOO_FEW_ctr++ +#define TICK_SLOW_CALL_FUN_CORRECT() SLOW_CALL_FUN_CORRECT_ctr++ +#define TICK_SLOW_CALL_FUN_TOO_MANY() SLOW_CALL_FUN_TOO_MANY_ctr++ +#define TICK_SLOW_CALL_PAP_TOO_FEW() SLOW_CALL_PAP_TOO_FEW_ctr++ +#define TICK_SLOW_CALL_PAP_CORRECT() SLOW_CALL_PAP_CORRECT_ctr++ +#define TICK_SLOW_CALL_PAP_TOO_MANY() SLOW_CALL_PAP_TOO_MANY_ctr++ + +/* ----------------------------------------------------------------------------- + Returns + -------------------------------------------------------------------------- */ + +#define TICK_RET_HISTO(categ,n) \ + { I_ __idx; \ + __idx = (n); \ + RET_##categ##_hst[((__idx > 8) ? 8 : __idx)] += 1;} + +#define TICK_RET_NEW(n) RET_NEW_ctr++; \ + TICK_RET_HISTO(NEW,n) + +#define TICK_RET_OLD(n) RET_OLD_ctr++; \ + TICK_RET_HISTO(OLD,n) + +#define TICK_RET_UNBOXED_TUP(n) RET_UNBOXED_TUP_ctr++; \ + TICK_RET_HISTO(UNBOXED_TUP,n) + +#define TICK_VEC_RETURN(n) VEC_RETURN_ctr++; \ + TICK_RET_HISTO(VEC_RETURN,n) + +/* ----------------------------------------------------------------------------- + Stack Frames + + Macro Counts + ------------------ ------------------------------------------- + TICK_UPDF_PUSHED Update frame pushed + TICK_CATCHF_PUSHED Catch frame pushed + TICK_UPDF_OMITTED A thunk decided not to push an update frame + TICK_UPDF_RCC_PUSHED Cost Centre restore frame pushed + TICK_UPDF_RCC_OMITTED Cost Centres not required -- not pushed + + -------------------------------------------------------------------------- */ + +#define TICK_UPDF_OMITTED() UPDF_OMITTED_ctr++ +#define TICK_UPDF_PUSHED(tgt,inf) UPDF_PUSHED_ctr++ \ +/* ; fprintf(stderr,"UPDF_PUSHED:%p:%p\n",tgt,inf) */ +#define TICK_CATCHF_PUSHED() CATCHF_PUSHED_ctr++ +#define TICK_UPDF_RCC_PUSHED() UPDF_RCC_PUSHED_ctr++ +#define TICK_UPDF_RCC_OMITTED() UPDF_RCC_OMITTED_ctr++ + +/* ----------------------------------------------------------------------------- + Updates + + These macros record information when we do an update. We always + update either with a data constructor (CON) or a partial application + (PAP). + + + Macro Where + ----------------------- -------------------------------------------- + TICK_UPD_SQUEEZED Same as UPD_EXISTING but because + of stack-squeezing + + TICK_UPD_CON_IN_NEW Allocating a new CON + TICK_UPD_CON_IN_PLACE Updating with a PAP in place + TICK_UPD_PAP_IN_NEW Allocating a new PAP + TICK_UPD_PAP_IN_PLACE Updating with a PAP in place + + ToDo: the IN_PLACE versions are not relevant any more. + -------------------------------------------------------------------------- */ + +#define TICK_UPD_HISTO(categ,n) \ + { I_ __idx; \ + __idx = (n); \ + UPD_##categ##_hst[((__idx > 8) ? 8 : __idx)] += 1;} + +#define TICK_UPD_SQUEEZED() UPD_SQUEEZED_ctr++ + +#define TICK_UPD_CON_IN_NEW(n) UPD_CON_IN_NEW_ctr++ ; \ + TICK_UPD_HISTO(CON_IN_NEW,n) + +#define TICK_UPD_CON_IN_PLACE(n) UPD_CON_IN_PLACE_ctr++; \ + TICK_UPD_HISTO(CON_IN_PLACE,n) + +#define TICK_UPD_PAP_IN_NEW(n) UPD_PAP_IN_NEW_ctr++ ; \ + TICK_UPD_HISTO(PAP_IN_NEW,n) + +#define TICK_UPD_PAP_IN_PLACE() UPD_PAP_IN_PLACE_ctr++ + +/* For the generational collector: + */ +#define TICK_UPD_NEW_IND() UPD_NEW_IND_ctr++ +#define TICK_UPD_NEW_PERM_IND(tgt) UPD_NEW_PERM_IND_ctr++ \ +/* ; fprintf(stderr,"UPD_NEW_PERM:%p\n",tgt) */ +#define TICK_UPD_OLD_IND() UPD_OLD_IND_ctr++ +#define TICK_UPD_OLD_PERM_IND() UPD_OLD_PERM_IND_ctr++ + +/* Count blackholes: + */ +#define TICK_UPD_BH_UPDATABLE() UPD_BH_UPDATABLE_ctr++ +#define TICK_UPD_BH_SINGLE_ENTRY() UPD_BH_SINGLE_ENTRY_ctr++ +#define TICK_UPD_CAF_BH_UPDATABLE(s) \ + UPD_CAF_BH_UPDATABLE_ctr++ \ +/* ; fprintf(stderr,"TICK_UPD_CAF_BH_UPDATABLE(%s)\n",s) */ +#define TICK_UPD_CAF_BH_SINGLE_ENTRY(s) \ + UPD_CAF_BH_SINGLE_ENTRY_ctr++ \ +/* ; fprintf(stderr,"TICK_UPD_CAF_BH_SINGLE_ENTRY(%s)\n",s) */ + + +/* ----------------------------------------------------------------------------- + Garbage collection counters + -------------------------------------------------------------------------- */ + +/* Selectors: + * + * GC_SEL_ABANDONED: we could've done the selection, but we gave up + * (e.g., to avoid overflowing the C stack); GC_SEL_MINOR: did a + * selection in a minor GC; GC_SEL_MAJOR: ditto, but major GC. + */ +#define TICK_GC_SEL_ABANDONED() GC_SEL_ABANDONED_ctr++ +#define TICK_GC_SEL_MINOR() GC_SEL_MINOR_ctr++ +#define TICK_GC_SEL_MAJOR() GC_SEL_MAJOR_ctr++ + +/* Failed promotion: we wanted to promote an object early, but + * it had already been evacuated to (or resided in) a younger + * generation. + */ +#define TICK_GC_FAILED_PROMOTION() GC_FAILED_PROMOTION_ctr++ + +/* Bytes copied: this is a fairly good measure of GC cost and depends + * on all sorts of things like number of generations, aging, eager + * promotion, generation sizing policy etc. + */ +#define TICK_GC_WORDS_COPIED(n) GC_WORDS_COPIED_ctr+=(n) + +/* ----------------------------------------------------------------------------- + The accumulators (extern decls) + -------------------------------------------------------------------------- */ + +#ifdef TICKY_C +#define INIT(ializer) = ializer +#define EXTERN +#else +#define INIT(ializer) +#define EXTERN extern +#endif + +EXTERN unsigned long ALLOC_HEAP_ctr INIT(0); +EXTERN unsigned long ALLOC_HEAP_tot INIT(0); + +EXTERN unsigned long ALLOC_FUN_ctr INIT(0); +EXTERN unsigned long ALLOC_FUN_adm INIT(0); +EXTERN unsigned long ALLOC_FUN_gds INIT(0); +EXTERN unsigned long ALLOC_FUN_slp INIT(0); +EXTERN unsigned long ALLOC_FUN_hst[5] +#ifdef TICKY_C + = {0,0,0,0,0} /* urk, can't use INIT macro 'cause of the commas */ +#endif +; + +EXTERN unsigned long ALLOC_UP_THK_ctr INIT(0); +EXTERN unsigned long ALLOC_SE_THK_ctr INIT(0); +EXTERN unsigned long ALLOC_THK_adm INIT(0); +EXTERN unsigned long ALLOC_THK_gds INIT(0); +EXTERN unsigned long ALLOC_THK_slp INIT(0); +EXTERN unsigned long ALLOC_THK_hst[5] +#ifdef TICKY_C + = {0,0,0,0,0} +#endif +; + +EXTERN unsigned long ALLOC_CON_ctr INIT(0); +EXTERN unsigned long ALLOC_CON_adm INIT(0); +EXTERN unsigned long ALLOC_CON_gds INIT(0); +EXTERN unsigned long ALLOC_CON_slp INIT(0); +EXTERN unsigned long ALLOC_CON_hst[5] +#ifdef TICKY_C + = {0,0,0,0,0} +#endif +; + +EXTERN unsigned long ALLOC_TUP_ctr INIT(0); +EXTERN unsigned long ALLOC_TUP_adm INIT(0); +EXTERN unsigned long ALLOC_TUP_gds INIT(0); +EXTERN unsigned long ALLOC_TUP_slp INIT(0); +EXTERN unsigned long ALLOC_TUP_hst[5] +#ifdef TICKY_C + = {0,0,0,0,0} +#endif +; + +EXTERN unsigned long ALLOC_BH_ctr INIT(0); +EXTERN unsigned long ALLOC_BH_adm INIT(0); +EXTERN unsigned long ALLOC_BH_gds INIT(0); +EXTERN unsigned long ALLOC_BH_slp INIT(0); +EXTERN unsigned long ALLOC_BH_hst[5] +#ifdef TICKY_C + = {0,0,0,0,0} +#endif +; + +EXTERN unsigned long ALLOC_PRIM_ctr INIT(0); +EXTERN unsigned long ALLOC_PRIM_adm INIT(0); +EXTERN unsigned long ALLOC_PRIM_gds INIT(0); +EXTERN unsigned long ALLOC_PRIM_slp INIT(0); +EXTERN unsigned long ALLOC_PRIM_hst[5] +#ifdef TICKY_C + = {0,0,0,0,0} +#endif +; + +EXTERN unsigned long ALLOC_PAP_ctr INIT(0); +EXTERN unsigned long ALLOC_PAP_adm INIT(0); +EXTERN unsigned long ALLOC_PAP_gds INIT(0); +EXTERN unsigned long ALLOC_PAP_slp INIT(0); +EXTERN unsigned long ALLOC_PAP_hst[5] +#ifdef TICKY_C + = {0,0,0,0,0} +#endif +; + +EXTERN unsigned long ALLOC_TSO_ctr INIT(0); +EXTERN unsigned long ALLOC_TSO_adm INIT(0); +EXTERN unsigned long ALLOC_TSO_gds INIT(0); +EXTERN unsigned long ALLOC_TSO_slp INIT(0); +EXTERN unsigned long ALLOC_TSO_hst[5] +#ifdef TICKY_C + = {0,0,0,0,0} +#endif +; + +# ifdef PAR +EXTERN unsigned long ALLOC_FMBQ_ctr INIT(0); +EXTERN unsigned long ALLOC_FMBQ_adm INIT(0); +EXTERN unsigned long ALLOC_FMBQ_gds INIT(0); +EXTERN unsigned long ALLOC_FMBQ_slp INIT(0); +EXTERN unsigned long ALLOC_FMBQ_hst[5] +#ifdef TICKY_C + = {0,0,0,0,0} +#endif +; + +EXTERN unsigned long ALLOC_FME_ctr INIT(0); +EXTERN unsigned long ALLOC_FME_adm INIT(0); +EXTERN unsigned long ALLOC_FME_gds INIT(0); +EXTERN unsigned long ALLOC_FME_slp INIT(0); +EXTERN unsigned long ALLOC_FME_hst[5] +#ifdef TICKY_C + = {0,0,0,0,0} +#endif +; + +EXTERN unsigned long ALLOC_BF_ctr INIT(0); +EXTERN unsigned long ALLOC_BF_adm INIT(0); +EXTERN unsigned long ALLOC_BF_gds INIT(0); +EXTERN unsigned long ALLOC_BF_slp INIT(0); +EXTERN unsigned long ALLOC_BF_hst[5] +#ifdef TICKY_C + = {0,0,0,0,0} +#endif +; +#endif /* PAR */ + +EXTERN unsigned long ENT_VIA_NODE_ctr INIT(0); +EXTERN unsigned long ENT_STATIC_THK_ctr INIT(0); +EXTERN unsigned long ENT_DYN_THK_ctr INIT(0); +EXTERN unsigned long ENT_STATIC_FUN_DIRECT_ctr INIT(0); +EXTERN unsigned long ENT_DYN_FUN_DIRECT_ctr INIT(0); +EXTERN unsigned long ENT_STATIC_CON_ctr INIT(0); +EXTERN unsigned long ENT_DYN_CON_ctr INIT(0); +EXTERN unsigned long ENT_STATIC_IND_ctr INIT(0); +EXTERN unsigned long ENT_DYN_IND_ctr INIT(0); +EXTERN unsigned long ENT_PERM_IND_ctr INIT(0); +EXTERN unsigned long ENT_PAP_ctr INIT(0); +EXTERN unsigned long ENT_AP_ctr INIT(0); +EXTERN unsigned long ENT_AP_STACK_ctr INIT(0); +EXTERN unsigned long ENT_BH_ctr INIT(0); + +EXTERN unsigned long UNKNOWN_CALL_ctr INIT(0); + +EXTERN unsigned long SLOW_CALL_v_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_f_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_d_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_l_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_n_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_p_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_pv_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_pp_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_ppv_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_ppp_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_pppv_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_pppp_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_ppppp_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_pppppp_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_OTHER_ctr INIT(0); + +EXTERN unsigned long ticky_slow_call_unevald INIT(0); +EXTERN unsigned long SLOW_CALL_ctr INIT(0); +EXTERN unsigned long MULTI_CHUNK_SLOW_CALL_ctr INIT(0); +EXTERN unsigned long MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr INIT(0); +EXTERN unsigned long KNOWN_CALL_ctr INIT(0); +EXTERN unsigned long KNOWN_CALL_TOO_FEW_ARGS_ctr INIT(0); +EXTERN unsigned long KNOWN_CALL_EXTRA_ARGS_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_FUN_TOO_FEW_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_FUN_CORRECT_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_FUN_TOO_MANY_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_PAP_TOO_FEW_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_PAP_CORRECT_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_PAP_TOO_MANY_ctr INIT(0); +EXTERN unsigned long SLOW_CALL_UNEVALD_ctr INIT(0); + +EXTERN unsigned long SLOW_CALL_hst[8] +#ifdef TICKY_C + = {0,0,0,0,0,0,0,0} +#endif +; + +EXTERN unsigned long RET_NEW_ctr INIT(0); +EXTERN unsigned long RET_OLD_ctr INIT(0); +EXTERN unsigned long RET_UNBOXED_TUP_ctr INIT(0); + +EXTERN unsigned long VEC_RETURN_ctr INIT(0); + +EXTERN unsigned long RET_NEW_hst[9] +#ifdef TICKY_C + = {0,0,0,0,0,0,0,0,0} +#endif +; +EXTERN unsigned long RET_OLD_hst[9] +#ifdef TICKY_C + = {0,0,0,0,0,0,0,0,0} +#endif +; +EXTERN unsigned long RET_UNBOXED_TUP_hst[9] +#ifdef TICKY_C + = {0,0,0,0,0,0,0,0,0} +#endif +; +EXTERN unsigned long RET_SEMI_IN_HEAP_hst[9] +#ifdef TICKY_C + = {0,0,0,0,0,0,0,0,0} +#endif +; +EXTERN unsigned long RET_VEC_RETURN_hst[9] +#ifdef TICKY_C + = {0,0,0,0,0,0,0,0,0} +#endif +; + +EXTERN unsigned long RET_SEMI_loads_avoided INIT(0); + +EXTERN unsigned long UPDF_OMITTED_ctr INIT(0); +EXTERN unsigned long UPDF_PUSHED_ctr INIT(0); +EXTERN unsigned long CATCHF_PUSHED_ctr INIT(0); +EXTERN unsigned long UPDF_RCC_PUSHED_ctr INIT(0); +EXTERN unsigned long UPDF_RCC_OMITTED_ctr INIT(0); + +EXTERN unsigned long UPD_SQUEEZED_ctr INIT(0); +EXTERN unsigned long UPD_CON_IN_NEW_ctr INIT(0); +EXTERN unsigned long UPD_CON_IN_PLACE_ctr INIT(0); +EXTERN unsigned long UPD_PAP_IN_NEW_ctr INIT(0); +EXTERN unsigned long UPD_PAP_IN_PLACE_ctr INIT(0); + +EXTERN unsigned long UPD_CON_IN_NEW_hst[9] +#ifdef TICKY_C + = {0,0,0,0,0,0,0,0,0} +#endif +; +EXTERN unsigned long UPD_CON_IN_PLACE_hst[9] +#ifdef TICKY_C + = {0,0,0,0,0,0,0,0,0} +#endif +; +EXTERN unsigned long UPD_PAP_IN_NEW_hst[9] +#ifdef TICKY_C + = {0,0,0,0,0,0,0,0,0} +#endif +; + +EXTERN unsigned long UPD_NEW_IND_ctr INIT(0); +EXTERN unsigned long UPD_NEW_PERM_IND_ctr INIT(0); +EXTERN unsigned long UPD_OLD_IND_ctr INIT(0); +EXTERN unsigned long UPD_OLD_PERM_IND_ctr INIT(0); + +EXTERN unsigned long UPD_BH_UPDATABLE_ctr INIT(0); +EXTERN unsigned long UPD_BH_SINGLE_ENTRY_ctr INIT(0); +EXTERN unsigned long UPD_CAF_BH_UPDATABLE_ctr INIT(0); +EXTERN unsigned long UPD_CAF_BH_SINGLE_ENTRY_ctr INIT(0); + +EXTERN unsigned long GC_SEL_ABANDONED_ctr INIT(0); +EXTERN unsigned long GC_SEL_MINOR_ctr INIT(0); +EXTERN unsigned long GC_SEL_MAJOR_ctr INIT(0); + +EXTERN unsigned long GC_FAILED_PROMOTION_ctr INIT(0); + +EXTERN unsigned long GC_WORDS_COPIED_ctr INIT(0); + +#undef INIT +#undef EXTERN + +/* ----------------------------------------------------------------------------- + Just stubs if no ticky-ticky profiling + -------------------------------------------------------------------------- */ + +#else /* !TICKY_TICKY */ + +#define TICK_ALLOC_HEAP(words, f_ct) +#define TICK_ALLOC_HEAP_NOCTR(words) + +#define TICK_ALLOC_FUN(g,s) +#define TICK_ALLOC_UP_THK(g,s) +#define TICK_ALLOC_SE_THK(g,s) +#define TICK_ALLOC_CON(g,s) +#define TICK_ALLOC_TUP(g,s) +#define TICK_ALLOC_BH(g,s) +#define TICK_ALLOC_PAP(g,s) +#define TICK_ALLOC_TSO(g,s) +#define TICK_ALLOC_FMBQ(a,g,s) +#define TICK_ALLOC_FME(a,g,s) +#define TICK_ALLOC_BF(a,g,s) +#define TICK_ALLOC_PRIM(a,g,s) +#define TICK_ALLOC_PRIM2(w) + +#define TICK_ENT_VIA_NODE() + +#define TICK_ENT_STATIC_THK() +#define TICK_ENT_DYN_THK() +#define TICK_ENT_STATIC_FUN_DIRECT(n) +#define TICK_ENT_DYN_FUN_DIRECT(n) +#define TICK_ENT_STATIC_CON(n) +#define TICK_ENT_DYN_CON(n) +#define TICK_ENT_STATIC_IND(n) +#define TICK_ENT_DYN_IND(n) +#define TICK_ENT_PERM_IND(n) +#define TICK_ENT_PAP(n) +#define TICK_ENT_AP(n) +#define TICK_ENT_AP_STACK(n) +#define TICK_ENT_BH() + +#define TICK_SLOW_CALL(n) +#define TICK_SLOW_CALL_UNEVALD(n) +#define TICK_SLOW_CALL_FUN_TOO_FEW() +#define TICK_SLOW_CALL_FUN_CORRECT() +#define TICK_SLOW_CALL_FUN_TOO_MANY() +#define TICK_SLOW_CALL_PAP_TOO_FEW() +#define TICK_SLOW_CALL_PAP_CORRECT() +#define TICK_SLOW_CALL_PAP_TOO_MANY() + +#define TICK_SLOW_CALL_v() +#define TICK_SLOW_CALL_f() +#define TICK_SLOW_CALL_d() +#define TICK_SLOW_CALL_l() +#define TICK_SLOW_CALL_n() +#define TICK_SLOW_CALL_p() +#define TICK_SLOW_CALL_pv() +#define TICK_SLOW_CALL_pp() +#define TICK_SLOW_CALL_ppv() +#define TICK_SLOW_CALL_ppp() +#define TICK_SLOW_CALL_pppv() +#define TICK_SLOW_CALL_pppp() +#define TICK_SLOW_CALL_ppppp() +#define TICK_SLOW_CALL_pppppp() +#define TICK_SLOW_CALL_OTHER(pattern) + +#define TICK_KNOWN_CALL() +#define TICK_KNOWN_CALL_TOO_FEW_ARGS() +#define TICK_KNOWN_CALL_EXTRA_ARGS() +#define TICK_UNKNOWN_CALL() + +#define TICK_RET_NEW(n) +#define TICK_RET_OLD(n) +#define TICK_RET_UNBOXED_TUP(n) +#define TICK_RET_SEMI(n) +#define TICK_RET_SEMI_BY_DEFAULT() +#define TICK_RET_SEMI_FAILED(tag) +#define TICK_VEC_RETURN(n) + +#define TICK_UPDF_OMITTED() +#define TICK_UPDF_PUSHED(tgt,inf) +#define TICK_CATCHF_PUSHED() +#define TICK_UPDF_RCC_PUSHED() +#define TICK_UPDF_RCC_OMITTED() + +#define TICK_UPD_SQUEEZED() +#define TICK_UPD_CON_IN_NEW(n) +#define TICK_UPD_CON_IN_PLACE(n) +#define TICK_UPD_PAP_IN_NEW(n) +#define TICK_UPD_PAP_IN_PLACE() + +#define TICK_UPD_NEW_IND() +#define TICK_UPD_NEW_PERM_IND(tgt) +#define TICK_UPD_OLD_IND() +#define TICK_UPD_OLD_PERM_IND() + +#define TICK_UPD_BH_UPDATABLE() +#define TICK_UPD_BH_SINGLE_ENTRY() +#define TICK_UPD_CAF_BH_UPDATABLE() +#define TICK_UPD_CAF_BH_SINGLE_ENTRY() + +#define TICK_GC_SEL_ABANDONED() +#define TICK_GC_SEL_MINOR() +#define TICK_GC_SEL_MAJOR() + +#define TICK_GC_FAILED_PROMOTION() +#define TICK_GC_WORDS_COPIED(n) + +#endif /* !TICKY_TICKY */ + +#endif /* TICKY_H */ diff --git a/includes/StgTypes.h b/includes/StgTypes.h new file mode 100644 index 0000000000..ac2f78e27c --- /dev/null +++ b/includes/StgTypes.h @@ -0,0 +1,152 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Various C datatypes used in the run-time system. This is the + * lowest-level include file, after ghcconfig.h and RtsConfig.h. + * + * This module should define types *only*, all beginning with "Stg". + * + * Specifically: + + StgInt8, 16, 32, 64 + StgWord8, 16, 32, 64 + StgChar, StgFloat, StgDouble + + ***** All the same size (i.e. sizeof(void *)): ***** + StgPtr Basic pointer type + StgWord Unit of heap allocation + StgInt Signed version of StgWord + StgAddr Generic address type + + StgBool, StgVoid, StgClosurePtr, StgPtr, StgOffset, + StgTSOPtr, StgForeignPtr, StgStackOffset, StgStackPtr, + StgCode, StgArray, StgByteArray, StgStablePtr, StgFunPtr, + StgUnion. + + * WARNING: Keep this file, MachDeps.h, and HsFFI.h in synch! + * + * NOTE: assumes #include "ghcconfig.h" + * + * Works with or without _POSIX_SOURCE. + * + * ---------------------------------------------------------------------------*/ + +#ifndef STGTYPES_H +#define STGTYPES_H + +/* + * 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; +typedef unsigned char StgWord8; + +typedef signed short StgInt16; +typedef unsigned short StgWord16; + +#if SIZEOF_UNSIGNED_INT == 4 +typedef signed int StgInt32; +typedef unsigned int StgWord32; +#else +#error GHC untested on this architecture: sizeof(unsigned int) != 4 +#endif + +#ifdef SUPPORT_LONG_LONGS +/* assume long long is 64 bits */ +# ifndef _MSC_VER +typedef signed long long int StgInt64; +typedef unsigned long long int StgWord64; +# else +typedef __int64 StgInt64; +typedef unsigned __int64 StgWord64; +# endif +#elif SIZEOF_LONG == 8 +typedef signed long StgInt64; +typedef unsigned long StgWord64; +#elif defined(__MSVC__) +typedef __int64 StgInt64; +typedef unsigned __int64 StgWord64; +#else +#error GHC untested on this architecture: sizeof(void *) < 8 and no long longs. +#endif + +/* + * Define the standard word size we'll use on this machine: make it + * big enough to hold a pointer. + */ + +#if SIZEOF_VOID_P == 8 +typedef StgInt64 StgInt; +typedef StgWord64 StgWord; +typedef StgInt32 StgHalfInt; +typedef StgWord32 StgHalfWord; +#else +#if SIZEOF_VOID_P == 4 +typedef StgInt32 StgInt; +typedef StgWord32 StgWord; +typedef StgInt16 StgHalfInt; +typedef StgWord16 StgHalfWord; +#else +#error GHC untested on this architecture: sizeof(void *) != 4 or 8 +#endif +#endif + +#define W_MASK (sizeof(W_)-1) + +typedef void* StgAddr; + +/* + * Other commonly-used STG datatypes. + */ + +typedef StgWord32 StgChar; +typedef int StgBool; + +typedef float StgFloat; +typedef double StgDouble; + +typedef void StgVoid; + +typedef struct StgClosure_ StgClosure; +typedef StgClosure* StgClosurePtr; +typedef StgWord* StgPtr; /* pointer into closure */ +typedef StgWord volatile* StgVolatilePtr; /* pointer to volatile word */ +typedef StgWord StgOffset; /* byte offset within closure */ + +typedef struct StgTSO_* StgTSOPtr; + +typedef void* StgForeignPtr; + +typedef StgInt StgStackOffset; /* offset in words! */ + +typedef StgWord* StgStackPtr; + +typedef StgWord8 StgCode; /* close enough */ + +typedef StgPtr* StgArray; /* the goods of an Array# */ +typedef char* StgByteArray; /* the goods of a ByteArray# */ + +typedef void* StgStablePtr; + +/* + 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 + + Note: Neither StgFunPtr not StgFun is quite right (that is, + StgFunPtr != StgFun*). So, the functions we define all have type + StgFun but we always have to cast them to StgFunPtr when we assign + them to something. + The only way round this would be to write a recursive type but + C only allows that if you're defining a struct or union. +*/ + +typedef void *(*(*StgFunPtr)(void))(void); +typedef StgFunPtr StgFun(void); + +#endif /* STGTYPES_H */ diff --git a/includes/Storage.h b/includes/Storage.h new file mode 100644 index 0000000000..3a6bb2fde1 --- /dev/null +++ b/includes/Storage.h @@ -0,0 +1,518 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * External Storage Manger Interface + * + * ---------------------------------------------------------------------------*/ + +#ifndef STORAGE_H +#define STORAGE_H + +#include <stddef.h> +#include "OSThreads.h" + +/* ----------------------------------------------------------------------------- + * Generational GC + * + * We support an arbitrary number of generations, with an arbitrary number + * of steps per generation. Notes (in no particular order): + * + * - all generations except the oldest should have two steps. This gives + * objects a decent chance to age before being promoted, and in + * particular will ensure that we don't end up with too many + * thunks being updated in older generations. + * + * - the oldest generation has one step. There's no point in aging + * objects in the oldest generation. + * + * - generation 0, step 0 (G0S0) is the allocation area. It is given + * a fixed set of blocks during initialisation, and these blocks + * are never freed. + * + * - during garbage collection, each step which is an evacuation + * destination (i.e. all steps except G0S0) is allocated a to-space. + * evacuated objects are allocated into the step's to-space until + * GC is finished, when the original step's contents may be freed + * and replaced by the to-space. + * + * - the mutable-list is per-generation (not per-step). G0 doesn't + * have one (since every garbage collection collects at least G0). + * + * - block descriptors contain pointers to both the step and the + * generation that the block belongs to, for convenience. + * + * - static objects are stored in per-generation lists. See GC.c for + * details of how we collect CAFs in the generational scheme. + * + * - large objects are per-step, and are promoted in the same way + * as small objects, except that we may allocate large objects into + * generation 1 initially. + * + * ------------------------------------------------------------------------- */ + +typedef struct step_ { + unsigned int no; /* step number */ + bdescr * blocks; /* blocks in this step */ + unsigned int n_blocks; /* number of blocks */ + struct step_ * to; /* destination step for live objects */ + struct generation_ * gen; /* generation this step belongs to */ + unsigned int gen_no; /* generation number (cached) */ + bdescr * large_objects; /* large objects (doubly linked) */ + unsigned int n_large_blocks; /* no. of blocks used by large objs */ + int is_compacted; /* compact this step? (old gen only) */ + + /* During GC, if we are collecting this step, blocks and n_blocks + * are copied into the following two fields. After GC, these blocks + * are freed. */ + bdescr * old_blocks; /* bdescr of first from-space block */ + unsigned int n_old_blocks; /* number of blocks in from-space */ + + /* temporary use during GC: */ + StgPtr hp; /* next free locn in to-space */ + StgPtr hpLim; /* end of current to-space block */ + bdescr * hp_bd; /* bdescr of current to-space block */ + StgPtr scavd_hp; /* ... same as above, but already */ + StgPtr scavd_hpLim; /* scavenged. */ + bdescr * scan_bd; /* block currently being scanned */ + StgPtr scan; /* scan pointer in current block */ + bdescr * new_large_objects; /* large objects collected so far */ + bdescr * scavenged_large_objects; /* live large objs after GC (d-link) */ + unsigned int n_scavenged_large_blocks;/* size of above */ + bdescr * bitmap; /* bitmap for compacting collection */ +} step; + +typedef struct generation_ { + unsigned int no; /* generation number */ + step * steps; /* steps */ + unsigned int n_steps; /* number of steps */ + unsigned int max_blocks; /* max blocks in step 0 */ + bdescr *mut_list; /* mut objects in this gen (not G0)*/ + + /* temporary use during GC: */ + bdescr *saved_mut_list; + + /* stats information */ + unsigned int collections; + unsigned int failed_promotions; +} generation; + +extern generation * RTS_VAR(generations); + +extern generation * RTS_VAR(g0); +extern step * RTS_VAR(g0s0); +extern generation * RTS_VAR(oldest_gen); + +/* ----------------------------------------------------------------------------- + Initialisation / De-initialisation + -------------------------------------------------------------------------- */ + +extern void initStorage(void); +extern void exitStorage(void); +extern void freeStorage(void); + +/* ----------------------------------------------------------------------------- + Generic allocation + + StgPtr allocate(nat n) Allocates a chunk of contiguous store + n words long, returning a pointer to + the first word. Always succeeds. + + StgPtr allocatePinned(nat n) Allocates a chunk of contiguous store + n words long, which is at a fixed + address (won't be moved by GC). + Returns a pointer to the first word. + Always succeeds. + + NOTE: the GC can't in general handle + pinned objects, so allocatePinned() + can only be used for ByteArrays at the + moment. + + Don't forget to TICK_ALLOC_XXX(...) + after calling allocate or + allocatePinned, for the + benefit of the ticky-ticky profiler. + + rtsBool doYouWantToGC(void) Returns True if the storage manager is + ready to perform a GC, False otherwise. + + lnat allocated_bytes(void) Returns the number of bytes allocated + via allocate() since the last GC. + Used in the reporting of statistics. + + THREADED_RTS: allocate and doYouWantToGC can be used from STG code, they are + surrounded by a mutex. + -------------------------------------------------------------------------- */ + +extern StgPtr allocate ( nat n ); +extern StgPtr allocateLocal ( Capability *cap, nat n ); +extern StgPtr allocatePinned ( nat n ); +extern lnat allocated_bytes ( void ); + +extern bdescr * RTS_VAR(small_alloc_list); +extern bdescr * RTS_VAR(large_alloc_list); +extern bdescr * RTS_VAR(pinned_object_block); + +extern StgPtr RTS_VAR(alloc_Hp); +extern StgPtr RTS_VAR(alloc_HpLim); + +extern nat RTS_VAR(alloc_blocks); +extern nat RTS_VAR(alloc_blocks_lim); + +INLINE_HEADER rtsBool +doYouWantToGC( void ) +{ + return (alloc_blocks >= alloc_blocks_lim); +} + +/* ----------------------------------------------------------------------------- + Performing Garbage Collection + + GarbageCollect(get_roots) Performs a garbage collection. + 'get_roots' is called to find all the + roots that the system knows about. + + StgClosure Called by get_roots on each root. + MarkRoot(StgClosure *p) Returns the new location of the root. + -------------------------------------------------------------------------- */ + +extern void GarbageCollect(void (*get_roots)(evac_fn),rtsBool force_major_gc); + +/* ----------------------------------------------------------------------------- + Generational garbage collection support + + recordMutable(StgPtr p) Informs the garbage collector that a + previously immutable object has + become (permanently) mutable. Used + by thawArray and similar. + + updateWithIndirection(p1,p2) Updates the object at p1 with an + indirection pointing to p2. This is + normally called for objects in an old + generation (>0) when they are updated. + + updateWithPermIndirection(p1,p2) As above but uses a permanent indir. + + -------------------------------------------------------------------------- */ + +/* + * Storage manager mutex + */ +#if defined(THREADED_RTS) +extern Mutex sm_mutex; +extern Mutex atomic_modify_mutvar_mutex; +#endif + +#if defined(THREADED_RTS) +#define ACQUIRE_SM_LOCK ACQUIRE_LOCK(&sm_mutex); +#define RELEASE_SM_LOCK RELEASE_LOCK(&sm_mutex); +#define ASSERT_SM_LOCK() ASSERT_LOCK_HELD(&sm_mutex); +#else +#define ACQUIRE_SM_LOCK +#define RELEASE_SM_LOCK +#define ASSERT_SM_LOCK() +#endif + +INLINE_HEADER void +recordMutableGen(StgClosure *p, generation *gen) +{ + bdescr *bd; + + bd = gen->mut_list; + if (bd->free >= bd->start + BLOCK_SIZE_W) { + bdescr *new_bd; + new_bd = allocBlock(); + new_bd->link = bd; + bd = new_bd; + gen->mut_list = bd; + } + *bd->free++ = (StgWord)p; + +} + +INLINE_HEADER void +recordMutableGenLock(StgClosure *p, generation *gen) +{ + ACQUIRE_SM_LOCK; + recordMutableGen(p,gen); + RELEASE_SM_LOCK; +} + +INLINE_HEADER void +recordMutable(StgClosure *p) +{ + bdescr *bd; + ASSERT(closure_MUTABLE(p)); + bd = Bdescr((P_)p); + if (bd->gen_no > 0) recordMutableGen(p, &RTS_DEREF(generations)[bd->gen_no]); +} + +INLINE_HEADER void +recordMutableLock(StgClosure *p) +{ + ACQUIRE_SM_LOCK; + recordMutable(p); + RELEASE_SM_LOCK; +} + +/* ----------------------------------------------------------------------------- + The CAF table - used to let us revert CAFs in GHCi + -------------------------------------------------------------------------- */ + +/* set to disable CAF garbage collection in GHCi. */ +/* (needed when dynamic libraries are used). */ +extern rtsBool keepCAFs; + +/* ----------------------------------------------------------------------------- + This is the write barrier for MUT_VARs, a.k.a. IORefs. A + MUT_VAR_CLEAN object is not on the mutable list; a MUT_VAR_DIRTY + is. When written to, a MUT_VAR_CLEAN turns into a MUT_VAR_DIRTY + and is put on the mutable list. + -------------------------------------------------------------------------- */ + +void dirty_MUT_VAR(StgRegTable *reg, StgClosure *p); + +/* ----------------------------------------------------------------------------- + DEBUGGING predicates for pointers + + LOOKS_LIKE_INFO_PTR(p) returns False if p is definitely not an info ptr + LOOKS_LIKE_CLOSURE_PTR(p) returns False if p is definitely not a closure ptr + + These macros are complete but not sound. That is, they might + return false positives. Do not rely on them to distinguish info + pointers from closure pointers, for example. + + We don't use address-space predicates these days, for portability + reasons, and the fact that code/data can be scattered about the + address space in a dynamically-linked environment. Our best option + is to look at the alleged info table and see whether it seems to + make sense... + -------------------------------------------------------------------------- */ + +#define LOOKS_LIKE_INFO_PTR(p) \ + (p && ((StgInfoTable *)(INFO_PTR_TO_STRUCT(p)))->type != INVALID_OBJECT && \ + ((StgInfoTable *)(INFO_PTR_TO_STRUCT(p)))->type < N_CLOSURE_TYPES) + +#define LOOKS_LIKE_CLOSURE_PTR(p) \ + (LOOKS_LIKE_INFO_PTR(((StgClosure *)(p))->header.info)) + +/* ----------------------------------------------------------------------------- + Macros for calculating how big a closure will be (used during allocation) + -------------------------------------------------------------------------- */ + +INLINE_HEADER StgOffset PAP_sizeW ( nat n_args ) +{ return sizeofW(StgPAP) + n_args; } + +INLINE_HEADER StgOffset AP_sizeW ( nat n_args ) +{ return sizeofW(StgAP) + n_args; } + +INLINE_HEADER StgOffset AP_STACK_sizeW ( nat size ) +{ return sizeofW(StgAP_STACK) + size; } + +INLINE_HEADER StgOffset CONSTR_sizeW( nat p, nat np ) +{ return sizeofW(StgHeader) + p + np; } + +INLINE_HEADER StgOffset THUNK_SELECTOR_sizeW ( void ) +{ return sizeofW(StgSelector); } + +INLINE_HEADER StgOffset BLACKHOLE_sizeW ( void ) +{ return sizeofW(StgHeader)+MIN_PAYLOAD_SIZE; } + +/* -------------------------------------------------------------------------- + Sizes of closures + ------------------------------------------------------------------------*/ + +INLINE_HEADER StgOffset sizeW_fromITBL( const StgInfoTable* itbl ) +{ return sizeofW(StgClosure) + + sizeofW(StgPtr) * itbl->layout.payload.ptrs + + sizeofW(StgWord) * itbl->layout.payload.nptrs; } + +INLINE_HEADER StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl ) +{ return sizeofW(StgThunk) + + sizeofW(StgPtr) * itbl->layout.payload.ptrs + + sizeofW(StgWord) * itbl->layout.payload.nptrs; } + +INLINE_HEADER StgOffset ap_stack_sizeW( StgAP_STACK* x ) +{ return AP_STACK_sizeW(x->size); } + +INLINE_HEADER StgOffset ap_sizeW( StgAP* x ) +{ return AP_sizeW(x->n_args); } + +INLINE_HEADER StgOffset pap_sizeW( StgPAP* x ) +{ return PAP_sizeW(x->n_args); } + +INLINE_HEADER StgOffset arr_words_sizeW( StgArrWords* x ) +{ return sizeofW(StgArrWords) + x->words; } + +INLINE_HEADER StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x ) +{ return sizeofW(StgMutArrPtrs) + x->ptrs; } + +INLINE_HEADER StgWord tso_sizeW ( StgTSO *tso ) +{ return TSO_STRUCT_SIZEW + tso->stack_size; } + +INLINE_HEADER StgWord bco_sizeW ( StgBCO *bco ) +{ return bco->size; } + +STATIC_INLINE nat +closure_sizeW_ (StgClosure *p, StgInfoTable *info) +{ + switch (info->type) { + case THUNK_0_1: + case THUNK_1_0: + return sizeofW(StgThunk) + 1; + case FUN_0_1: + case CONSTR_0_1: + case FUN_1_0: + case CONSTR_1_0: + return sizeofW(StgHeader) + 1; + case THUNK_0_2: + case THUNK_1_1: + case THUNK_2_0: + return sizeofW(StgThunk) + 2; + case FUN_0_2: + case CONSTR_0_2: + case FUN_1_1: + case CONSTR_1_1: + case FUN_2_0: + case CONSTR_2_0: + return sizeofW(StgHeader) + 2; + case THUNK: + return thunk_sizeW_fromITBL(info); + case THUNK_SELECTOR: + return THUNK_SELECTOR_sizeW(); + case AP_STACK: + return ap_stack_sizeW((StgAP_STACK *)p); + case AP: + case PAP: + return pap_sizeW((StgPAP *)p); + case IND: + case IND_PERM: + case IND_OLDGEN: + case IND_OLDGEN_PERM: + return sizeofW(StgInd); + case ARR_WORDS: + return arr_words_sizeW((StgArrWords *)p); + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: + case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: + return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); + case TSO: + return tso_sizeW((StgTSO *)p); + case BCO: + return bco_sizeW((StgBCO *)p); + case TVAR_WAIT_QUEUE: + return sizeofW(StgTVarWaitQueue); + case TVAR: + return sizeofW(StgTVar); + case TREC_CHUNK: + return sizeofW(StgTRecChunk); + case TREC_HEADER: + return sizeofW(StgTRecHeader); + default: + return sizeW_fromITBL(info); + } +} + +// The definitive way to find the size, in words, of a heap-allocated closure +STATIC_INLINE nat +closure_sizeW (StgClosure *p) +{ + return closure_sizeW_(p, get_itbl(p)); +} + +/* ----------------------------------------------------------------------------- + Sizes of stack frames + -------------------------------------------------------------------------- */ + +INLINE_HEADER StgWord stack_frame_sizeW( StgClosure *frame ) +{ + StgRetInfoTable *info; + + info = get_ret_itbl(frame); + switch (info->i.type) { + + case RET_DYN: + { + StgRetDyn *dyn = (StgRetDyn *)frame; + return sizeofW(StgRetDyn) + RET_DYN_BITMAP_SIZE + + RET_DYN_NONPTR_REGS_SIZE + + RET_DYN_PTRS(dyn->liveness) + RET_DYN_NONPTRS(dyn->liveness); + } + + case RET_FUN: + return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size; + + case RET_BIG: + case RET_VEC_BIG: + return 1 + GET_LARGE_BITMAP(&info->i)->size; + + case RET_BCO: + return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]); + + default: + return 1 + BITMAP_SIZE(info->i.layout.bitmap); + } +} + +/* ----------------------------------------------------------------------------- + Nursery manipulation + -------------------------------------------------------------------------- */ + +extern void allocNurseries ( void ); +extern void resetNurseries ( void ); +extern void resizeNurseries ( nat blocks ); +extern void resizeNurseriesFixed ( nat blocks ); +extern void tidyAllocateLists ( void ); +extern lnat countNurseryBlocks ( void ); + +/* ----------------------------------------------------------------------------- + Functions from GC.c + -------------------------------------------------------------------------- */ + +extern void threadPaused ( Capability *cap, StgTSO * ); +extern StgClosure * isAlive ( StgClosure *p ); +extern void markCAFs ( evac_fn evac ); + +/* ----------------------------------------------------------------------------- + Stats 'n' DEBUG stuff + -------------------------------------------------------------------------- */ + +extern ullong RTS_VAR(total_allocated); + +extern lnat calcAllocated ( void ); +extern lnat calcLive ( void ); +extern lnat calcNeeded ( void ); + +#if defined(DEBUG) +extern void memInventory(void); +extern void checkSanity(void); +extern nat countBlocks(bdescr *); +extern void checkNurserySanity( step *stp ); +#endif + +#if defined(DEBUG) +void printMutOnceList(generation *gen); +void printMutableList(generation *gen); +#endif + +/* ---------------------------------------------------------------------------- + Storage manager internal APIs and globals + ------------------------------------------------------------------------- */ + +#define END_OF_STATIC_LIST stgCast(StgClosure*,1) + +extern void newDynCAF(StgClosure *); + +extern void move_TSO(StgTSO *src, StgTSO *dest); +extern StgTSO *relocate_stack(StgTSO *dest, ptrdiff_t diff); + +extern StgClosure * RTS_VAR(scavenged_static_objects); +extern StgWeak * RTS_VAR(old_weak_ptr_list); +extern StgWeak * RTS_VAR(weak_ptr_list); +extern StgClosure * RTS_VAR(caf_list); +extern StgClosure * RTS_VAR(revertible_caf_list); +extern StgTSO * RTS_VAR(resurrected_threads); + +#endif /* STORAGE_H */ diff --git a/includes/TSO.h b/includes/TSO.h new file mode 100644 index 0000000000..d096d401cf --- /dev/null +++ b/includes/TSO.h @@ -0,0 +1,279 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-1999 + * + * The definitions for Thread State Objects. + * + * ---------------------------------------------------------------------------*/ + +#ifndef TSO_H +#define TSO_H + +#if DEBUG +#define TSO_MAGIC 4321 +#endif + +typedef struct { + StgInt pri; + StgInt magic; + StgInt sparkname; + rtsTime startedat; + rtsBool exported; + StgInt basicblocks; + StgInt allocs; + rtsTime exectime; + rtsTime fetchtime; + rtsTime fetchcount; + rtsTime blocktime; + StgInt blockcount; + rtsTime blockedat; + StgInt globalsparks; + StgInt localsparks; + rtsTime clock; +} StgTSOStatBuf; + +/* + * GRAN: We distinguish between the various classes of threads in + * the system. + */ +typedef enum { + AdvisoryPriority, + MandatoryPriority, + RevalPriority +} StgThreadPriority; + +/* + * PROFILING info in a TSO + */ +typedef struct { + CostCentreStack *CCCS; /* thread's current CCS */ +} StgTSOProfInfo; + +/* + * PAR info in a TSO + */ +typedef StgTSOStatBuf StgTSOParInfo; + +/* + * DIST info in a TSO + */ +typedef struct { + StgThreadPriority priority; + StgInt revalTid; /* ToDo: merge both into 1 word */ + StgInt revalSlot; +} StgTSODistInfo; + +/* + * GRAN info in a TSO + */ +typedef StgTSOStatBuf StgTSOGranInfo; + +/* + * There is no TICKY info in a TSO at this time. + */ + +/* + * Thread IDs are 32 bits. + */ +typedef StgWord32 StgThreadID; + +/* + * Flags for the tso->flags field. + * + * The TSO_DIRTY flag indicates that this TSO's stack should be + * scanned during garbage collection. The link field of a TSO is + * always scanned, so we don't have to dirty a TSO just for linking + * it on a different list. + * + * TSO_DIRTY is set by + * - schedule(), just before running a thread, + * - raiseAsync(), because it modifies a thread's stack + * - resumeThread(), just before running the thread again + * and unset by the garbage collector (only). + */ +#define TSO_DIRTY 1 + +/* + * TSO_LOCKED is set when a TSO is locked to a particular Capability. + */ +#define TSO_LOCKED 2 + +#define tsoDirty(tso) ((tso)->flags & TSO_DIRTY) +#define tsoLocked(tso) ((tso)->flags & TSO_LOCKED) + +/* + * Type returned after running a thread. Values of this type + * include HeapOverflow, StackOverflow etc. See Constants.h for the + * full list. + */ +typedef unsigned int StgThreadReturnCode; + +#if defined(mingw32_HOST_OS) +/* results from an async I/O request + its request ID. */ +typedef struct { + unsigned int reqID; + int len; + int errCode; +} StgAsyncIOResult; +#endif + +typedef union { + StgClosure *closure; + struct StgTSO_ *tso; + StgInt fd; /* StgInt instead of int, so that it's the same size as the ptrs */ +#if defined(mingw32_HOST_OS) + StgAsyncIOResult *async_result; +#endif + StgWord target; +} StgTSOBlockInfo; + +/* + * TSOs live on the heap, and therefore look just like heap objects. + * Large TSOs will live in their own "block group" allocated by the + * storage manager, and won't be copied during garbage collection. + */ + +/* + * Threads may be blocked for several reasons. A blocked thread will + * have the reason in the why_blocked field of the TSO, and some + * further info (such as the closure the thread is blocked on, or the + * file descriptor if the thread is waiting on I/O) in the block_info + * field. + */ + +typedef struct StgTSO_ { + StgHeader header; + + struct StgTSO_* link; /* Links threads onto blocking queues */ + struct StgTSO_* global_link; /* Links all threads together */ + + StgWord16 what_next; /* Values defined in Constants.h */ + StgWord16 why_blocked; /* Values defined in Constants.h */ + StgWord32 flags; + StgTSOBlockInfo block_info; + struct StgTSO_* blocked_exceptions; + StgThreadID id; + int saved_errno; + struct Task_* bound; + struct Capability_* cap; + struct StgTRecHeader_ * trec; /* STM transaction record */ + +#ifdef TICKY_TICKY + /* TICKY-specific stuff would go here. */ +#endif +#ifdef PROFILING + StgTSOProfInfo prof; +#endif +#ifdef PAR + StgTSOParInfo par; +#endif +#ifdef GRAN + StgTSOGranInfo gran; +#endif +#ifdef DIST + StgTSODistInfo dist; +#endif + + /* The thread stack... */ + StgWord32 stack_size; /* stack size in *words* */ + StgWord32 max_stack_size; /* maximum stack size in *words* */ + StgPtr sp; + + StgWord stack[FLEXIBLE_ARRAY]; +} StgTSO; + +/* ----------------------------------------------------------------------------- + Invariants: + + An active thread has the following properties: + + tso->stack < tso->sp < tso->stack+tso->stack_size + tso->stack_size <= tso->max_stack_size + + RESERVED_STACK_WORDS is large enough for any heap-check or + stack-check failure. + + The size of the TSO struct plus the stack is either + (a) smaller than a block, or + (b) a multiple of BLOCK_SIZE + + tso->why_blocked tso->block_info location + ---------------------------------------------------------------------- + NotBlocked NULL runnable_queue, or running + + BlockedOnBlackHole the BLACKHOLE_BQ the BLACKHOLE_BQ's queue + + BlockedOnMVar the MVAR the MVAR's queue + + BlockedOnSTM END_TSO_QUEUE STM wait queue(s) + + BlockedOnException the TSO TSO->blocked_exception + + BlockedOnRead NULL blocked_queue + BlockedOnWrite NULL blocked_queue + BlockedOnDelay NULL blocked_queue + BlockedOnGA closure TSO blocks on BQ of that closure + BlockedOnGA_NoSend closure TSO blocks on BQ of that closure + + tso->link == END_TSO_QUEUE, if the thread is currently running. + + A zombie thread has the following properties: + + tso->what_next == ThreadComplete or ThreadKilled + tso->link == (could be on some queue somewhere) + tso->su == tso->stack + tso->stack_size + tso->sp == tso->stack + tso->stack_size - 1 (i.e. top stack word) + tso->sp[0] == return value of thread, if what_next == ThreadComplete, + exception , if what_next == ThreadKilled + + (tso->sp is left pointing at the top word on the stack so that + the return value or exception will be retained by a GC). + + tso->blocked_exceptions is either: + + NULL if async exceptions are unblocked. + + END_TSO_QUEUE if async exceptions are blocked, but no threads + are currently waiting to deliver. + + (StgTSO *)tso if threads are currently awaiting delivery of + exceptions to this thread. + + The 2 cases BlockedOnGA and BlockedOnGA_NoSend are needed in a GUM + setup only. They mark a TSO that has entered a FETCH_ME or + FETCH_ME_BQ closure, respectively; only the first TSO hitting the + closure will send a Fetch message. + Currently we have no separate code for blocking on an RBH; we use the + BlockedOnBlackHole case for that. -- HWL + + ---------------------------------------------------------------------------- */ + +/* Workaround for a bug/quirk in gcc on certain architectures. + * symptom is that (&tso->stack - &tso->header) /= sizeof(StgTSO) + * in other words, gcc pads the structure at the end. + */ + +extern StgTSO dummy_tso; + +#define TSO_STRUCT_SIZE \ + ((char *)&dummy_tso.stack - (char *)&dummy_tso.header) + +#define TSO_STRUCT_SIZEW (TSO_STRUCT_SIZE / sizeof(W_)) + + +/* this is the NIL ptr for a TSO queue (e.g. runnable queue) */ +#if IN_STG_CODE +#define END_TSO_QUEUE (stg_END_TSO_QUEUE_closure) +#else +#define END_TSO_QUEUE ((StgTSO *)(void*)&stg_END_TSO_QUEUE_closure) +#endif + +#if defined(PAR) || defined(GRAN) +/* this is the NIL ptr for a blocking queue */ +# define END_BQ_QUEUE ((StgBlockingQueueElement *)(void*)&stg_END_TSO_QUEUE_closure) +/* this is the NIL ptr for a blocked fetch queue (as in PendingFetches in GUM) */ +# define END_BF_QUEUE ((StgBlockedFetch *)(void*)&stg_END_TSO_QUEUE_closure) +#endif +/* ToDo?: different name for end of sleeping queue ? -- HWL */ + +#endif /* TSO_H */ diff --git a/includes/TailCalls.h b/includes/TailCalls.h new file mode 100644 index 0000000000..670da9546f --- /dev/null +++ b/includes/TailCalls.h @@ -0,0 +1,272 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-1999 + * + * Stuff for implementing proper tail jumps. + * + * ---------------------------------------------------------------------------*/ + +#ifndef TAILCALLS_H +#define TAILCALLS_H + +/* ----------------------------------------------------------------------------- + Unmangled tail-jumping: use the mini interpretter. + -------------------------------------------------------------------------- */ + +#ifdef USE_MINIINTERPRETER + +#define JMP_(cont) return((StgFunPtr)(cont)) +#define FB_ +#define FE_ + +#else + +extern void __DISCARD__(void); + +/* ----------------------------------------------------------------------------- + Tail calling on x86 + -------------------------------------------------------------------------- */ + +#if i386_HOST_ARCH + +/* Note about discard: possibly there to fool GCC into clearing up + before we do the jump eg. if there are some arguments left on the C + stack that GCC hasn't popped yet. Also possibly to fool any + optimisations (a function call often acts as a barrier). Not sure + if any of this is necessary now -- SDM + + Comment to above note: I don't think the __DISCARD__() in JMP_ is + necessary. Arguments should be popped from the C stack immediately + after returning from a function, as long as we pass -fno-defer-pop + to gcc. Moreover, a goto to a first-class label acts as a barrier + for optimisations in the same way a function call does. + -= chak + */ + +/* The goto here seems to cause gcc -O2 to delete all the code after + it - including the FE_ marker and the epilogue code - exactly what + we want! -- SDM + */ + +#define JMP_(cont) \ + { \ + void *__target; \ + __DISCARD__(); \ + __target = (void *)(cont); \ + goto *__target; \ + } + +#endif /* i386_HOST_ARCH */ + +/* ----------------------------------------------------------------------------- + Tail calling on x86_64 + -------------------------------------------------------------------------- */ + +#if x86_64_HOST_ARCH + +/* + NOTE about __DISCARD__(): + + On x86_64 this is necessary to work around bugs in the register + variable support in gcc. Without the __DISCARD__() call, gcc will + silently throw away assignements to global register variables that + happen before the jump. + + Here's the example: + + extern void g(void); + static void f(void) { + R1 = g; + __DISCARD__() + goto *R1; + } + + without the dummy function call, gcc throws away the assignment to R1 + (gcc 3.4.3) gcc bug #20359. +*/ + +#define JMP_(cont) \ + { \ + __DISCARD__(); \ + goto *(void *)(cont); \ + } + +#endif /* x86_64_HOST_ARCH */ + +/* ----------------------------------------------------------------------------- + Tail calling on Sparc + -------------------------------------------------------------------------- */ + +#ifdef sparc_HOST_ARCH + +#define JMP_(cont) ((F_) (cont))() + /* Oh so happily, the above turns into a "call" instruction, + which, on a SPARC, is nothing but a "jmpl" with the + return address in %o7 [which we don't care about]. + */ + +/* Don't need these for sparc mangling */ +#define FB_ +#define FE_ + +#endif /* sparc_HOST_ARCH */ + +/* ----------------------------------------------------------------------------- + Tail calling on Alpha + -------------------------------------------------------------------------- */ + +#ifdef alpha_HOST_ARCH + +#if IN_STG_CODE +register void *_procedure __asm__("$27"); +#endif + +#define JMP_(cont) \ + do { _procedure = (void *)(cont); \ + __DISCARD__(); \ + goto *_procedure; \ + } while(0) + +/* Don't need these for alpha mangling */ +#define FB_ +#define FE_ + +#endif /* alpha_HOST_ARCH */ + +/* ----------------------------------------------------------------------------- + Tail calling on HP + +Description of HP's weird procedure linkage, many thanks to Andy Bennet +<andy_bennett@hp.com>: + +I've been digging a little further into the problem of how HP-UX does +dynamic procedure calls. My solution in the last e-mail inserting an extra +'if' statement into the JMP_ I think is probably the best general solution I +can come up with. There are still a few problems with it however: It wont +work, if JMP_ ever has to call anything in a shared library, if this is +likely to be required it'll need something more elaborate. It also wont work +with PA-RISC 2.0 wide mode (64-bit) which uses a different format PLT. + +I had some feedback from someone in HP's compiler lab and the problem +relates to the linker on HP-UX, not gcc as I first suspected. The reason the +'hsc' executable works is most likely due to a change in 'ld's behaviour for +performance reasons between your revision and mine. + +The major issue relating to this is shared libraries and how they are +implented under HP-UX. The whole point of the Procedure Label Table (PLT) is +to allow a function pointer to hold the address of the function and a +pointer to the library's global data lookup table (DLT) used by position +independent code (PIC). This makes the PLT absolutely essential for shared +library calls. HP has two linker introduced assembly functions for dealing +with dynamic calls, $$dyncall and $$dyncall_external. The former does a +check to see if the address is a PLT pointer and dereferences if necessary +or just calls the address otherwise; the latter skips the check and just +does the indirect jump no matter what. + +Since $$dyncall_external runs faster due to its not having the test, the +linker nowadays prefers to generate calls to that, rather than $$dyncall. It +makes this decision based on the presence of any shared library. If it even +smells an sl's existence at link time, it rigs the runtime system to +generate PLT references for everything on the assumption that the result +will be slightly more efficient. This is what is crashing GHC since the +calls it is generating have no understanding of the procedure label proper. +The only way to get real addresses is to link everything archive, including +system libraries, at which point it assumes you probably are going to be +using calls similar to GHC's (its rigged for HP's +ESfic compiler option) +but uses $$dyncall if necessary to cope, just in case you aren't. + + -------------------------------------------------------------------------- */ + +#ifdef hppa1_1_hp_hpux_TARGET + +#define JMP_(cont) \ + do { void *_procedure = (void *)(cont); \ + if (((int) _procedure) & 2) \ + _procedure = (void *)(*((int *) (_procedure - 2))); \ + goto *_procedure; \ + } while(0) + +#endif /* hppa1_1_hp_hpux_TARGET */ + +/* ----------------------------------------------------------------------------- + Tail calling on PowerPC + -------------------------------------------------------------------------- */ + +#ifdef powerpc_HOST_ARCH + +#define JMP_(cont) \ + { \ + void *target; \ + target = (void *)(cont); \ + __DISCARD__(); \ + goto *target; \ + } + +/* + The __DISCARD__ is there because Apple's April 2002 Beta of GCC 3.1 + sometimes generates incorrect code otherwise. + It tends to "forget" to update global register variables in the presence + of decrement/increment operators: + JMP_(*(--Sp)) is wrongly compiled as JMP_(Sp[-1]). + Calling __DISCARD__ in between works around this problem. +*/ + +/* + I would _love_ to use the following instead, + but some versions of Apple's GCC fail to generate code for it + if it is called for a casted data pointer - which is exactly what + we are going to do... + + #define JMP_(cont) ((F_) (cont))() +*/ + +#endif /* powerpc_HOST_ARCH */ + +#ifdef powerpc64_HOST_ARCH +#define JMP_(cont) ((F_) (cont))() +#endif + +/* ----------------------------------------------------------------------------- + Tail calling on IA64 + -------------------------------------------------------------------------- */ + +#ifdef ia64_HOST_ARCH + +/* The compiler can more intelligently decide how to do this. We therefore + * implement it as a call and optimise to a jump at mangle time. */ +#define JMP_(cont) ((F_) (cont))(); __asm__ volatile ("--- TAILCALL ---"); + +/* Don't emit calls to __DISCARD__ as this causes hassles */ +#define __DISCARD__() + +#endif + +/* ----------------------------------------------------------------------------- + FUNBEGIN and FUNEND. + + These are markers indicating the start and end of Real Code in a + function. All instructions between the actual start and end of the + function and these markers is shredded by the mangler. + -------------------------------------------------------------------------- */ + +/* The following __DISCARD__() has become necessary with gcc 2.96 on x86. + * It prevents gcc from moving stack manipulation code from the function + * body (aka the Real Code) into the function prologue, ie, from moving it + * over the --- BEGIN --- marker. It should be noted that (like some + * other black magic in GHC's code), there is no essential reason why gcc + * could not move some stack manipulation code across the __DISCARD__() - + * it just doesn't choose to do it at the moment. + * -= chak + */ + +#ifndef FB_ +#define FB_ __asm__ volatile ("--- BEGIN ---"); __DISCARD__ (); +#endif + +#ifndef FE_ +#define FE_ __asm__ volatile ("--- END ---"); +#endif + +#endif /* !USE_MINIINTERPRETER */ + +#endif /* TAILCALLS_H */ diff --git a/includes/config.h b/includes/config.h new file mode 100644 index 0000000000..66e2ade637 --- /dev/null +++ b/includes/config.h @@ -0,0 +1,7 @@ +#ifndef __CONFIG_H__ +#define __CONFIG_H__ + +#warning config.h is deprecated; please use ghcconfig.h instead +#include "ghcconfig.h" + +#endif diff --git a/includes/ghcconfig.h b/includes/ghcconfig.h new file mode 100644 index 0000000000..5f10e923fd --- /dev/null +++ b/includes/ghcconfig.h @@ -0,0 +1,7 @@ +#ifndef __GHCCONFIG_H__ +#define __GHCCONFIG_H__ + +#include "ghcautoconf.h" +#include "ghcplatform.h" + +#endif diff --git a/includes/ieee-flpt.h b/includes/ieee-flpt.h new file mode 100644 index 0000000000..a1fce3a8da --- /dev/null +++ b/includes/ieee-flpt.h @@ -0,0 +1,35 @@ +/* this file is #included into both C (.c and .hc) and Haskell files */ + + /* IEEE format floating-point */ +#define IEEE_FLOATING_POINT 1 + + /* Radix of exponent representation */ +#ifndef FLT_RADIX +# define FLT_RADIX 2 +#endif + + /* Number of base-FLT_RADIX digits in the significand of a float */ +#ifndef FLT_MANT_DIG +# define FLT_MANT_DIG 24 +#endif + /* Minimum int x such that FLT_RADIX**(x-1) is a normalised float */ +#ifndef FLT_MIN_EXP +# define FLT_MIN_EXP (-125) +#endif + /* Maximum int x such that FLT_RADIX**(x-1) is a representable float */ +#ifndef FLT_MAX_EXP +# define FLT_MAX_EXP 128 +#endif + + /* Number of base-FLT_RADIX digits in the significand of a double */ +#ifndef DBL_MANT_DIG +# define DBL_MANT_DIG 53 +#endif + /* Minimum int x such that FLT_RADIX**(x-1) is a normalised double */ +#ifndef DBL_MIN_EXP +# define DBL_MIN_EXP (-1021) +#endif + /* Maximum int x such that FLT_RADIX**(x-1) is a representable double */ +#ifndef DBL_MAX_EXP +# define DBL_MAX_EXP 1024 +#endif diff --git a/includes/mkDerivedConstants.c b/includes/mkDerivedConstants.c new file mode 100644 index 0000000000..27d4fa9e7b --- /dev/null +++ b/includes/mkDerivedConstants.c @@ -0,0 +1,404 @@ +/* -------------------------------------------------------------------------- + * + * (c) The GHC Team, 1992-2004 + * + * 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 + +#include "Rts.h" +#include "RtsFlags.h" +#include "Storage.h" +#include "OSThreads.h" +#include "Capability.h" + +#include <stdio.h> + +#define str(a,b) #a "_" #b + +#define OFFSET(s_type, field) ((unsigned int)&(((s_type*)0)->field)) + +#if defined(GEN_HASKELL) +#define def_offset(str, offset) \ + printf("oFFSET_" str " = %d::Int\n", offset); +#else +#define def_offset(str, offset) \ + printf("#define OFFSET_" str " %d\n", offset); +#endif + +#if defined(GEN_HASKELL) +#define ctype(type) /* nothing */ +#else +#define ctype(type) \ + printf("#define SIZEOF_" #type " %d\n", sizeof(type)); +#endif + +#if defined(GEN_HASKELL) +#define field_type_(str, s_type, field) /* nothing */ +#else +#define field_type_(str, s_type, field) \ + printf("#define REP_" str " I"); \ + printf("%d\n", sizeof (__typeof__(((((s_type*)0)->field)))) * 8); +#endif + +#define field_type(s_type, field) \ + field_type_(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) \ + printf("#define " str "(__ptr__) REP_" str "[__ptr__+OFFSET_" str "]\n"); + +/* Outputs the byte offset and MachRep for a field */ +#define struct_field(s_type, field) \ + field_offset(s_type, field); \ + field_type(s_type, field); \ + struct_field_macro(str(s_type,field)) + +#define struct_field_(str, s_type, field) \ + field_offset_(str, s_type, field); \ + field_type_(str, s_type, field); \ + struct_field_macro(str) + +#if defined(GEN_HASKELL) +#define def_size(str, size) \ + printf("sIZEOF_" str " = %d::Int\n", size); +#else +#define def_size(str, size) \ + printf("#define SIZEOF_" str " %d\n", 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+%d)\n", size); +#endif + +#define struct_size(s_type) \ + def_size(#s_type, sizeof(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", sizeof(s_type) - sizeof(StgHeader)); \ + def_closure_size(#s_type, sizeof(s_type) - sizeof(StgHeader)); + +#define thunk_size(s_type) \ + def_size(#s_type "_NoThunkHdr", sizeof(s_type) - sizeof(StgThunkHeader)); \ + closure_size(s_type) + +/* An access macro for use in C-- sources. */ +#define closure_field_macro(str) \ + printf("#define " str "(__ptr__) REP_" str "[__ptr__+SIZEOF_StgHeader+OFFSET_" str "]\n"); + +#define closure_field_offset_(str, s_type,field) \ + def_offset(str, OFFSET(s_type,field) - sizeof(StgHeader)); + +#define closure_field_offset(s_type,field) \ + closure_field_offset_(str(s_type,field),s_type,field) + +#define closure_payload_macro(str) \ + printf("#define " str "(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_" str " + WDS(__ix__)]\n"); + +#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(s_type, field) \ + closure_field_offset(s_type,field) \ + field_type(s_type, field); \ + closure_field_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_(str, s_type, field); \ + closure_field_macro(str) + +/* 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) - sizeof(StgHeader) - sizeof(StgTSOProfInfo)); + +/* Full byte offset for a TSO field, for use from Cmm */ +#define tso_field_offset_macro(str) \ + printf("#define TSO_OFFSET_" str " (SIZEOF_StgHeader+SIZEOF_OPT_StgTSOProfInfo+SIZEOF_OPT_StgTSOParInfo+SIZEOF_OPT_StgTSOGranInfo+SIZEOF_OPT_StgTSODistInfo+OFFSET_" str ")\n"); + +#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) \ + printf("#define " str "(__ptr__) REP_" str "[__ptr__+TSO_OFFSET_" str "]\n") +#define tso_field(s_type, field) \ + field_type(s_type, field); \ + tso_field_offset(s_type,field); \ + tso_field_macro(str(s_type,field)) + +#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"); + +#define FUN_OFFSET(sym) (OFFSET(Capability,f.sym) - OFFSET(Capability,r)) + + +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 %d\n", sizeofW(StgHeader) - sizeofW(StgProfHeader)); + /* grrr.. PROFILING is on so we need to subtract sizeofW(StgProfHeader) */ + printf("#define PROF_HDR_SIZE %d\n", sizeofW(StgProfHeader)); + printf("#define GRAN_HDR_SIZE %d\n", sizeofW(StgGranHeader)); + + printf("#define STD_ITBL_SIZE %d\n", sizeofW(StgInfoTable)); + printf("#define RET_ITBL_SIZE %d\n", sizeofW(StgRetInfoTable) - sizeofW(StgInfoTable)); + printf("#define PROF_ITBL_SIZE %d\n", sizeofW(StgProfInfo)); + + printf("#define GRAN_ITBL_SIZE %d\n", 0); + printf("#define TICKY_ITBL_SIZE %d\n", 0); + + printf("#define BLOCK_SIZE %d\n", BLOCK_SIZE); + printf("#define MBLOCK_SIZE %d\n", MBLOCK_SIZE); + + printf("\n\n"); +#endif + + 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, rD1); + field_offset(StgRegTable, rD2); + field_offset(StgRegTable, rL1); + field_offset(StgRegTable, rSp); + field_offset(StgRegTable, rSpLim); + field_offset(StgRegTable, rHp); + field_offset(StgRegTable, rHpLim); + field_offset(StgRegTable, rCurrentTSO); + field_offset(StgRegTable, rCurrentNursery); + field_offset(StgRegTable, rHpAlloc); + struct_field(StgRegTable, rRet); + + // Needed for SMP builds + field_offset(StgRegTable, rmp_tmp_w); + field_offset(StgRegTable, rmp_tmp1); + field_offset(StgRegTable, rmp_tmp2); + field_offset(StgRegTable, rmp_result1); + field_offset(StgRegTable, rmp_result2); + + def_offset("stgGCEnter1", FUN_OFFSET(stgGCEnter1)); + def_offset("stgGCFun", FUN_OFFSET(stgGCFun)); + + field_offset(Capability, r); + + struct_field(bdescr, start); + struct_field(bdescr, free); + struct_field(bdescr, blocks); + struct_field(bdescr, gen_no); + struct_field(bdescr, link); + + struct_size(generation); + struct_field(generation, mut_list); + + struct_size(CostCentreStack); + struct_field(CostCentreStack, ccsID); + struct_field(CostCentreStack, mem_alloc); + struct_field(CostCentreStack, scc_count); + 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); + + closure_payload(StgClosure,payload); + + struct_field(StgEntCounter, allocs); + struct_field(StgEntCounter, registeredp); + struct_field(StgEntCounter, link); + + closure_size(StgUpdateFrame); + closure_size(StgCatchFrame); + closure_size(StgStopFrame); + + closure_size(StgMutArrPtrs); + closure_field(StgMutArrPtrs, ptrs); + + closure_size(StgArrWords); + closure_field(StgArrWords, words); + 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, saved_errno); + closure_field(StgTSO, trec); + closure_field_("StgTSO_CCCS", StgTSO, prof.CCCS); + tso_field(StgTSO, sp); + tso_field_offset(StgTSO, stack); + tso_field(StgTSO, stack_size); + + struct_size(StgTSOProfInfo); + struct_size(StgTSOParInfo); + struct_size(StgTSOGranInfo); + struct_size(StgTSODistInfo); + + opt_struct_size(StgTSOProfInfo,PROFILING); + opt_struct_size(StgTSOParInfo,PAR); + opt_struct_size(StgTSOGranInfo,GRAN); + opt_struct_size(StgTSODistInfo,DIST); + + closure_field(StgUpdateFrame, updatee); + + closure_field(StgCatchFrame, handler); + closure_field(StgCatchFrame, exceptions_blocked); + + closure_size(StgPAP); + closure_field(StgPAP, n_args); + closure_field(StgPAP, fun); + closure_field(StgPAP, arity); + closure_payload(StgPAP, payload); + + thunk_size(StgAP); + closure_field(StgAP, n_args); + closure_field(StgAP, fun); + closure_payload(StgAP, payload); + + thunk_size(StgAP_STACK); + closure_field(StgAP_STACK, size); + closure_field(StgAP_STACK, fun); + closure_payload(StgAP_STACK, payload); + + closure_field(StgInd, indirectee); + + closure_size(StgMutVar); + closure_field(StgMutVar, var); + + closure_size(StgAtomicallyFrame); + closure_field(StgAtomicallyFrame, code); + + closure_size(StgCatchSTMFrame); + closure_field(StgCatchSTMFrame, handler); + + closure_size(StgCatchRetryFrame); + closure_field(StgCatchRetryFrame, running_alt_code); + closure_field(StgCatchRetryFrame, first_code); + closure_field(StgCatchRetryFrame, alt_code); + closure_field(StgCatchRetryFrame, first_code_trec); + + closure_size(StgWeak); + closure_field(StgWeak,link); + closure_field(StgWeak,key); + closure_field(StgWeak,value); + closure_field(StgWeak,finalizer); + + closure_size(StgDeadWeak); + closure_field(StgDeadWeak,link); + + closure_size(StgMVar); + closure_field(StgMVar,head); + closure_field(StgMVar,tail); + closure_field(StgMVar,value); + + closure_size(StgBCO); + closure_field(StgBCO, instrs); + closure_field(StgBCO, literals); + closure_field(StgBCO, ptrs); + closure_field(StgBCO, itbls); + closure_field(StgBCO, arity); + closure_field(StgBCO, size); + closure_payload(StgBCO, bitmap); + + closure_size(StgStableName); + closure_field(StgStableName,sn); + + struct_field_("RtsFlags_ProfFlags_showCCSOnException", + RTS_FLAGS, ProfFlags.showCCSOnException); + struct_field_("RtsFlags_DebugFlags_apply", + RTS_FLAGS, DebugFlags.apply); + struct_field_("RtsFlags_DebugFlags_sanity", + RTS_FLAGS, DebugFlags.sanity); + struct_field_("RtsFlags_DebugFlags_weak", + RTS_FLAGS, DebugFlags.weak); + struct_field_("RtsFlags_GcFlags_initialStkSize", + RTS_FLAGS, GcFlags.initialStkSize); + + struct_size(StgFunInfoExtraFwd); + struct_field(StgFunInfoExtraFwd, slow_apply); + struct_field(StgFunInfoExtraFwd, fun_type); + struct_field(StgFunInfoExtraFwd, arity); + struct_field_("StgFunInfoExtraFwd_bitmap", StgFunInfoExtraFwd, b.bitmap); + + struct_size(StgFunInfoExtraRev); + struct_field(StgFunInfoExtraRev, slow_apply_offset); + struct_field(StgFunInfoExtraRev, fun_type); + struct_field(StgFunInfoExtraRev, arity); + struct_field_("StgFunInfoExtraRev_bitmap", StgFunInfoExtraRev, b.bitmap); + + struct_field(StgLargeBitmap, size); + field_offset(StgLargeBitmap, bitmap); + + struct_size(snEntry); + struct_field(snEntry,sn_obj); + struct_field(snEntry,addr); + +#ifdef mingw32_HOST_OS + struct_size(StgAsyncIOResult); + struct_field(StgAsyncIOResult, reqID); + struct_field(StgAsyncIOResult, len); + struct_field(StgAsyncIOResult, errCode); +#endif + + struct_size(MP_INT); + struct_field(MP_INT,_mp_alloc); + struct_field(MP_INT,_mp_size); + struct_field(MP_INT,_mp_d); + + ctype(mp_limb_t); + return 0; +} |