X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FStgMiscClosures.hc;h=8bf5dbbfa62a93fa051995b0ac660506b32d2825;hb=553e90d9a32ee1b1809430f260c401cc4169c6c7;hp=669df325e75aa40e6b1f0f3efa5ca90e7da37b49;hpb=40aaaa640eee02495ecf80155043946b8839d575;p=ghc-hetmet.git diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc index 669df32..8bf5dbb 100644 --- a/ghc/rts/StgMiscClosures.hc +++ b/ghc/rts/StgMiscClosures.hc @@ -1,119 +1,384 @@ /* ----------------------------------------------------------------------------- - * $Id: StgMiscClosures.hc,v 1.15 1999/03/02 19:59:40 sof Exp $ + * $Id: StgMiscClosures.hc,v 1.85 2003/05/14 09:14:00 simonmar Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2002 * * Entry code for various built-in closure types. * * ---------------------------------------------------------------------------*/ +#include "Stg.h" #include "Rts.h" #include "RtsUtils.h" +#include "RtsFlags.h" #include "StgMiscClosures.h" -#include "HeapStackCheck.h" /* for stg_gen_yield */ #include "Storage.h" #include "StoragePriv.h" +#include "Profiling.h" +#include "Prelude.h" +#include "Schedule.h" +#include "SMP.h" +#if defined(GRAN) || defined(PAR) +# include "GranSimRts.h" /* for DumpRawGranEvent */ +# include "StgRun.h" /* for StgReturn and register saving */ +#endif -#ifdef HAVE_STDIO_H -#include +#ifdef HAVE_STDLIB_H +#include #endif -/* ----------------------------------------------------------------------------- - Entry code for an indirection. +/* ToDo: make the printing of panics more win32-friendly, i.e., + * pop up some lovely message boxes (as well). + */ +#define DUMP_ERRMSG(msg) STGCALL2(fprintf,stderr,msg) + +/* + Template for the entry code of non-enterable closures. +*/ + +#define NON_ENTERABLE_ENTRY_CODE(type) \ +IF_(stg_##type##_entry) \ +{ \ + FB_ \ + STGCALL1(barf, #type " object entered!"); \ + FE_ \ +} - This code assumes R1 is in a register for now. + +/* ----------------------------------------------------------------------------- + Support for the bytecode interpreter. -------------------------------------------------------------------------- */ -INFO_TABLE(IND_info,IND_entry,1,0,IND,const,EF_,0,0); -STGFUN(IND_entry) +/* 9 bits of return code for constructors created by the interpreter. */ +FN_(stg_interp_constr_entry) +{ + /* R1 points at the constructor */ + FB_ + /* STGCALL2(fprintf,stderr,"stg_interp_constr_entry (direct return)!\n"); */ + /* Pointless, since SET_TAG doesn't do anything */ + SET_TAG( GET_TAG(GET_INFO(R1.cl))); + JMP_(ENTRY_CODE((P_)(*Sp))); + FE_ +} + +FN_(stg_interp_constr1_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),0)); FE_ } +FN_(stg_interp_constr2_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),1)); FE_ } +FN_(stg_interp_constr3_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),2)); FE_ } +FN_(stg_interp_constr4_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),3)); FE_ } +FN_(stg_interp_constr5_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),4)); FE_ } +FN_(stg_interp_constr6_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),5)); FE_ } +FN_(stg_interp_constr7_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),6)); FE_ } +FN_(stg_interp_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ } + +/* Some info tables to be used when compiled code returns a value to + the interpreter, i.e. the interpreter pushes one of these onto the + stack before entering a value. What the code does is to + impedance-match the compiled return convention (in R1p/R1n/F1/D1 etc) to + the interpreter's convention (returned value is on top of stack), + and then cause the scheduler to enter the interpreter. + + On entry, the stack (growing down) looks like this: + + ptr to BCO holding return continuation + ptr to one of these info tables. + + The info table code, both direct and vectored, must: + * push R1/F1/D1 on the stack, and its tag if necessary + * push the BCO (so it's now on the stack twice) + * Yield, ie, go to the scheduler. + + Scheduler examines the t.o.s, discovers it is a BCO, and proceeds + directly to the bytecode interpreter. That pops the top element + (the BCO, containing the return continuation), and interprets it. + Net result: return continuation gets interpreted, with the + following stack: + + ptr to this BCO + ptr to the info table just jumped thru + return value + + which is just what we want -- the "standard" return layout for the + interpreter. Hurrah! + + Don't ask me how unboxed tuple returns are supposed to work. We + haven't got a good story about that yet. +*/ + +// When the returned value is a pointer in R1... +#define STG_CtoI_RET_R1p_Template(label) \ + IF_(label) \ + { \ + FB_ \ + Sp -= 2; \ + Sp[1] = R1.w; \ + Sp[0] = (W_)&stg_enter_info; \ + JMP_(stg_yield_to_interpreter); \ + FE_ \ + } + +STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_ret); +STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_0_ret); +STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_1_ret); +STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_2_ret); +STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_3_ret); +STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_4_ret); +STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_5_ret); +STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_6_ret); +STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_7_ret); + +VEC_POLY_INFO_TABLE( stg_ctoi_ret_R1p, 0/* special layout */, + 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, + RET_BCO,, EF_); + +// When the returned value is a pointer, but unlifted, in R1 ... +INFO_TABLE_RET( stg_ctoi_ret_R1unpt_info, stg_ctoi_ret_R1unpt_entry, + 0/* special layout */, + 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0); +IF_(stg_ctoi_ret_R1unpt_entry) +{ + FB_ + Sp -= 2; + Sp[1] = R1.w; + Sp[0] = (W_)&stg_gc_unpt_r1_info; + JMP_(stg_yield_to_interpreter); + FE_ +} + +// When the returned value is a non-pointer in R1 ... +INFO_TABLE_RET( stg_ctoi_ret_R1n_info, stg_ctoi_ret_R1n_entry, + 0/* special layout */, + 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0); +IF_(stg_ctoi_ret_R1n_entry) +{ + FB_ + Sp -= 2; + Sp[1] = R1.w; + Sp[0] = (W_)&stg_gc_unbx_r1_info; + JMP_(stg_yield_to_interpreter); + FE_ +} + + +// When the returned value is in F1 ... +INFO_TABLE_RET( stg_ctoi_ret_F1_info, stg_ctoi_ret_F1_entry, + 0/* special layout */, + 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0); +IF_(stg_ctoi_ret_F1_entry) +{ + FB_ + Sp -= 2; + ASSIGN_FLT(Sp+1, F1); + Sp[0] = (W_)&stg_gc_f1_info; + JMP_(stg_yield_to_interpreter); + FE_ +} + +// When the returned value is in D1 ... +INFO_TABLE_RET( stg_ctoi_ret_D1_info, stg_ctoi_ret_D1_entry, + 0/* special layout */, + 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0); +IF_(stg_ctoi_ret_D1_entry) +{ + FB_ + Sp -= 1 + sizeofW(StgDouble); + ASSIGN_DBL(Sp+1, D1); + Sp[0] = (W_)&stg_gc_d1_info; + JMP_(stg_yield_to_interpreter); + FE_ +} + +// When the returned value is in L1 ... +INFO_TABLE_RET( stg_ctoi_ret_L1_info, stg_ctoi_ret_L1_entry, + 0/* special layout */, + 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0); +IF_(stg_ctoi_ret_L1_entry) +{ + FB_ + Sp -= 1 + sizeofW(StgInt64); + ASSIGN_Word64(Sp+1, L1); + Sp[0] = (W_)&stg_gc_l1_info; + JMP_(stg_yield_to_interpreter); + FE_ +} + +// When the returned value a VoidRep ... +INFO_TABLE_RET( stg_ctoi_ret_V_info, stg_ctoi_ret_V_entry, + 0/* special layout */, + 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0); +IF_(stg_ctoi_ret_V_entry) +{ + FB_ + Sp--; + Sp[0] = (W_)&stg_gc_void_info; + JMP_(stg_yield_to_interpreter); + FE_ +} + +// Dummy info table pushed on the top of the stack when the interpreter +// should apply the BCO on the stack to its arguments, also on the stack. +INFO_TABLE_RET( stg_apply_interp_info, stg_apply_interp_entry, + 0/* special layout */, + 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0); +IF_(stg_apply_interp_entry) { FB_ - TICK_ENT_IND(Node); /* tick */ + // Just in case we end up in here... (we shouldn't) + JMP_(stg_yield_to_interpreter); + FE_ +} + +/* ----------------------------------------------------------------------------- + Entry code for a BCO + -------------------------------------------------------------------------- */ + +INFO_TABLE_FUN_GEN(stg_BCO_info,stg_BCO_entry,4,0, + 0,0,0, /* no SRT */ + ARG_BCO, 0/*dummy arity*/, 0/*dummy bitmap*/, NULL/*slow_apply*/, + BCO,,EF_,"BCO","BCO"); +FN_(stg_BCO_entry) { + FB_ + // entering a BCO means "apply it", same as a function + Sp -= 2; + Sp[1] = R1.w; + Sp[0] = (W_)&stg_apply_interp_info; + JMP_(stg_yield_to_interpreter); + FE_ +} + +/* ----------------------------------------------------------------------------- + Info tables for indirections. + SPECIALISED INDIRECTIONS: we have a specialised indirection for each + kind of return (direct, vectored 0-7), so that we can avoid entering + the object when we know what kind of return it will do. The update + code (Updates.hc) updates objects with the appropriate kind of + indirection. We only do this for young-gen indirections. + -------------------------------------------------------------------------- */ + +INFO_TABLE(stg_IND_info,stg_IND_entry,1,0,IND,,IF_,"IND","IND"); +IF_(stg_IND_entry) +{ + FB_ + TICK_ENT_DYN_IND(Node); /* tick */ R1.p = (P_) ((StgInd*)R1.p)->indirectee; TICK_ENT_VIA_NODE(); - JMP_(*R1.p); + JMP_(GET_ENTRY(R1.cl)); FE_ } -INFO_TABLE(IND_STATIC_info,IND_STATIC_entry,1,0,IND_STATIC,const,EF_,0,0); -STGFUN(IND_STATIC_entry) +#define IND_SPEC(n,ret) \ +INFO_TABLE(stg_IND_##n##_info,stg_IND_##n##_entry,1,0,IND,,IF_,"IND","IND"); \ +IF_(stg_IND_##n##_entry) \ +{ \ + FB_ \ + TICK_ENT_DYN_IND(Node); /* tick */ \ + R1.p = (P_) ((StgInd*)R1.p)->indirectee; \ + TICK_ENT_VIA_NODE(); \ + JMP_(ret); \ + FE_ \ +} + +IND_SPEC(direct, ENTRY_CODE(Sp[0])) +IND_SPEC(0, RET_VEC(Sp[0],0)) +IND_SPEC(1, RET_VEC(Sp[0],1)) +IND_SPEC(2, RET_VEC(Sp[0],2)) +IND_SPEC(3, RET_VEC(Sp[0],3)) +IND_SPEC(4, RET_VEC(Sp[0],4)) +IND_SPEC(5, RET_VEC(Sp[0],5)) +IND_SPEC(6, RET_VEC(Sp[0],6)) +IND_SPEC(7, RET_VEC(Sp[0],7)) + +INFO_TABLE(stg_IND_STATIC_info,stg_IND_STATIC_entry,1,0,IND_STATIC,,IF_,"IND_STATIC","IND_STATIC"); +IF_(stg_IND_STATIC_entry) { FB_ - TICK_ENT_IND(Node); /* tick */ - + TICK_ENT_STATIC_IND(Node); /* tick */ R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee; TICK_ENT_VIA_NODE(); - JMP_(*R1.p); + JMP_(GET_ENTRY(R1.cl)); FE_ } -INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,0,IND_PERM,const,EF_,0,0); -STGFUN(IND_PERM_entry) +INFO_TABLE(stg_IND_PERM_info,stg_IND_PERM_entry,1,1,IND_PERM,,IF_,"IND_PERM","IND_PERM"); +IF_(stg_IND_PERM_entry) { FB_ /* Don't add INDs to granularity cost */ + /* Dont: TICK_ENT_STATIC_IND(Node); for ticky-ticky; this ind is here only to help profiling */ + +#if defined(TICKY_TICKY) && !defined(PROFILING) + /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */ + TICK_ENT_PERM_IND(R1.p); /* tick */ +#endif - /* Dont: ENT_IND(Node); for ticky-ticky; this ind is here only to help profi -ling */ + LDV_ENTER((StgInd *)R1.p); /* Enter PAP cost centre -- lexical scoping only */ ENTER_CCS_PAP_CL(R1.cl); + /* For ticky-ticky, change the perm_ind to a normal ind on first + * entry, so the number of ent_perm_inds is the number of *thunks* + * entered again, not the number of subsequent entries. + * + * Since this screws up cost centres, we die if profiling and + * ticky_ticky are on at the same time. KSW 1999-01. + */ + +#ifdef TICKY_TICKY +# ifdef PROFILING +# error Profiling and ticky-ticky do not mix at present! +# endif /* PROFILING */ + SET_INFO((StgInd*)R1.p,&stg_IND_info); +#endif /* TICKY_TICKY */ + R1.p = (P_) ((StgInd*)R1.p)->indirectee; /* Dont: TICK_ENT_VIA_NODE(); for ticky-ticky; as above */ - JMP_(*R1.p); +#if defined(TICKY_TICKY) && !defined(PROFILING) + TICK_ENT_VIA_NODE(); +#endif + + JMP_(GET_ENTRY(R1.cl)); FE_ } -INFO_TABLE(IND_OLDGEN_info,IND_OLDGEN_entry,1,1,IND_OLDGEN,const,EF_,0,0); -STGFUN(IND_OLDGEN_entry) +INFO_TABLE(stg_IND_OLDGEN_info,stg_IND_OLDGEN_entry,1,1,IND_OLDGEN,,IF_,"IND_OLDGEN","IND_OLDGEN"); +IF_(stg_IND_OLDGEN_entry) { FB_ - TICK_ENT_IND(Node); /* tick */ - + TICK_ENT_STATIC_IND(Node); /* tick */ R1.p = (P_) ((StgInd*)R1.p)->indirectee; TICK_ENT_VIA_NODE(); - JMP_(*R1.p); + JMP_(GET_ENTRY(R1.cl)); FE_ } -INFO_TABLE(IND_OLDGEN_PERM_info,IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,const,EF_,0,0); -STGFUN(IND_OLDGEN_PERM_entry) +INFO_TABLE(stg_IND_OLDGEN_PERM_info,stg_IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,IF_,"IND_OLDGEN_PERM","IND_OLDGEN_PERM"); +IF_(stg_IND_OLDGEN_PERM_entry) { FB_ - TICK_ENT_IND(Node); /* tick */ - - R1.p = (P_) ((StgInd*)R1.p)->indirectee; - TICK_ENT_VIA_NODE(); - JMP_(*R1.p); - FE_ -} + /* Dont: TICK_ENT_STATIC_IND(Node); for ticky-ticky; this ind is here only to help profiling */ -/* ----------------------------------------------------------------------------- - Entry code for CAFs +#if defined(TICKY_TICKY) && !defined(PROFILING) + /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */ + TICK_ENT_PERM_IND(R1.p); /* tick */ +#endif - This code assumes R1 is in a register for now. - -------------------------------------------------------------------------- */ + LDV_ENTER((StgInd *)R1.p); -INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,2,CAF_UNENTERED,const,EF_,0,0); -STGFUN(CAF_UNENTERED_entry) -{ - FB_ - /* ToDo: implement directly in GHC */ - Sp -= 1; - Sp[0] = R1.w; - JMP_(stg_yield_to_Hugs); - FE_ -} + /* Enter PAP cost centre -- lexical scoping only */ + ENTER_CCS_PAP_CL(R1.cl); -INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,2,1,CAF_ENTERED,const,EF_,0,0); -STGFUN(CAF_ENTERED_entry) -{ - FB_ - R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */ + /* see comment in IND_PERM */ +#ifdef TICKY_TICKY +# ifdef PROFILING +# error Profiling and ticky-ticky do not mix at present! +# endif /* PROFILING */ + SET_INFO((StgInd*)R1.p,&stg_IND_OLDGEN_info); +#endif /* TICKY_TICKY */ + + R1.p = (P_) ((StgInd*)R1.p)->indirectee; TICK_ENT_VIA_NODE(); JMP_(GET_ENTRY(R1.cl)); FE_ @@ -128,93 +393,258 @@ STGFUN(CAF_ENTERED_entry) waiting for the evaluation of the closure to finish. -------------------------------------------------------------------------- */ -/* Note: a black hole must be big enough to be overwritten with an - * indirection/evacuee/catch. Thus we claim it has 1 non-pointer word of - * payload (in addition to the pointer word for the blocking queue), which - * should be big enough for an old-generation indirection. +/* Note: a BLACKHOLE and BLACKHOLE_BQ must be big enough to be + * overwritten with an indirection/evacuee/catch. Thus we claim it + * has 1 non-pointer word of payload (in addition to the pointer word + * for the blocking queue in a BQ), which should be big enough for an + * old-generation indirection. */ -INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,const,EF_,0,0); -STGFUN(BLACKHOLE_entry) +INFO_TABLE(stg_BLACKHOLE_info, stg_BLACKHOLE_entry,0,2,BLACKHOLE,,IF_,"BLACKHOLE","BLACKHOLE"); +IF_(stg_BLACKHOLE_entry) { FB_ +#if defined(GRAN) + /* Before overwriting TSO_LINK */ + STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/); +#endif + +#ifdef SMP + { + bdescr *bd = Bdescr(R1.p); + if (bd->u.back != (bdescr *)BaseReg) { + if (bd->gen_no >= 1 || bd->step->no >= 1) { + CMPXCHG(R1.cl->header.info, &stg_BLACKHOLE_info, &stg_WHITEHOLE_info); + } else { + EXTFUN_RTS(stg_gc_enter_1_hponly); + JMP_(stg_gc_enter_1_hponly); + } + } + } +#endif TICK_ENT_BH(); - /* Change the BLACKHOLE into a BLACKHOLE_BQ */ - ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info; + // Actually this is not necessary because R1.p is about to be destroyed. + LDV_ENTER((StgClosure *)R1.p); + /* Put ourselves on the blocking queue for this black hole */ - CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure; +#if defined(GRAN) || defined(PAR) + // in fact, only difference is the type of the end-of-queue marker! + CurrentTSO->link = END_BQ_QUEUE; + ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO; +#else + CurrentTSO->link = END_TSO_QUEUE; ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO; +#endif + // jot down why and on what closure we are blocked + CurrentTSO->why_blocked = BlockedOnBlackHole; + CurrentTSO->block_info.closure = R1.cl; + + /* Change the BLACKHOLE into a BLACKHOLE_BQ */ +#ifdef PROFILING + + // The size remains the same, so we call LDV_recordDead() - no need to fill slop. + LDV_recordDead((StgClosure *)R1.p, BLACKHOLE_sizeW()); +#endif + // + // Todo: maybe use SET_HDR() and remove LDV_recordCreate()? + // + ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info; +#ifdef PROFILING + LDV_recordCreate((StgClosure *)R1.p); +#endif + + // closure is mutable since something has just been added to its BQ recordMutable((StgMutClosure *)R1.cl); - /* stg_gen_block is too heavyweight, use a specialised one */ + // PAR: dumping of event now done in blockThread -- HWL + + // stg_gen_block is too heavyweight, use a specialised one BLOCK_NP(1); FE_ } -INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,const,EF_,0,0); -STGFUN(BLACKHOLE_BQ_entry) +INFO_TABLE(stg_BLACKHOLE_BQ_info, stg_BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,IF_,"BLACKHOLE","BLACKHOLE"); +IF_(stg_BLACKHOLE_BQ_entry) { FB_ +#if defined(GRAN) + /* Before overwriting TSO_LINK */ + STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/); +#endif + +#ifdef SMP + { + bdescr *bd = Bdescr(R1.p); + if (bd->u.back != (bdescr *)BaseReg) { + if (bd->gen_no >= 1 || bd->step->no >= 1) { + CMPXCHG(R1.cl->header.info, &stg_BLACKHOLE_info, &stg_WHITEHOLE_info); + } else { + EXTFUN_RTS(stg_gc_enter_1_hponly); + JMP_(stg_gc_enter_1_hponly); + } + } + } +#endif + TICK_ENT_BH(); + LDV_ENTER((StgClosure *)R1.p); /* Put ourselves on the blocking queue for this black hole */ CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue; ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO; + /* jot down why and on what closure we are blocked */ + CurrentTSO->why_blocked = BlockedOnBlackHole; + CurrentTSO->block_info.closure = R1.cl; +#ifdef SMP + ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info; +#endif + + /* PAR: dumping of event now done in blockThread -- HWL */ /* stg_gen_block is too heavyweight, use a specialised one */ BLOCK_NP(1); FE_ } +/* + Revertible black holes are needed in the parallel world, to handle + negative acknowledgements of messages containing updatable closures. + The idea is that when the original message is transmitted, the closure + is turned into a revertible black hole...an object which acts like a + black hole when local threads try to enter it, but which can be reverted + back to the original closure if necessary. + + It's actually a lot like a blocking queue (BQ) entry, because revertible + black holes are initially set up with an empty blocking queue. +*/ + +#if defined(PAR) || defined(GRAN) + +INFO_TABLE(stg_RBH_info, stg_RBH_entry,1,1,RBH,,IF_,"RBH","RBH"); +IF_(stg_RBH_entry) +{ + FB_ +# if defined(GRAN) + /* mainly statistics gathering for GranSim simulation */ + STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/); +# endif + + /* exactly the same as a BLACKHOLE_BQ_entry -- HWL */ + /* Put ourselves on the blocking queue for this black hole */ + CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue; + ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO; + /* jot down why and on what closure we are blocked */ + CurrentTSO->why_blocked = BlockedOnBlackHole; + CurrentTSO->block_info.closure = R1.cl; + + /* PAR: dumping of event now done in blockThread -- HWL */ + + /* stg_gen_block is too heavyweight, use a specialised one */ + BLOCK_NP(1); + FE_ +} + +INFO_TABLE(stg_RBH_Save_0_info, stg_RBH_Save_0_entry,0,2,CONSTR,,IF_,"RBH_Save_0","RBH_Save_0"); +NON_ENTERABLE_ENTRY_CODE(RBH_Save_0); + +INFO_TABLE(stg_RBH_Save_1_info, stg_RBH_Save_1_entry,1,1,CONSTR,,IF_,"RBH_Save_1","RBH_Save_1"); +NON_ENTERABLE_ENTRY_CODE(RBH_Save_1); + +INFO_TABLE(stg_RBH_Save_2_info, stg_RBH_Save_2_entry,2,0,CONSTR,,IF_,"RBH_Save_2","RBH_Save_2"); +NON_ENTERABLE_ENTRY_CODE(RBH_Save_2); +#endif /* defined(PAR) || defined(GRAN) */ + /* identical to BLACKHOLEs except for the infotag */ -INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,const,EF_,0,0); -STGFUN(CAF_BLACKHOLE_entry) +INFO_TABLE(stg_CAF_BLACKHOLE_info, stg_CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,IF_,"CAF_BLACKHOLE","CAF_BLACKHOLE"); +IF_(stg_CAF_BLACKHOLE_entry) { FB_ +#if defined(GRAN) + /* mainly statistics gathering for GranSim simulation */ + STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/); +#endif + +#ifdef SMP + { + bdescr *bd = Bdescr(R1.p); + if (bd->u.back != (bdescr *)BaseReg) { + if (bd->gen_no >= 1 || bd->step->no >= 1) { + CMPXCHG(R1.cl->header.info, &stg_CAF_BLACKHOLE_info, &stg_WHITEHOLE_info); + } else { + EXTFUN_RTS(stg_gc_enter_1_hponly); + JMP_(stg_gc_enter_1_hponly); + } + } + } +#endif + TICK_ENT_BH(); + LDV_ENTER((StgClosure *)R1.p); - /* Change the BLACKHOLE into a BLACKHOLE_BQ */ - ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info; - /* Put ourselves on the blocking queue for this black hole */ - CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure; + // Put ourselves on the blocking queue for this black hole +#if defined(GRAN) || defined(PAR) + // in fact, only difference is the type of the end-of-queue marker! + CurrentTSO->link = END_BQ_QUEUE; + ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO; +#else + CurrentTSO->link = END_TSO_QUEUE; ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO; +#endif + // jot down why and on what closure we are blocked + CurrentTSO->why_blocked = BlockedOnBlackHole; + CurrentTSO->block_info.closure = R1.cl; + + // Change the CAF_BLACKHOLE into a BLACKHOLE_BQ_STATIC + ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info; + + // closure is mutable since something has just been added to its BQ recordMutable((StgMutClosure *)R1.cl); - /* stg_gen_block is too heavyweight, use a specialised one */ + // PAR: dumping of event now done in blockThread -- HWL + + // stg_gen_block is too heavyweight, use a specialised one BLOCK_NP(1); FE_ } -/* ----------------------------------------------------------------------------- - The code for a BCO returns to the scheduler - -------------------------------------------------------------------------- */ -INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,const,EF_,0,0); -EF_(BCO_entry) { - FB_ - Sp -= 1; - Sp[0] = R1.w; - JMP_(stg_yield_to_Hugs); - FE_ +#ifdef EAGER_BLACKHOLING +INFO_TABLE(stg_SE_BLACKHOLE_info, stg_SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,IF_,"SE_BLACKHOLE","SE_BLACKHOLE"); +IF_(stg_SE_BLACKHOLE_entry) +{ + FB_ + STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1.p); + STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE); + FE_ +} + +INFO_TABLE(stg_SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,IF_,"CAF_BLACKHOLE","CAF_BLACKHOLE"); +IF_(stg_SE_CAF_BLACKHOLE_entry) +{ + FB_ + STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1.p); + STGCALL1(shutdownHaskellAndExit,EXIT_FAILURE); + FE_ } +#endif + +#ifdef SMP +INFO_TABLE(stg_WHITEHOLE_info, stg_WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,IF_,"WHITEHOLE","WHITEHOLE"); +IF_(stg_WHITEHOLE_entry) +{ + FB_ + JMP_(GET_ENTRY(R1.cl)); + FE_ +} +#endif /* ----------------------------------------------------------------------------- Some static info tables for things that don't get entered, and therefore don't need entry code (i.e. boxed but unpointed objects) + NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file -------------------------------------------------------------------------- */ -#define NON_ENTERABLE_ENTRY_CODE(type) \ -STGFUN(type##_entry) \ -{ \ - FB_ \ - STGCALL1(fflush,stdout); \ - STGCALL2(fprintf,stderr,#type " object entered!\n"); \ - STGCALL1(raiseError, errorHandler); \ - stg_exit(EXIT_FAILURE); /* not executed */ \ - FE_ \ -} - -INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,const,EF_,0,0); +INFO_TABLE(stg_TSO_info, stg_TSO_entry, 0,0,TSO,,IF_,"TSO","TSO"); NON_ENTERABLE_ENTRY_CODE(TSO); /* ----------------------------------------------------------------------------- @@ -222,7 +652,7 @@ NON_ENTERABLE_ENTRY_CODE(TSO); one is a real bug. -------------------------------------------------------------------------- */ -INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,const,EF_,0,0); +INFO_TABLE(stg_EVACUATED_info,stg_EVACUATED_entry,1,0,EVACUATED,,IF_,"EVACUATED","EVACUATED"); NON_ENTERABLE_ENTRY_CODE(EVACUATED); /* ----------------------------------------------------------------------------- @@ -233,10 +663,15 @@ NON_ENTERABLE_ENTRY_CODE(EVACUATED); live weak pointers with dead ones). -------------------------------------------------------------------------- */ -INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,const,EF_,0,0); +INFO_TABLE(stg_WEAK_info,stg_WEAK_entry,0,4,WEAK,,IF_,"WEAK","WEAK"); NON_ENTERABLE_ENTRY_CODE(WEAK); -INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,const,EF_,0,0); +// It's important when turning an existing WEAK into a DEAD_WEAK +// (which is what finalizeWeak# does) that we don't lose the link +// field and break the linked list of weak pointers. Hence, we give +// DEAD_WEAK 4 non-pointer fields, the same as WEAK. + +INFO_TABLE_CONSTR(stg_DEAD_WEAK_info,stg_DEAD_WEAK_entry,0,4,0,CONSTR,,IF_,"DEAD_WEAK","DEAD_WEAK"); NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK); /* ----------------------------------------------------------------------------- @@ -246,24 +681,24 @@ NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK); finalizer in a weak pointer object. -------------------------------------------------------------------------- */ -INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0); +INFO_TABLE_CONSTR(stg_NO_FINALIZER_info,stg_NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,IF_,"NO_FINALIZER","NO_FINALIZER"); NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER); -SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_) -}; +SET_STATIC_HDR(stg_NO_FINALIZER_closure,stg_NO_FINALIZER_info,0/*CC*/,,extern const StgInfoTable) +, /*payload*/{} }; /* ----------------------------------------------------------------------------- Foreign Objects are unlifted and therefore never entered. -------------------------------------------------------------------------- */ -INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,const,EF_,0,0); +INFO_TABLE(stg_FOREIGN_info,stg_FOREIGN_entry,0,1,FOREIGN,,IF_,"FOREIGN","FOREIGN"); NON_ENTERABLE_ENTRY_CODE(FOREIGN); /* ----------------------------------------------------------------------------- Stable Names are unlifted too. -------------------------------------------------------------------------- */ -INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,const,EF_,0,0); +INFO_TABLE(stg_STABLE_NAME_info,stg_STABLE_NAME_entry,0,1,STABLE_NAME,,IF_,"STABLE_NAME","STABLE_NAME"); NON_ENTERABLE_ENTRY_CODE(STABLE_NAME); /* ----------------------------------------------------------------------------- @@ -273,10 +708,10 @@ NON_ENTERABLE_ENTRY_CODE(STABLE_NAME); and entry code for each type. -------------------------------------------------------------------------- */ -INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,const,EF_,0,0); +INFO_TABLE(stg_FULL_MVAR_info,stg_FULL_MVAR_entry,4,0,MVAR,,IF_,"MVAR","MVAR"); NON_ENTERABLE_ENTRY_CODE(FULL_MVAR); -INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,const,EF_,0,0); +INFO_TABLE(stg_EMPTY_MVAR_info,stg_EMPTY_MVAR_entry,4,0,MVAR,,IF_,"MVAR","MVAR"); NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR); /* ----------------------------------------------------------------------------- @@ -286,11 +721,11 @@ NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR); end of a linked TSO queue. -------------------------------------------------------------------------- */ -INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0); +INFO_TABLE_CONSTR(stg_END_TSO_QUEUE_info,stg_END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,IF_,"END_TSO_QUEUE","END_TSO_QUEUE"); NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE); -SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_) -}; +SET_STATIC_HDR(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE_info,0/*CC*/,,extern const StgInfoTable) +, /*payload*/{} }; /* ----------------------------------------------------------------------------- Mutable lists @@ -300,16 +735,29 @@ SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_) an END_MUT_LIST closure. -------------------------------------------------------------------------- */ -INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0); +INFO_TABLE_CONSTR(stg_END_MUT_LIST_info,stg_END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,IF_,"END_MUT_LIST","END_MUT_LIST"); NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST); -SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_) -}; +SET_STATIC_HDR(stg_END_MUT_LIST_closure,stg_END_MUT_LIST_info,0/*CC*/,,extern const StgInfoTable) +, /*payload*/{} }; -INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, const, EF_, 0, 0); +INFO_TABLE(stg_MUT_CONS_info, stg_MUT_CONS_entry, 1, 1, MUT_CONS, , IF_, "MUT_CONS", "MUT_CONS"); NON_ENTERABLE_ENTRY_CODE(MUT_CONS); /* ----------------------------------------------------------------------------- + Exception lists + -------------------------------------------------------------------------- */ + +INFO_TABLE_CONSTR(stg_END_EXCEPTION_LIST_info,stg_END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,IF_,"END_EXCEPTION_LIST","END_EXCEPTION_LIST"); +NON_ENTERABLE_ENTRY_CODE(END_EXCEPTION_LIST); + +SET_STATIC_HDR(stg_END_EXCEPTION_LIST_closure,stg_END_EXCEPTION_LIST_info,0/*CC*/,,extern const StgInfoTable) +, /*payload*/{} }; + +INFO_TABLE(stg_EXCEPTION_CONS_info, stg_EXCEPTION_CONS_entry, 1, 1, CONSTR, , IF_, "EXCEPTION_CONS", "EXCEPTION_CONS"); +NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS); + +/* ----------------------------------------------------------------------------- Arrays These come in two basic flavours: arrays of data (StgArrWords) and arrays of @@ -324,13 +772,15 @@ NON_ENTERABLE_ENTRY_CODE(MUT_CONS); -------------------------------------------------------------------------- */ -#define ArrayInfo(type) \ -INFO_TABLE(type##_info, type##_entry, 0, 0, type, const, EF_,0,0); \ -NON_ENTERABLE_ENTRY_CODE(type); +#define ArrayInfo(type) \ +INFO_TABLE(stg_##type##_info, stg_##type##_entry, 0, 0, type, , IF_,"" # type "","" # type ""); ArrayInfo(ARR_WORDS); +NON_ENTERABLE_ENTRY_CODE(ARR_WORDS); ArrayInfo(MUT_ARR_PTRS); +NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS); ArrayInfo(MUT_ARR_PTRS_FROZEN); +NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN); #undef ArrayInfo @@ -338,27 +788,10 @@ ArrayInfo(MUT_ARR_PTRS_FROZEN); Mutable Variables -------------------------------------------------------------------------- */ -INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, const, EF_, 0, 0); +INFO_TABLE(stg_MUT_VAR_info, stg_MUT_VAR_entry, 1, 1, MUT_VAR, , IF_, "MUT_VAR", "MUT_VAR"); NON_ENTERABLE_ENTRY_CODE(MUT_VAR); /* ----------------------------------------------------------------------------- - Standard Error Entry. - - This is used for filling in vector-table entries that can never happen, - for instance. - -------------------------------------------------------------------------- */ - -STGFUN(stg_error_entry) \ -{ \ - FB_ \ - STGCALL1(fflush,stdout); \ - STGCALL2(fprintf,stderr,"fatal: stg_error_entry"); \ - STGCALL1(raiseError, errorHandler); \ - exit(EXIT_FAILURE); /* not executed */ \ - FE_ \ -} - -/* ----------------------------------------------------------------------------- Dummy return closure Entering this closure will just return to the address on the top of the @@ -366,81 +799,17 @@ STGFUN(stg_error_entry) \ just enter the top stack word to start the thread. (see deleteThread) * -------------------------------------------------------------------------- */ -INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, const, EF_, 0, 0); -FN_(dummy_ret_entry) +INFO_TABLE( stg_dummy_ret_info, stg_dummy_ret_entry, + 0, 0, CONSTR_NOCAF_STATIC, , EF_, "DUMMY_RET", "DUMMY_RET"); + +STGFUN(stg_dummy_ret_entry) { - W_ ret_addr; FB_ - ret_addr = Sp[0]; - Sp++; - JMP_(ENTRY_CODE(ret_addr)); + JMP_(ENTRY_CODE(Sp[0])); FE_ } -SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_) -}; - -/* ----------------------------------------------------------------------------- - Standard Infotables (for use in interpreter) - -------------------------------------------------------------------------- */ - -#ifdef INTERPRETER - -STGFUN(Hugs_CONSTR_entry) -{ - Sp -= 1; - ((StgPtr*)Sp)[0] = R1.p; - /* vectored: JMP_(RET_VEC(((StgPtr*)Sp)[1],constrTag(?))); */ - JMP_(ENTRY_CODE(((StgPtr*)Sp)[1])); -} - -#define RET_BCO_ENTRY_TEMPLATE(label) \ - IFN_(label) \ - { \ - FB_ \ - Sp -= 1; \ - ((StgPtr*)Sp)[0] = R1.p; \ - JMP_(stg_yield_to_Hugs); \ - FE_ \ - } - -RET_BCO_ENTRY_TEMPLATE(ret_bco_entry ); -RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry); -RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry); -RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry); -RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry); -RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry); -RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry); -RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry); -RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry); - -VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO); - -#endif /* INTERPRETER */ - -#ifndef COMPILER - -INFO_TABLE_CONSTR(Czh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,const,EF_,0,0); -INFO_TABLE_CONSTR(Izh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,const,EF_,0,0); -INFO_TABLE_CONSTR(I64zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,const,EF_,0,0); -INFO_TABLE_CONSTR(Fzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,const,EF_,0,0); -INFO_TABLE_CONSTR(Dzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,const,EF_,0,0); -INFO_TABLE_CONSTR(Azh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,const,EF_,0,0); -INFO_TABLE_CONSTR(Wzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,const,EF_,0,0); -INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,const,EF_,0,0); - -/* These might seem redundant but {I,C}zh_static_info are used in - * {INT,CHAR}LIKE and the rest are used in RtsAPI.c - */ -INFO_TABLE_CONSTR(Czh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,const,EF_,0,0); -INFO_TABLE_CONSTR(Izh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,const,EF_,0,0); -INFO_TABLE_CONSTR(I64zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,const,EF_,0,0); -INFO_TABLE_CONSTR(Fzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,const,EF_,0,0); -INFO_TABLE_CONSTR(Dzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,const,EF_,0,0); -INFO_TABLE_CONSTR(Azh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0); -INFO_TABLE_CONSTR(Wzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,const,EF_,0,0); -INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0); - -#endif /* !defined(COMPILER) */ +SET_STATIC_HDR(stg_dummy_ret_closure,stg_dummy_ret_info,CCS_DONT_CARE,,extern const StgInfoTable) +, /*payload*/{} }; /* ----------------------------------------------------------------------------- CHARLIKE and INTLIKE closures. @@ -450,33 +819,33 @@ INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr replace them with references to the static objects. -------------------------------------------------------------------------- */ -#ifdef HAVE_WIN32_DLL_SUPPORT +#if defined(INTERPRETER) || defined(ENABLE_WIN32_DLL_SUPPORT) /* * When sticking the RTS in a DLL, we delay populating the * Charlike and Intlike tables until load-time, which is only * when we've got the real addresses to the C# and I# closures. * */ -static const StgInfoTable czh_static_info; -static const StgInfoTable izh_static_info; +static INFO_TBL_CONST StgInfoTable czh_static_info; +static INFO_TBL_CONST StgInfoTable izh_static_info; #define Char_hash_static_info czh_static_info #define Int_hash_static_info izh_static_info #else -#define Char_hash_static_info Czh_static_info -#define Int_hash_static_info Izh_static_info +#define Char_hash_static_info GHCziBase_Czh_static_info +#define Int_hash_static_info GHCziBase_Izh_static_info #endif #define CHARLIKE_HDR(n) \ { \ STATIC_HDR(Char_hash_static_info, /* C# */ \ - CCS_DONTZuCARE), \ + CCS_DONT_CARE), \ data : n \ } #define INTLIKE_HDR(n) \ { \ STATIC_HDR(Int_hash_static_info, /* I# */ \ - CCS_DONTZuCARE), \ + CCS_DONT_CARE), \ data : n \ } @@ -486,7 +855,7 @@ static const StgInfoTable izh_static_info; /* end the name with _closure, to convince the mangler this is a closure */ -StgIntCharlikeClosure CHARLIKE_closure[] = { +StgIntCharlikeClosure stg_CHARLIKE_closure[] = { CHARLIKE_HDR(0), CHARLIKE_HDR(1), CHARLIKE_HDR(2), @@ -745,7 +1114,7 @@ StgIntCharlikeClosure CHARLIKE_closure[] = { CHARLIKE_HDR(255) }; -StgIntCharlikeClosure INTLIKE_closure[] = { +StgIntCharlikeClosure stg_INTLIKE_closure[] = { INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */ INTLIKE_HDR(-15), INTLIKE_HDR(-14),