X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FStgMacros.h;h=8aabf2ee55e204af960dd403fe09480f3016497e;hb=351afa5ad7cc7012d5460c126cad4999e457a30d;hp=c112dd8d36bf16f7d5bd55a290ff880830786e0e;hpb=b86f4b95cb51d69a2537217132f675afa1e9519c;p=ghc-hetmet.git diff --git a/ghc/includes/StgMacros.h b/ghc/includes/StgMacros.h index c112dd8..8aabf2e 100644 --- a/ghc/includes/StgMacros.h +++ b/ghc/includes/StgMacros.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgMacros.h,v 1.33 2000/08/15 14:18:43 simonmar Exp $ + * $Id: StgMacros.h,v 1.49 2002/10/12 23:19:54 wolfgang Exp $ * * (c) The GHC Team, 1998-1999 * @@ -132,7 +132,6 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define STK_CHK(headroom,ret,r,layout,tag_assts) \ if (Sp - headroom < SpLim) { \ - EXTFUN_RTS(stg_chk_##layout); \ tag_assts \ (r) = (P_)ret; \ JMP_(stg_chk_##layout); \ @@ -141,20 +140,20 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define HP_CHK(headroom,ret,r,layout,tag_assts) \ DO_GRAN_ALLOCATE(headroom) \ if ((Hp += headroom) > HpLim) { \ - EXTFUN_RTS(stg_chk_##layout); \ + HpAlloc = (headroom); \ tag_assts \ (r) = (P_)ret; \ JMP_(stg_chk_##layout); \ - } + } #define HP_STK_CHK(stk_headroom,hp_headroom,ret,r,layout,tag_assts) \ DO_GRAN_ALLOCATE(hp_headroom) \ - if (Sp - stk_headroom < SpLim || (Hp += hp_headroom) > HpLim) { \ - EXTFUN_RTS(stg_chk_##layout); \ + if ((Hp += hp_headroom) > HpLim || Sp - stk_headroom < SpLim) { \ + HpAlloc = (hp_headroom); \ tag_assts \ (r) = (P_)ret; \ JMP_(stg_chk_##layout); \ - } + } /* ----------------------------------------------------------------------------- A Heap Check in a case alternative are much simpler: everything is @@ -177,7 +176,6 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define STK_CHK_NP(headroom,ptrs,tag_assts) \ if ((Sp - (headroom)) < SpLim) { \ - EXTFUN_RTS(stg_gc_enter_##ptrs); \ tag_assts \ JMP_(stg_gc_enter_##ptrs); \ } @@ -185,26 +183,26 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define HP_CHK_NP(headroom,ptrs,tag_assts) \ DO_GRAN_ALLOCATE(headroom) \ if ((Hp += (headroom)) > HpLim) { \ - EXTFUN_RTS(stg_gc_enter_##ptrs); \ + HpAlloc = (headroom); \ tag_assts \ JMP_(stg_gc_enter_##ptrs); \ - } + } #define HP_CHK_SEQ_NP(headroom,ptrs,tag_assts) \ DO_GRAN_ALLOCATE(headroom) \ if ((Hp += (headroom)) > HpLim) { \ - EXTFUN_RTS(stg_gc_seq_##ptrs); \ + HpAlloc = (headroom); \ tag_assts \ JMP_(stg_gc_seq_##ptrs); \ - } + } #define HP_STK_CHK_NP(stk_headroom, hp_headroom, ptrs, tag_assts) \ DO_GRAN_ALLOCATE(hp_headroom) \ - if ((Sp - (stk_headroom)) < SpLim || (Hp += (hp_headroom)) > HpLim) { \ - EXTFUN_RTS(stg_gc_enter_##ptrs); \ + if ((Hp += (hp_headroom)) > HpLim || (Sp - (stk_headroom)) < SpLim) { \ + HpAlloc = (hp_headroom); \ tag_assts \ JMP_(stg_gc_enter_##ptrs); \ - } + } /* Heap checks for branches of a primitive case / unboxed tuple return */ @@ -213,9 +211,10 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } DO_GRAN_ALLOCATE(headroom) \ if ((Hp += (headroom)) > HpLim) { \ EXTFUN_RTS(lbl); \ + HpAlloc = (headroom); \ tag_assts \ JMP_(lbl); \ - } + } #define HP_CHK_NOREGS(headroom,tag_assts) \ GEN_HP_CHK_ALT(headroom,stg_gc_noregs,tag_assts); @@ -229,7 +228,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } GEN_HP_CHK_ALT(headroom,stg_gc_d1,tag_assts); #define HP_CHK_L1(headroom,tag_assts) \ - GEN_HP_CHK_ALT(headroom,stg_gc_d1,tag_assts); + GEN_HP_CHK_ALT(headroom,stg_gc_l1,tag_assts); #define HP_CHK_UT_ALT(headroom, ptrs, nptrs, r, ret, tag_assts) \ GEN_HP_CHK_ALT(headroom, stg_gc_ut_##ptrs##_##nptrs, \ @@ -294,12 +293,12 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define HP_CHK_GEN(headroom,liveness,reentry,tag_assts) \ if ((Hp += (headroom)) > HpLim ) { \ - EXTFUN_RTS(stg_gen_chk); \ + HpAlloc = (headroom); \ tag_assts \ R9.w = (W_)LIVENESS_MASK(liveness); \ R10.w = (W_)reentry; \ JMP_(stg_gen_chk); \ - } + } #define HP_CHK_GEN_TICKY(headroom,liveness,reentry,tag_assts) \ HP_CHK_GEN(headroom,liveness,reentry,tag_assts); \ @@ -307,7 +306,6 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define STK_CHK_GEN(headroom,liveness,reentry,tag_assts) \ if ((Sp - (headroom)) < SpLim) { \ - EXTFUN_RTS(stg_gen_chk); \ tag_assts \ R9.w = (W_)LIVENESS_MASK(liveness); \ R10.w = (W_)reentry; \ @@ -316,7 +314,6 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define MAYBE_GC(liveness,reentry) \ if (doYouWantToGC()) { \ - EXTFUN_RTS(stg_gen_hp); \ R9.w = (W_)LIVENESS_MASK(liveness); \ R10.w = (W_)reentry; \ JMP_(stg_gen_hp); \ @@ -413,8 +410,8 @@ EXTINFO_RTS(stg_gen_chk_info); TICK_UPD_BH_UPDATABLE(); \ { \ bdescr *bd = Bdescr(R1.p); \ - if (bd->back != (bdescr *)BaseReg) { \ - if (bd->gen->no >= 1 || bd->step->no >= 1) { \ + if (bd->u.back != (bdescr *)BaseReg) { \ + if (bd->gen_no >= 1 || bd->step->no >= 1) { \ LOCK_THUNK(info); \ } else { \ EXTFUN_RTS(stg_gc_enter_1_hponly); \ @@ -422,13 +419,13 @@ EXTINFO_RTS(stg_gen_chk_info); } \ } \ } \ - SET_INFO(R1.cl,&BLACKHOLE_info) + SET_INFO(R1.cl,&stg_BLACKHOLE_info) # define UPD_BH_SINGLE_ENTRY(info) \ TICK_UPD_BH_SINGLE_ENTRY(); \ { \ bdescr *bd = Bdescr(R1.p); \ - if (bd->back != (bdescr *)BaseReg) { \ - if (bd->gen->no >= 1 || bd->step->no >= 1) { \ + if (bd->u.back != (bdescr *)BaseReg) { \ + if (bd->gen_no >= 1 || bd->step->no >= 1) { \ LOCK_THUNK(info); \ } else { \ EXTFUN_RTS(stg_gc_enter_1_hponly); \ @@ -436,14 +433,31 @@ EXTINFO_RTS(stg_gen_chk_info); } \ } \ } \ - SET_INFO(R1.cl,&BLACKHOLE_info) + SET_INFO(R1.cl,&stg_BLACKHOLE_info) # else +# ifndef PROFILING # define UPD_BH_UPDATABLE(info) \ TICK_UPD_BH_UPDATABLE(); \ - SET_INFO(R1.cl,&BLACKHOLE_info) + SET_INFO(R1.cl,&stg_BLACKHOLE_info) # define UPD_BH_SINGLE_ENTRY(info) \ TICK_UPD_BH_SINGLE_ENTRY(); \ - SET_INFO(R1.cl,&SE_BLACKHOLE_info) + SET_INFO(R1.cl,&stg_SE_BLACKHOLE_info) +# else +// An object is replaced by a blackhole, so we fill the slop with zeros. +// +// Todo: maybe use SET_HDR() and remove LDV_recordCreate()? +// +# define UPD_BH_UPDATABLE(info) \ + TICK_UPD_BH_UPDATABLE(); \ + LDV_recordDead_FILL_SLOP_DYNAMIC(R1.cl); \ + SET_INFO(R1.cl,&stg_BLACKHOLE_info); \ + LDV_recordCreate(R1.cl) +# define UPD_BH_SINGLE_ENTRY(info) \ + TICK_UPD_BH_SINGLE_ENTRY(); \ + LDV_recordDead_FILL_SLOP_DYNAMIC(R1.cl); \ + SET_INFO(R1.cl,&stg_SE_BLACKHOLE_info) \ + LDV_recordCreate(R1.cl) +# endif /* PROFILING */ # endif #else /* !EAGER_BLACKHOLING */ # define UPD_BH_UPDATABLE(thunk) /* nothing */ @@ -611,13 +625,36 @@ static inline StgInt64 PK_Int64(W_ p_src[]) y.iu.dlo = p_src[1]; return(y.i); } + +#elif SIZEOF_VOID_P == 8 + +static inline void ASSIGN_Word64(W_ p_dest[], StgWord64 src) +{ + p_dest[0] = src; +} + +static inline StgWord64 PK_Word64(W_ p_src[]) +{ + return p_src[0]; +} + +static inline void ASSIGN_Int64(W_ p_dest[], StgInt64 src) +{ + p_dest[0] = src; +} + +static inline StgInt64 PK_Int64(W_ p_src[]) +{ + return p_src[0]; +} + #endif /* ----------------------------------------------------------------------------- Catch frames -------------------------------------------------------------------------- */ -extern DLL_IMPORT_DATA const StgPolyInfoTable catch_frame_info; +extern DLL_IMPORT_RTS const StgPolyInfoTable stg_catch_frame_info; /* ----------------------------------------------------------------------------- Seq frames @@ -626,14 +663,14 @@ extern DLL_IMPORT_DATA const StgPolyInfoTable catch_frame_info; an update... -------------------------------------------------------------------------- */ -extern DLL_IMPORT_DATA const StgPolyInfoTable seq_frame_info; +extern DLL_IMPORT_RTS const StgPolyInfoTable stg_seq_frame_info; #define PUSH_SEQ_FRAME(sp) \ { \ StgSeqFrame *__frame; \ TICK_SEQF_PUSHED(); \ __frame = (StgSeqFrame *)(sp); \ - SET_HDR_(__frame,&seq_frame_info,CCCS); \ + SET_HDR((StgClosure *)__frame,(StgInfoTable *)&stg_seq_frame_info,CCCS);\ __frame->link = Su; \ Su = (StgUpdateFrame *)__frame; \ } @@ -643,7 +680,11 @@ extern DLL_IMPORT_DATA const StgPolyInfoTable seq_frame_info; -------------------------------------------------------------------------- */ #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 @@ -652,11 +693,20 @@ extern DLL_IMPORT_DATA const StgPolyInfoTable seq_frame_info; Closure and Info Macros with casting. We don't want to mess around with casts in the generated C code, so - we use these casting versions of the closure/info tables macros. + we use this casting versions of the closure macro. + + This version of SET_HDR also includes CCS_ALLOC for profiling - the + reason we don't use two separate macros is that the cost centre + field is sometimes a non-simple expression and we want to share its + value between SET_HDR and CCS_ALLOC. -------------------------------------------------------------------------- */ -#define SET_HDR_(c,info,ccs) \ - SET_HDR((StgClosure *)(c),(StgInfoTable *)(info),ccs) +#define SET_HDR_(c,info,ccs,size) \ + { \ + CostCentreStack *tmp = (ccs); \ + SET_HDR((StgClosure *)(c),(StgInfoTable *)(info),tmp); \ + CCS_ALLOC(tmp,size); \ + } /* ----------------------------------------------------------------------------- Saving context for exit from the STG world, and loading up context @@ -724,9 +774,34 @@ LoadThreadState (void) /* ----------------------------------------------------------------------------- Module initialisation - -------------------------------------------------------------------------- */ -#if 1 /* old init stuff */ + The module initialisation code looks like this, roughly: + + FN(__stginit_Foo) { + JMP_(__stginit_Foo_1_p) + } + + FN(__stginit_Foo_1_p) { + ... + } + + We have one version of the init code with a module version and the + 'way' attached to it. The version number helps to catch cases + where modules are not compiled in dependency order before being + linked: if a module has been compiled since any modules which depend on + it, then the latter modules will refer to a different version in their + init blocks and a link error will ensue. + + The 'way' suffix helps to catch cases where modules compiled in different + ways are linked together (eg. profiled and non-profiled). + + We provide a plain, unadorned, version of the module init code + which just jumps to the version with the label and way attached. The + reason for this is that when using foreign exports, the caller of + startupHaskell() must supply the name of the init function for the "top" + module in the program, and we don't want to require that this name + has the version and way info appended to it. + -------------------------------------------------------------------------- */ #define PUSH_INIT_STACK(reg_function) \ *(Sp++) = (W_)reg_function @@ -734,9 +809,18 @@ LoadThreadState (void) #define POP_INIT_STACK() \ *(--Sp) -#define START_MOD_INIT(reg_mod_name) \ +#define MOD_INIT_WRAPPER(label,real_init) \ + + +#define START_MOD_INIT(plain_lbl, real_lbl) \ static int _module_registered = 0; \ - FN_(reg_mod_name) { \ + EF_(real_lbl); \ + FN_(plain_lbl) { \ + FB_ \ + JMP_(real_lbl); \ + FE_ \ + } \ + FN_(real_lbl) { \ FB_; \ if (! _module_registered) { \ _module_registered = 1; \ @@ -754,29 +838,6 @@ LoadThreadState (void) JMP_(POP_INIT_STACK()); \ FE_ } -#else - -#define PUSH_INIT_STACK(reg_function) /* nothing */ -#define POP_INIT_STACK() /* nothing */ -#define REGISTER_IMPORT(reg_mod_name) /* nothing */ - -#define START_MOD_INIT(reg_mod_name) \ - FN_(reg_mod_name) { \ - EF_(StgReturn); \ - TEXT_SET(hs_init_set, reg_mod_name); \ - FB_; - /* extern decls go here, followed by init code */ - -#define REGISTER_FOREIGN_EXPORT(reg_fe_binder) \ - STGCALL1(getStablePtr,reg_fe_binder) - - -#define END_MOD_INIT() \ - JMP_(StgReturn); \ - FE_ } \ - -#endif - /* ----------------------------------------------------------------------------- Support for _ccall_GC_ and _casm_GC. -------------------------------------------------------------------------- */ @@ -785,20 +846,20 @@ LoadThreadState (void) * Suspending/resuming threads for doing external C-calls (_ccall_GC). * These functions are defined in rts/Schedule.c. */ -StgInt suspendThread ( StgRegTable *cap ); -StgRegTable * resumeThread ( StgInt ); +StgInt suspendThread ( StgRegTable *, rtsBool); +StgRegTable * resumeThread ( StgInt, rtsBool ); -#define SUSPEND_THREAD(token) \ +#define SUSPEND_THREAD(token,threaded) \ SaveThreadState(); \ - token = suspendThread(BaseReg); + token = suspendThread(BaseReg,threaded); #ifdef SMP -#define RESUME_THREAD(token) \ - BaseReg = resumeThread(token); \ - LoadThreadState(); +#define RESUME_THREAD(token,threaded) \ + BaseReg = resumeThread(token,threaded); \ + LoadThreadState(); #else -#define RESUME_THREAD(token) \ - (void)resumeThread(token); \ +#define RESUME_THREAD(token,threaded) \ + (void)resumeThread(token,threaded); \ LoadThreadState(); #endif