diff options
| author | Simon Marlow <simonmar@microsoft.com> | 2006-04-07 02:05:11 +0000 |
|---|---|---|
| committer | Simon Marlow <simonmar@microsoft.com> | 2006-04-07 02:05:11 +0000 |
| commit | 0065d5ab628975892cea1ec7303f968c3338cbe1 (patch) | |
| tree | 8e2afe0ab48ee33cf95009809d67c9649573ef92 /includes | |
| parent | 28a464a75e14cece5db40f2765a29348273ff2d2 (diff) | |
| download | haskell-0065d5ab628975892cea1ec7303f968c3338cbe1.tar.gz | |
Reorganisation of the source tree
Most of the other users of the fptools build system have migrated to
Cabal, and with the move to darcs we can now flatten the source tree
without losing history, so here goes.
The main change is that the ghc/ subdir is gone, and most of what it
contained is now at the top level. The build system now makes no
pretense at being multi-project, it is just the GHC build system.
No doubt this will break many things, and there will be a period of
instability while we fix the dependencies. A straightforward build
should work, but I haven't yet fixed binary/source distributions.
Changes to the Building Guide will follow, too.
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; +} |