X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FStgMiscClosures.hc;h=9fced45f2f71fdefa2afafa99d5b1106bad26f0c;hb=9d9784263ae1cb1d2add4b714ca676ca4b6cc22c;hp=8fcdfde272c4043e715f57eafd91a843e88ae79a;hpb=53d50b9c155b7deb44267100aa58497b0eedde9f;p=ghc-hetmet.git diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc index 8fcdfde..9fced45 100644 --- a/ghc/rts/StgMiscClosures.hc +++ b/ghc/rts/StgMiscClosures.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgMiscClosures.hc,v 1.54 2000/12/14 15:19:48 sewardj Exp $ + * $Id: StgMiscClosures.hc,v 1.66 2001/03/23 16:36:21 simonmar Exp $ * * (c) The GHC Team, 1998-2000 * @@ -7,6 +7,7 @@ * * ---------------------------------------------------------------------------*/ +#include "Stg.h" #include "Rts.h" #include "RtsUtils.h" #include "RtsFlags.h" @@ -51,33 +52,31 @@ STGFUN(stg_##type##_entry) \ Support for the bytecode interpreter. -------------------------------------------------------------------------- */ -#ifdef GHCI - -/* 9 bits of return code for constructors created by mci_make_constr. */ -FN_(stg_bco_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,"stg_bco_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_bco_constr1_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),0)); FE_ } -FN_(stg_bco_constr2_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),1)); FE_ } -FN_(stg_bco_constr3_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),2)); FE_ } -FN_(stg_bco_constr4_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),3)); FE_ } -FN_(stg_bco_constr5_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),4)); FE_ } -FN_(stg_bco_constr6_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),5)); FE_ } -FN_(stg_bco_constr7_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),6)); FE_ } -FN_(stg_bco_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 R1/F1/D1 etc) 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. @@ -87,7 +86,7 @@ FN_(stg_bco_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ } ptr to one of these info tables. The info table code, both direct and vectored, must: - * push R1/F1/D1 on the stack + * 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. @@ -108,8 +107,9 @@ FN_(stg_bco_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ } haven't got a good story about that yet. */ -/* When the returned value is in R1 ... */ -#define STG_BCORET_R1_Template(label) \ +/* 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; \ @@ -123,22 +123,159 @@ FN_(stg_bco_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ } FE_ \ } -STG_BCORET_R1_Template(stg_bcoret_R1_entry); -STG_BCORET_R1_Template(stg_bcoret_R1_0_entry); -STG_BCORET_R1_Template(stg_bcoret_R1_1_entry); -STG_BCORET_R1_Template(stg_bcoret_R1_2_entry); -STG_BCORET_R1_Template(stg_bcoret_R1_3_entry); -STG_BCORET_R1_Template(stg_bcoret_R1_4_entry); -STG_BCORET_R1_Template(stg_bcoret_R1_5_entry); -STG_BCORET_R1_Template(stg_bcoret_R1_6_entry); -STG_BCORET_R1_Template(stg_bcoret_R1_7_entry); +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_); -VEC_POLY_INFO_TABLE(stg_bcoret_R1,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_); + + +/* 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,3,0,BCO,,EF_,"BCO","BCO"); +INFO_TABLE(stg_BCO_info,stg_BCO_entry,4,0,BCO,,EF_,"BCO","BCO"); STGFUN(stg_BCO_entry) { FB_ Sp -= 1; @@ -147,8 +284,6 @@ STGFUN(stg_BCO_entry) { FE_ } -#endif /* GHCI */ - /* ----------------------------------------------------------------------------- Entry code for an indirection. @@ -204,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; @@ -250,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; @@ -260,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_interpreter); - 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 @@ -317,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); @@ -366,7 +473,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); @@ -457,7 +564,7 @@ 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); + 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); @@ -482,7 +589,7 @@ STGFUN(stg_CAF_BLACKHOLE_entry) 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 */ @@ -733,7 +840,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_