X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FStgMiscClosures.hc;h=06286a09962b56d5f2e54c69964762b9405be7bf;hb=fb7a723bfd7650a705cb226e07c5b08b7a8e9279;hp=27e881b234b7b385458f87b422e58925313d24f5;hpb=d6214fb69dcf14826a1835ec16cf58939469f25b;p=ghc-hetmet.git diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc index 27e881b..06286a0 100644 --- a/ghc/rts/StgMiscClosures.hc +++ b/ghc/rts/StgMiscClosures.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgMiscClosures.hc,v 1.60 2001/01/16 12:44:34 sewardj 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" @@ -51,8 +52,6 @@ STGFUN(stg_##type##_entry) \ Support for the bytecode interpreter. -------------------------------------------------------------------------- */ -#ifdef GHCI - /* 9 bits of return code for constructors created by the interpreter. */ FN_(stg_interp_constr_entry) { @@ -229,6 +228,34 @@ 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: @@ -257,8 +284,6 @@ STGFUN(stg_BCO_entry) { FE_ } -#endif /* GHCI */ - /* ----------------------------------------------------------------------------- Entry code for an indirection. @@ -314,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; @@ -360,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; @@ -370,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 @@ -427,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); @@ -437,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_ } @@ -476,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); @@ -566,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); @@ -578,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_ } @@ -730,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); /* ----------------------------------------------------------------------------- @@ -843,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_