/* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.58 2001/01/15 16:55:25 sewardj Exp $
+ * $Id: StgMiscClosures.hc,v 1.68 2001/08/10 09:41:17 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
*
* ---------------------------------------------------------------------------*/
+#include "Stg.h"
#include "Rts.h"
#include "RtsUtils.h"
#include "RtsFlags.h"
Support for the bytecode interpreter.
-------------------------------------------------------------------------- */
-#ifdef GHCI
-
/* 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");
+ /* 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)));
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:
FE_
}
-#endif /* GHCI */
-
/* -----------------------------------------------------------------------------
Entry code for an indirection.
# 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;
# 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;
}
/* -----------------------------------------------------------------------------
- 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
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);
#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_
}
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);
{
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);
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_
}
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);
/* -----------------------------------------------------------------------------
}
#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_
projects / ghc-hetmet.git / blobdiff