/* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.72 2002/01/22 13:54:23 simonmar Exp $
+ * $Id: StgMiscClosures.hc,v 1.85 2003/05/14 09:14:00 simonmar Exp $
*
- * (c) The GHC Team, 1998-2000
+ * (c) The GHC Team, 1998-2002
*
* Entry code for various built-in closure types.
*
# include "StgRun.h" /* for StgReturn and register saving */
#endif
-#ifdef HAVE_STDIO_H
-#include <stdio.h>
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
#endif
/* ToDo: make the printing of panics more win32-friendly, i.e.,
Template for the entry code of non-enterable closures.
*/
-#define NON_ENTERABLE_ENTRY_CODE(type) \
-STGFUN(stg_##type##_entry) \
-{ \
- FB_ \
- DUMP_ERRMSG(#type " object entered!\n"); \
- STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \
- return NULL; \
- FE_ \
+#define NON_ENTERABLE_ENTRY_CODE(type) \
+IF_(stg_##type##_entry) \
+{ \
+ FB_ \
+ STGCALL1(barf, #type " object entered!"); \
+ FE_ \
}
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_ \
+// When the returned value is a pointer in R1...
+#define STG_CtoI_RET_R1p_Template(label) \
+ IF_(label) \
+ { \
+ FB_ \
+ Sp -= 2; \
+ Sp[1] = R1.w; \
+ Sp[0] = (W_)&stg_enter_info; \
+ 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_ \
- }
-
-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);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_ret);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_0_ret);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_1_ret);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_2_ret);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_3_ret);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_4_ret);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_5_ret);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_6_ret);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_7_ret);
+
+VEC_POLY_INFO_TABLE( stg_ctoi_ret_R1p, 0/* special layout */,
+ 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/,
+ RET_BCO,, EF_);
+
+// When the returned value is a pointer, but unlifted, in R1 ...
+INFO_TABLE_RET( stg_ctoi_ret_R1unpt_info, stg_ctoi_ret_R1unpt_entry,
+ 0/* special layout */,
+ 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
+IF_(stg_ctoi_ret_R1unpt_entry)
+{
+ FB_
+ Sp -= 2;
+ Sp[1] = R1.w;
+ Sp[0] = (W_)&stg_gc_unpt_r1_info;
+ JMP_(stg_yield_to_interpreter);
+ FE_
+}
-VEC_POLY_INFO_TABLE(stg_ctoi_ret_V,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
+// When the returned value is a non-pointer in R1 ...
+INFO_TABLE_RET( stg_ctoi_ret_R1n_info, stg_ctoi_ret_R1n_entry,
+ 0/* special layout */,
+ 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
+IF_(stg_ctoi_ret_R1n_entry)
+{
+ FB_
+ Sp -= 2;
+ Sp[1] = R1.w;
+ Sp[0] = (W_)&stg_gc_unbx_r1_info;
+ JMP_(stg_yield_to_interpreter);
+ FE_
+}
-/* The other way round: when the interpreter returns a value to
- compiled code. The stack looks like this:
+// When the returned value is in F1 ...
+INFO_TABLE_RET( stg_ctoi_ret_F1_info, stg_ctoi_ret_F1_entry,
+ 0/* special layout */,
+ 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
+IF_(stg_ctoi_ret_F1_entry)
+{
+ FB_
+ Sp -= 2;
+ ASSIGN_FLT(Sp+1, F1);
+ Sp[0] = (W_)&stg_gc_f1_info;
+ JMP_(stg_yield_to_interpreter);
+ FE_
+}
- return info table (pushed by compiled code)
- return value (pushed by interpreter)
+// When the returned value is in D1 ...
+INFO_TABLE_RET( stg_ctoi_ret_D1_info, stg_ctoi_ret_D1_entry,
+ 0/* special layout */,
+ 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
+IF_(stg_ctoi_ret_D1_entry)
+{
+ FB_
+ Sp -= 1 + sizeofW(StgDouble);
+ ASSIGN_DBL(Sp+1, D1);
+ Sp[0] = (W_)&stg_gc_d1_info;
+ JMP_(stg_yield_to_interpreter);
+ FE_
+}
- If the value is ptr-rep'd, the interpreter simply returns to the
- scheduler, instructing it to ThreadEnterGHC.
+// When the returned value is in L1 ...
+INFO_TABLE_RET( stg_ctoi_ret_L1_info, stg_ctoi_ret_L1_entry,
+ 0/* special layout */,
+ 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
+IF_(stg_ctoi_ret_L1_entry)
+{
+ FB_
+ Sp -= 1 + sizeofW(StgInt64);
+ ASSIGN_Word64(Sp+1, L1);
+ Sp[0] = (W_)&stg_gc_l1_info;
+ JMP_(stg_yield_to_interpreter);
+ FE_
+}
- 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.
+// When the returned value a VoidRep ...
+INFO_TABLE_RET( stg_ctoi_ret_V_info, stg_ctoi_ret_V_entry,
+ 0/* special layout */,
+ 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
+IF_(stg_ctoi_ret_V_entry)
+{
+ FB_
+ Sp--;
+ Sp[0] = (W_)&stg_gc_void_info;
+ JMP_(stg_yield_to_interpreter);
+ FE_
+}
- No supporting code needed!
-*/
+// Dummy info table pushed on the top of the stack when the interpreter
+// should apply the BCO on the stack to its arguments, also on the stack.
+INFO_TABLE_RET( stg_apply_interp_info, stg_apply_interp_entry,
+ 0/* special layout */,
+ 0/*srt*/, 0/*srt_off*/, 0/*srt_bitmap*/, RET_BCO,, IF_, 0, 0);
+IF_(stg_apply_interp_entry)
+{
+ FB_
+ // Just in case we end up in here... (we shouldn't)
+ JMP_(stg_yield_to_interpreter);
+ FE_
+}
+/* -----------------------------------------------------------------------------
+ Entry code for a BCO
+ -------------------------------------------------------------------------- */
-/* 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) {
+INFO_TABLE_FUN_GEN(stg_BCO_info,stg_BCO_entry,4,0,
+ 0,0,0, /* no SRT */
+ ARG_BCO, 0/*dummy arity*/, 0/*dummy bitmap*/, NULL/*slow_apply*/,
+ BCO,,EF_,"BCO","BCO");
+FN_(stg_BCO_entry) {
FB_
- Sp -= 1;
- Sp[0] = R1.w;
- JMP_(stg_yield_to_interpreter);
+ // entering a BCO means "apply it", same as a function
+ Sp -= 2;
+ Sp[1] = R1.w;
+ Sp[0] = (W_)&stg_apply_interp_info;
+ JMP_(stg_yield_to_interpreter);
FE_
}
-
/* -----------------------------------------------------------------------------
- Entry code for an indirection.
+ Info tables for indirections.
+
+ SPECIALISED INDIRECTIONS: we have a specialised indirection for each
+ kind of return (direct, vectored 0-7), so that we can avoid entering
+ the object when we know what kind of return it will do. The update
+ code (Updates.hc) updates objects with the appropriate kind of
+ indirection. We only do this for young-gen indirections.
-------------------------------------------------------------------------- */
-INFO_TABLE(stg_IND_info,stg_IND_entry,1,0,IND,,EF_,"IND","IND");
-STGFUN(stg_IND_entry)
+INFO_TABLE(stg_IND_info,stg_IND_entry,1,0,IND,,IF_,"IND","IND");
+IF_(stg_IND_entry)
{
FB_
- TICK_ENT_IND(Node); /* tick */
+ TICK_ENT_DYN_IND(Node); /* tick */
R1.p = (P_) ((StgInd*)R1.p)->indirectee;
TICK_ENT_VIA_NODE();
JMP_(GET_ENTRY(R1.cl));
FE_
}
-INFO_TABLE(stg_IND_STATIC_info,stg_IND_STATIC_entry,1,0,IND_STATIC,,EF_,"IND_STATIC","IND_STATIC");
-STGFUN(stg_IND_STATIC_entry)
+#define IND_SPEC(n,ret) \
+INFO_TABLE(stg_IND_##n##_info,stg_IND_##n##_entry,1,0,IND,,IF_,"IND","IND"); \
+IF_(stg_IND_##n##_entry) \
+{ \
+ FB_ \
+ TICK_ENT_DYN_IND(Node); /* tick */ \
+ R1.p = (P_) ((StgInd*)R1.p)->indirectee; \
+ TICK_ENT_VIA_NODE(); \
+ JMP_(ret); \
+ FE_ \
+}
+
+IND_SPEC(direct, ENTRY_CODE(Sp[0]))
+IND_SPEC(0, RET_VEC(Sp[0],0))
+IND_SPEC(1, RET_VEC(Sp[0],1))
+IND_SPEC(2, RET_VEC(Sp[0],2))
+IND_SPEC(3, RET_VEC(Sp[0],3))
+IND_SPEC(4, RET_VEC(Sp[0],4))
+IND_SPEC(5, RET_VEC(Sp[0],5))
+IND_SPEC(6, RET_VEC(Sp[0],6))
+IND_SPEC(7, RET_VEC(Sp[0],7))
+
+INFO_TABLE(stg_IND_STATIC_info,stg_IND_STATIC_entry,1,0,IND_STATIC,,IF_,"IND_STATIC","IND_STATIC");
+IF_(stg_IND_STATIC_entry)
{
FB_
- TICK_ENT_IND(Node); /* tick */
+ TICK_ENT_STATIC_IND(Node); /* tick */
R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
TICK_ENT_VIA_NODE();
JMP_(GET_ENTRY(R1.cl));
FE_
}
-INFO_TABLE(stg_IND_PERM_info,stg_IND_PERM_entry,1,1,IND_PERM,,EF_,"IND_PERM","IND_PERM");
-STGFUN(stg_IND_PERM_entry)
+INFO_TABLE(stg_IND_PERM_info,stg_IND_PERM_entry,1,1,IND_PERM,,IF_,"IND_PERM","IND_PERM");
+IF_(stg_IND_PERM_entry)
{
FB_
/* Don't add INDs to granularity cost */
- /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
+ /* Dont: TICK_ENT_STATIC_IND(Node); for ticky-ticky; this ind is here only to help profiling */
#if defined(TICKY_TICKY) && !defined(PROFILING)
/* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
FE_
}
-INFO_TABLE(stg_IND_OLDGEN_info,stg_IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,"IND_OLDGEN","IND_OLDGEN");
-STGFUN(stg_IND_OLDGEN_entry)
+INFO_TABLE(stg_IND_OLDGEN_info,stg_IND_OLDGEN_entry,1,1,IND_OLDGEN,,IF_,"IND_OLDGEN","IND_OLDGEN");
+IF_(stg_IND_OLDGEN_entry)
{
FB_
- TICK_ENT_IND(Node); /* tick */
+ TICK_ENT_STATIC_IND(Node); /* tick */
R1.p = (P_) ((StgInd*)R1.p)->indirectee;
TICK_ENT_VIA_NODE();
JMP_(GET_ENTRY(R1.cl));
FE_
}
-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)
+INFO_TABLE(stg_IND_OLDGEN_PERM_info,stg_IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,IF_,"IND_OLDGEN_PERM","IND_OLDGEN_PERM");
+IF_(stg_IND_OLDGEN_PERM_entry)
{
FB_
- /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profiling */
+ /* Dont: TICK_ENT_STATIC_IND(Node); for ticky-ticky; this ind is here only to help profiling */
#if defined(TICKY_TICKY) && !defined(PROFILING)
/* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than being extra */
* old-generation indirection.
*/
-INFO_TABLE(stg_BLACKHOLE_info, stg_BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,"BLACKHOLE","BLACKHOLE");
-STGFUN(stg_BLACKHOLE_entry)
+INFO_TABLE(stg_BLACKHOLE_info, stg_BLACKHOLE_entry,0,2,BLACKHOLE,,IF_,"BLACKHOLE","BLACKHOLE");
+IF_(stg_BLACKHOLE_entry)
{
FB_
#if defined(GRAN)
FE_
}
-INFO_TABLE(stg_BLACKHOLE_BQ_info, stg_BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,"BLACKHOLE","BLACKHOLE");
-STGFUN(stg_BLACKHOLE_BQ_entry)
+INFO_TABLE(stg_BLACKHOLE_BQ_info, stg_BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,IF_,"BLACKHOLE","BLACKHOLE");
+IF_(stg_BLACKHOLE_BQ_entry)
{
FB_
#if defined(GRAN)
#if defined(PAR) || defined(GRAN)
-INFO_TABLE(stg_RBH_info, stg_RBH_entry,1,1,RBH,,EF_,"RBH","RBH");
-STGFUN(stg_RBH_entry)
+INFO_TABLE(stg_RBH_info, stg_RBH_entry,1,1,RBH,,IF_,"RBH","RBH");
+IF_(stg_RBH_entry)
{
FB_
# if defined(GRAN)
FE_
}
-INFO_TABLE(stg_RBH_Save_0_info, stg_RBH_Save_0_entry,0,2,CONSTR,,EF_,"RBH_Save_0","RBH_Save_0");
+INFO_TABLE(stg_RBH_Save_0_info, stg_RBH_Save_0_entry,0,2,CONSTR,,IF_,"RBH_Save_0","RBH_Save_0");
NON_ENTERABLE_ENTRY_CODE(RBH_Save_0);
-INFO_TABLE(stg_RBH_Save_1_info, stg_RBH_Save_1_entry,1,1,CONSTR,,EF_,"RBH_Save_1","RBH_Save_1");
+INFO_TABLE(stg_RBH_Save_1_info, stg_RBH_Save_1_entry,1,1,CONSTR,,IF_,"RBH_Save_1","RBH_Save_1");
NON_ENTERABLE_ENTRY_CODE(RBH_Save_1);
-INFO_TABLE(stg_RBH_Save_2_info, stg_RBH_Save_2_entry,2,0,CONSTR,,EF_,"RBH_Save_2","RBH_Save_2");
+INFO_TABLE(stg_RBH_Save_2_info, stg_RBH_Save_2_entry,2,0,CONSTR,,IF_,"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(stg_CAF_BLACKHOLE_info, stg_CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
-STGFUN(stg_CAF_BLACKHOLE_entry)
+INFO_TABLE(stg_CAF_BLACKHOLE_info, stg_CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,IF_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
+IF_(stg_CAF_BLACKHOLE_entry)
{
FB_
#if defined(GRAN)
FE_
}
-#ifdef TICKY_TICKY
-INFO_TABLE(stg_SE_BLACKHOLE_info, stg_SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,"SE_BLACKHOLE","SE_BLACKHOLE");
-STGFUN(stg_SE_BLACKHOLE_entry)
+#ifdef EAGER_BLACKHOLING
+INFO_TABLE(stg_SE_BLACKHOLE_info, stg_SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,IF_,"SE_BLACKHOLE","SE_BLACKHOLE");
+IF_(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_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
-STGFUN(stg_SE_CAF_BLACKHOLE_entry)
+INFO_TABLE(stg_SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,IF_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
+IF_(stg_SE_CAF_BLACKHOLE_entry)
{
FB_
STGCALL3(fprintf,stderr,"SE_CAF_BLACKHOLE at %p entered!\n",R1.p);
#endif
#ifdef SMP
-INFO_TABLE(stg_WHITEHOLE_info, stg_WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,"WHITEHOLE","WHITEHOLE");
-STGFUN(stg_WHITEHOLE_entry)
+INFO_TABLE(stg_WHITEHOLE_info, stg_WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,IF_,"WHITEHOLE","WHITEHOLE");
+IF_(stg_WHITEHOLE_entry)
{
FB_
- JMP_(GET_ENTRY(R1.cl));
+ JMP_(GET_ENTRY(R1.cl));
FE_
}
#endif
NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file
-------------------------------------------------------------------------- */
-INFO_TABLE(stg_TSO_info, stg_TSO_entry, 0,0,TSO,,EF_,"TSO","TSO");
+INFO_TABLE(stg_TSO_info, stg_TSO_entry, 0,0,TSO,,IF_,"TSO","TSO");
NON_ENTERABLE_ENTRY_CODE(TSO);
/* -----------------------------------------------------------------------------
one is a real bug.
-------------------------------------------------------------------------- */
-INFO_TABLE(stg_EVACUATED_info,stg_EVACUATED_entry,1,0,EVACUATED,,EF_,"EVACUATED","EVACUATED");
+INFO_TABLE(stg_EVACUATED_info,stg_EVACUATED_entry,1,0,EVACUATED,,IF_,"EVACUATED","EVACUATED");
NON_ENTERABLE_ENTRY_CODE(EVACUATED);
/* -----------------------------------------------------------------------------
live weak pointers with dead ones).
-------------------------------------------------------------------------- */
-INFO_TABLE(stg_WEAK_info,stg_WEAK_entry,0,4,WEAK,,EF_,"WEAK","WEAK");
+INFO_TABLE(stg_WEAK_info,stg_WEAK_entry,0,4,WEAK,,IF_,"WEAK","WEAK");
NON_ENTERABLE_ENTRY_CODE(WEAK);
-// 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.
+// It's important when turning an existing WEAK into a DEAD_WEAK
+// (which is what finalizeWeak# does) that we don't lose the link
+// field and break the linked list of weak pointers. Hence, we give
+// DEAD_WEAK 4 non-pointer fields, the same as WEAK.
-#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");
+INFO_TABLE_CONSTR(stg_DEAD_WEAK_info,stg_DEAD_WEAK_entry,0,4,0,CONSTR,,IF_,"DEAD_WEAK","DEAD_WEAK");
NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
/* -----------------------------------------------------------------------------
finalizer in a weak pointer object.
-------------------------------------------------------------------------- */
-INFO_TABLE_CONSTR(stg_NO_FINALIZER_info,stg_NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,EF_,"NO_FINALIZER","NO_FINALIZER");
+INFO_TABLE_CONSTR(stg_NO_FINALIZER_info,stg_NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,,IF_,"NO_FINALIZER","NO_FINALIZER");
NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
-SET_STATIC_HDR(stg_NO_FINALIZER_closure,stg_NO_FINALIZER_info,0/*CC*/,,EI_)
+SET_STATIC_HDR(stg_NO_FINALIZER_closure,stg_NO_FINALIZER_info,0/*CC*/,,extern const StgInfoTable)
, /*payload*/{} };
/* -----------------------------------------------------------------------------
Foreign Objects are unlifted and therefore never entered.
-------------------------------------------------------------------------- */
-INFO_TABLE(stg_FOREIGN_info,stg_FOREIGN_entry,0,1,FOREIGN,,EF_,"FOREIGN","FOREIGN");
+INFO_TABLE(stg_FOREIGN_info,stg_FOREIGN_entry,0,1,FOREIGN,,IF_,"FOREIGN","FOREIGN");
NON_ENTERABLE_ENTRY_CODE(FOREIGN);
/* -----------------------------------------------------------------------------
Stable Names are unlifted too.
-------------------------------------------------------------------------- */
-INFO_TABLE(stg_STABLE_NAME_info,stg_STABLE_NAME_entry,0,1,STABLE_NAME,,EF_,"STABLE_NAME","STABLE_NAME");
+INFO_TABLE(stg_STABLE_NAME_info,stg_STABLE_NAME_entry,0,1,STABLE_NAME,,IF_,"STABLE_NAME","STABLE_NAME");
NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
/* -----------------------------------------------------------------------------
and entry code for each type.
-------------------------------------------------------------------------- */
-INFO_TABLE(stg_FULL_MVAR_info,stg_FULL_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
+INFO_TABLE(stg_FULL_MVAR_info,stg_FULL_MVAR_entry,4,0,MVAR,,IF_,"MVAR","MVAR");
NON_ENTERABLE_ENTRY_CODE(FULL_MVAR);
-INFO_TABLE(stg_EMPTY_MVAR_info,stg_EMPTY_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
+INFO_TABLE(stg_EMPTY_MVAR_info,stg_EMPTY_MVAR_entry,4,0,MVAR,,IF_,"MVAR","MVAR");
NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
/* -----------------------------------------------------------------------------
end of a linked TSO queue.
-------------------------------------------------------------------------- */
-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");
+INFO_TABLE_CONSTR(stg_END_TSO_QUEUE_info,stg_END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,,IF_,"END_TSO_QUEUE","END_TSO_QUEUE");
NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
-SET_STATIC_HDR(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE_info,0/*CC*/,,EI_)
+SET_STATIC_HDR(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE_info,0/*CC*/,,extern const StgInfoTable)
, /*payload*/{} };
/* -----------------------------------------------------------------------------
an END_MUT_LIST closure.
-------------------------------------------------------------------------- */
-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");
+INFO_TABLE_CONSTR(stg_END_MUT_LIST_info,stg_END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,IF_,"END_MUT_LIST","END_MUT_LIST");
NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
-SET_STATIC_HDR(stg_END_MUT_LIST_closure,stg_END_MUT_LIST_info,0/*CC*/,,EI_)
+SET_STATIC_HDR(stg_END_MUT_LIST_closure,stg_END_MUT_LIST_info,0/*CC*/,,extern const StgInfoTable)
, /*payload*/{} };
-INFO_TABLE(stg_MUT_CONS_info, stg_MUT_CONS_entry, 1, 1, MUT_CONS, , EF_, "MUT_CONS", "MUT_CONS");
+INFO_TABLE(stg_MUT_CONS_info, stg_MUT_CONS_entry, 1, 1, MUT_CONS, , IF_, "MUT_CONS", "MUT_CONS");
NON_ENTERABLE_ENTRY_CODE(MUT_CONS);
/* -----------------------------------------------------------------------------
Exception lists
-------------------------------------------------------------------------- */
-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");
+INFO_TABLE_CONSTR(stg_END_EXCEPTION_LIST_info,stg_END_EXCEPTION_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,,IF_,"END_EXCEPTION_LIST","END_EXCEPTION_LIST");
NON_ENTERABLE_ENTRY_CODE(END_EXCEPTION_LIST);
-SET_STATIC_HDR(stg_END_EXCEPTION_LIST_closure,stg_END_EXCEPTION_LIST_info,0/*CC*/,,EI_)
+SET_STATIC_HDR(stg_END_EXCEPTION_LIST_closure,stg_END_EXCEPTION_LIST_info,0/*CC*/,,extern const StgInfoTable)
, /*payload*/{} };
-INFO_TABLE(stg_EXCEPTION_CONS_info, stg_EXCEPTION_CONS_entry, 1, 1, CONSTR, , EF_, "EXCEPTION_CONS", "EXCEPTION_CONS");
+INFO_TABLE(stg_EXCEPTION_CONS_info, stg_EXCEPTION_CONS_entry, 1, 1, CONSTR, , IF_, "EXCEPTION_CONS", "EXCEPTION_CONS");
NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS);
/* -----------------------------------------------------------------------------
-------------------------------------------------------------------------- */
#define ArrayInfo(type) \
-INFO_TABLE(stg_##type##_info, stg_##type##_entry, 0, 0, type, , EF_,"" # type "","" # type "");
+INFO_TABLE(stg_##type##_info, stg_##type##_entry, 0, 0, type, , IF_,"" # type "","" # type "");
ArrayInfo(ARR_WORDS);
NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
Mutable Variables
-------------------------------------------------------------------------- */
-INFO_TABLE(stg_MUT_VAR_info, stg_MUT_VAR_entry, 1, 1, MUT_VAR, , EF_, "MUT_VAR", "MUT_VAR");
+INFO_TABLE(stg_MUT_VAR_info, stg_MUT_VAR_entry, 1, 1, MUT_VAR, , IF_, "MUT_VAR", "MUT_VAR");
NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
/* -----------------------------------------------------------------------------
- Standard Error Entry.
-
- 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
Entering this closure will just return to the address on the top of the
just enter the top stack word to start the thread. (see deleteThread)
* -------------------------------------------------------------------------- */
-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_
- ret_addr = Sp[0];
- Sp++;
- JMP_(ENTRY_CODE(ret_addr));
- FE_
-}
-SET_STATIC_HDR(stg_dummy_ret_closure,stg_dummy_ret_info,CCS_DONT_CARE,,EI_)
-, /*payload*/{} };
+INFO_TABLE( stg_dummy_ret_info, stg_dummy_ret_entry,
+ 0, 0, CONSTR_NOCAF_STATIC, , EF_, "DUMMY_RET", "DUMMY_RET");
-/* -----------------------------------------------------------------------------
- Strict IO application - performing an IO action and entering its result.
-
- rts_evalIO() lets you perform Haskell IO actions from outside of Haskell-land,
- returning back to you their result. Want this result to be evaluated to WHNF
- by that time, so that we can easily get at the int/char/whatever using the
- various get{Ty} functions provided by the RTS API.
-
- forceIO takes care of this, performing the IO action and entering the
- results that comes back.
-
- * -------------------------------------------------------------------------- */
-
-#ifdef REG_R1
-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++;
- Sp -= sizeofW(StgSeqFrame);
- PUSH_SEQ_FRAME(Sp);
- JMP_(GET_ENTRY(R1.cl));
-}
-#else
-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_
- rval = (StgClosure *)Sp[0];
- Sp += 2;
- Sp -= sizeofW(StgSeqFrame);
- PUSH_SEQ_FRAME(Sp);
- R1.cl = rval;
- JMP_(GET_ENTRY(R1.cl));
-}
-#endif
-
-INFO_TABLE(stg_forceIO_info,stg_forceIO_entry,1,0,FUN_STATIC,,EF_,"FORCE_IO","FORCE_IO");
-FN_(stg_forceIO_entry)
+STGFUN(stg_dummy_ret_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_)&stg_forceIO_ret_info;
- Sp--;
- /* Push the RealWorld# tag and enter */
- Sp[0] =(W_)REALWORLD_TAG;
- JMP_(GET_ENTRY(R1.cl));
+ JMP_(ENTRY_CODE(Sp[0]));
FE_
}
-SET_STATIC_HDR(stg_forceIO_closure,stg_forceIO_info,CCS_DONT_CARE,,EI_)
+SET_STATIC_HDR(stg_dummy_ret_closure,stg_dummy_ret_info,CCS_DONT_CARE,,extern const StgInfoTable)
, /*payload*/{} };
-
/* -----------------------------------------------------------------------------
CHARLIKE and INTLIKE closures.
#define Char_hash_static_info czh_static_info
#define Int_hash_static_info izh_static_info
#else
-#define Char_hash_static_info PrelBase_Czh_static_info
-#define Int_hash_static_info PrelBase_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) \
projects / ghc-hetmet.git / blobdiff