X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FClosureMacros.h;h=41d3fd8c4e7edebc6813a01816a4715e06571014;hb=9ac55e08e159d7a4647ab01e7872e69dd762f275;hp=c99caaa02de02b24ad0b4bedccda515d96e94654;hpb=7f309f1c021e7583f724cce599ce2dd3c439361b;p=ghc-hetmet.git diff --git a/ghc/includes/ClosureMacros.h b/ghc/includes/ClosureMacros.h index c99caaa..41d3fd8 100644 --- a/ghc/includes/ClosureMacros.h +++ b/ghc/includes/ClosureMacros.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $Id: ClosureMacros.h,v 1.4 1999/02/05 16:02:20 simonm Exp $ + * $Id: ClosureMacros.h,v 1.29 2000/12/04 12:31:20 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -10,14 +10,15 @@ #ifndef CLOSUREMACROS_H #define CLOSUREMACROS_H -/* ----------------------------------------------------------------------------- - Fixed Header Size - - The compiler tries to abstract away from the actual value of this - constant. - -------------------------------------------------------------------------- */ +/* 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 +*/ -#define _FHS sizeof(StgHeader) +#undef TEXT_BEFORE_HEAP +#ifndef mingw32_TARGET_OS +#define TEXT_BEFORE_HEAP 1 +#endif /* ----------------------------------------------------------------------------- Info tables are slammed up against the entry code, and the label @@ -59,144 +60,25 @@ #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)) -#if USE_MINIINTERPRETER -#define INIT_ENTRY(e) entry : (F_)(e) -#define GET_ENTRY(c) ((c)->header.info->entry) -#define ENTRY_CODE(info) (stgCast(StgInfoTable*,info)->entry) -#define INFO_PTR_TO_STRUCT(info) (info) -#define get_itbl(c) ((c)->header.info) -static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) { - return itbl->entry; -} -#else +#ifdef TABLES_NEXT_TO_CODE #define INIT_ENTRY(e) code : {} -#define GET_ENTRY(c) stgCast(StgFunPtr,((c)->header.info)) #define ENTRY_CODE(info) (info) -#define INFO_PTR_TO_STRUCT(info) (stgCast(StgInfoTable*,info) - 1) -#define get_itbl(c) (stgCast(StgInfoTable*,(c)->header.info) -1) +#define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1) static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) { - return stgCast(StgFunPtr,itbl+1); + return (StgFunPtr)(itbl+1); } -#endif - -/* ----------------------------------------------------------------------------- - Macros for distinguishing data pointers from code pointers - -------------------------------------------------------------------------- */ -/* - * 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 StgFun TEXT_SECTION_END_MARKER_DECL; -extern StgFun DATA_SECTION_END_MARKER_DECL; - -#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) - -/* ----------------------------------------------------------------------------- - 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 USE_MINIINTERPRETER -/* yoiks: one of the dreaded pointer equality tests */ -#define IS_HUGS_CONSTR_INFO(info) (stgCast(StgInfoTable*,info)->entry == stgCast(StgFunPtr,&Hugs_CONSTR_entry)) #else -#define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */ -#endif - -#ifdef USE_MINIINTERPRETER -/* in the mininterpreter, we put infotables on closures */ -#define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info) -#else -/* otherwise we have entry pointers on closures */ -#define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info) +#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; +} #endif -#define LOOKS_LIKE_STATIC(r) IS_DATA_PTR(r) - -/* ----------------------------------------------------------------------------- - 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! - */ -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 size_fromITBL( const StgInfoTable* itbl ) -{ return sizeof(StgClosure) - + sizeof(StgPtr) * itbl->layout.payload.ptrs - + sizeof(StgWord) * itbl->layout.payload.nptrs; } - -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_size( StgPAP* x ) -{ return sizeof(StgPAP) - + sizeof(StgWord) * x->n_args; } - -static __inline__ StgOffset pap_sizeW( StgPAP* x ) -{ return PAP_sizeW(x->n_args); } - -/* These two functions give the same result - but have slightly - * different types. - */ -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 -------------------------------------------------------------------------- */ @@ -217,8 +99,6 @@ static __inline__ StgWord tso_sizeW ( StgTSO *tso ) #define SET_STATIC_GRAN_HDR #endif -/* there is no PAR header, as far as I can tell -- SDM */ - #ifdef PAR #define SET_PAR_HDR(c,stuff) #define SET_STATIC_PAR_HDR(stuff) @@ -227,48 +107,48 @@ static __inline__ StgWord tso_sizeW ( StgTSO *tso ) #define SET_STATIC_PAR_HDR(stuff) #endif -#ifdef TICKY -#define SET_TICKY_HDR(c,stuff) (c)->header.ticky.updated = stuff -#define SET_STATIC_TICKY_HDR(stuff) ticky : { updated : stuff } +#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) \ - { \ - SET_INFO(c,info); \ +#define SET_HDR(c,info,ccs) \ + { \ + SET_INFO(c,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); \ +#define SET_ARR_HDR(c,info,costCentreStack,n_words) \ + SET_HDR(c,info,costCentreStack); \ (c)->words = n_words; /* ----------------------------------------------------------------------------- Static closures are defined as follows: -SET_STATIC_HDR(PrelBase_CZh_closure,PrelBase_CZh_info,costCentreStack,const); + 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. -------------------------------------------------------------------------- */ -#define SET_STATIC_HDR(label,info,costCentreStack,closure_class,info_class) \ - info_class info; \ - closure_class StgClosure label = { \ +#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) \ +#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. @@ -276,27 +156,34 @@ SET_STATIC_HDR(PrelBase_CZh_closure,PrelBase_CZh_info,costCentreStack,const); * 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) \ - (*stgCast(StgClosure**,&((p)->payload[info->layout.payload.ptrs + \ +#define STATIC_LINK(info,p) \ + (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs + \ info->layout.payload.nptrs]))) -#define STATIC_LINK2(info,p) \ - (*stgCast(StgClosure**,&((p)->payload[info->layout.payload.ptrs + \ + +/* These macros are optimised versions of the above for certain + * closure types. They *must* be equivalent to the generic + * STATIC_LINK. + */ +#define FUN_STATIC_LINK(p) ((p)->payload[0]) +#define THUNK_STATIC_LINK(p) ((p)->payload[2]) +#define IND_STATIC_LINK(p) ((p)->payload[1]) + +#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_)&CHARLIKE_closure[n]) -#define INTLIKE_CLOSURE(n) ((P_)&INTLIKE_closure[(n)-MIN_INTLIKE]) +#define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE]) +#define INTLIKE_CLOSURE(n) ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE]) /* ----------------------------------------------------------------------------- - Payload access + Closure Tables (for enumerated data types) -------------------------------------------------------------------------- */ -#define payloadPtr( c, i ) (*stgCast(StgPtr*, ((c)->payload+(i)))) -#define payloadCPtr( c, i ) (*stgCast(StgClosure**, ((c)->payload+(i)))) -#define payloadWord( c, i ) (*stgCast(StgWord*, ((c)->payload+(i)))) +#define CLOSURE_TBL(lbl) const StgClosure *lbl[] = { /* ----------------------------------------------------------------------------- CONSTRs. @@ -319,6 +206,8 @@ SET_STATIC_HDR(PrelBase_CZh_closure,PrelBase_CZh_info,costCentreStack,const); #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(StgNat8*, ((bco)->payload+(bco)->n_ptrs+(bco)->n_words))[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; } #endif /* CLOSUREMACROS_H */