/* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.32 2000/01/14 11:45:21 hwloidl Exp $
+ * $Id: StgMiscClosures.hc,v 1.49 2000/10/09 11:41:43 simonmar Exp $
*
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2000
*
* Entry code for various built-in closure types.
*
#include "HeapStackCheck.h" /* for stg_gen_yield */
#include "Storage.h"
#include "StoragePriv.h"
-#include "ProfRts.h"
+#include "Profiling.h"
+#include "Prelude.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)
FB_ \
DUMP_ERRMSG(#type " object entered!\n"); \
STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \
+ return NULL; \
FE_ \
}
+
/* -----------------------------------------------------------------------------
- Entry code for an indirection.
+ Support for the metacircular interpreter.
+ -------------------------------------------------------------------------- */
- This code assumes R1 is in a register for now.
+#ifdef GHCI
+
+/* 9 bits of return code for constructors created by mci_make_constr. */
+FN_(mci_constr_entry)
+{
+ /* R1 points at the constructor */
+ FB_
+ STGCALL2(fprintf,stderr,"mci_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_(mci_constr1_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),0)); FE_ }
+FN_(mci_constr2_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),1)); FE_ }
+FN_(mci_constr3_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),2)); FE_ }
+FN_(mci_constr4_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),3)); FE_ }
+FN_(mci_constr5_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),4)); FE_ }
+FN_(mci_constr6_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),5)); FE_ }
+FN_(mci_constr7_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),6)); FE_ }
+FN_(mci_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ }
+
+
+/* Since this stuff is ostensibly in some other module, we need
+ to supply an __init_ function.
+*/
+START_MOD_INIT(__init_MCIzumakezuconstr)
+END_MOD_INIT()
+
+
+INFO_TABLE(mci_make_constr_info, mci_make_constr_entry, 0,0,FUN_STATIC,,EF_,0,0);
+INFO_TABLE(mci_make_constrI_info, mci_make_constrI_entry, 0,0,FUN_STATIC,,EF_,0,0);
+INFO_TABLE(mci_make_constrP_info, mci_make_constrP_entry, 0,0,FUN_STATIC,,EF_,0,0);
+INFO_TABLE(mci_make_constrPP_info, mci_make_constrPP_entry, 0,0,FUN_STATIC,,EF_,0,0);
+INFO_TABLE(mci_make_constrPPP_info,mci_make_constrPPP_entry,0,0,FUN_STATIC,,EF_,0,0);
+
+SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstr_closure,
+ mci_make_constr_info,0,,EI_)
+ ,{ /* payload */ }
+};
+SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrI_closure,
+ mci_make_constrI_info,0,,EI_)
+ ,{ /* payload */ }
+};
+SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrP_closure,
+ mci_make_constrP_info,0,,EI_)
+ ,{ /* payload */ }
+};
+SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrPP_closure,
+ mci_make_constrPP_info,0,,EI_)
+ ,{ /* payload */ }
+};
+SET_STATIC_HDR(MCIzumakezuconstr_mcizumakezuconstrPPP_closure,
+ mci_make_constrPPP_info,0,,EI_)
+ ,{ /* payload */ }
+};
+
+
+/* Make a constructor with no args. */
+STGFUN(mci_make_constr_entry)
+{
+ nat size, np, nw;
+ StgClosure* con;
+ StgInfoTable* itbl;
+ FB_
+ /* Sp[0 & 1] are tag, Addr#
+ */
+ itbl = ((StgInfoTable**)Sp)[1];
+ np = INFO_PTR_TO_STRUCT(itbl)->layout.payload.ptrs;
+ nw = INFO_PTR_TO_STRUCT(itbl)->layout.payload.nptrs;
+ size = sizeofW(StgHeader) + stg_max(MIN_NONUPD_SIZE, np+nw);
+ /* STGCALL5(fprintf,stderr,"np %d nw %d size %d\n",np,nw,size); */
+
+ /* The total number of words to copy off the stack is np + nw.
+ That doesn't include tag words, tho.
+ */
+ HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constr_entry, );
+ TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0);
+ CCS_ALLOC(CCCS,size); /* ccs prof */
+
+ con = (StgClosure*)(Hp + 1 - size);
+ SET_HDR(con, itbl,CCCS);
+
+ Sp = Sp +2; /* Zap the Addr# arg */
+ R1.cl = con;
+
+ JMP_(ENTRY_CODE(GET_INFO(R1.cl)));
+ FE_
+}
+
+/* Make a constructor with 1 Int# arg */
+STGFUN(mci_make_constrI_entry)
+{
+ nat size, np, nw;
+ StgClosure* con;
+ StgInfoTable* itbl;
+ FB_
+ /* Sp[0 & 1] are tag, Addr#
+ Sp[2 & 3] are tag, Int#
+ */
+ itbl = ((StgInfoTable**)Sp)[1];
+ np = INFO_PTR_TO_STRUCT(itbl)->layout.payload.ptrs;
+ nw = INFO_PTR_TO_STRUCT(itbl)->layout.payload.nptrs;
+ size = sizeofW(StgHeader) + stg_max(MIN_NONUPD_SIZE, np+nw);
+ /* STGCALL5(fprintf,stderr,"np %d nw %d size %d\n",np,nw,size); */
+
+ /* The total number of words to copy off the stack is np + nw.
+ That doesn't include tag words, tho.
+ */
+ HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constrI_entry, );
+ TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0);
+ CCS_ALLOC(CCCS,size); /* ccs prof */
+
+ con = (StgClosure*)(Hp + 1 - size);
+ SET_HDR(con, itbl,CCCS);
+
+ con->payload[0] = ((StgClosure**)Sp)[3];
+ Sp = Sp +1/*word*/ +1/*tag*/; /* Zap the Int# arg */
+ Sp = Sp +2; /* Zap the Addr# arg */
+ R1.cl = con;
+
+ JMP_(ENTRY_CODE(GET_INFO(R1.cl)));
+ FE_
+}
+
+STGFUN(mci_make_constrP_entry)
+{
+ FB_
+ DUMP_ERRMSG("mci_make_constrP_entry: unimplemented!\n");
+ STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE);
+ return 0;
+ FE_
+}
+
+
+/* Make a constructor with 2 pointer args. */
+STGFUN(mci_make_constrPP_entry)
+{
+ nat size, np, nw;
+ StgClosure* con;
+ StgInfoTable* itbl;
+ FB_
+ /* Sp[0 & 1] are tag, Addr#
+ Sp[2] first arg
+ Sp[3] second arg
+ */
+ itbl = ((StgInfoTable**)Sp)[1];
+ np = INFO_PTR_TO_STRUCT(itbl)->layout.payload.ptrs;
+ nw = INFO_PTR_TO_STRUCT(itbl)->layout.payload.nptrs;
+ size = sizeofW(StgHeader) + stg_max(MIN_NONUPD_SIZE, np+nw);
+ /* STGCALL5(fprintf,stderr,"np %d nw %d size %d\n",np,nw,size); */
+
+ /* The total number of words to copy off the stack is np + nw.
+ That doesn't include tag words, tho.
+ */
+ HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constrPP_entry, );
+ TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0);
+ CCS_ALLOC(CCCS,size); /* ccs prof */
+
+ con = (StgClosure*)(Hp + 1 - size);
+ SET_HDR(con, itbl,CCCS);
+
+ con->payload[0] = ((StgClosure**)Sp)[2];
+ con->payload[1] = ((StgClosure**)Sp)[3];
+ Sp = Sp +2; /* Zap 2 ptr args */
+ Sp = Sp +2; /* Zap the Addr# arg */
+ R1.cl = con;
+
+ JMP_(ENTRY_CODE(GET_INFO(R1.cl)));
+ FE_
+}
+
+
+STGFUN(mci_make_constrPPP_entry)
+{
+ FB_
+ DUMP_ERRMSG("mci_make_constrPPP_entry: unimplemented!\n");
+ STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE);
+ return 0;
+ FE_
+}
+
+#if 0
+/* It would be nice if this worked, but it doesn't. Yet. */
+STGFUN(mci_make_constr_entry)
+{
+ nat size, np, nw_heap, nw_really, w;
+ StgClosure* con;
+ StgInfoTable* itbl;
+ W_* r;
+ FB_
+ itbl = ((StgInfoTable**)Sp)[0];
+STGCALL3(fprintf,stderr,"mmc: itbl = %d\n",itbl);
+
+STGCALL3(fprintf,stderr,"mmc: sp-4 = %d\n", ((W_*)Sp)[-4] );
+STGCALL3(fprintf,stderr,"mmc: sp-3 = %d\n", ((W_*)Sp)[-3] );
+STGCALL3(fprintf,stderr,"mmc: sp-2 = %d\n", ((W_*)Sp)[-2] );
+STGCALL3(fprintf,stderr,"mmc: sp-1 = %d\n", ((W_*)Sp)[-1] );
+STGCALL3(fprintf,stderr,"mmc: sp+0 = %d\n", ((W_*)Sp)[0] );
+STGCALL3(fprintf,stderr,"mmc: sp+1 = %d\n", ((W_*)Sp)[1] );
+STGCALL3(fprintf,stderr,"mmc: sp+2 = %d\n", ((W_*)Sp)[2] );
+STGCALL3(fprintf,stderr,"mmc: sp+3 = %d\n", ((W_*)Sp)[3] );
+STGCALL3(fprintf,stderr,"mmc: sp+4 = %d\n", ((W_*)Sp)[4] );
+ np = itbl->layout.payload.ptrs;
+ nw_really = itbl->layout.payload.nptrs;
+ nw_heap = stg_max(nw_really, MIN_NONUPD_SIZE-np);
+ size = CONSTR_sizeW( np, nw_heap );
+
+ /* The total number of words to copy off the stack is np + nw.
+ That doesn't include tag words, tho.
+ */
+ HP_CHK_GEN_TICKY(size, NO_PTRS, mci_make_constr_entry, );
+ TICK_ALLOC_PRIM(sizeofW(StgHeader), size-sizeofW(StgHeader), 0);
+ CCS_ALLOC(CCCS,size); /* ccs prof */
+
+ con = (StgClosure*)(Hp + 1 - size);
+ SET_HDR(con, itbl,CCCS);
+
+ /* Copy into the closure. */
+ w = 0;
+ r = Sp+1;
+ while (1) {
+ if (w == np + nw) break;
+ ASSERT(w < np + nw);
+ if (IS_ARG_TAG(*r)) {
+ nat n = *r++;
+ for (; n > 0; n--)
+ con->payload[w++] = (StgClosure*)(*r++);
+ } else {
+ con->payload[w++] = (StgClosure*)(*r++);
+ }
+ ASSERT((P_)r <= (P_)Su);
+ }
+
+ /* Remove all the args we've used. */
+ Sp = r;
+
+ R1.cl = con;
+ JMP_(ENTRY_CODE(R1.cl));
+ FE_
+}
+#endif
+
+#endif /* GHCI */
+
+
+/* -----------------------------------------------------------------------------
+ Entry code for an indirection.
-------------------------------------------------------------------------- */
INFO_TABLE(IND_info,IND_entry,1,0,IND,,EF_,0,0);
{
FB_
TICK_ENT_IND(Node); /* tick */
-
R1.p = (P_) ((StgIndStatic*)R1.p)->indirectee;
TICK_ENT_VIA_NODE();
JMP_(ENTRY_CODE(*R1.p));
FE_
}
-INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,,EF_,0,0);
+INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,,EF_,"IND_PERM","IND_PERM");
STGFUN(IND_PERM_entry)
{
FB_
* old-generation indirection.
*/
-INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,0,0);
+INFO_TABLE(BLACKHOLE_info, BLACKHOLE_entry,0,2,BLACKHOLE,,EF_,"BLACKHOLE","BLACKHOLE");
STGFUN(BLACKHOLE_entry)
{
FB_
#endif
#ifdef SMP
- CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info);
+ {
+ 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);
+ } else {
+ EXTFUN_RTS(stg_gc_enter_1_hponly);
+ JMP_(stg_gc_enter_1_hponly);
+ }
+ }
+ }
#endif
-
TICK_ENT_BH();
/* Put ourselves on the blocking queue for this black hole */
/* 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);
- }
+ /* 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_
}
-INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,0,0);
+INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,"BLACKHOLE","BLACKHOLE");
STGFUN(BLACKHOLE_BQ_entry)
{
FB_
#endif
#ifdef SMP
- CMPXCHG(R1.cl->header.info, &BLACKHOLE_BQ_info, &WHITEHOLE_info);
+ {
+ 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);
+ } else {
+ EXTFUN_RTS(stg_gc_enter_1_hponly);
+ JMP_(stg_gc_enter_1_hponly);
+ }
+ }
+ }
#endif
TICK_ENT_BH();
((StgBlockingQueue *)R1.p)->header.info = &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_
}
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_
}
#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);
+INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,"CAF_BLACKHOLE","CAF_BLACKHOLE");
STGFUN(CAF_BLACKHOLE_entry)
{
FB_
#endif
#ifdef SMP
- CMPXCHG(R1.cl->header.info, &CAF_BLACKHOLE_info, &WHITEHOLE_info);
+ {
+ 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);
+ } else {
+ EXTFUN_RTS(stg_gc_enter_1_hponly);
+ JMP_(stg_gc_enter_1_hponly);
+ }
+ }
+ }
#endif
TICK_ENT_BH();
/* 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);
- }
+ /* 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_
}
/* -----------------------------------------------------------------------------
The code for a BCO returns to the scheduler
-------------------------------------------------------------------------- */
-INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,,EF_,0,0);
+INFO_TABLE(BCO_info,BCO_entry,0,0,BCO,,EF_,"BCO","BCO");
EF_(BCO_entry) {
FB_
Sp -= 1;
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(TSO_info, TSO_entry, 0,0,TSO,,EF_,"TSO","TSO");
NON_ENTERABLE_ENTRY_CODE(TSO);
/* -----------------------------------------------------------------------------
live weak pointers with dead ones).
-------------------------------------------------------------------------- */
-INFO_TABLE(WEAK_info,WEAK_entry,0,4,WEAK,,EF_,0,0);
+INFO_TABLE(WEAK_info,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);
+INFO_TABLE_CONSTR(DEAD_WEAK_info,DEAD_WEAK_entry,0,1,0,CONSTR,,EF_,"DEAD_WEAK","DEAD_WEAK");
NON_ENTERABLE_ENTRY_CODE(DEAD_WEAK);
/* -----------------------------------------------------------------------------
Foreign Objects are unlifted and therefore never entered.
-------------------------------------------------------------------------- */
-INFO_TABLE(FOREIGN_info,FOREIGN_entry,0,1,FOREIGN,,EF_,0,0);
+INFO_TABLE(FOREIGN_info,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(STABLE_NAME_info,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(FULL_MVAR_info,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(EMPTY_MVAR_info,EMPTY_MVAR_entry,4,0,MVAR,,EF_,"MVAR","MVAR");
NON_ENTERABLE_ENTRY_CODE(EMPTY_MVAR);
/* -----------------------------------------------------------------------------
-------------------------------------------------------------------------- */
#define ArrayInfo(type) \
-INFO_TABLE(type##_info, type##_entry, 0, 0, type, , EF_,0,0);
+INFO_TABLE(type##_info, 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(MUT_VAR_info, 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
JMP_(ENTRY_CODE(ret_addr));
FE_
}
-SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_)
+SET_STATIC_HDR(dummy_ret_closure,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)
{
PUSH_SEQ_FRAME(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)
+{
+ 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(forceIO_info,forceIO_entry,1,0,FUN,,EF_,0,0);
+INFO_TABLE(forceIO_info,forceIO_entry,1,0,FUN_STATIC,,EF_,0,0);
FN_(forceIO_entry)
{
FB_
JMP_(GET_ENTRY(R1.cl));
FE_
}
-SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONTZuCARE,,EI_)
+SET_STATIC_HDR(forceIO_closure,forceIO_info,CCS_DONT_CARE,,EI_)
, /*payload*/{} };
#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.
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 PrelBase_Czh_static_info
+#define Int_hash_static_info PrelBase_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 \
}