X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FStgMacros.h;h=711db95b44339402c5e7d3129346792a031a6446;hb=19f8036efd024ccf19cdf8426853b21e0467d0c5;hp=c4a14210d3e012fdcd6b5e2f2b6956507886c81d;hpb=706f5ed719b4ae00eaeba2340dac9f675a3ef662;p=ghc-hetmet.git diff --git a/ghc/includes/StgMacros.h b/ghc/includes/StgMacros.h index c4a1421..711db95 100644 --- a/ghc/includes/StgMacros.h +++ b/ghc/includes/StgMacros.h @@ -1,5 +1,7 @@ /* ----------------------------------------------------------------------------- - * $Id: StgMacros.h,v 1.4 1999/01/23 17:51:27 sof Exp $ + * $Id: StgMacros.h,v 1.46 2002/02/15 22:14:27 sof Exp $ + * + * (c) The GHC Team, 1998-1999 * * Macros used for writing STG-ish C code. * @@ -37,21 +39,29 @@ --------------------------------------------------------------------------- */ #define STGFUN(f) StgFunPtr f(void) -#define STATICFUN(f) static StgFunPtr f(void) #define EXTFUN(f) extern StgFunPtr f(void) +#define EXTFUN_RTS(f) extern DLL_IMPORT_RTS StgFunPtr f(void) #define FN_(f) F_ f(void) #define IFN_(f) static F_ f(void) #define IF_(f) static F_ f(void) #define EF_(f) extern F_ f(void) +#define EDF_(f) extern DLLIMPORT F_ f(void) +#define EXTINFO_RTS extern DLL_IMPORT_RTS INFO_TBL_CONST StgInfoTable #define ED_ extern +#define EDD_ extern DLLIMPORT #define ED_RO_ extern const -#define ID_ extern -#define ID_RO_ extern const -#define EI_ extern const StgInfoTable -#define II_ extern const StgInfoTable +#define ID_ static +#define ID_RO_ static const +#define EI_ extern INFO_TBL_CONST StgInfoTable +#define EDI_ extern DLLIMPORT INFO_TBL_CONST StgInfoTable +#define II_ static INFO_TBL_CONST StgInfoTable #define EC_ extern StgClosure -#define IC_ extern StgClosure +#define EDC_ extern DLLIMPORT StgClosure +#define IC_ static StgClosure +#define ECP_(x) extern const StgClosure *(x)[] +#define EDCP_(x) extern DLLIMPORT StgClosure *(x)[] +#define ICP_(x) static const StgClosure *(x)[] /* ----------------------------------------------------------------------------- Stack Tagging. @@ -61,65 +71,29 @@ words in the block. -------------------------------------------------------------------------- */ -#ifndef DEBUG_EXTRA #define ARGTAG_MAX 16 /* probably arbitrary */ #define ARG_TAG(n) (n) -#define ARG_SIZE(n) stgCast(StgWord,n) +#define ARG_SIZE(n) (StgWord)n typedef enum { REALWORLD_TAG = 0, - INT_TAG = sizeofW(StgInt), - INT64_TAG = sizeofW(StgInt64), - WORD_TAG = sizeofW(StgWord), - ADDR_TAG = sizeofW(StgAddr), - CHAR_TAG = sizeofW(StgChar), - FLOAT_TAG = sizeofW(StgFloat), - DOUBLE_TAG = sizeofW(StgDouble), - STABLE_TAG = sizeofW(StgWord), -} StackTag; - -#else /* DEBUG_EXTRA */ - -typedef enum { - ILLEGAL_TAG, - REALWORLD_TAG, - INT_TAG , - INT64_TAG , - WORD_TAG , - ADDR_TAG , - CHAR_TAG , - FLOAT_TAG , - DOUBLE_TAG , - STABLE_TAG , - ARGTAG_MAX = DOUBLE_TAG + INT_TAG = sizeofW(StgInt), + INT64_TAG = sizeofW(StgInt64), + WORD_TAG = sizeofW(StgWord), + ADDR_TAG = sizeofW(StgAddr), + CHAR_TAG = sizeofW(StgChar), + FLOAT_TAG = sizeofW(StgFloat), + DOUBLE_TAG = sizeofW(StgDouble), + STABLE_TAG = sizeofW(StgWord), } StackTag; -/* putting this in a .h file generates many copies - but its only a - * debugging build. - */ -static StgWord stg_arg_size[] = { - [REALWORLD_TAG] = 0, - [INT_TAG ] = sizeofW(StgInt), - [INT64_TAG ] = sizeofW(StgInt64), - [WORD_TAG ] = sizeofW(StgWord), - [ADDR_TAG ] = sizeofW(StgAddr), - [CHAR_TAG ] = sizeofW(StgChar), - [FLOAT_TAG ] = sizeofW(StgFloat), - [DOUBLE_TAG] = sizeofW(StgDouble), - [STABLE_TAG] = sizeofW(StgWord) -}; - -#define ARG_SIZE(tag) stg_arg_size[stgCast(StgWord,tag)] - -#endif /* DEBUG_EXTRA */ - static inline int IS_ARG_TAG( StgWord p ); static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } /* ----------------------------------------------------------------------------- Argument checks. - If (Sp + ) > Su { JMP_(stg_updatePAP); } + If (Sp + ) > Su { JMP_(stg_update_PAP); } Sp points to the topmost used word on the stack, and Su points to the most recently pushed update frame. @@ -158,29 +132,28 @@ 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(stg_chk_##layout); \ tag_assts \ (r) = (P_)ret; \ JMP_(stg_chk_##layout); \ } #define HP_CHK(headroom,ret,r,layout,tag_assts) \ + DO_GRAN_ALLOCATE(headroom) \ if ((Hp += headroom) > HpLim) { \ - EXTFUN(stg_chk_##layout); \ + HpAlloc = (headroom); \ tag_assts \ (r) = (P_)ret; \ JMP_(stg_chk_##layout); \ - } \ - TICK_ALLOC_HEAP(headroom); + } #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(stg_chk_##layout); \ + HpAlloc = (hp_headroom); \ tag_assts \ (r) = (P_)ret; \ JMP_(stg_chk_##layout); \ - } \ - TICK_ALLOC_HEAP(hp_headroom); + } /* ----------------------------------------------------------------------------- A Heap Check in a case alternative are much simpler: everything is @@ -194,49 +167,54 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } functions. In all these cases, node points to a closure that we can just enter to restart the heap check (the NP stands for 'node points'). + In the NP case GranSim absolutely has to check whether the current node + resides on the current processor. Otherwise a FETCH event has to be + scheduled. All that is done in GranSimFetch. -- HWL + HpLim points to the LAST WORD of valid allocation space. -------------------------------------------------------------------------- */ #define STK_CHK_NP(headroom,ptrs,tag_assts) \ if ((Sp - (headroom)) < SpLim) { \ - EXTFUN(stg_gc_enter_##ptrs); \ tag_assts \ JMP_(stg_gc_enter_##ptrs); \ } #define HP_CHK_NP(headroom,ptrs,tag_assts) \ + DO_GRAN_ALLOCATE(headroom) \ if ((Hp += (headroom)) > HpLim) { \ - EXTFUN(stg_gc_enter_##ptrs); \ + HpAlloc = (headroom); \ tag_assts \ JMP_(stg_gc_enter_##ptrs); \ - } \ - TICK_ALLOC_HEAP(headroom); + } #define HP_CHK_SEQ_NP(headroom,ptrs,tag_assts) \ + DO_GRAN_ALLOCATE(headroom) \ if ((Hp += (headroom)) > HpLim) { \ - EXTFUN(stg_gc_seq_##ptrs); \ + HpAlloc = (headroom); \ tag_assts \ JMP_(stg_gc_seq_##ptrs); \ - } \ - TICK_ALLOC_HEAP(headroom); + } #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(stg_gc_enter_##ptrs); \ + HpAlloc = (hp_headroom); \ tag_assts \ JMP_(stg_gc_enter_##ptrs); \ - } \ - TICK_ALLOC_HEAP(hp_headroom); + } + /* Heap checks for branches of a primitive case / unboxed tuple return */ #define GEN_HP_CHK_ALT(headroom,lbl,tag_assts) \ + DO_GRAN_ALLOCATE(headroom) \ if ((Hp += (headroom)) > HpLim) { \ - EXTFUN(lbl); \ + EXTFUN_RTS(lbl); \ + HpAlloc = (headroom); \ tag_assts \ JMP_(lbl); \ - } \ - TICK_ALLOC_HEAP(headroom); + } #define HP_CHK_NOREGS(headroom,tag_assts) \ GEN_HP_CHK_ALT(headroom,stg_gc_noregs,tag_assts); @@ -250,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, \ @@ -315,27 +293,27 @@ 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 ) { \ - EF_(stg_gen_chk); \ + HpAlloc = (headroom); \ tag_assts \ R9.w = (W_)LIVENESS_MASK(liveness); \ R10.w = (W_)reentry; \ JMP_(stg_gen_chk); \ - } \ - TICK_ALLOC_HEAP(headroom); + } + +#define HP_CHK_GEN_TICKY(headroom,liveness,reentry,tag_assts) \ + HP_CHK_GEN(headroom,liveness,reentry,tag_assts); \ + TICK_ALLOC_HEAP_NOCTR(headroom) #define STK_CHK_GEN(headroom,liveness,reentry,tag_assts) \ if ((Sp - (headroom)) < SpLim) { \ - EF_(stg_gen_chk); \ tag_assts \ R9.w = (W_)LIVENESS_MASK(liveness); \ R10.w = (W_)reentry; \ JMP_(stg_gen_chk); \ - } \ - TICK_ALLOC_HEAP(headroom); + } #define MAYBE_GC(liveness,reentry) \ if (doYouWantToGC()) { \ - EF_(stg_gen_hp); \ R9.w = (W_)LIVENESS_MASK(liveness); \ R10.w = (W_)reentry; \ JMP_(stg_gen_hp); \ @@ -348,9 +326,11 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } out to be slowing us down we can make specialised ones. -------------------------------------------------------------------------- */ +EXTFUN_RTS(stg_gen_yield); +EXTFUN_RTS(stg_gen_block); + #define YIELD(liveness,reentry) \ { \ - EF_(stg_gen_yield); \ R9.w = (W_)LIVENESS_MASK(liveness); \ R10.w = (W_)reentry; \ JMP_(stg_gen_yield); \ @@ -358,7 +338,6 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define BLOCK(liveness,reentry) \ { \ - EF_(stg_gen_block); \ R9.w = (W_)LIVENESS_MASK(liveness); \ R10.w = (W_)reentry; \ JMP_(stg_gen_block); \ @@ -366,10 +345,29 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define BLOCK_NP(ptrs) \ { \ - EF_(stg_bock_##ptrs); \ + EXTFUN_RTS(stg_block_##ptrs); \ JMP_(stg_block_##ptrs); \ } +#if defined(PAR) +/* + Similar to BLOCK_NP but separates the saving of the thread state from the + actual jump via an StgReturn +*/ + +#define SAVE_THREAD_STATE(ptrs) \ + ASSERT(ptrs==1); \ + Sp -= 1; \ + Sp[0] = R1.w; \ + SaveThreadState(); + +#define THREAD_RETURN(ptrs) \ + ASSERT(ptrs==1); \ + CurrentTSO->what_next = ThreadEnterGHC; \ + R1.i = ThreadBlocked; \ + JMP_(StgReturn); +#endif + /* ----------------------------------------------------------------------------- CCall_GC needs to push a dummy stack frame containing the contents of volatile registers and variables. @@ -377,7 +375,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } We use a RET_DYN frame the same as for a dynamic heap check. ------------------------------------------------------------------------- */ -EI_(stg_gen_chk_info); +EXTINFO_RTS(stg_gen_chk_info); /* ----------------------------------------------------------------------------- Vectored Returns @@ -392,22 +390,82 @@ EI_(stg_gen_chk_info); The extra subtraction of one word is because tags start at zero. -------------------------------------------------------------------------- */ -#ifdef USE_MINIINTERPRETER -#define RET_VEC(p,t) ((*(stgCast(StgInfoTable*,p)->vector))[t]) -#else +#ifdef TABLES_NEXT_TO_CODE #define RET_VEC(p,t) (*((P_)(p) - sizeofW(StgInfoTable) - t - 1)) +#else +#define RET_VEC(p,t) (((StgInfoTable *)p)->vector[t]) #endif /* ----------------------------------------------------------------------------- Misc -------------------------------------------------------------------------- */ + /* set the tag register (if we have one) */ #define SET_TAG(t) /* nothing */ -/* don't do eager blackholing for now */ -#define UPD_BH_UPDATABLE(thunk) /* nothing */ -#define UPD_BH_SINGLE_ENTRY(thunk) /* nothing */ +#ifdef EAGER_BLACKHOLING +# ifdef SMP +# define UPD_BH_UPDATABLE(info) \ + TICK_UPD_BH_UPDATABLE(); \ + { \ + bdescr *bd = Bdescr(R1.p); \ + 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); \ + JMP_(stg_gc_enter_1_hponly); \ + } \ + } \ + } \ + 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->u.back != (bdescr *)BaseReg) { \ + if (bd->gen_no >= 1 || bd->step->no >= 1) { \ + LOCK_THUNK(info); \ + } else { \ + EXTFUN_RTS(stg_gc_enter_1_hponly); \ + JMP_(stg_gc_enter_1_hponly); \ + } \ + } \ + } \ + SET_INFO(R1.cl,&stg_BLACKHOLE_info) +# else +# ifndef PROFILING +# define UPD_BH_UPDATABLE(info) \ + TICK_UPD_BH_UPDATABLE(); \ + SET_INFO(R1.cl,&stg_BLACKHOLE_info) +# define UPD_BH_SINGLE_ENTRY(info) \ + TICK_UPD_BH_SINGLE_ENTRY(); \ + 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 */ +# define UPD_BH_SINGLE_ENTRY(thunk) /* nothing */ +#endif /* EAGER_BLACKHOLING */ + +#define UPD_FRAME_UPDATEE(p) ((P_)(((StgUpdateFrame *)(p))->updatee)) +#define UPDATE_SU_FROM_UPD_FRAME(p) (Su=((StgUpdateFrame *)(p))->link) /* ----------------------------------------------------------------------------- Moving Floats and Doubles @@ -463,12 +521,15 @@ static inline StgDouble PK_DBL (W_ p_src[]) { return *(StgDou */ #if sparc_TARGET_ARCH -#define ASSIGN_DBL(dst,src) \ +#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)); + "=m" (((P_)(dst))[1]) : "f" (src)); \ + } -#define PK_DBL(src) \ - ( { register double d; \ +#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; \ } ) @@ -529,11 +590,11 @@ typedef union } int64_thing; typedef union - { StgNat64 w; + { StgWord64 w; unpacked_double_word wu; } word64_thing; -static inline void ASSIGN_Word64(W_ p_dest[], StgNat64 src) +static inline void ASSIGN_Word64(W_ p_dest[], StgWord64 src) { word64_thing y; y.w = src; @@ -541,7 +602,7 @@ static inline void ASSIGN_Word64(W_ p_dest[], StgNat64 src) p_dest[1] = y.wu.dlo; } -static inline StgNat64 PK_Word64(W_ p_src[]) +static inline StgWord64 PK_Word64(W_ p_src[]) { word64_thing y; y.wu.dhi = p_src[0]; @@ -564,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 const StgPolyInfoTable catch_frame_info; +extern DLL_IMPORT_RTS const StgPolyInfoTable stg_catch_frame_info; /* ----------------------------------------------------------------------------- Seq frames @@ -579,14 +663,14 @@ extern const StgPolyInfoTable catch_frame_info; an update... -------------------------------------------------------------------------- */ -extern 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; \ } @@ -596,20 +680,33 @@ extern const StgPolyInfoTable seq_frame_info; -------------------------------------------------------------------------- */ #if defined(USE_SPLIT_MARKERS) -#define __STG_SPLIT_MARKER(n) FN_(__stg_split_marker##n) { } +#if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS) +#define __STG_SPLIT_MARKER __asm__("\n___stg_split_marker:"); #else -#define __STG_SPLIT_MARKER(n) /* nothing */ +#define __STG_SPLIT_MARKER __asm__("\n__stg_split_marker:"); +#endif +#else +#define __STG_SPLIT_MARKER /* nothing */ #endif /* ----------------------------------------------------------------------------- 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 @@ -618,20 +715,33 @@ extern const StgPolyInfoTable seq_frame_info; We save all the STG registers (that is, the ones that are mapped to machine registers) in their places in the TSO. - The stack registers go into the current stack object, and the heap - registers are saved in global locations. + The stack registers go into the current stack object, and the + current nursery is updated from the heap pointer. + + These functions assume that BaseReg is loaded appropriately (if + we have one). -------------------------------------------------------------------------- */ +#if IN_STG_CODE + static __inline__ void SaveThreadState(void) { + StgTSO *tso; + /* Don't need to save REG_Base, it won't have changed. */ - CurrentTSO->sp = Sp; - CurrentTSO->su = Su; - CurrentTSO->splim = SpLim; + tso = CurrentTSO; + tso->sp = Sp; + tso->su = Su; CloseNursery(Hp); +#ifdef REG_CurrentTSO + SAVE_CurrentTSO = tso; +#endif +#ifdef REG_CurrentNursery + SAVE_CurrentNursery = CurrentNursery; +#endif #if defined(PROFILING) CurrentTSO->prof.CCCS = CCCS; #endif @@ -640,19 +750,82 @@ SaveThreadState(void) static __inline__ void LoadThreadState (void) { -#ifdef REG_Base - BaseReg = &MainRegTable; + StgTSO *tso; + +#ifdef REG_CurrentTSO + CurrentTSO = SAVE_CurrentTSO; #endif - Sp = CurrentTSO->sp; - Su = CurrentTSO->su; - SpLim = CurrentTSO->splim; + tso = CurrentTSO; + Sp = tso->sp; + Su = tso->su; + SpLim = (P_)&(tso->stack) + RESERVED_STACK_WORDS; OpenNursery(Hp,HpLim); +#ifdef REG_CurrentNursery + CurrentNursery = SAVE_CurrentNursery; +#endif # if defined(PROFILING) CCCS = CurrentTSO->prof.CCCS; # endif } +#endif + +/* ----------------------------------------------------------------------------- + Module initialisation + -------------------------------------------------------------------------- */ + +#define PUSH_INIT_STACK(reg_function) \ + *(Sp++) = (W_)reg_function + +#define POP_INIT_STACK() \ + *(--Sp) + +#define START_MOD_INIT(reg_mod_name) \ + static int _module_registered = 0; \ + FN_(reg_mod_name) { \ + FB_; \ + if (! _module_registered) { \ + _module_registered = 1; \ + { + /* extern decls go here, followed by init code */ + +#define REGISTER_FOREIGN_EXPORT(reg_fe_binder) \ + STGCALL1(getStablePtr,reg_fe_binder) + +#define REGISTER_IMPORT(reg_mod_name) \ + PUSH_INIT_STACK(reg_mod_name) + +#define END_MOD_INIT() \ + }}; \ + JMP_(POP_INIT_STACK()); \ + FE_ } + +/* ----------------------------------------------------------------------------- + Support for _ccall_GC_ and _casm_GC. + -------------------------------------------------------------------------- */ + +/* + * Suspending/resuming threads for doing external C-calls (_ccall_GC). + * These functions are defined in rts/Schedule.c. + */ +StgInt suspendThread ( StgRegTable *, rtsBool); +StgRegTable * resumeThread ( StgInt, rtsBool ); + +#define SUSPEND_THREAD(token,threaded) \ + SaveThreadState(); \ + token = suspendThread(BaseReg,threaded); + +#ifdef SMP +#define RESUME_THREAD(token,threaded) \ + BaseReg = resumeThread(token,threaded); \ + LoadThreadState(); +#else +#define RESUME_THREAD(token,threaded) \ + (void)resumeThread(token,threaded); \ + LoadThreadState(); +#endif + #endif /* STGMACROS_H */