/* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.37 2000/03/13 10:53:55 simonmar Exp $
+ * $Id: StgMiscClosures.hc,v 1.73 2002/02/12 15:17:22 simonmar Exp $
*
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
*
* Entry code for various built-in closure types.
*
* ---------------------------------------------------------------------------*/
+#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 "ProfRts.h"
+#include "Profiling.h"
#include "Prelude.h"
+#include "Schedule.h"
#include "SMP.h"
#if defined(GRAN) || defined(PAR)
# include "GranSimRts.h" /* for DumpRawGranEvent */
#include <stdio.h>
#endif
-/* ToDo: make the printing of panics more Win32-friendly, i.e.,
+/* ToDo: make the printing of panics more win32-friendly, i.e.,
* pop up some lovely message boxes (as well).
*/
#define DUMP_ERRMSG(msg) STGCALL2(fprintf,stderr,msg)
*/
#define NON_ENTERABLE_ENTRY_CODE(type) \
-STGFUN(type##_entry) \
+STGFUN(stg_##type##_entry) \
{ \
FB_ \
DUMP_ERRMSG(#type " object entered!\n"); \
STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \
+ return NULL; \
FE_ \
}
+
/* -----------------------------------------------------------------------------
- Entry code for an indirection.
+ Support for the bytecode interpreter.
+ -------------------------------------------------------------------------- */
+
+/* 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"); */
+ /* Pointless, since SET_TAG doesn't do anything */
+ SET_TAG( GET_TAG(GET_INFO(R1.cl)));
+ JMP_(ENTRY_CODE((P_)(*Sp)));
+ 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:
+
+ 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.
+*/
+
+/* 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_ \
+ }
+
+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_);
+
+
+/* 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_ \
+ }
- This code assumes R1 is in a register for now.
+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,4,0,BCO,,EF_,"BCO","BCO");
+STGFUN(stg_BCO_entry) {
+ FB_
+ Sp -= 1;
+ Sp[0] = R1.w;
+ JMP_(stg_yield_to_interpreter);
+ FE_
+}
+
+
+/* -----------------------------------------------------------------------------
+ Entry code for an indirection.
-------------------------------------------------------------------------- */
-INFO_TABLE(IND_info,IND_entry,1,0,IND,,EF_,0,0);
-STGFUN(IND_entry)
+INFO_TABLE(stg_IND_info,stg_IND_entry,1,0,IND,,EF_,"IND","IND");
+STGFUN(stg_IND_entry)
{
FB_
TICK_ENT_IND(Node); /* tick */
-
R1.p = (P_) ((StgInd*)R1.p)->indirectee;
TICK_ENT_VIA_NODE();
- JMP_(ENTRY_CODE(*R1.p));
+ JMP_(GET_ENTRY(R1.cl));
FE_
}
-INFO_TABLE(IND_STATIC_info,IND_STATIC_entry,1,0,IND_STATIC,,EF_,0,0);
-STGFUN(IND_STATIC_entry)
+INFO_TABLE(stg_IND_STATIC_info,stg_IND_STATIC_entry,1,0,IND_STATIC,,EF_,"IND_STATIC","IND_STATIC");
+STGFUN(stg_IND_STATIC_entry)
{
FB_
TICK_ENT_IND(Node); /* tick */
-
R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
TICK_ENT_VIA_NODE();
- JMP_(ENTRY_CODE(*R1.p));
+ JMP_(GET_ENTRY(R1.cl));
FE_
}
-INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,,EF_,0,0);
-STGFUN(IND_PERM_entry)
+INFO_TABLE(stg_IND_PERM_info,stg_IND_PERM_entry,1,1,IND_PERM,,EF_,"IND_PERM","IND_PERM");
+STGFUN(stg_IND_PERM_entry)
{
FB_
/* Don't add INDs to granularity cost */
TICK_ENT_PERM_IND(R1.p); /* tick */
#endif
+ LDV_ENTER((StgInd *)R1.p);
+
/* Enter PAP cost centre -- lexical scoping only */
ENTER_CCS_PAP_CL(R1.cl);
# 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;
TICK_ENT_VIA_NODE();
#endif
- JMP_(ENTRY_CODE(*R1.p));
+ JMP_(GET_ENTRY(R1.cl));
FE_
}
-INFO_TABLE(IND_OLDGEN_info,IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,0,0);
-STGFUN(IND_OLDGEN_entry)
+INFO_TABLE(stg_IND_OLDGEN_info,stg_IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,"IND_OLDGEN","IND_OLDGEN");
+STGFUN(stg_IND_OLDGEN_entry)
{
FB_
TICK_ENT_IND(Node); /* tick */
-
R1.p = (P_) ((StgInd*)R1.p)->indirectee;
TICK_ENT_VIA_NODE();
- JMP_(ENTRY_CODE(*R1.p));
+ JMP_(GET_ENTRY(R1.cl));
FE_
}
-INFO_TABLE(IND_OLDGEN_PERM_info,IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,EF_,0,0);
-STGFUN(IND_OLDGEN_PERM_entry)
+INFO_TABLE(stg_IND_OLDGEN_PERM_info,stg_IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,EF_,"IND_OLDGEN_PERM","IND_OLDGEN_PERM");
+STGFUN(stg_IND_OLDGEN_PERM_entry)
{
FB_
/* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
/* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
TICK_ENT_PERM_IND(R1.p); /* tick */
#endif
-
+
+ LDV_ENTER((StgInd *)R1.p);
+
/* Enter PAP cost centre -- lexical scoping only */
ENTER_CCS_PAP_CL(R1.cl);
# 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;
TICK_ENT_VIA_NODE();
- JMP_(ENTRY_CODE(*R1.p));
- FE_
-}
-
-/* -----------------------------------------------------------------------------
- Entry code for CAFs
-
- This code assumes R1 is in a register for now.
- -------------------------------------------------------------------------- */
-
-INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,3,CAF_UNENTERED,,EF_,0,0);
-STGFUN(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(CAF_ENTERED_info,CAF_ENTERED_entry,0,4,CAF_ENTERED,,EF_,0,0);
-STGFUN(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_
}
* old-generation indirection.
*/
-INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,0,0);
-STGFUN(BLACKHOLE_entry)
+INFO_TABLE(stg_BLACKHOLE_info, stg_BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,"BLACKHOLE","BLACKHOLE");
+STGFUN(stg_BLACKHOLE_entry)
{
FB_
#if defined(GRAN)
#ifdef SMP
{
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);
+ if (bd->u.back != (bdescr *)BaseReg) {
+ if (bd->gen_no >= 1 || bd->step->no >= 1) {
+ 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();
+ // Actually this is not necessary because R1.p is about to be destroyed.
+ LDV_ENTER((StgClosure *)R1.p);
+
/* 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 */
- ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
-
-#if defined(PAR)
- /* Save the Thread State here, before calling RTS routines below! */
- SAVE_THREAD_STATE(1);
-
- /* if collecting stats update the execution time etc */
- if (RtsFlags.ParFlags.ParStats.Full) {
- /* Note that CURRENT_TIME may perform an unsafe call */
- //rtsTime now = CURRENT_TIME; /* Now */
- CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
- CurrentTSO->par.blockcount++;
- CurrentTSO->par.blockedat = CURRENT_TIME;
- DumpRawGranEvent(CURRENT_PROC, thisPE,
- GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
- }
+#ifdef PROFILING
- THREAD_RETURN(1); /* back to the scheduler */
-#else
- /* stg_gen_block is too heavyweight, use a specialised one */
- BLOCK_NP(1);
+ // The size remains the same, so we call LDV_recordDead() - no need to fill slop.
+ LDV_recordDead((StgClosure *)R1.p, BLACKHOLE_sizeW());
+#endif
+ //
+ // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
+ //
+ ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info;
+#ifdef PROFILING
+ LDV_recordCreate((StgClosure *)R1.p);
#endif
+ // closure is mutable since something has just been added to its BQ
+ recordMutable((StgMutClosure *)R1.cl);
+
+ // PAR: dumping of event now done in blockThread -- HWL
+
+ // stg_gen_block is too heavyweight, use a specialised one
+ BLOCK_NP(1);
FE_
}
-INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,0,0);
-STGFUN(BLACKHOLE_BQ_entry)
+INFO_TABLE(stg_BLACKHOLE_BQ_info, stg_BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,"BLACKHOLE","BLACKHOLE");
+STGFUN(stg_BLACKHOLE_BQ_entry)
{
FB_
#if defined(GRAN)
#ifdef SMP
{
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);
+ if (bd->u.back != (bdescr *)BaseReg) {
+ if (bd->gen_no >= 1 || bd->step->no >= 1) {
+ 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();
+ LDV_ENTER((StgClosure *)R1.p);
/* Put ourselves on the blocking queue for this black hole */
CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
CurrentTSO->why_blocked = BlockedOnBlackHole;
CurrentTSO->block_info.closure = R1.cl;
#ifdef SMP
- ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
+ ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info;
#endif
-#if defined(PAR)
- /* Save the Thread State here, before calling RTS routines below! */
- SAVE_THREAD_STATE(1);
-
- /* if collecting stats update the execution time etc */
- if (RtsFlags.ParFlags.ParStats.Full) {
- /* Note that CURRENT_TIME may perform an unsafe call */
- //rtsTime now = CURRENT_TIME; /* Now */
- CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
- CurrentTSO->par.blockcount++;
- CurrentTSO->par.blockedat = CURRENT_TIME;
- DumpRawGranEvent(CURRENT_PROC, thisPE,
- GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
- }
+ /* PAR: dumping of event now done in blockThread -- HWL */
- THREAD_RETURN(1); /* back to the scheduler */
-#else
/* stg_gen_block is too heavyweight, use a specialised one */
BLOCK_NP(1);
-#endif
FE_
}
#if defined(PAR) || defined(GRAN)
-INFO_TABLE(RBH_info, RBH_entry,1,1,RBH,,EF_,0,0);
-STGFUN(RBH_entry)
+INFO_TABLE(stg_RBH_info, stg_RBH_entry,1,1,RBH,,EF_,"RBH","RBH");
+STGFUN(stg_RBH_entry)
{
FB_
# if defined(GRAN)
CurrentTSO->why_blocked = BlockedOnBlackHole;
CurrentTSO->block_info.closure = R1.cl;
-#if defined(PAR)
- /* Save the Thread State here, before calling RTS routines below! */
- SAVE_THREAD_STATE(1);
-
- /* if collecting stats update the execution time etc */
- if (RtsFlags.ParFlags.ParStats.Full) {
- /* Note that CURRENT_TIME may perform an unsafe call */
- //rtsTime now = CURRENT_TIME; /* Now */
- CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
- CurrentTSO->par.blockcount++;
- CurrentTSO->par.blockedat = CURRENT_TIME;
- DumpRawGranEvent(CURRENT_PROC, thisPE,
- GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
- }
+ /* PAR: dumping of event now done in blockThread -- HWL */
- THREAD_RETURN(1); /* back to the scheduler */
-#else
- /* saves thread state and leaves thread in ThreadEnterGHC state; */
/* stg_gen_block is too heavyweight, use a specialised one */
BLOCK_NP(1);
-#endif
-
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_,"RBH_Save_0","RBH_Save_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_,"RBH_Save_1","RBH_Save_1");
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_,"RBH_Save_2","RBH_Save_2");
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_,0,0);
-STGFUN(CAF_BLACKHOLE_entry)
+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_
#if defined(GRAN)
#ifdef SMP
{
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->u.back != (bdescr *)BaseReg) {
+ 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);
#endif
TICK_ENT_BH();
+ LDV_ENTER((StgClosure *)R1.p);
- /* 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 */
+
+ // Change the CAF_BLACKHOLE into a BLACKHOLE_BQ_STATIC
+ ((StgBlockingQueue *)R1.p)->header.info = &stg_BLACKHOLE_BQ_info;
+
+ // closure is mutable since something has just been added to its BQ
recordMutable((StgMutClosure *)R1.cl);
- /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ */
- ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
-
-#if defined(PAR)
- /* Save the Thread State here, before calling RTS routines below! */
- SAVE_THREAD_STATE(1);
-
- /* if collecting stats update the execution time etc */
- if (RtsFlags.ParFlags.ParStats.Full) {
- /* Note that CURRENT_TIME may perform an unsafe call */
- //rtsTime now = CURRENT_TIME; /* Now */
- CurrentTSO->par.exectime += CURRENT_TIME - CurrentTSO->par.blockedat;
- CurrentTSO->par.blockcount++;
- CurrentTSO->par.blockedat = CURRENT_TIME;
- DumpRawGranEvent(CURRENT_PROC, thisPE,
- GR_BLOCK, CurrentTSO, (StgClosure *)R1.p, 0);
- }
- THREAD_RETURN(1); /* back to the scheduler */
-#else
- /* stg_gen_block is too heavyweight, use a specialised one */
- BLOCK_NP(1);
-#endif
+ // PAR: dumping of event now done in blockThread -- HWL
+ // stg_gen_block is too heavyweight, use a specialised one
+ BLOCK_NP(1);
FE_
}
#ifdef TICKY_TICKY
-INFO_TABLE(SE_BLACKHOLE_info, SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,0,0);
-STGFUN(SE_BLACKHOLE_entry)
+INFO_TABLE(stg_SE_BLACKHOLE_info, stg_SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,"SE_BLACKHOLE","SE_BLACKHOLE");
+STGFUN(stg_SE_BLACKHOLE_entry)
{
FB_
STGCALL3(fprintf,stderr,"SE_BLACKHOLE at %p entered!\n",R1.p);
FE_
}
-INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,0,0);
-STGFUN(SE_CAF_BLACKHOLE_entry)
+INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
+STGFUN(stg_SE_CAF_BLACKHOLE_entry)
{
FB_
STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1.p);
#endif
#ifdef SMP
-INFO_TABLE(WHITEHOLE_info, WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,0,0);
-STGFUN(WHITEHOLE_entry)
+INFO_TABLE(stg_WHITEHOLE_info, stg_WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,"WHITEHOLE","WHITEHOLE");
+STGFUN(stg_WHITEHOLE_entry)
{
FB_
JMP_(GET_ENTRY(R1.cl));
#endif
/* -----------------------------------------------------------------------------
- The code for a BCO returns to the scheduler
- -------------------------------------------------------------------------- */
-INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,,EF_,0,0);
-EF_(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(TSO_info, TSO_entry, 0,0,TSO,,EF_,0,0);
+INFO_TABLE(stg_TSO_info, stg_TSO_entry, 0,0,TSO,,EF_,"TSO","TSO");
NON_ENTERABLE_ENTRY_CODE(TSO);
/* -----------------------------------------------------------------------------
one is a real bug.
-------------------------------------------------------------------------- */
-INFO_TABLE(EVACUATED_info,EVACUATED_entry,1,0,EVACUATED,,EF_,0,0);
+INFO_TABLE(stg_EVACUATED_info,stg_EVACUATED_entry,1,0,EVACUATED,,EF_,"EVACUATED","EVACUATED");
NON_ENTERABLE_ENTRY_CODE(EVACUATED);
/* -----------------------------------------------------------------------------
live weak pointers with dead ones).
-------------------------------------------------------------------------- */
-INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,,EF_,0,0);
+INFO_TABLE(stg_WEAK_info,stg_WEAK_entry,0,4,WEAK,,EF_,"WEAK","WEAK");
NON_ENTERABLE_ENTRY_CODE(WEAK);
-INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,0,0);
+// XXX! The garbage collector replaces a WEAK with a DEAD_WEAK
+// in-place, which causes problems if the heap is scanned linearly
+// after GC (certain kinds of profiling do this). So when profiling,
+// we set the size of a DEAD_WEAK to 4 non-pointers, rather than its
+// usual 1.
+
+#ifdef PROFILING
+#define DEAD_WEAK_PAYLOAD_WORDS 4
+#else
+#define DEAD_WEAK_PAYLOAD_WORDS 1
+#endif
+
+INFO_TABLE_CONSTR(stg_DEAD_WEAK_info,stg_DEAD_WEAK_entry,0,DEAD_WEAK_PAYLOAD_WORDS,0,CONSTR,,EF_,"DEAD_WEAK","DEAD_WEAK");
NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
/* -----------------------------------------------------------------------------
finalizer in a weak pointer object.
-------------------------------------------------------------------------- */
-INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
+INFO_TABLE_CONSTR(stg_NO_FINALIZER_info,stg_NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,"NO_FINALIZER","NO_FINALIZER");
NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
-SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
+SET_STATIC_HDR(stg_NO_FINALIZER_closure,stg_NO_FINALIZER_info,0/*CC*/,,EI_)
, /*payload*/{} };
/* -----------------------------------------------------------------------------
Foreign Objects are unlifted and therefore never entered.
-------------------------------------------------------------------------- */
-INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,,EF_,0,0);
+INFO_TABLE(stg_FOREIGN_info,stg_FOREIGN_entry,0,1,FOREIGN,,EF_,"FOREIGN","FOREIGN");
NON_ENTERABLE_ENTRY_CODE(FOREIGN);
/* -----------------------------------------------------------------------------
Stable Names are unlifted too.
-------------------------------------------------------------------------- */
-INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,0,0);
+INFO_TABLE(stg_STABLE_NAME_info,stg_STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,"STABLE_NAME","STABLE_NAME");
NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
/* -----------------------------------------------------------------------------
and entry code for each type.
-------------------------------------------------------------------------- */
-INFO_TABLE(FULL_MVAR_info,FULL_MVAR_entry,4,0,MVAR,,EF_,0,0);
+INFO_TABLE(stg_FULL_MVAR_info,stg_FULL_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
-INFO_TABLE(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,,EF_,0,0);
+INFO_TABLE(stg_EMPTY_MVAR_info,stg_EMPTY_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
/* -----------------------------------------------------------------------------
end of a linked TSO queue.
-------------------------------------------------------------------------- */
-INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
+INFO_TABLE_CONSTR(stg_END_TSO_QUEUE_info,stg_END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,"END_TSO_QUEUE","END_TSO_QUEUE");
NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
-SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
+SET_STATIC_HDR(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE_info,0/*CC*/,,EI_)
, /*payload*/{} };
/* -----------------------------------------------------------------------------
an END_MUT_LIST closure.
-------------------------------------------------------------------------- */
-INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
+INFO_TABLE_CONSTR(stg_END_MUT_LIST_info,stg_END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,"END_MUT_LIST","END_MUT_LIST");
NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
-SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
+SET_STATIC_HDR(stg_END_MUT_LIST_closure,stg_END_MUT_LIST_info,0/*CC*/,,EI_)
, /*payload*/{} };
-INFO_TABLE(MUT_CONS_info, 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_, "MUT_CONS", "MUT_CONS");
NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
/* -----------------------------------------------------------------------------
Exception lists
-------------------------------------------------------------------------- */
-INFO_TABLE_CONSTR(END_EXCEPTION_LIST_info,END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,0,0);
+INFO_TABLE_CONSTR(stg_END_EXCEPTION_LIST_info,stg_END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,"END_EXCEPTION_LIST","END_EXCEPTION_LIST");
NON_ENTERABLE_ENTRY_CODE(END_EXCEPTION_LIST);
-SET_STATIC_HDR(END_EXCEPTION_LIST_closure,END_EXCEPTION_LIST_info,0/*CC*/,,EI_)
+SET_STATIC_HDR(stg_END_EXCEPTION_LIST_closure,stg_END_EXCEPTION_LIST_info,0/*CC*/,,EI_)
, /*payload*/{} };
-INFO_TABLE(EXCEPTION_CONS_info, EXCEPTION_CONS_entry, 1, 1, CONSTR, , EF_, 0, 0);
+INFO_TABLE(stg_EXCEPTION_CONS_info, stg_EXCEPTION_CONS_entry, 1, 1, CONSTR, , EF_, "EXCEPTION_CONS", "EXCEPTION_CONS");
NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS);
/* -----------------------------------------------------------------------------
-------------------------------------------------------------------------- */
#define ArrayInfo(type) \
-INFO_TABLE(type##_info, type##_entry, 0, 0, type, , EF_,0,0);
+INFO_TABLE(stg_##type##_info, stg_##type##_entry, 0, 0, type, , EF_,"" # type "","" # type "");
ArrayInfo(ARR_WORDS);
NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
Mutable Variables
-------------------------------------------------------------------------- */
-INFO_TABLE(MUT_VAR_info, MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, 0, 0);
+INFO_TABLE(stg_MUT_VAR_info, stg_MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, "MUT_VAR", "MUT_VAR");
NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
/* -----------------------------------------------------------------------------
This is used for filling in vector-table entries that can never happen,
for instance.
-------------------------------------------------------------------------- */
-
+/* No longer used; we use NULL, because a) it never happens, right? and b)
+ Windows doesn't like DLL entry points being used as static initialisers
STGFUN(stg_error_entry) \
{ \
FB_ \
DUMP_ERRMSG("fatal: stg_error_entry"); \
STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \
+ return NULL; \
FE_ \
}
-
+*/
/* -----------------------------------------------------------------------------
Dummy return closure
just enter the top stack word to start the thread. (see deleteThread)
* -------------------------------------------------------------------------- */
-INFO_TABLE(dummy_ret_info, dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, , EF_, 0, 0);
-FN_(dummy_ret_entry)
+INFO_TABLE(stg_dummy_ret_info, stg_dummy_ret_entry, 0, 0, CONSTR_NOCAF_STATIC, , EF_, "DUMMY_RET", "DUMMY_RET");
+STGFUN(stg_dummy_ret_entry)
{
W_ ret_addr;
FB_
JMP_(ENTRY_CODE(ret_addr));
FE_
}
-SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
+SET_STATIC_HDR(stg_dummy_ret_closure,stg_dummy_ret_info,CCS_DONT_CARE,,EI_)
, /*payload*/{} };
/* -----------------------------------------------------------------------------
* -------------------------------------------------------------------------- */
#ifdef REG_R1
-INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
-FN_(forceIO_ret_entry)
+INFO_TABLE_SRT_BITMAP(stg_forceIO_ret_info,stg_forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
+STGFUN(stg_forceIO_ret_entry)
{
FB_
Sp++;
JMP_(GET_ENTRY(R1.cl));
}
#else
-INFO_TABLE_SRT_BITMAP(forceIO_ret_info,forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
-FN_(forceIO_ret_entry)
+INFO_TABLE_SRT_BITMAP(stg_forceIO_ret_info,stg_forceIO_ret_entry,0,0,0,0,RET_SMALL,,EF_,0,0);
+STGFUN(stg_forceIO_ret_entry)
{
StgClosure *rval;
FB_
}
#endif
-INFO_TABLE(forceIO_info,forceIO_entry,1,0,FUN_STATIC,,EF_,0,0);
-FN_(forceIO_entry)
+INFO_TABLE(stg_forceIO_info,stg_forceIO_entry,1,0,FUN_STATIC,,EF_,"FORCE_IO","FORCE_IO");
+FN_(stg_forceIO_entry)
{
FB_
/* Sp[0] contains the IO action we want to perform */
R1.p = (P_)Sp[0];
/* Replace it with the return continuation that enters the result. */
- Sp[0] = (W_)&forceIO_ret_info;
+ Sp[0] = (W_)&stg_forceIO_ret_info;
Sp--;
/* Push the RealWorld# tag and enter */
Sp[0] =(W_)REALWORLD_TAG;
JMP_(GET_ENTRY(R1.cl));
FE_
}
-SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONTZuCARE,,EI_)
+SET_STATIC_HDR(stg_forceIO_closure,stg_forceIO_info,CCS_DONT_CARE,,EI_)
, /*payload*/{} };
/* -----------------------------------------------------------------------------
- Standard Infotables (for use in interpreter)
- -------------------------------------------------------------------------- */
-
-#ifdef INTERPRETER
-
-STGFUN(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(ret_bco_entry );
-RET_BCO_ENTRY_TEMPLATE(ret_bco_0_entry);
-RET_BCO_ENTRY_TEMPLATE(ret_bco_1_entry);
-RET_BCO_ENTRY_TEMPLATE(ret_bco_2_entry);
-RET_BCO_ENTRY_TEMPLATE(ret_bco_3_entry);
-RET_BCO_ENTRY_TEMPLATE(ret_bco_4_entry);
-RET_BCO_ENTRY_TEMPLATE(ret_bco_5_entry);
-RET_BCO_ENTRY_TEMPLATE(ret_bco_6_entry);
-RET_BCO_ENTRY_TEMPLATE(ret_bco_7_entry);
-
-VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
-
-#endif /* INTERPRETER */
-
-#ifndef COMPILER
-
-INFO_TABLE_CONSTR(Czh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(Izh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(I64zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(Fzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(Dzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(Azh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(Wzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,,EF_,0,0);
-INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,,EF_,0,0);
-
-/* These might seem redundant but {I,C}zh_static_info are used in
- * {INT,CHAR}LIKE and the rest are used in RtsAPI.c
- */
-INFO_TABLE_CONSTR(Czh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(Izh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(I64zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(Fzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(Dzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(Azh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(Wzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,,EF_,0,0);
-
-#endif /* !defined(COMPILER) */
-
-/* -----------------------------------------------------------------------------
CHARLIKE and INTLIKE closures.
These are static representations of Chars and small Ints, so that
replace them with references to the static objects.
-------------------------------------------------------------------------- */
-#ifdef ENABLE_WIN32_DLL_SUPPORT
+#if defined(INTERPRETER) || defined(ENABLE_WIN32_DLL_SUPPORT)
/*
* When sticking the RTS in a DLL, we delay populating the
* Charlike and Intlike tables until load-time, which is only
#define Char_hash_static_info czh_static_info
#define Int_hash_static_info izh_static_info
#else
-#define Char_hash_static_info Czh_static_info
-#define Int_hash_static_info Izh_static_info
+#define Char_hash_static_info GHCziBase_Czh_static_info
+#define Int_hash_static_info GHCziBase_Izh_static_info
#endif
#define CHARLIKE_HDR(n) \
{ \
STATIC_HDR(Char_hash_static_info, /* C# */ \
- CCS_DONTZuCARE), \
+ CCS_DONT_CARE), \
data : n \
}
#define INTLIKE_HDR(n) \
{ \
STATIC_HDR(Int_hash_static_info, /* I# */ \
- CCS_DONTZuCARE), \
+ CCS_DONT_CARE), \
data : n \
}
/* end the name with _closure, to convince the mangler this is a closure */
-StgIntCharlikeClosure CHARLIKE_closure[] = {
+StgIntCharlikeClosure stg_CHARLIKE_closure[] = {
CHARLIKE_HDR(0),
CHARLIKE_HDR(1),
CHARLIKE_HDR(2),
CHARLIKE_HDR(255)
};
-StgIntCharlikeClosure INTLIKE_closure[] = {
+StgIntCharlikeClosure stg_INTLIKE_closure[] = {
INTLIKE_HDR(-16), /* MIN_INTLIKE == -16 */
INTLIKE_HDR(-15),
INTLIKE_HDR(-14),
projects / ghc-hetmet.git / blobdiff