/* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.50 2000/11/13 14:40:37 simonmar Exp $
+ * $Id: StgMiscClosures.hc,v 1.69 2001/11/08 12:46:31 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
*
* ---------------------------------------------------------------------------*/
+#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 "Profiling.h"
/* -----------------------------------------------------------------------------
- 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 */
/* -----------------------------------------------------------------------------
# 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_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
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);
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_
{
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_
}
#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
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*/{} };
/* -----------------------------------------------------------------------------
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_
/* -----------------------------------------------------------------------------
- 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
projects / ghc-hetmet.git / blobdiff