/* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.3 1999/01/13 17:25:46 simonm Exp $
+ * $Id: StgMiscClosures.hc,v 1.20 1999/04/23 09:47:33 simonm Exp $
+ *
+ * (c) The GHC Team, 1998-1999
*
* Entry code for various built-in closure types.
*
#include "RtsUtils.h"
#include "StgMiscClosures.h"
#include "HeapStackCheck.h" /* for stg_gen_yield */
+#include "Storage.h"
+#include "StoragePriv.h"
+#include "ProfRts.h"
#ifdef HAVE_STDIO_H
#include <stdio.h>
FE_
}
-INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,0,IND_PERM,const,EF_,0,0);
+INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,const,EF_,0,0);
STGFUN(IND_PERM_entry)
{
FB_
/* Don't add INDs to granularity cost */
- /* Dont: ENT_IND(Node); for ticky-ticky; this ind is here only to help profi
+ /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profi
ling */
/* Enter PAP cost centre -- lexical scoping only */
FB_
TICK_ENT_IND(Node); /* tick */
+ /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profi
+ling */
+
+ /* 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_(*R1.p);
This code assumes R1 is in a register for now.
-------------------------------------------------------------------------- */
-INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,2,CAF_UNENTERED,const,EF_,0,0);
+INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,3,CAF_UNENTERED,const,EF_,0,0);
STGFUN(CAF_UNENTERED_entry)
{
FB_
FE_
}
-INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,2,1,CAF_ENTERED,const,EF_,0,0);
+/* 0,4 is entirely bogus; _do not_ rely on this info */
+INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,0,4,CAF_ENTERED,const,EF_,0,0);
STGFUN(CAF_ENTERED_entry)
{
FB_
- TICK_ENT_CAF_ENTERED(Node); /* tick */
-
R1.p = (P_) ((StgCAF*)R1.p)->value; /* just a fancy indirection */
TICK_ENT_VIA_NODE();
JMP_(GET_ENTRY(R1.cl));
* should be big enough for an old-generation indirection.
*/
-INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,1,1,BLACKHOLE,const,EF_,0,0);
+INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,const,EF_,0,0);
STGFUN(BLACKHOLE_entry)
{
FB_
+ TICK_ENT_BH();
+
+ /* Change the BLACKHOLE into a BLACKHOLE_BQ */
+ ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
+ /* Put ourselves on the blocking queue for this black hole */
+ CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
+ ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
+ CurrentTSO->blocked_on = R1.cl;
+ recordMutable((StgMutClosure *)R1.cl);
+
+ /* 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,const,EF_,0,0);
+STGFUN(BLACKHOLE_BQ_entry)
+{
+ FB_
+ TICK_ENT_BH();
+
/* Put ourselves on the blocking queue for this black hole */
- CurrentTSO->link = ((StgBlackHole *)R1.p)->blocking_queue;
- ((StgBlackHole *)R1.p)->blocking_queue = CurrentTSO;
+ CurrentTSO->blocked_on = R1.cl;
+ CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue;
+ ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
/* stg_gen_block is too heavyweight, use a specialised one */
BLOCK_NP(1);
}
/* identical to BLACKHOLEs except for the infotag */
-INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,1,1,CAF_BLACKHOLE,const,EF_,0,0);
+INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,const,EF_,0,0);
STGFUN(CAF_BLACKHOLE_entry)
{
FB_
+ TICK_ENT_BH();
+
+ /* Change the BLACKHOLE into a BLACKHOLE_BQ */
+ ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info;
/* Put ourselves on the blocking queue for this black hole */
- CurrentTSO->link = ((StgBlackHole *)R1.p)->blocking_queue;
- ((StgBlackHole *)R1.p)->blocking_queue = CurrentTSO;
+ CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
+ ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO;
+ CurrentTSO->blocked_on = R1.cl;
+ recordMutable((StgMutClosure *)R1.cl);
/* stg_gen_block is too heavyweight, use a specialised one */
BLOCK_NP(1);
NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
/* -----------------------------------------------------------------------------
+ NO_FINALIZER
+
+ This is a static nullary constructor (like []) that we use to mark an empty
+ finalizer in a weak pointer object.
+ -------------------------------------------------------------------------- */
+
+INFO_TABLE_CONSTR(NO_FINALIZER_info,NO_FINALIZER_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+NON_ENTERABLE_ENTRY_CODE(NO_FINALIZER);
+
+SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_)
+};
+
+/* -----------------------------------------------------------------------------
Foreign Objects are unlifted and therefore never entered.
-------------------------------------------------------------------------- */
NON_ENTERABLE_ENTRY_CODE(FOREIGN);
/* -----------------------------------------------------------------------------
+ Stable Names are unlifted too.
+ -------------------------------------------------------------------------- */
+
+INFO_TABLE(STABLE_NAME_info,STABLE_NAME_entry,0,1,STABLE_NAME,const,EF_,0,0);
+NON_ENTERABLE_ENTRY_CODE(STABLE_NAME);
+
+/* -----------------------------------------------------------------------------
MVars
There are two kinds of these: full and empty. We need an info table
INFO_TABLE_CONSTR(END_TSO_QUEUE_info,END_TSO_QUEUE_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
NON_ENTERABLE_ENTRY_CODE(END_TSO_QUEUE);
-SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,const,EI_)
+SET_STATIC_HDR(END_TSO_QUEUE_closure,END_TSO_QUEUE_info,0/*CC*/,,EI_)
};
/* -----------------------------------------------------------------------------
INFO_TABLE_CONSTR(END_MUT_LIST_info,END_MUT_LIST_entry,0,0,0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
NON_ENTERABLE_ENTRY_CODE(END_MUT_LIST);
-SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,const,EI_)
+SET_STATIC_HDR(END_MUT_LIST_closure,END_MUT_LIST_info,0/*CC*/,,EI_)
};
INFO_TABLE(MUT_CONS_info, MUT_CONS_entry, 1, 1, MUT_VAR, const, EF_, 0, 0);
-------------------------------------------------------------------------- */
-#define ArrayInfo(type) \
-INFO_TABLE(type##_info, type##_entry, 0, 0, type, const, EF_,0,0); \
-NON_ENTERABLE_ENTRY_CODE(type);
+#define ArrayInfo(type) \
+INFO_TABLE(type##_info, type##_entry, 0, 0, type, const, EF_,0,0);
ArrayInfo(ARR_WORDS);
-ArrayInfo(MUT_ARR_WORDS);
+NON_ENTERABLE_ENTRY_CODE(ARR_WORDS);
ArrayInfo(MUT_ARR_PTRS);
+NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS);
ArrayInfo(MUT_ARR_PTRS_FROZEN);
+NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN);
#undef ArrayInfo
ret_addr = Sp[0];
Sp++;
JMP_(ENTRY_CODE(ret_addr));
+ FE_
}
-SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,const,EI_)
+SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
};
/* -----------------------------------------------------------------------------
#ifndef COMPILER
-INFO_TABLE_CONSTR(CZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(IZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(I64Zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(FZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(DZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(AZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,const,EF_,0,0);
-INFO_TABLE_CONSTR(WZh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,const,EF_,0,0);
+INFO_TABLE_CONSTR(Czh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR,const,EF_,0,0);
+INFO_TABLE_CONSTR(Izh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR,const,EF_,0,0);
+INFO_TABLE_CONSTR(I64zh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR,const,EF_,0,0);
+INFO_TABLE_CONSTR(Fzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR,const,EF_,0,0);
+INFO_TABLE_CONSTR(Dzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR,const,EF_,0,0);
+INFO_TABLE_CONSTR(Azh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR,const,EF_,0,0);
+INFO_TABLE_CONSTR(Wzh_con_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR,const,EF_,0,0);
INFO_TABLE_CONSTR(StablePtr_con_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR,const,EF_,0,0);
-/* These might seem redundant but {I,C}Zh_static_info are used in
+/* 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,const,EF_,0,0);
-INFO_TABLE_CONSTR(IZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
-INFO_TABLE_CONSTR(I64Zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
-INFO_TABLE_CONSTR(FZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
-INFO_TABLE_CONSTR(DZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
-INFO_TABLE_CONSTR(AZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
-INFO_TABLE_CONSTR(WZh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+INFO_TABLE_CONSTR(Czh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgChar),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+INFO_TABLE_CONSTR(Izh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+INFO_TABLE_CONSTR(I64zh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgInt64),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+INFO_TABLE_CONSTR(Fzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgFloat),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+INFO_TABLE_CONSTR(Dzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgDouble),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+INFO_TABLE_CONSTR(Azh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgAddr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
+INFO_TABLE_CONSTR(Wzh_static_info,Hugs_CONSTR_entry,0,sizeofW(StgWord),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr),0,CONSTR_NOCAF_STATIC,const,EF_,0,0);
#endif /* !defined(COMPILER) */
replace them with references to the static objects.
-------------------------------------------------------------------------- */
+#ifdef HAVE_WIN32_DLL_SUPPORT
+/*
+ * When sticking the RTS in a DLL, we delay populating the
+ * Charlike and Intlike tables until load-time, which is only
+ * when we've got the real addresses to the C# and I# closures.
+ *
+ */
+static const StgInfoTable czh_static_info;
+static const StgInfoTable izh_static_info;
+#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
+#endif
+
#define CHARLIKE_HDR(n) \
{ \
- STATIC_HDR(CZh_static_info, /* C# */ \
+ STATIC_HDR(Char_hash_static_info, /* C# */ \
CCS_DONTZuCARE), \
data : n \
}
#define INTLIKE_HDR(n) \
{ \
- STATIC_HDR(IZh_static_info, /* I# */ \
+ STATIC_HDR(Int_hash_static_info, /* I# */ \
CCS_DONTZuCARE), \
data : n \
}