X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FClosureMacros.h;h=e2519bb5039c23cea559a10c615d5431ec85329f;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=20333485794cda07170cd7eda648072b9b49e1a8;hpb=67baef1313c8e65851305a58f9e7004ff4e4514f;p=ghc-hetmet.git diff --git a/ghc/includes/ClosureMacros.h b/ghc/includes/ClosureMacros.h index 2033348..e2519bb 100644 --- a/ghc/includes/ClosureMacros.h +++ b/ghc/includes/ClosureMacros.h @@ -1,7 +1,6 @@ /* ---------------------------------------------------------------------------- - * $Id: ClosureMacros.h,v 1.24 2000/08/16 15:29:34 rrt Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2004 * * Macros for building and manipulating closures * @@ -10,14 +9,10 @@ #ifndef CLOSUREMACROS_H #define CLOSUREMACROS_H -/* ----------------------------------------------------------------------------- - Fixed Header Size - - The compiler tries to abstract away from the actual value of this - constant. - -------------------------------------------------------------------------- */ - -#define _FHS sizeof(StgHeader) +/* 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 @@ -56,198 +51,72 @@ -------------------------------------------------------------------------- */ -#define INIT_INFO(i) info : &(i) #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 INIT_ENTRY(e) code : {} -#define ENTRY_CODE(info) (info) #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1) -static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) { - return (StgFunPtr)(itbl+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 INIT_ENTRY(e) entry : (F_)(e) -#define ENTRY_CODE(info) (((StgInfoTable *)info)->entry) #define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)info) -static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) { - return itbl->entry; -} +#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 distinguishing data pointers from code pointers + Macros for building closures -------------------------------------------------------------------------- */ -/* - * We use some symbols inserted automatically by the linker to decide - * whether a pointer points to text, data, or user space. These tests - * assume that text is lower in the address space than data, which in - * turn is lower than user allocated memory. - * - * If this assumption is false (say on some strange architecture) then - * the tests IS_CODE_PTR and IS_DATA_PTR below will need to be - * modified (and that should be all that's necessary). - * - * _start } start of read-only text space - * _etext } end of read-only text space - * _end } end of read-write data space - */ -extern StgFun start; -extern void* TEXT_SECTION_END_MARKER_DECL; -extern void* DATA_SECTION_END_MARKER_DECL; - -#ifdef INTERPRETER -/* Take into account code sections in dynamically loaded object files. */ -#define IS_CODE_PTR(p) ( ((P_)(p) < (P_)&TEXT_SECTION_END_MARKER) \ - || is_dynamically_loaded_code_or_rodata_ptr(p) ) -#define IS_DATA_PTR(p) ( ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && \ - (P_)(p) < (P_)&DATA_SECTION_END_MARKER) \ - || is_dynamically_loaded_rwdata_ptr(p) ) -#define IS_USER_PTR(p) ( ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER) \ - && is_not_dynamically_loaded_ptr(p) ) -#else -#define IS_CODE_PTR(p) ((P_)(p) < (P_)&TEXT_SECTION_END_MARKER) -#define IS_DATA_PTR(p) ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && (P_)(p) < (P_)&DATA_SECTION_END_MARKER) -#define IS_USER_PTR(p) ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER) -#endif - - -#ifdef HAVE_WIN32_DLL_SUPPORT /* needed for mingw DietHEP */ - extern int is_heap_alloced(const void* x); -# define HEAP_ALLOCED(x) (is_heap_alloced(x)) -#else -# define HEAP_ALLOCED(x) IS_USER_PTR(x) -#endif - -/* When working with Win32 DLLs, static closures are identified by - being prefixed with a zero word. This is needed so that we can - distinguish between pointers to static closures and (reversed!) - info tables. - - This 'scheme' breaks down for closure tables such as CHARLIKE, - so we catch these separately. - - LOOKS_LIKE_STATIC_CLOSURE() - - discriminates between static closures and info tbls - (needed by LOOKS_LIKE_GHC_INFO() below - [Win32 DLLs only.]) - LOOKS_LIKE_STATIC() - - distinguishes between static and heap allocated data. +#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. */ -#if defined(HAVE_WIN32_DLL_SUPPORT) && !defined(INTERPRETER) - /* definitely do not enable for mingw DietHEP */ -#define LOOKS_LIKE_STATIC(r) (!(HEAP_ALLOCED(r))) - -/* Tiresome predicates needed to check for pointers into the closure tables */ -#define IS_CHARLIKE_CLOSURE(p) \ - ( (P_)(p) >= (P_)CHARLIKE_closure && \ - (char*)(p) <= ((char*)CHARLIKE_closure + \ - (MAX_CHARLIKE-MIN_CHARLIKE) * sizeof(StgIntCharlikeClosure)) ) -#define IS_INTLIKE_CLOSURE(p) \ - ( (P_)(p) >= (P_)INTLIKE_closure && \ - (char*)(p) <= ((char*)INTLIKE_closure + \ - (MAX_INTLIKE-MIN_INTLIKE) * sizeof(StgIntCharlikeClosure)) ) - -#define LOOKS_LIKE_STATIC_CLOSURE(r) (((*(((unsigned long *)(r))-1)) == 0) || IS_CHARLIKE_CLOSURE(r) || IS_INTLIKE_CLOSURE(r)) -#else -#define LOOKS_LIKE_STATIC(r) IS_DATA_PTR(r) -#define LOOKS_LIKE_STATIC_CLOSURE(r) IS_DATA_PTR(r) -#endif - - -/* ----------------------------------------------------------------------------- - Macros for distinguishing infotables from closures. - - You'd think it'd be easy to tell an info pointer from a closure pointer: - closures live on the heap and infotables are in read only memory. Right? - Wrong! Static closures live in read only memory and Hugs allocates - infotables for constructors on the (writable) C heap. - - ToDo: in the combined Hugs-GHC system, the following are but crude - approximations. This absolutely has to be fixed. - -------------------------------------------------------------------------- */ - -#ifdef INTERPRETER -# ifdef USE_MINIINTERPRETER - /* yoiks: one of the dreaded pointer equality tests */ -# define IS_HUGS_CONSTR_INFO(info) \ - (((StgInfoTable *)(info))->entry == (StgFunPtr)&Hugs_CONSTR_entry) -# else -# define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */ -# endif +#define SET_PROF_HDR(c,ccs_) \ + ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip)) #else -# define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */ -#endif - -#ifdef ENABLE_WIN32_DLL_SUPPORT /* needed for mingw DietHEP */ -# define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) \ - && !LOOKS_LIKE_STATIC_CLOSURE(info)) -#else -# define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info) -#endif - -/* ----------------------------------------------------------------------------- - Macros for calculating how big a closure will be (used during allocation) - -------------------------------------------------------------------------- */ - -/* ToDo: replace unsigned int by nat. The only fly in the ointment is that - * nat comes from Rts.h which many folk dont include. Sigh! +/* + 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. */ -static __inline__ StgOffset AP_sizeW ( unsigned int n_args ) -{ return sizeofW(StgAP_UPD) + n_args; } - -static __inline__ StgOffset PAP_sizeW ( unsigned int n_args ) -{ return sizeofW(StgPAP) + n_args; } - -static __inline__ StgOffset CONSTR_sizeW( unsigned int p, unsigned int np ) -{ return sizeofW(StgHeader) + p + np; } - -static __inline__ StgOffset BCO_sizeW ( unsigned int p, unsigned int np, unsigned int is ) -{ return sizeofW(StgBCO) + p + np + (is+sizeof(StgWord)-1)/sizeof(StgWord); } - -static __inline__ StgOffset THUNK_SELECTOR_sizeW ( void ) -{ return sizeofW(StgHeader) + MIN_UPD_SIZE; } - -static __inline__ StgOffset BLACKHOLE_sizeW ( void ) -{ return sizeofW(StgHeader) + MIN_UPD_SIZE; } - -static __inline__ StgOffset CAF_sizeW ( void ) -{ return sizeofW(StgCAF); } - -/* -------------------------------------------------------------------------- - * Sizes of closures - * ------------------------------------------------------------------------*/ - -static __inline__ StgOffset sizeW_fromITBL( const StgInfoTable* itbl ) -{ return sizeofW(StgClosure) - + sizeofW(StgPtr) * itbl->layout.payload.ptrs - + sizeofW(StgWord) * itbl->layout.payload.nptrs; } - -static __inline__ StgOffset pap_sizeW( StgPAP* x ) -{ return PAP_sizeW(x->n_args); } - -static __inline__ StgOffset arr_words_sizeW( StgArrWords* x ) -{ return sizeofW(StgArrWords) + x->words; } - -static __inline__ StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x ) -{ return sizeofW(StgMutArrPtrs) + x->ptrs; } - -static __inline__ StgWord bco_sizeW( StgBCO* bco ) -{ return BCO_sizeW(bco->n_ptrs,bco->n_words,bco->n_instrs); } - -static __inline__ StgWord tso_sizeW ( StgTSO *tso ) -{ return TSO_STRUCT_SIZEW + tso->stack_size; } - -/* ----------------------------------------------------------------------------- - Macros for building closures - -------------------------------------------------------------------------- */ - -#ifdef PROFILING -#define SET_PROF_HDR(c,ccs_) (c)->header.prof.ccs = ccs_ -#define SET_STATIC_PROF_HDR(ccs_) prof : { ccs : ccs_ }, +/* +#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) @@ -276,9 +145,10 @@ static __inline__ StgWord tso_sizeW ( StgTSO *tso ) #define SET_TICKY_HDR(c,stuff) #define SET_STATIC_TICKY_HDR(stuff) #endif -#define SET_HDR(c,info,ccs) \ + +#define SET_HDR(c,_info,ccs) \ { \ - SET_INFO(c,info); \ + (c)->header.info = _info; \ SET_GRAN_HDR((StgClosure *)(c),ThisPE); \ SET_PAR_HDR((StgClosure *)(c),LOCAL_GA); \ SET_PROF_HDR((StgClosure *)(c),ccs); \ @@ -290,34 +160,13 @@ static __inline__ StgWord tso_sizeW ( StgTSO *tso ) (c)->words = n_words; /* ----------------------------------------------------------------------------- - Static closures are defined as follows: - - - SET_STATIC_HDR(PrelBase_CZh_closure,PrelBase_CZh_info,costCentreStack,const); - - The info argument must have type 'StgInfoTable' or - 'StgSRTInfoTable', since we use '&' to get its address in the macro. + How to get hold of the static link field for a static closure. + + Note that we have to use (*cast(T*,&e)) instead of cast(T,e) + because C won't let us take the address of a casted + expression. Huh? -------------------------------------------------------------------------- */ -#define SET_STATIC_HDR(label,info,costCentreStack,closure_class,info_class) \ - info_class info; \ - closure_class StgClosure label = { \ - STATIC_HDR(info,costCentreStack) - -#define STATIC_HDR(info,ccs) \ - header : { \ - INIT_INFO(info), \ - SET_STATIC_GRAN_HDR \ - SET_STATIC_PAR_HDR(LOCAL_GA) \ - SET_STATIC_PROF_HDR(ccs) \ - SET_STATIC_TICKY_HDR(0) \ - } - -/* how to get hold of the static link field for a static closure. - * - * Note that we have to use (*cast(T*,&e)) instead of cast(T,e) - * because C won't let us take the address of a casted expression. Huh? - */ #define STATIC_LINK(info,p) \ (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs + \ info->layout.payload.nptrs]))) @@ -325,6 +174,13 @@ static __inline__ StgWord tso_sizeW ( StgTSO *tso ) /* These macros are optimised versions of the above for certain * closure types. They *must* be equivalent to the generic * STATIC_LINK. + * + * You may be surprised that the STATIC_LINK field for a THUNK_STATIC + * is at offset 2; that's because a THUNK_STATIC always has two words + * of (non-ptr) padding, to make room for the IND_STATIC that is + * going to overwrite it. It doesn't do any harm, because a + * THUNK_STATIC needs this extra word for the IND_STATIC's saved_info + * field anyhow. Hmm, this is all rather delicate. --SDM */ #define FUN_STATIC_LINK(p) ((p)->payload[0]) #define THUNK_STATIC_LINK(p) ((p)->payload[2]) @@ -338,38 +194,7 @@ static __inline__ StgWord tso_sizeW ( StgTSO *tso ) INTLIKE and CHARLIKE closures. -------------------------------------------------------------------------- */ -#define CHARLIKE_CLOSURE(n) ((P_)&CHARLIKE_closure[(n)-MIN_CHARLIKE]) -#define INTLIKE_CLOSURE(n) ((P_)&INTLIKE_closure[(n)-MIN_INTLIKE]) - -/* ----------------------------------------------------------------------------- - Closure Tables (for enumerated data types) - -------------------------------------------------------------------------- */ - -#define CLOSURE_TBL(lbl) const StgClosure *lbl[] = { - -/* ----------------------------------------------------------------------------- - CONSTRs. - -------------------------------------------------------------------------- */ - -/* constructors don't have SRTs */ -#define GET_TAG(info) (INFO_PTR_TO_STRUCT(info)->srt_len) - -/* ----------------------------------------------------------------------------- - BCOs. - -------------------------------------------------------------------------- */ - -#define bcoConstPtr( bco, i ) (*stgCast(StgPtr*, ((bco)->payload+(i)))) -#define bcoConstCPtr( bco, i ) (*stgCast(StgClosurePtr*,((bco)->payload+(i)))) -#define bcoConstInfoPtr( bco, i )(*stgCast(StgInfoTable**,((bco)->payload+(bco)->n_ptrs+i))) -#define bcoConstInt( bco, i ) (*stgCast(StgInt*, ((bco)->payload+(bco)->n_ptrs+i))) -#define bcoConstInt64( bco, i ) (PK_Int64(stgCast(StgWord*,(bco)->payload+(bco)->n_ptrs+i))) -#define bcoConstWord( bco, i ) (*stgCast(StgWord*, ((bco)->payload+(bco)->n_ptrs+i))) -#define bcoConstAddr( bco, i ) (*stgCast(StgAddr*, ((bco)->payload+(bco)->n_ptrs+i))) -#define bcoConstChar( bco, i ) (*stgCast(StgChar*, ((bco)->payload+(bco)->n_ptrs+i))) -#define bcoConstFloat( bco, i ) (PK_FLT(stgCast(StgWord*,(bco)->payload+(bco)->n_ptrs+i))) -#define bcoConstDouble( bco, i ) (PK_DBL(stgCast(StgWord*,(bco)->payload+(bco)->n_ptrs+i))) -#define bcoInstr( bco, i ) (stgCast(StgWord8*, ((bco)->payload+(bco)->n_ptrs+(bco)->n_words))[i]) -static __inline__ StgInt bcoInstr16 ( StgBCO* bco, unsigned int i ) -{ StgInt x = (bcoInstr(bco,i) << 8) + bcoInstr(bco,i+1); return x; } +#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 */