X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FStgMacros.h;h=bb1fcf69d0c2ba580e3776bd3e88f528b3b90907;hb=553e90d9a32ee1b1809430f260c401cc4169c6c7;hp=55ddab58028e36c87958bfedb085f952472f7895;hpb=559b4a2e20f7323d6cf616c24ac8cf08d8614f96;p=ghc-hetmet.git diff --git a/ghc/includes/StgMacros.h b/ghc/includes/StgMacros.h index 55ddab5..bb1fcf6 100644 --- a/ghc/includes/StgMacros.h +++ b/ghc/includes/StgMacros.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgMacros.h,v 1.31 2000/07/21 09:48:47 rrt Exp $ + * $Id: StgMacros.h,v 1.57 2003/11/12 17:27:04 sof Exp $ * * (c) The GHC Team, 1998-1999 * @@ -42,20 +42,25 @@ #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 EXTINFO_RTS extern DLL_IMPORT_RTS const StgInfoTable +#define ETI_RTS extern DLL_IMPORT_RTS const StgThunkInfoTable + +// Info tables as generated by the compiler are simply arrays of words. +typedef StgWord StgWordArray[]; + #define ED_ extern -#define EDD_ extern DLLIMPORT +#define EDD_ extern DLLIMPORT #define ED_RO_ extern const #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 EI_ extern StgWordArray +#define ERI_ extern const StgRetInfoTable +#define II_ static StgWordArray +#define IRI_ static const StgRetInfoTable #define EC_ extern StgClosure #define EDC_ extern DLLIMPORT StgClosure #define IC_ static StgClosure @@ -64,58 +69,38 @@ #define ICP_(x) static const StgClosure *(x)[] /* ----------------------------------------------------------------------------- - Stack Tagging. + Entering - For a block of non-pointer words on the stack, we precede the - block with a small-integer tag giving the number of non-pointer - words in the block. + 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. -------------------------------------------------------------------------- */ -#define ARGTAG_MAX 16 /* probably arbitrary */ -#define ARG_TAG(n) (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; - -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_update_PAP); } - - Sp points to the topmost used word on the stack, and Su points to - the most recently pushed update frame. - - Remember that must include any tagging of unboxed values. - - ARGS_CHK_LOAD_NODE is for top-level functions, whose entry - convention doesn't require that Node is loaded with a pointer to - the closure. Thus we must load node before calling stg_updatePAP if - the argument check fails. - -------------------------------------------------------------------------- */ - -#define ARGS_CHK(n) \ - if ((P_)(Sp + (n)) > (P_)Su) { \ - JMP_(stg_update_PAP); \ - } - -#define ARGS_CHK_LOAD_NODE(n,closure) \ - if ((P_)(Sp + (n)) > (P_)Su) { \ - R1.p = (P_)closure; \ - JMP_(stg_update_PAP); \ - } +#define ENTER() \ + { \ + again: \ + switch (get_itbl(R1.cl)->type) { \ + case IND: \ + case IND_OLDGEN: \ + case IND_PERM: \ + case IND_OLDGEN_PERM: \ + case IND_STATIC: \ + R1.cl = ((StgInd *)R1.cl)->indirectee; \ + goto again; \ + case BCO: \ + case FUN: \ + case FUN_1_0: \ + case FUN_0_1: \ + case FUN_2_0: \ + case FUN_1_1: \ + case FUN_0_2: \ + case FUN_STATIC: \ + case PAP: \ + JMP_(ENTRY_CODE(Sp[0])); \ + default: \ + JMP_(GET_ENTRY(R1.cl)); \ + } \ + } /* ----------------------------------------------------------------------------- Heap/Stack Checks. @@ -130,30 +115,30 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } in the meantime. ------------------------------------------------------------------------- */ -#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); \ +#define STK_CHK_FUN(headroom,assts) \ + if (Sp - headroom < SpLim) { \ + assts \ + JMP_(stg_gc_fun); \ } - -#define HP_CHK(headroom,ret,r,layout,tag_assts) \ - DO_GRAN_ALLOCATE(headroom) \ - if ((Hp += headroom) > HpLim) { \ - EXTFUN_RTS(stg_chk_##layout); \ - tag_assts \ - (r) = (P_)ret; \ - JMP_(stg_chk_##layout); \ + +#define HP_CHK_FUN(headroom,assts) \ + DO_GRAN_ALLOCATE(headroom) \ + if ((Hp += headroom) > HpLim) { \ + HpAlloc = (headroom); \ + assts \ + JMP_(stg_gc_fun); \ } -#define HP_STK_CHK(stk_headroom,hp_headroom,ret,r,layout,tag_assts) \ - DO_GRAN_ALLOCATE(hp_headroom) \ +// When doing both a heap and a stack check, don't move the heap +// pointer unless the stack check succeeds. Otherwise we might end up +// with slop at the end of the current block, which can confuse the +// LDV profiler. +#define HP_STK_CHK_FUN(stk_headroom,hp_headroom,assts) \ + DO_GRAN_ALLOCATE(hp_headroom) \ if (Sp - stk_headroom < SpLim || (Hp += hp_headroom) > HpLim) { \ - EXTFUN_RTS(stg_chk_##layout); \ - tag_assts \ - (r) = (P_)ret; \ - JMP_(stg_chk_##layout); \ + HpAlloc = (hp_headroom); \ + assts \ + JMP_(stg_gc_fun); \ } /* ----------------------------------------------------------------------------- @@ -175,36 +160,28 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } HpLim points to the LAST WORD of valid allocation space. -------------------------------------------------------------------------- */ -#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); \ +#define STK_CHK_NP(headroom,tag_assts) \ + if ((Sp - (headroom)) < SpLim) { \ + tag_assts \ + JMP_(stg_gc_enter_1); \ } -#define HP_CHK_NP(headroom,ptrs,tag_assts) \ - DO_GRAN_ALLOCATE(headroom) \ - if ((Hp += (headroom)) > HpLim) { \ - EXTFUN_RTS(stg_gc_enter_##ptrs); \ - tag_assts \ - JMP_(stg_gc_enter_##ptrs); \ - } +#define HP_CHK_NP(headroom,tag_assts) \ + DO_GRAN_ALLOCATE(headroom) \ + if ((Hp += (headroom)) > HpLim) { \ + HpAlloc = (headroom); \ + tag_assts \ + JMP_(stg_gc_enter_1); \ + } -#define HP_CHK_SEQ_NP(headroom,ptrs,tag_assts) \ - DO_GRAN_ALLOCATE(headroom) \ - if ((Hp += (headroom)) > HpLim) { \ - EXTFUN_RTS(stg_gc_seq_##ptrs); \ - tag_assts \ - JMP_(stg_gc_seq_##ptrs); \ - } - -#define HP_STK_CHK_NP(stk_headroom, hp_headroom, ptrs, tag_assts) \ +// See comment on HP_STK_CHK_FUN above. +#define HP_STK_CHK_NP(stk_headroom, hp_headroom, tag_assts) \ DO_GRAN_ALLOCATE(hp_headroom) \ if ((Sp - (stk_headroom)) < SpLim || (Hp += (hp_headroom)) > HpLim) { \ - EXTFUN_RTS(stg_gc_enter_##ptrs); \ + HpAlloc = (hp_headroom); \ tag_assts \ - JMP_(stg_gc_enter_##ptrs); \ - } + JMP_(stg_gc_enter_1); \ + } /* Heap checks for branches of a primitive case / unboxed tuple return */ @@ -212,10 +189,10 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define GEN_HP_CHK_ALT(headroom,lbl,tag_assts) \ 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); @@ -227,13 +204,8 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } GEN_HP_CHK_ALT(headroom,stg_gc_f1,tag_assts); #define HP_CHK_D1(headroom,tag_assts) \ 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); - -#define HP_CHK_UT_ALT(headroom, ptrs, nptrs, r, ret, tag_assts) \ - GEN_HP_CHK_ALT(headroom, stg_gc_ut_##ptrs##_##nptrs, \ - tag_assts r = (P_)ret;) + GEN_HP_CHK_ALT(headroom,stg_gc_l1,tag_assts); /* ----------------------------------------------------------------------------- Generic Heap checks. @@ -256,32 +228,55 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } - primitives (no SRT required). - The stack layout is like this: - - DblReg1-2 - FltReg1-4 - R1-8 - return address - liveness mask - stg_gen_chk_info - - so the liveness mask depends on the size of an StgDouble (FltRegs - and R are guaranteed to be 1 word in size). - + The stack frame layout for a RET_DYN is like this: + + some pointers |-- GET_PTRS(liveness) words + some nonpointers |-- GET_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). + + 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. -------------------------------------------------------------------------- */ -/* VERY MAGIC CONSTANTS! - * must agree with code in HeapStackCheck.c, stg_gen_chk - */ - -#if SIZEOF_DOUBLE > SIZEOF_VOID_P -#define ALL_NON_PTRS 0xffff -#else /* SIZEOF_DOUBLE == SIZEOF_VOID_P */ -#define ALL_NON_PTRS 0x3fff +// 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 +#define ALL_NON_PTRS 0xff + +// 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 #define LIVENESS_MASK(ptr_regs) (ALL_NON_PTRS ^ (ptr_regs)) +// We can have up to 255 pointers and 255 nonpointers in the stack +// frame. +#define N_NONPTRS(n) ((n)<<16) +#define N_PTRS(n) ((n)<<24) + +#define GET_NONPTRS(l) ((l)>>16 & 0xff) +#define GET_PTRS(l) ((l)>>24 & 0xff) +#define GET_LIVENESS(l) ((l) & 0xffff) + #define NO_PTRS 0 #define R1_PTR 1<<0 #define R2_PTR 1<<1 @@ -292,34 +287,38 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; } #define R7_PTR 1<<6 #define R8_PTR 1<<7 -#define HP_CHK_GEN(headroom,liveness,reentry,tag_assts) \ +#define HP_CHK_UNBX_TUPLE(headroom,liveness,code) \ if ((Hp += (headroom)) > HpLim ) { \ - EXTFUN_RTS(stg_gen_chk); \ - tag_assts \ + HpAlloc = (headroom); \ + code \ R9.w = (W_)LIVENESS_MASK(liveness); \ - R10.w = (W_)reentry; \ - JMP_(stg_gen_chk); \ - } + JMP_(stg_gc_ut); \ + } + +#define HP_CHK_GEN(headroom,liveness,reentry) \ + if ((Hp += (headroom)) > HpLim ) { \ + HpAlloc = (headroom); \ + R9.w = (W_)LIVENESS_MASK(liveness); \ + R10.w = (W_)reentry; \ + JMP_(stg_gc_gen); \ + } -#define HP_CHK_GEN_TICKY(headroom,liveness,reentry,tag_assts) \ - HP_CHK_GEN(headroom,liveness,reentry,tag_assts); \ +#define HP_CHK_GEN_TICKY(headroom,liveness,reentry) \ + HP_CHK_GEN(headroom,liveness,reentry); \ TICK_ALLOC_HEAP_NOCTR(headroom) -#define STK_CHK_GEN(headroom,liveness,reentry,tag_assts) \ +#define STK_CHK_GEN(headroom,liveness,reentry) \ if ((Sp - (headroom)) < SpLim) { \ - EXTFUN_RTS(stg_gen_chk); \ - tag_assts \ R9.w = (W_)LIVENESS_MASK(liveness); \ R10.w = (W_)reentry; \ - JMP_(stg_gen_chk); \ + JMP_(stg_gc_gen); \ } #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); \ + JMP_(stg_gc_gen_hp); \ } /* ----------------------------------------------------------------------------- @@ -378,11 +377,6 @@ EXTFUN_RTS(stg_gen_block); We use a RET_DYN frame the same as for a dynamic heap check. ------------------------------------------------------------------------- */ -#if COMPILING_RTS -EI_(stg_gen_chk_info); -#else -EDI_(stg_gen_chk_info); -#endif /* ----------------------------------------------------------------------------- Vectored Returns @@ -392,14 +386,14 @@ EDI_(stg_gen_chk_info); Return vectors are placed in *reverse order* immediately before the info table for the return address. Hence the formula for computing the - actual return address is (addr - sizeof(InfoTable) - tag - 1). + actual return address is (addr - sizeof(RetInfoTable) - tag - 1). The extra subtraction of one word is because tags start at zero. -------------------------------------------------------------------------- */ #ifdef TABLES_NEXT_TO_CODE -#define RET_VEC(p,t) (*((P_)(p) - sizeofW(StgInfoTable) - t - 1)) +#define RET_VEC(p,t) (*((P_)(p) - sizeofW(StgRetInfoTable) - t - 1)) #else -#define RET_VEC(p,t) (((StgInfoTable *)p)->vector[t]) +#define RET_VEC(p,t) (((StgRetInfoTable *)p)->vector[t]) #endif /* ----------------------------------------------------------------------------- @@ -416,8 +410,8 @@ EDI_(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); \ @@ -425,13 +419,13 @@ EDI_(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); \ @@ -439,52 +433,74 @@ EDI_(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. +// +// This looks like it can't work - we're overwriting the contents of +// the THUNK with slop! Perhaps this never worked??? --SDM +// The problem is that with eager-black-holing we currently perform +// the black-holing operation at the *beginning* of the basic block, +// when we still need the contents of the thunk. +// Perhaps the thing to do is to overwrite it at the *end* of the +// basic block, when we've already sucked out the thunk's contents? -- SLPJ +// +// 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 ASSIGN_FLT is for assigning a float to memory (usually the stack/heap). The memory address is guaranteed to be - StgWord aligned (currently == sizeof(long)). + StgWord aligned (currently == sizeof(void *)). PK_FLT is for pulling a float out of memory. The memory is guaranteed to be StgWord aligned. -------------------------------------------------------------------------- */ -static inline void ASSIGN_FLT (W_ [], StgFloat); -static inline StgFloat PK_FLT (W_ []); +INLINE_HEADER void ASSIGN_FLT (W_ [], StgFloat); +INLINE_HEADER StgFloat PK_FLT (W_ []); #if ALIGNMENT_FLOAT <= ALIGNMENT_LONG -static inline void ASSIGN_FLT(W_ p_dest[], StgFloat src) { *(StgFloat *)p_dest = src; } -static inline StgFloat PK_FLT (W_ p_src[]) { return *(StgFloat *)p_src; } +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 */ -static inline void ASSIGN_FLT(W_ p_dest[], StgFloat src) +INLINE_HEADER void ASSIGN_FLT(W_ p_dest[], StgFloat src) { float_thing y; y.f = src; *p_dest = y.fu; } -static inline StgFloat PK_FLT(W_ p_src[]) +INLINE_HEADER StgFloat PK_FLT(W_ p_src[]) { float_thing y; y.fu = *p_src; @@ -495,11 +511,11 @@ static inline StgFloat PK_FLT(W_ p_src[]) #if ALIGNMENT_DOUBLE <= ALIGNMENT_LONG -static inline void ASSIGN_DBL (W_ [], StgDouble); -static inline StgDouble PK_DBL (W_ []); +INLINE_HEADER void ASSIGN_DBL (W_ [], StgDouble); +INLINE_HEADER StgDouble PK_DBL (W_ []); -static inline void ASSIGN_DBL(W_ p_dest[], StgDouble src) { *(StgDouble *)p_dest = src; } -static inline StgDouble PK_DBL (W_ p_src[]) { return *(StgDouble *)p_src; } +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 */ @@ -525,8 +541,8 @@ static inline StgDouble PK_DBL (W_ p_src[]) { return *(StgDou #else /* ! sparc_TARGET_ARCH */ -static inline void ASSIGN_DBL (W_ [], StgDouble); -static inline StgDouble PK_DBL (W_ []); +INLINE_HEADER void ASSIGN_DBL (W_ [], StgDouble); +INLINE_HEADER StgDouble PK_DBL (W_ []); typedef struct { StgWord dhi; @@ -538,7 +554,7 @@ typedef union unpacked_double du; } double_thing; -static inline void ASSIGN_DBL(W_ p_dest[], StgDouble src) +INLINE_HEADER void ASSIGN_DBL(W_ p_dest[], StgDouble src) { double_thing y; y.d = src; @@ -554,7 +570,7 @@ static inline void ASSIGN_DBL(W_ p_dest[], StgDouble src) *(p_dest+1) = ((double_thing) src).du.dlo \ */ -static inline StgDouble PK_DBL(W_ p_src[]) +INLINE_HEADER StgDouble PK_DBL(W_ p_src[]) { double_thing y; y.du.dhi = p_src[0]; @@ -583,7 +599,7 @@ typedef union unpacked_double_word wu; } word64_thing; -static inline void ASSIGN_Word64(W_ p_dest[], StgWord64 src) +INLINE_HEADER void ASSIGN_Word64(W_ p_dest[], StgWord64 src) { word64_thing y; y.w = src; @@ -591,7 +607,7 @@ static inline void ASSIGN_Word64(W_ p_dest[], StgWord64 src) p_dest[1] = y.wu.dlo; } -static inline StgWord64 PK_Word64(W_ p_src[]) +INLINE_HEADER StgWord64 PK_Word64(W_ p_src[]) { word64_thing y; y.wu.dhi = p_src[0]; @@ -599,7 +615,7 @@ static inline StgWord64 PK_Word64(W_ p_src[]) return(y.w); } -static inline void ASSIGN_Int64(W_ p_dest[], StgInt64 src) +INLINE_HEADER void ASSIGN_Int64(W_ p_dest[], StgInt64 src) { int64_thing y; y.i = src; @@ -607,46 +623,54 @@ static inline void ASSIGN_Int64(W_ p_dest[], StgInt64 src) p_dest[1] = y.iu.dlo; } -static inline StgInt64 PK_Int64(W_ p_src[]) +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); } -#endif -/* ----------------------------------------------------------------------------- - Catch frames - -------------------------------------------------------------------------- */ +#elif SIZEOF_VOID_P == 8 -extern DLL_IMPORT_DATA const StgPolyInfoTable catch_frame_info; +INLINE_HEADER void ASSIGN_Word64(W_ p_dest[], StgWord64 src) +{ + p_dest[0] = src; +} -/* ----------------------------------------------------------------------------- - Seq frames +INLINE_HEADER StgWord64 PK_Word64(W_ p_src[]) +{ + return p_src[0]; +} - A seq frame is very like an update frame, except that it doesn't do - an update... - -------------------------------------------------------------------------- */ +INLINE_HEADER void ASSIGN_Int64(W_ p_dest[], StgInt64 src) +{ + p_dest[0] = src; +} -extern DLL_IMPORT_DATA const StgPolyInfoTable seq_frame_info; +INLINE_HEADER StgInt64 PK_Int64(W_ p_src[]) +{ + return p_src[0]; +} -#define PUSH_SEQ_FRAME(sp) \ - { \ - StgSeqFrame *__frame; \ - TICK_SEQF_PUSHED(); \ - __frame = (StgSeqFrame *)(sp); \ - SET_HDR_(__frame,&seq_frame_info,CCCS); \ - __frame->link = Su; \ - Su = (StgUpdateFrame *)__frame; \ - } +#endif + +/* ----------------------------------------------------------------------------- + Catch frames + -------------------------------------------------------------------------- */ + +extern DLL_IMPORT_RTS const StgPolyInfoTable stg_catch_frame_info; /* ----------------------------------------------------------------------------- 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 @@ -655,11 +679,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 @@ -677,7 +710,7 @@ extern DLL_IMPORT_DATA const StgPolyInfoTable seq_frame_info; #if IN_STG_CODE -static __inline__ void +INLINE_HEADER void SaveThreadState(void) { StgTSO *tso; @@ -686,8 +719,6 @@ SaveThreadState(void) tso = CurrentTSO; tso->sp = Sp; - tso->su = Su; - tso->splim = SpLim; CloseNursery(Hp); #ifdef REG_CurrentTSO @@ -701,7 +732,7 @@ SaveThreadState(void) #endif } -static __inline__ void +INLINE_HEADER void LoadThreadState (void) { StgTSO *tso; @@ -712,8 +743,7 @@ LoadThreadState (void) tso = CurrentTSO; Sp = tso->sp; - Su = tso->su; - SpLim = tso->splim; + SpLim = (P_)&(tso->stack) + RESERVED_STACK_WORDS; OpenNursery(Hp,HpLim); #ifdef REG_CurrentNursery @@ -728,6 +758,33 @@ LoadThreadState (void) /* ----------------------------------------------------------------------------- Module initialisation + + 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) \ @@ -736,9 +793,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; \ @@ -749,10 +815,8 @@ LoadThreadState (void) STGCALL1(getStablePtr,reg_fe_binder) #define REGISTER_IMPORT(reg_mod_name) \ - do { EXTFUN_RTS(reg_mod_name); \ - PUSH_INIT_STACK(reg_mod_name) ; \ - } while (0) - + PUSH_INIT_STACK(reg_mod_name) + #define END_MOD_INIT() \ }}; \ JMP_(POP_INIT_STACK()); \ @@ -766,20 +830,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