/* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.62 2001/01/31 10:12:08 simonmar Exp $
+ * $Id: StgMiscClosures.hc,v 1.80 2002/09/17 12:34: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"
# 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) \
+STGFUN(stg_##type##_entry) \
+{ \
+ FB_ \
+ STGCALL1(barf, #type " object entered!\n"); \
+ FE_ \
}
Support for the bytecode interpreter.
-------------------------------------------------------------------------- */
-#ifdef GHCI
-
/* 9 bits of return code for constructors created by the interpreter. */
FN_(stg_interp_constr_entry)
{
VEC_POLY_INFO_TABLE(stg_ctoi_ret_D1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
+
+/* When the returned value a VoidRep ... */
+#define STG_CtoI_RET_V_Template(label) \
+ IFN_(label) \
+ { \
+ StgPtr bco; \
+ FB_ \
+ bco = ((StgPtr*)Sp)[1]; \
+ Sp -= 1; \
+ ((StgPtr*)Sp)[0] = 0; /* VoidRep tag */ \
+ Sp -= 1; \
+ ((StgPtr*)Sp)[0] = bco; \
+ JMP_(stg_yield_to_interpreter); \
+ FE_ \
+ }
+
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_0_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_1_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_2_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_3_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_4_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_5_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_6_entry);
+STG_CtoI_RET_V_Template(stg_ctoi_ret_V_7_entry);
+
+VEC_POLY_INFO_TABLE(stg_ctoi_ret_V,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
+
+
/* The other way round: when the interpreter returns a value to
compiled code. The stack looks like this:
FE_
}
-#endif /* GHCI */
-
/* -----------------------------------------------------------------------------
Entry code for an indirection.
-------------------------------------------------------------------------- */
-INFO_TABLE(stg_IND_info,stg_IND_entry,1,0,IND,,EF_,0,0);
+INFO_TABLE(stg_IND_info,stg_IND_entry,1,0,IND,,EF_,"IND","IND");
STGFUN(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_(ENTRY_CODE(*R1.p));
+ JMP_(GET_ENTRY(R1.cl));
FE_
}
-INFO_TABLE(stg_IND_STATIC_info,stg_IND_STATIC_entry,1,0,IND_STATIC,,EF_,0,0);
+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 */
+ TICK_ENT_STATIC_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_
}
{
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 */
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);
TICK_ENT_VIA_NODE();
#endif
- JMP_(ENTRY_CODE(*R1.p));
+ JMP_(GET_ENTRY(R1.cl));
FE_
}
-INFO_TABLE(stg_IND_OLDGEN_info,stg_IND_OLDGEN_entry,1,1,IND_OLDGEN,,EF_,0,0);
+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 */
-
+ TICK_ENT_STATIC_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(stg_IND_OLDGEN_PERM_info,stg_IND_OLDGEN_PERM_entry,1,1,IND_OLDGEN_PERM,,EF_,0,0);
+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 */
+ /* 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 */
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);
R1.p = (P_) ((StgInd*)R1.p)->indirectee;
TICK_ENT_VIA_NODE();
- JMP_(ENTRY_CODE(*R1.p));
+ JMP_(GET_ENTRY(R1.cl));
FE_
}
#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 */
+#ifdef PROFILING
+
+ // 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
- /* 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_
}
#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;
#if defined(PAR) || defined(GRAN)
-INFO_TABLE(stg_RBH_info, stg_RBH_entry,1,1,RBH,,EF_,0,0);
+INFO_TABLE(stg_RBH_info, stg_RBH_entry,1,1,RBH,,EF_,"RBH","RBH");
STGFUN(stg_RBH_entry)
{
FB_
FE_
}
-INFO_TABLE(stg_RBH_Save_0_info, stg_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(stg_RBH_Save_1_info, stg_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(stg_RBH_Save_2_info, stg_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) */
#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 */
- recordMutable((StgMutClosure *)R1.cl);
- /* Change the CAF_BLACKHOLE into a BLACKHOLE_BQ_STATIC */
+
+ // 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_
}
#ifdef TICKY_TICKY
-INFO_TABLE(stg_SE_BLACKHOLE_info, stg_SE_BLACKHOLE_entry,0,2,SE_BLACKHOLE,,EF_,0,0);
+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_
FE_
}
-INFO_TABLE(SE_CAF_BLACKHOLE_info, SE_CAF_BLACKHOLE_entry,0,2,SE_CAF_BLACKHOLE,,EF_,0,0);
+INFO_TABLE(stg_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_
#endif
#ifdef SMP
-INFO_TABLE(stg_WHITEHOLE_info, stg_WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,0,0);
+INFO_TABLE(stg_WHITEHOLE_info, stg_WHITEHOLE_entry,0,2,CONSTR_NOCAF_STATIC,,EF_,"WHITEHOLE","WHITEHOLE");
STGFUN(stg_WHITEHOLE_entry)
{
FB_
one is a real bug.
-------------------------------------------------------------------------- */
-INFO_TABLE(stg_EVACUATED_info,stg_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);
/* -----------------------------------------------------------------------------
INFO_TABLE(stg_WEAK_info,stg_WEAK_entry,0,4,WEAK,,EF_,"WEAK","WEAK");
NON_ENTERABLE_ENTRY_CODE(WEAK);
-INFO_TABLE_CONSTR(stg_DEAD_WEAK_info,stg_DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,"DEAD_WEAK","DEAD_WEAK");
+// 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.
+
+INFO_TABLE_CONSTR(stg_DEAD_WEAK_info,stg_DEAD_WEAK_entry,0,4,0,CONSTR,,EF_,"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_,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(stg_NO_FINALIZER_closure,stg_NO_FINALIZER_info,0/*CC*/,,EI_)
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_,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(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE_info,0/*CC*/,,EI_)
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_,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(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_, "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_,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(stg_END_EXCEPTION_LIST_closure,stg_END_EXCEPTION_LIST_info,0/*CC*/,,EI_)
, /*payload*/{} };
-INFO_TABLE(stg_EXCEPTION_CONS_info, stg_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);
/* -----------------------------------------------------------------------------
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_, 0, 0);
+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;
}
#endif
-INFO_TABLE(stg_forceIO_info,stg_forceIO_entry,1,0,FUN_STATIC,,EF_,0,0);
+INFO_TABLE(stg_forceIO_info,stg_forceIO_entry,1,0,FUN_STATIC,,EF_,"FORCE_IO","FORCE_IO");
FN_(stg_forceIO_entry)
{
FB_
#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