X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FStgMiscClosures.hc;h=266b6fde2447089438ceb0d459409da671cc587a;hb=2cc5b907318f97e19b28b2ad8ed9ff8c1f401dcc;hp=5e966c39099c6a5fad5ace4d5aa11a7be4f9c2a2;hpb=0d5d32bf62c39c390934d9ef4b01e2bf2db910f8;p=ghc-hetmet.git diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc index 5e966c3..266b6fd 100644 --- a/ghc/rts/StgMiscClosures.hc +++ b/ghc/rts/StgMiscClosures.hc @@ -1,21 +1,22 @@ /* ----------------------------------------------------------------------------- - * $Id: StgMiscClosures.hc,v 1.37 2000/03/13 10:53:55 simonmar Exp $ + * $Id: StgMiscClosures.hc,v 1.73 2002/02/12 15:17:22 simonmar Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2000 * * 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 "ProfRts.h" +#include "Profiling.h" #include "Prelude.h" +#include "Schedule.h" #include "SMP.h" #if defined(GRAN) || defined(PAR) # include "GranSimRts.h" /* for DumpRawGranEvent */ @@ -26,7 +27,7 @@ #include #endif -/* ToDo: make the printing of panics more Win32-friendly, i.e., +/* 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) @@ -36,46 +37,281 @@ */ #define NON_ENTERABLE_ENTRY_CODE(type) \ -STGFUN(type##_entry) \ +STGFUN(stg_##type##_entry) \ { \ FB_ \ DUMP_ERRMSG(#type " object entered!\n"); \ STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \ + return NULL; \ FE_ \ } + /* ----------------------------------------------------------------------------- - Entry code for an indirection. + Support for the bytecode interpreter. + -------------------------------------------------------------------------- */ + +/* 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 in R1 and it is a pointer, so doesn't + need tagging ... */ +#define STG_CtoI_RET_R1p_Template(label) \ + IFN_(label) \ + { \ + StgPtr bco; \ + FB_ \ + bco = ((StgPtr*)Sp)[1]; \ + Sp -= 1; \ + ((StgPtr*)Sp)[0] = R1.p; \ + Sp -= 1; \ + ((StgPtr*)Sp)[0] = bco; \ + JMP_(stg_yield_to_interpreter); \ + FE_ \ + } + +STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_entry); +STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_0_entry); +STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_1_entry); +STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_2_entry); +STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_3_entry); +STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_4_entry); +STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_5_entry); +STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_6_entry); +STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_7_entry); + +VEC_POLY_INFO_TABLE(stg_ctoi_ret_R1p,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_); + + + +/* When the returned value is in R1 and it isn't a pointer. */ +#define STG_CtoI_RET_R1n_Template(label) \ + IFN_(label) \ + { \ + StgPtr bco; \ + FB_ \ + bco = ((StgPtr*)Sp)[1]; \ + Sp -= 1; \ + ((StgPtr*)Sp)[0] = (StgPtr)R1.i; \ + Sp -= 1; \ + ((StgPtr*)Sp)[0] = (StgPtr)1; /* tag */ \ + Sp -= 1; \ + ((StgPtr*)Sp)[0] = bco; \ + JMP_(stg_yield_to_interpreter); \ + FE_ \ + } + +STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_entry); +STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_0_entry); +STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_1_entry); +STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_2_entry); +STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_3_entry); +STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_4_entry); +STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_5_entry); +STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_6_entry); +STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_7_entry); + +VEC_POLY_INFO_TABLE(stg_ctoi_ret_R1n,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_); + + + +/* When the returned value is in F1 ... */ +#define STG_CtoI_RET_F1_Template(label) \ + IFN_(label) \ + { \ + StgPtr bco; \ + FB_ \ + bco = ((StgPtr*)Sp)[1]; \ + Sp -= sizeofW(StgFloat); \ + ASSIGN_FLT((W_*)Sp, F1); \ + Sp -= 1; \ + ((StgPtr*)Sp)[0] = (StgPtr)sizeofW(StgFloat); \ + Sp -= 1; \ + ((StgPtr*)Sp)[0] = bco; \ + JMP_(stg_yield_to_interpreter); \ + FE_ \ + } + +STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_entry); +STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_0_entry); +STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_1_entry); +STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_2_entry); +STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_3_entry); +STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_4_entry); +STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_5_entry); +STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_6_entry); +STG_CtoI_RET_F1_Template(stg_ctoi_ret_F1_7_entry); + +VEC_POLY_INFO_TABLE(stg_ctoi_ret_F1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_); + + +/* When the returned value is in D1 ... */ +#define STG_CtoI_RET_D1_Template(label) \ + IFN_(label) \ + { \ + StgPtr bco; \ + FB_ \ + bco = ((StgPtr*)Sp)[1]; \ + Sp -= sizeofW(StgDouble); \ + ASSIGN_DBL((W_*)Sp, D1); \ + Sp -= 1; \ + ((StgPtr*)Sp)[0] = (StgPtr)sizeofW(StgDouble); \ + Sp -= 1; \ + ((StgPtr*)Sp)[0] = bco; \ + JMP_(stg_yield_to_interpreter); \ + FE_ \ + } + +STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_entry); +STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_0_entry); +STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_1_entry); +STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_2_entry); +STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_3_entry); +STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_4_entry); +STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_5_entry); +STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_6_entry); +STG_CtoI_RET_D1_Template(stg_ctoi_ret_D1_7_entry); + +VEC_POLY_INFO_TABLE(stg_ctoi_ret_D1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_); + + +/* When the returned value a VoidRep ... */ +#define STG_CtoI_RET_V_Template(label) \ + IFN_(label) \ + { \ + StgPtr bco; \ + FB_ \ + bco = ((StgPtr*)Sp)[1]; \ + Sp -= 1; \ + ((StgPtr*)Sp)[0] = 0; /* VoidRep tag */ \ + Sp -= 1; \ + ((StgPtr*)Sp)[0] = bco; \ + JMP_(stg_yield_to_interpreter); \ + FE_ \ + } - This code assumes R1 is in a register for now. +STG_CtoI_RET_V_Template(stg_ctoi_ret_V_entry); +STG_CtoI_RET_V_Template(stg_ctoi_ret_V_0_entry); +STG_CtoI_RET_V_Template(stg_ctoi_ret_V_1_entry); +STG_CtoI_RET_V_Template(stg_ctoi_ret_V_2_entry); +STG_CtoI_RET_V_Template(stg_ctoi_ret_V_3_entry); +STG_CtoI_RET_V_Template(stg_ctoi_ret_V_4_entry); +STG_CtoI_RET_V_Template(stg_ctoi_ret_V_5_entry); +STG_CtoI_RET_V_Template(stg_ctoi_ret_V_6_entry); +STG_CtoI_RET_V_Template(stg_ctoi_ret_V_7_entry); + +VEC_POLY_INFO_TABLE(stg_ctoi_ret_V,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_); + + +/* The other way round: when the interpreter returns a value to + compiled code. The stack looks like this: + + return info table (pushed by compiled code) + return value (pushed by interpreter) + + If the value is ptr-rep'd, the interpreter simply returns to the + scheduler, instructing it to ThreadEnterGHC. + + Otherwise (unboxed return value), we replace the top stack word, + which must be the tag, with stg_gc_unbx_r1_info (or f1_info or d1_info), + and return to the scheduler, instructing it to ThreadRunGHC. + + No supporting code needed! +*/ + + +/* Entering a BCO. Heave it on the stack and defer to the + scheduler. */ +INFO_TABLE(stg_BCO_info,stg_BCO_entry,4,0,BCO,,EF_,"BCO","BCO"); +STGFUN(stg_BCO_entry) { + FB_ + Sp -= 1; + Sp[0] = R1.w; + JMP_(stg_yield_to_interpreter); + FE_ +} + + +/* ----------------------------------------------------------------------------- + Entry code for an indirection. -------------------------------------------------------------------------- */ -INFO_TABLE(IND_info,IND_entry,1,0,IND,,EF_,0,0); -STGFUN(IND_entry) +INFO_TABLE(stg_IND_info,stg_IND_entry,1,0,IND,,EF_,"IND","IND"); +STGFUN(stg_IND_entry) { FB_ TICK_ENT_IND(Node); /* tick */ - R1.p = (P_) ((StgInd*)R1.p)->indirectee; TICK_ENT_VIA_NODE(); - JMP_(ENTRY_CODE(*R1.p)); + JMP_(GET_ENTRY(R1.cl)); FE_ } -INFO_TABLE(IND_STATIC_info,IND_STATIC_entry,1,0,IND_STATIC,,EF_,0,0); -STGFUN(IND_STATIC_entry) +INFO_TABLE(stg_IND_STATIC_info,stg_IND_STATIC_entry,1,0,IND_STATIC,,EF_,"IND_STATIC","IND_STATIC"); +STGFUN(stg_IND_STATIC_entry) { FB_ TICK_ENT_IND(Node); /* tick */ - R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee; TICK_ENT_VIA_NODE(); - JMP_(ENTRY_CODE(*R1.p)); + JMP_(GET_ENTRY(R1.cl)); FE_ } -INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,,EF_,0,0); -STGFUN(IND_PERM_entry) +INFO_TABLE(stg_IND_PERM_info,stg_IND_PERM_entry,1,1,IND_PERM,,EF_,"IND_PERM","IND_PERM"); +STGFUN(stg_IND_PERM_entry) { FB_ /* Don't add INDs to granularity cost */ @@ -86,6 +322,8 @@ STGFUN(IND_PERM_entry) TICK_ENT_PERM_IND(R1.p); /* tick */ #endif + LDV_ENTER((StgInd *)R1.p); + /* Enter PAP cost centre -- lexical scoping only */ ENTER_CCS_PAP_CL(R1.cl); @@ -101,7 +339,7 @@ STGFUN(IND_PERM_entry) # ifdef PROFILING # error Profiling and ticky-ticky do not mix at present! # endif /* PROFILING */ - SET_INFO((StgInd*)R1.p,&IND_info); + SET_INFO((StgInd*)R1.p,&stg_IND_info); #endif /* TICKY_TICKY */ R1.p = (P_) ((StgInd*)R1.p)->indirectee; @@ -112,24 +350,23 @@ STGFUN(IND_PERM_entry) TICK_ENT_VIA_NODE(); #endif - JMP_(ENTRY_CODE(*R1.p)); + JMP_(GET_ENTRY(R1.cl)); FE_ } -INFO_TABLE(IND_OLDGEN_info,IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,0,0); -STGFUN(IND_OLDGEN_entry) +INFO_TABLE(stg_IND_OLDGEN_info,stg_IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,"IND_OLDGEN","IND_OLDGEN"); +STGFUN(stg_IND_OLDGEN_entry) { FB_ TICK_ENT_IND(Node); /* tick */ - R1.p = (P_) ((StgInd*)R1.p)->indirectee; TICK_ENT_VIA_NODE(); - JMP_(ENTRY_CODE(*R1.p)); + JMP_(GET_ENTRY(R1.cl)); FE_ } -INFO_TABLE(IND_OLDGEN_PERM_info,IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,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,,EF_,"IND_OLDGEN_PERM","IND_OLDGEN_PERM"); +STGFUN(stg_IND_OLDGEN_PERM_entry) { FB_ /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */ @@ -138,7 +375,9 @@ STGFUN(IND_OLDGEN_PERM_entry) /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */ TICK_ENT_PERM_IND(R1.p); /* tick */ #endif - + + LDV_ENTER((StgInd *)R1.p); + /* Enter PAP cost centre -- lexical scoping only */ ENTER_CCS_PAP_CL(R1.cl); @@ -147,39 +386,11 @@ STGFUN(IND_OLDGEN_PERM_entry) # ifdef PROFILING # error Profiling and ticky-ticky do not mix at present! # endif /* PROFILING */ - SET_INFO((StgInd*)R1.p,&IND_OLDGEN_info); + SET_INFO((StgInd*)R1.p,&stg_IND_OLDGEN_info); #endif /* TICKY_TICKY */ R1.p = (P_) ((StgInd*)R1.p)->indirectee; TICK_ENT_VIA_NODE(); - JMP_(ENTRY_CODE(*R1.p)); - FE_ -} - -/* ----------------------------------------------------------------------------- - Entry code for CAFs - - This code assumes R1 is in a register for now. - -------------------------------------------------------------------------- */ - -INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,3,CAF_UNENTERED,,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_ -} - -/* 0,4 is entirely bogus; _do not_ rely on this info */ -INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,0,4,CAF_ENTERED,,EF_,0,0); -STGFUN(CAF_ENTERED_entry) -{ - FB_ - R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */ - TICK_ENT_VIA_NODE(); JMP_(GET_ENTRY(R1.cl)); FE_ } @@ -200,8 +411,8 @@ STGFUN(CAF_ENTERED_entry) * old-generation indirection. */ -INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,0,0); -STGFUN(BLACKHOLE_entry) +INFO_TABLE(stg_BLACKHOLE_info, stg_BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,"BLACKHOLE","BLACKHOLE"); +STGFUN(stg_BLACKHOLE_entry) { FB_ #if defined(GRAN) @@ -212,9 +423,9 @@ STGFUN(BLACKHOLE_entry) #ifdef SMP { bdescr *bd = Bdescr(R1.p); - if (bd->back != (bdescr *)BaseReg) { - if (bd->gen->no >= 1 || bd->step->no >= 1) { - CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info); + 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); @@ -224,49 +435,48 @@ STGFUN(BLACKHOLE_entry) #endif TICK_ENT_BH(); + // 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 */ #if defined(GRAN) || defined(PAR) - /* in fact, only difference is the type of the end-of-queue marker! */ + // 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 */ + // jot down why and on what closure we are blocked CurrentTSO->why_blocked = BlockedOnBlackHole; CurrentTSO->block_info.closure = R1.cl; - /* closure is mutable since something has just been added to its BQ */ - recordMutable((StgMutClosure *)R1.cl); + /* Change the BLACKHOLE into a BLACKHOLE_BQ */ - ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info; - -#if defined(PAR) - /* Save the Thread State here, before calling RTS routines below! */ - SAVE_THREAD_STATE(1); - - /* if collecting stats update the execution time etc */ - if (RtsFlags.ParFlags.ParStats.Full) { - /* Note that CURRENT_TIME may perform an unsafe call */ - //rtsTime now = CURRENT_TIME; /* Now */ - CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat; - CurrentTSO->par.blockcount++; - CurrentTSO->par.blockedat = CURRENT_TIME; - DumpRawGranEvent(CURRENT_PROC, thisPE, - GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0); - } +#ifdef PROFILING - THREAD_RETURN(1); /* back to the scheduler */ -#else - /* stg_gen_block is too heavyweight, use a specialised one */ - BLOCK_NP(1); + // 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); + + // 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,,EF_,0,0); -STGFUN(BLACKHOLE_BQ_entry) +INFO_TABLE(stg_BLACKHOLE_BQ_info, stg_BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,"BLACKHOLE","BLACKHOLE"); +STGFUN(stg_BLACKHOLE_BQ_entry) { FB_ #if defined(GRAN) @@ -277,9 +487,9 @@ STGFUN(BLACKHOLE_BQ_entry) #ifdef SMP { bdescr *bd = Bdescr(R1.p); - if (bd->back != (bdescr *)BaseReg) { - if (bd->gen->no >= 1 || bd->step->no >= 1) { - CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info); + 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); @@ -289,6 +499,7 @@ STGFUN(BLACKHOLE_BQ_entry) #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; @@ -297,29 +508,13 @@ STGFUN(BLACKHOLE_BQ_entry) CurrentTSO->why_blocked = BlockedOnBlackHole; CurrentTSO->block_info.closure = R1.cl; #ifdef SMP - ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info; + ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info; #endif -#if defined(PAR) - /* Save the Thread State here, before calling RTS routines below! */ - SAVE_THREAD_STATE(1); - - /* if collecting stats update the execution time etc */ - if (RtsFlags.ParFlags.ParStats.Full) { - /* Note that CURRENT_TIME may perform an unsafe call */ - //rtsTime now = CURRENT_TIME; /* Now */ - CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat; - CurrentTSO->par.blockcount++; - CurrentTSO->par.blockedat = CURRENT_TIME; - DumpRawGranEvent(CURRENT_PROC, thisPE, - GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0); - } + /* PAR: dumping of event now done in blockThread -- HWL */ - THREAD_RETURN(1); /* back to the scheduler */ -#else /* stg_gen_block is too heavyweight, use a specialised one */ BLOCK_NP(1); -#endif FE_ } @@ -337,8 +532,8 @@ STGFUN(BLACKHOLE_BQ_entry) #if defined(PAR) || defined(GRAN) -INFO_TABLE(RBH_info, RBH_entry,1,1,RBH,,EF_,0,0); -STGFUN(RBH_entry) +INFO_TABLE(stg_RBH_info, stg_RBH_entry,1,1,RBH,,EF_,"RBH","RBH"); +STGFUN(stg_RBH_entry) { FB_ # if defined(GRAN) @@ -354,44 +549,26 @@ STGFUN(RBH_entry) CurrentTSO->why_blocked = BlockedOnBlackHole; CurrentTSO->block_info.closure = R1.cl; -#if defined(PAR) - /* Save the Thread State here, before calling RTS routines below! */ - SAVE_THREAD_STATE(1); - - /* if collecting stats update the execution time etc */ - if (RtsFlags.ParFlags.ParStats.Full) { - /* Note that CURRENT_TIME may perform an unsafe call */ - //rtsTime now = CURRENT_TIME; /* Now */ - CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat; - CurrentTSO->par.blockcount++; - CurrentTSO->par.blockedat = CURRENT_TIME; - DumpRawGranEvent(CURRENT_PROC, thisPE, - GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0); - } + /* PAR: dumping of event now done in blockThread -- HWL */ - THREAD_RETURN(1); /* back to the scheduler */ -#else - /* saves thread state and leaves thread in ThreadEnterGHC state; */ /* stg_gen_block is too heavyweight, use a specialised one */ BLOCK_NP(1); -#endif - FE_ } -INFO_TABLE(RBH_Save_0_info, RBH_Save_0_entry,0,2,CONSTR,,EF_,0,0); +INFO_TABLE(stg_RBH_Save_0_info, stg_RBH_Save_0_entry,0,2,CONSTR,,EF_,"RBH_Save_0","RBH_Save_0"); NON_ENTERABLE_ENTRY_CODE(RBH_Save_0); -INFO_TABLE(RBH_Save_1_info, RBH_Save_1_entry,1,1,CONSTR,,EF_,0,0); +INFO_TABLE(stg_RBH_Save_1_info, stg_RBH_Save_1_entry,1,1,CONSTR,,EF_,"RBH_Save_1","RBH_Save_1"); NON_ENTERABLE_ENTRY_CODE(RBH_Save_1); -INFO_TABLE(RBH_Save_2_info, RBH_Save_2_entry,2,0,CONSTR,,EF_,0,0); +INFO_TABLE(stg_RBH_Save_2_info, stg_RBH_Save_2_entry,2,0,CONSTR,,EF_,"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,,EF_,0,0); -STGFUN(CAF_BLACKHOLE_entry) +INFO_TABLE(stg_CAF_BLACKHOLE_info, stg_CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,"CAF_BLACKHOLE","CAF_BLACKHOLE"); +STGFUN(stg_CAF_BLACKHOLE_entry) { FB_ #if defined(GRAN) @@ -402,9 +579,9 @@ STGFUN(CAF_BLACKHOLE_entry) #ifdef SMP { bdescr *bd = Bdescr(R1.p); - if (bd->back != (bdescr *)BaseReg) { - if (bd->gen->no >= 1 || bd->step->no >= 1) { - CMPXCHG(R1.cl->header.info, &CAF_BLACKHOLE_info, &WHITEHOLE_info); + 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); @@ -414,51 +591,37 @@ STGFUN(CAF_BLACKHOLE_entry) #endif TICK_ENT_BH(); + LDV_ENTER((StgClosure *)R1.p); - /* Put ourselves on the blocking queue for this black hole */ + // 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! */ + // 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 */ + // jot down why and on what closure we are blocked CurrentTSO->why_blocked = BlockedOnBlackHole; CurrentTSO->block_info.closure = R1.cl; - /* closure is mutable since something has just been added to its BQ */ + + // 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); - /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ */ - ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info; - -#if defined(PAR) - /* Save the Thread State here, before calling RTS routines below! */ - SAVE_THREAD_STATE(1); - - /* if collecting stats update the execution time etc */ - if (RtsFlags.ParFlags.ParStats.Full) { - /* Note that CURRENT_TIME may perform an unsafe call */ - //rtsTime now = CURRENT_TIME; /* Now */ - CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat; - CurrentTSO->par.blockcount++; - CurrentTSO->par.blockedat = CURRENT_TIME; - DumpRawGranEvent(CURRENT_PROC, thisPE, - GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0); - } - THREAD_RETURN(1); /* back to the scheduler */ -#else - /* stg_gen_block is too heavyweight, use a specialised one */ - BLOCK_NP(1); -#endif + // PAR: dumping of event now done in blockThread -- HWL + // stg_gen_block is too heavyweight, use a specialised one + BLOCK_NP(1); FE_ } #ifdef TICKY_TICKY -INFO_TABLE(SE_BLACKHOLE_info, SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,0,0); -STGFUN(SE_BLACKHOLE_entry) +INFO_TABLE(stg_SE_BLACKHOLE_info, stg_SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,"SE_BLACKHOLE","SE_BLACKHOLE"); +STGFUN(stg_SE_BLACKHOLE_entry) { FB_ STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1.p); @@ -466,8 +629,8 @@ STGFUN(SE_BLACKHOLE_entry) FE_ } -INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,0,0); -STGFUN(SE_CAF_BLACKHOLE_entry) +INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,"CAF_BLACKHOLE","CAF_BLACKHOLE"); +STGFUN(stg_SE_CAF_BLACKHOLE_entry) { FB_ STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1.p); @@ -477,8 +640,8 @@ STGFUN(SE_CAF_BLACKHOLE_entry) #endif #ifdef SMP -INFO_TABLE(WHITEHOLE_info, WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,0,0); -STGFUN(WHITEHOLE_entry) +INFO_TABLE(stg_WHITEHOLE_info, stg_WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,"WHITEHOLE","WHITEHOLE"); +STGFUN(stg_WHITEHOLE_entry) { FB_ JMP_(GET_ENTRY(R1.cl)); @@ -487,24 +650,12 @@ STGFUN(WHITEHOLE_entry) #endif /* ----------------------------------------------------------------------------- - The code for a BCO returns to the scheduler - -------------------------------------------------------------------------- */ -INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,,EF_,0,0); -EF_(BCO_entry) { - FB_ - Sp -= 1; - Sp[0] = R1.w; - JMP_(stg_yield_to_Hugs); - FE_ -} - -/* ----------------------------------------------------------------------------- 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 -------------------------------------------------------------------------- */ -INFO_TABLE(TSO_info, TSO_entry, 0,0,TSO,,EF_,0,0); +INFO_TABLE(stg_TSO_info, stg_TSO_entry, 0,0,TSO,,EF_,"TSO","TSO"); NON_ENTERABLE_ENTRY_CODE(TSO); /* ----------------------------------------------------------------------------- @@ -512,7 +663,7 @@ NON_ENTERABLE_ENTRY_CODE(TSO); one is a real bug. -------------------------------------------------------------------------- */ -INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,,EF_,0,0); +INFO_TABLE(stg_EVACUATED_info,stg_EVACUATED_entry,1,0,EVACUATED,,EF_,"EVACUATED","EVACUATED"); NON_ENTERABLE_ENTRY_CODE(EVACUATED); /* ----------------------------------------------------------------------------- @@ -523,10 +674,22 @@ NON_ENTERABLE_ENTRY_CODE(EVACUATED); live weak pointers with dead ones). -------------------------------------------------------------------------- */ -INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,,EF_,0,0); +INFO_TABLE(stg_WEAK_info,stg_WEAK_entry,0,4,WEAK,,EF_,"WEAK","WEAK"); NON_ENTERABLE_ENTRY_CODE(WEAK); -INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,0,0); +// XXX! The garbage collector replaces a WEAK with a DEAD_WEAK +// in-place, which causes problems if the heap is scanned linearly +// after GC (certain kinds of profiling do this). So when profiling, +// we set the size of a DEAD_WEAK to 4 non-pointers, rather than its +// usual 1. + +#ifdef PROFILING +#define DEAD_WEAK_PAYLOAD_WORDS 4 +#else +#define DEAD_WEAK_PAYLOAD_WORDS 1 +#endif + +INFO_TABLE_CONSTR(stg_DEAD_WEAK_info,stg_DEAD_WEAK_entry,0,DEAD_WEAK_PAYLOAD_WORDS,0,CONSTR,,EF_,"DEAD_WEAK","DEAD_WEAK"); NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK); /* ----------------------------------------------------------------------------- @@ -536,24 +699,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,,EF_,0,0); +INFO_TABLE_CONSTR(stg_NO_FINALIZER_info,stg_NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,"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*/,,EI_) , /*payload*/{} }; /* ----------------------------------------------------------------------------- Foreign Objects are unlifted and therefore never entered. -------------------------------------------------------------------------- */ -INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,,EF_,0,0); +INFO_TABLE(stg_FOREIGN_info,stg_FOREIGN_entry,0,1,FOREIGN,,EF_,"FOREIGN","FOREIGN"); NON_ENTERABLE_ENTRY_CODE(FOREIGN); /* ----------------------------------------------------------------------------- Stable Names are unlifted too. -------------------------------------------------------------------------- */ -INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,0,0); +INFO_TABLE(stg_STABLE_NAME_info,stg_STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,"STABLE_NAME","STABLE_NAME"); NON_ENTERABLE_ENTRY_CODE(STABLE_NAME); /* ----------------------------------------------------------------------------- @@ -563,10 +726,10 @@ NON_ENTERABLE_ENTRY_CODE(STABLE_NAME); and entry code for each type. -------------------------------------------------------------------------- */ -INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,,EF_,0,0); +INFO_TABLE(stg_FULL_MVAR_info,stg_FULL_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR"); NON_ENTERABLE_ENTRY_CODE(FULL_MVAR); -INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,,EF_,0,0); +INFO_TABLE(stg_EMPTY_MVAR_info,stg_EMPTY_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR"); NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR); /* ----------------------------------------------------------------------------- @@ -576,10 +739,10 @@ 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,,EF_,0,0); +INFO_TABLE_CONSTR(stg_END_TSO_QUEUE_info,stg_END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,"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*/,,EI_) , /*payload*/{} }; /* ----------------------------------------------------------------------------- @@ -590,26 +753,26 @@ 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,,EF_,0,0); +INFO_TABLE_CONSTR(stg_END_MUT_LIST_info,stg_END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,"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*/,,EI_) , /*payload*/{} }; -INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, , EF_, 0, 0); +INFO_TABLE(stg_MUT_CONS_info, stg_MUT_CONS_entry, 1, 1, MUT_CONS, , EF_, "MUT_CONS", "MUT_CONS"); NON_ENTERABLE_ENTRY_CODE(MUT_CONS); /* ----------------------------------------------------------------------------- Exception lists -------------------------------------------------------------------------- */ -INFO_TABLE_CONSTR(END_EXCEPTION_LIST_info,END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0); +INFO_TABLE_CONSTR(stg_END_EXCEPTION_LIST_info,stg_END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,"END_EXCEPTION_LIST","END_EXCEPTION_LIST"); NON_ENTERABLE_ENTRY_CODE(END_EXCEPTION_LIST); -SET_STATIC_HDR(END_EXCEPTION_LIST_closure,END_EXCEPTION_LIST_info,0/*CC*/,,EI_) +SET_STATIC_HDR(stg_END_EXCEPTION_LIST_closure,stg_END_EXCEPTION_LIST_info,0/*CC*/,,EI_) , /*payload*/{} }; -INFO_TABLE(EXCEPTION_CONS_info, EXCEPTION_CONS_entry, 1, 1, CONSTR, , EF_, 0, 0); +INFO_TABLE(stg_EXCEPTION_CONS_info, stg_EXCEPTION_CONS_entry, 1, 1, CONSTR, , EF_, "EXCEPTION_CONS", "EXCEPTION_CONS"); NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS); /* ----------------------------------------------------------------------------- @@ -628,7 +791,7 @@ NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS); -------------------------------------------------------------------------- */ #define ArrayInfo(type) \ -INFO_TABLE(type##_info, type##_entry, 0, 0, type, , EF_,0,0); +INFO_TABLE(stg_##type##_info, stg_##type##_entry, 0, 0, type, , EF_,"" # type "","" # type ""); ArrayInfo(ARR_WORDS); NON_ENTERABLE_ENTRY_CODE(ARR_WORDS); @@ -643,7 +806,7 @@ NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN); Mutable Variables -------------------------------------------------------------------------- */ -INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, 0, 0); +INFO_TABLE(stg_MUT_VAR_info, stg_MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, "MUT_VAR", "MUT_VAR"); NON_ENTERABLE_ENTRY_CODE(MUT_VAR); /* ----------------------------------------------------------------------------- @@ -652,15 +815,17 @@ NON_ENTERABLE_ENTRY_CODE(MUT_VAR); This is used for filling in vector-table entries that can never happen, for instance. -------------------------------------------------------------------------- */ - +/* No longer used; we use NULL, because a) it never happens, right? and b) + Windows doesn't like DLL entry points being used as static initialisers STGFUN(stg_error_entry) \ { \ FB_ \ DUMP_ERRMSG("fatal: stg_error_entry"); \ STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \ + return NULL; \ FE_ \ } - +*/ /* ----------------------------------------------------------------------------- Dummy return closure @@ -669,8 +834,8 @@ 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, , 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_ @@ -679,7 +844,7 @@ FN_(dummy_ret_entry) JMP_(ENTRY_CODE(ret_addr)); FE_ } -SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_) +SET_STATIC_HDR(stg_dummy_ret_closure,stg_dummy_ret_info,CCS_DONT_CARE,,EI_) , /*payload*/{} }; /* ----------------------------------------------------------------------------- @@ -696,8 +861,8 @@ SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_) * -------------------------------------------------------------------------- */ #ifdef REG_R1 -INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0); -FN_(forceIO_ret_entry) +INFO_TABLE_SRT_BITMAP(stg_forceIO_ret_info,stg_forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0); +STGFUN(stg_forceIO_ret_entry) { FB_ Sp++; @@ -706,8 +871,8 @@ FN_(forceIO_ret_entry) JMP_(GET_ENTRY(R1.cl)); } #else -INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0); -FN_(forceIO_ret_entry) +INFO_TABLE_SRT_BITMAP(stg_forceIO_ret_info,stg_forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0); +STGFUN(stg_forceIO_ret_entry) { StgClosure *rval; FB_ @@ -720,86 +885,25 @@ FN_(forceIO_ret_entry) } #endif -INFO_TABLE(forceIO_info,forceIO_entry,1,0,FUN_STATIC,,EF_,0,0); -FN_(forceIO_entry) +INFO_TABLE(stg_forceIO_info,stg_forceIO_entry,1,0,FUN_STATIC,,EF_,"FORCE_IO","FORCE_IO"); +FN_(stg_forceIO_entry) { FB_ /* Sp[0] contains the IO action we want to perform */ R1.p = (P_)Sp[0]; /* Replace it with the return continuation that enters the result. */ - Sp[0] = (W_)&forceIO_ret_info; + Sp[0] = (W_)&stg_forceIO_ret_info; Sp--; /* Push the RealWorld# tag and enter */ Sp[0] =(W_)REALWORLD_TAG; JMP_(GET_ENTRY(R1.cl)); FE_ } -SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONTZuCARE,,EI_) +SET_STATIC_HDR(stg_forceIO_closure,stg_forceIO_info,CCS_DONT_CARE,,EI_) , /*payload*/{} }; /* ----------------------------------------------------------------------------- - Standard Infotables (for use in interpreter) - -------------------------------------------------------------------------- */ - -#ifdef INTERPRETER - -STGFUN(Hugs_CONSTR_entry) -{ - /* R1 points at the constructor */ - JMP_(ENTRY_CODE(((StgPtr*)Sp)[0])); -} - -#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,, EF_); - -#endif /* INTERPRETER */ - -#ifndef COMPILER - -INFO_TABLE_CONSTR(Czh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,,EF_,0,0); -INFO_TABLE_CONSTR(Izh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,,EF_,0,0); -INFO_TABLE_CONSTR(I64zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,,EF_,0,0); -INFO_TABLE_CONSTR(Fzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,,EF_,0,0); -INFO_TABLE_CONSTR(Dzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,,EF_,0,0); -INFO_TABLE_CONSTR(Azh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,,EF_,0,0); -INFO_TABLE_CONSTR(Wzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,,EF_,0,0); -INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,,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,,EF_,0,0); -INFO_TABLE_CONSTR(Izh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,,EF_,0,0); -INFO_TABLE_CONSTR(I64zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,,EF_,0,0); -INFO_TABLE_CONSTR(Fzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,,EF_,0,0); -INFO_TABLE_CONSTR(Dzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,,EF_,0,0); -INFO_TABLE_CONSTR(Azh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,,EF_,0,0); -INFO_TABLE_CONSTR(Wzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,,EF_,0,0); -INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,,EF_,0,0); - -#endif /* !defined(COMPILER) */ - -/* ----------------------------------------------------------------------------- CHARLIKE and INTLIKE closures. These are static representations of Chars and small Ints, so that @@ -807,7 +911,7 @@ INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr replace them with references to the static objects. -------------------------------------------------------------------------- */ -#ifdef ENABLE_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 @@ -819,21 +923,21 @@ 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 \ } @@ -843,7 +947,7 @@ static INFO_TBL_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), @@ -1102,7 +1206,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),