X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FStgMiscClosures.hc;h=06286a09962b56d5f2e54c69964762b9405be7bf;hb=2db150e82af6cb9802006227cffb8414d99261f3;hp=a2de22c76345e943b089d408936d2c45612a4433;hpb=34a98f40dea6d31ced5213b7810dc39b4989c395;p=ghc-hetmet.git diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc index a2de22c..06286a0 100644 --- a/ghc/rts/StgMiscClosures.hc +++ b/ghc/rts/StgMiscClosures.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgMiscClosures.hc,v 1.50 2000/11/13 14:40:37 simonmar Exp $ + * $Id: StgMiscClosures.hc,v 1.68 2001/08/10 09:41:17 simonmar Exp $ * * (c) The GHC Team, 1998-2000 * @@ -7,6 +7,7 @@ * * ---------------------------------------------------------------------------*/ +#include "Stg.h" #include "Rts.h" #include "RtsUtils.h" #include "RtsFlags.h" @@ -48,255 +49,240 @@ STGFUN(stg_##type##_entry) \ /* ----------------------------------------------------------------------------- - Support for the metacircular interpreter. + Support for the bytecode interpreter. -------------------------------------------------------------------------- */ -#ifdef GHCI - -/* 9 bits of return code for constructors created by mci_make_constr. */ -FN_(stg_mci_constr_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,"mci_constr_entry (direct return)!\n"); + /* 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_mci_constr1_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),0)); FE_ } -FN_(stg_mci_constr2_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),1)); FE_ } -FN_(stg_mci_constr3_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),2)); FE_ } -FN_(stg_mci_constr4_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),3)); FE_ } -FN_(stg_mci_constr5_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),4)); FE_ } -FN_(stg_mci_constr6_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),5)); FE_ } -FN_(stg_mci_constr7_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),6)); FE_ } -FN_(stg_mci_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); 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: -/* Since this stuff is ostensibly in some other module, we need - to supply an __init_ function. + 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. */ -EF_(__init_MCIzumakezuconstr); -START_MOD_INIT(__init_MCIzumakezuconstr) -END_MOD_INIT() +/* 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_ \ + } -INFO_TABLE(mci_make_constr_info, mci_make_constr_entry, 0,0,FUN_STATIC,static,EF_,0,0); -INFO_TABLE(mci_make_constrI_info, mci_make_constrI_entry, 0,0,FUN_STATIC,static,EF_,0,0); -INFO_TABLE(mci_make_constrP_info, mci_make_constrP_entry, 0,0,FUN_STATIC,static,EF_,0,0); -INFO_TABLE(mci_make_constrPP_info, mci_make_constrPP_entry, 0,0,FUN_STATIC,static,EF_,0,0); -INFO_TABLE(mci_make_constrPPP_info,mci_make_constrPPP_entry,0,0,FUN_STATIC,static,EF_,0,0); +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); -SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstr_closure, - mci_make_constr_info,0,,EI_) - ,{ /* payload */ } -}; -SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrI_closure, - mci_make_constrI_info,0,,EI_) - ,{ /* payload */ } -}; -SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrP_closure, - mci_make_constrP_info,0,,EI_) - ,{ /* payload */ } -}; -SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrPP_closure, - mci_make_constrPP_info,0,,EI_) - ,{ /* payload */ } -}; -SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrPPP_closure, - mci_make_constrPPP_info,0,,EI_) - ,{ /* payload */ } -}; +VEC_POLY_INFO_TABLE(stg_ctoi_ret_R1p,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_); -/* Make a constructor with no args. */ -STGFUN(mci_make_constr_entry) -{ - nat size, np, nw; - StgClosure* con; - StgInfoTable* itbl; - FB_ - /* Sp[0 & 1] are tag, Addr# - */ - itbl = ((StgInfoTable**)Sp)[1]; - np = INFO_PTR_TO_STRUCT(itbl)->layout.payload.ptrs; - nw = INFO_PTR_TO_STRUCT(itbl)->layout.payload.nptrs; - size = sizeofW(StgHeader) + stg_max(MIN_NONUPD_SIZE, np+nw); - /* STGCALL5(fprintf,stderr,"np %d nw %d size %d\n",np,nw,size); */ - - /* The total number of words to copy off the stack is np + nw. - That doesn't include tag words, tho. - */ - HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constr_entry, ); - TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0); - CCS_ALLOC(CCCS,size); /* ccs prof */ - - con = (StgClosure*)(Hp + 1 - size); - SET_HDR(con, itbl,CCCS); - - Sp = Sp +2; /* Zap the Addr# arg */ - R1.cl = con; - - JMP_(ENTRY_CODE(GET_INFO(R1.cl))); - FE_ -} -/* Make a constructor with 1 Int# arg */ -STGFUN(mci_make_constrI_entry) -{ - nat size, np, nw; - StgClosure* con; - StgInfoTable* itbl; - FB_ - /* Sp[0 & 1] are tag, Addr# - Sp[2 & 3] are tag, Int# - */ - itbl = ((StgInfoTable**)Sp)[1]; - np = INFO_PTR_TO_STRUCT(itbl)->layout.payload.ptrs; - nw = INFO_PTR_TO_STRUCT(itbl)->layout.payload.nptrs; - size = sizeofW(StgHeader) + stg_max(MIN_NONUPD_SIZE, np+nw); - /* STGCALL5(fprintf,stderr,"np %d nw %d size %d\n",np,nw,size); */ - - /* The total number of words to copy off the stack is np + nw. - That doesn't include tag words, tho. - */ - HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constrI_entry, ); - TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0); - CCS_ALLOC(CCCS,size); /* ccs prof */ - - con = (StgClosure*)(Hp + 1 - size); - SET_HDR(con, itbl,CCCS); - - con->payload[0] = ((StgClosure**)Sp)[3]; - Sp = Sp +1/*word*/ +1/*tag*/; /* Zap the Int# arg */ - Sp = Sp +2; /* Zap the Addr# arg */ - R1.cl = con; - - JMP_(ENTRY_CODE(GET_INFO(R1.cl))); - FE_ -} +/* 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_ \ + } -STGFUN(mci_make_constrP_entry) -{ - FB_ - DUMP_ERRMSG("mci_make_constrP_entry: unimplemented!\n"); - STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); - return 0; - 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_); -/* Make a constructor with 2 pointer args. */ -STGFUN(mci_make_constrPP_entry) -{ - nat size, np, nw; - StgClosure* con; - StgInfoTable* itbl; - FB_ - /* Sp[0 & 1] are tag, Addr# - Sp[2] first arg - Sp[3] second arg - */ - itbl = ((StgInfoTable**)Sp)[1]; - np = INFO_PTR_TO_STRUCT(itbl)->layout.payload.ptrs; - nw = INFO_PTR_TO_STRUCT(itbl)->layout.payload.nptrs; - size = sizeofW(StgHeader) + stg_max(MIN_NONUPD_SIZE, np+nw); - /* STGCALL5(fprintf,stderr,"np %d nw %d size %d\n",np,nw,size); */ - - /* The total number of words to copy off the stack is np + nw. - That doesn't include tag words, tho. - */ - HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constrPP_entry, ); - TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0); - CCS_ALLOC(CCCS,size); /* ccs prof */ - - con = (StgClosure*)(Hp + 1 - size); - SET_HDR(con, itbl,CCCS); - - con->payload[0] = ((StgClosure**)Sp)[2]; - con->payload[1] = ((StgClosure**)Sp)[3]; - Sp = Sp +2; /* Zap 2 ptr args */ - Sp = Sp +2; /* Zap the Addr# arg */ - R1.cl = con; - - JMP_(ENTRY_CODE(GET_INFO(R1.cl))); - FE_ -} -STGFUN(mci_make_constrPPP_entry) -{ - FB_ - DUMP_ERRMSG("mci_make_constrPPP_entry: unimplemented!\n"); - STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); - return 0; - FE_ -} +/* 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_ \ + } -#if 0 -/* It would be nice if this worked, but it doesn't. Yet. */ -STGFUN(mci_make_constr_entry) -{ - nat size, np, nw_heap, nw_really, w; - StgClosure* con; - StgInfoTable* itbl; - W_* r; - FB_ - itbl = ((StgInfoTable**)Sp)[0]; -STGCALL3(fprintf,stderr,"mmc: itbl = %d\n",itbl); - -STGCALL3(fprintf,stderr,"mmc: sp-4 = %d\n", ((W_*)Sp)[-4] ); -STGCALL3(fprintf,stderr,"mmc: sp-3 = %d\n", ((W_*)Sp)[-3] ); -STGCALL3(fprintf,stderr,"mmc: sp-2 = %d\n", ((W_*)Sp)[-2] ); -STGCALL3(fprintf,stderr,"mmc: sp-1 = %d\n", ((W_*)Sp)[-1] ); -STGCALL3(fprintf,stderr,"mmc: sp+0 = %d\n", ((W_*)Sp)[0] ); -STGCALL3(fprintf,stderr,"mmc: sp+1 = %d\n", ((W_*)Sp)[1] ); -STGCALL3(fprintf,stderr,"mmc: sp+2 = %d\n", ((W_*)Sp)[2] ); -STGCALL3(fprintf,stderr,"mmc: sp+3 = %d\n", ((W_*)Sp)[3] ); -STGCALL3(fprintf,stderr,"mmc: sp+4 = %d\n", ((W_*)Sp)[4] ); - np = itbl->layout.payload.ptrs; - nw_really = itbl->layout.payload.nptrs; - nw_heap = stg_max(nw_really, MIN_NONUPD_SIZE-np); - size = CONSTR_sizeW( np, nw_heap ); - - /* The total number of words to copy off the stack is np + nw. - That doesn't include tag words, tho. - */ - HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constr_entry, ); - TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0); - CCS_ALLOC(CCCS,size); /* ccs prof */ - - con = (StgClosure*)(Hp + 1 - size); - SET_HDR(con, itbl,CCCS); - - /* Copy into the closure. */ - w = 0; - r = Sp+1; - while (1) { - if (w == np + nw) break; - ASSERT(w < np + nw); - if (IS_ARG_TAG(*r)) { - nat n = *r++; - for (; n > 0; n--) - con->payload[w++] = (StgClosure*)(*r++); - } else { - con->payload[w++] = (StgClosure*)(*r++); - } - ASSERT((P_)r <= (P_)Su); - } +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_ \ + } + +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_); - /* Remove all the args we've used. */ - Sp = r; - R1.cl = con; - JMP_(ENTRY_CODE(R1.cl)); +/* 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_ } -#endif - -#endif /* GHCI */ /* ----------------------------------------------------------------------------- @@ -353,7 +339,7 @@ STGFUN(stg_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; @@ -399,7 +385,7 @@ STGFUN(stg_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; @@ -409,34 +395,6 @@ STGFUN(stg_IND_OLDGEN_PERM_entry) } /* ----------------------------------------------------------------------------- - Entry code for CAFs - - This code assumes R1 is in a register for now. - -------------------------------------------------------------------------- */ - -INFO_TABLE(stg_CAF_UNENTERED_info,stg_CAF_UNENTERED_entry,1,3,CAF_UNENTERED,,EF_,0,0); -STGFUN(stg_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(stg_CAF_ENTERED_info,stg_CAF_ENTERED_entry,0,4,CAF_ENTERED,,EF_,0,0); -STGFUN(stg_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_ -} - -/* ----------------------------------------------------------------------------- Entry code for a black hole. Entering a black hole normally causes a cyclic data dependency, but @@ -466,7 +424,7 @@ STGFUN(stg_BLACKHOLE_entry) 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); + 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); @@ -476,28 +434,29 @@ STGFUN(stg_BLACKHOLE_entry) #endif TICK_ENT_BH(); - /* 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 */ - recordMutable((StgMutClosure *)R1.cl); - /* Change the BLACKHOLE into a BLACKHOLE_BQ */ + + // Change the CAF_BLACKHOLE into a BLACKHOLE_BQ_STATIC ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info; - /* PAR: dumping of event now done in blockThread -- HWL */ + // 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 */ - BLOCK_NP(1); + // PAR: dumping of event now done in blockThread -- HWL + // stg_gen_block is too heavyweight, use a specialised one + BLOCK_NP(1); FE_ } @@ -515,7 +474,7 @@ STGFUN(stg_BLACKHOLE_BQ_entry) 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); + 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); @@ -581,18 +540,18 @@ STGFUN(stg_RBH_entry) 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_,0,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_,0,0); 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_,0,0); 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_,"CAF_BLACKHOLE","CAF_BLACKHOLE"); +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_ @@ -605,8 +564,8 @@ STGFUN(stg_CAF_BLACKHOLE_entry) { 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->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); @@ -617,26 +576,28 @@ STGFUN(stg_CAF_BLACKHOLE_entry) TICK_ENT_BH(); - /* 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 */ - recordMutable((StgMutClosure *)R1.cl); - /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ */ + + // Change the CAF_BLACKHOLE into a BLACKHOLE_BQ_STATIC ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info; - /* PAR: dumping of event now done in blockThread -- HWL */ + // 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_ } @@ -672,18 +633,6 @@ STGFUN(stg_WHITEHOLE_entry) #endif /* ----------------------------------------------------------------------------- - The code for a BCO returns to the scheduler - -------------------------------------------------------------------------- */ -INFO_TABLE(stg_BCO_info,stg_BCO_entry,0,0,BCO,,EF_,"BCO","BCO"); -STGFUN(stg_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 @@ -724,7 +673,7 @@ NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK); INFO_TABLE_CONSTR(stg_NO_FINALIZER_info,stg_NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0); NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER); -SET_STATIC_HDR(stg_NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_) +SET_STATIC_HDR(stg_NO_FINALIZER_closure,stg_NO_FINALIZER_info,0/*CC*/,,EI_) , /*payload*/{} }; /* ----------------------------------------------------------------------------- @@ -781,7 +730,7 @@ NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST); SET_STATIC_HDR(stg_END_MUT_LIST_closure,stg_END_MUT_LIST_info,0/*CC*/,,EI_) , /*payload*/{} }; -INFO_TABLE(stg_MUT_CONS_info, stg_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_, 0, 0); NON_ENTERABLE_ENTRY_CODE(MUT_CONS); /* ----------------------------------------------------------------------------- @@ -894,7 +843,7 @@ STGFUN(stg_forceIO_ret_entry) } #else INFO_TABLE_SRT_BITMAP(stg_forceIO_ret_info,stg_forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0); -STGFUN(forceIO_ret_entry) +STGFUN(stg_forceIO_ret_entry) { StgClosure *rval; FB_ @@ -926,42 +875,6 @@ SET_STATIC_HDR(stg_forceIO_closure,stg_forceIO_info,CCS_DONT_CARE,,EI_) /* ----------------------------------------------------------------------------- - Standard Infotables (for use in interpreter) - -------------------------------------------------------------------------- */ - -#ifdef INTERPRETER - -STGFUN(stg_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(stg_ret_bco_entry ); -RET_BCO_ENTRY_TEMPLATE(stg_ret_bco_0_entry); -RET_BCO_ENTRY_TEMPLATE(stg_ret_bco_1_entry); -RET_BCO_ENTRY_TEMPLATE(stg_ret_bco_2_entry); -RET_BCO_ENTRY_TEMPLATE(stg_ret_bco_3_entry); -RET_BCO_ENTRY_TEMPLATE(stg_ret_bco_4_entry); -RET_BCO_ENTRY_TEMPLATE(stg_ret_bco_5_entry); -RET_BCO_ENTRY_TEMPLATE(stg_ret_bco_6_entry); -RET_BCO_ENTRY_TEMPLATE(stg_ret_bco_7_entry); - -VEC_POLY_INFO_TABLE(stg_ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_); - -#endif /* INTERPRETER */ - -/* ----------------------------------------------------------------------------- CHARLIKE and INTLIKE closures. These are static representations of Chars and small Ints, so that