X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FStgMiscClosures.hc;h=609eba35c5fdc70f1a4488fa354cb79792061e4e;hb=2540a99f8e67237f7fa9cd49143ae2cd9d7f84d6;hp=8c436d8b0418a158e266f93308b5a4b9f7452752;hpb=70cc03db59adadec93b0aa54708372608ca2e1e1;p=ghc-hetmet.git diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc index 8c436d8..609eba3 100644 --- a/ghc/rts/StgMiscClosures.hc +++ b/ghc/rts/StgMiscClosures.hc @@ -1,7 +1,7 @@ /* ----------------------------------------------------------------------------- - * $Id: StgMiscClosures.hc,v 1.30 1999/11/30 11:43:26 simonmar 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. * @@ -9,26 +9,296 @@ #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 "SMP.h" +#if defined(GRAN) || defined(PAR) +# include "GranSimRts.h" /* for DumpRawGranEvent */ +# include "StgRun.h" /* for StgReturn and register saving */ +#endif #ifdef HAVE_STDIO_H #include #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) +/* + Template for the entry code of non-enterable closures. +*/ + +#define NON_ENTERABLE_ENTRY_CODE(type) \ +STGFUN(type##_entry) \ +{ \ + 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); @@ -48,14 +318,13 @@ STGFUN(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)); 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_ @@ -181,78 +450,192 @@ STGFUN(CAF_ENTERED_entry) * 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_ -#ifdef SMP - CMPXCHG(R1.cl->header.info, &BLACKHOLE_info, &WHITEHOLE_info); +#if defined(GRAN) + /* Before overwriting TSO_LINK */ + STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/); #endif +#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); + } 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 */ - CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure; +#if defined(GRAN) || defined(PAR) + /* 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 */ 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; + + /* 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); +INFO_TABLE(BLACKHOLE_BQ_info, BLACKHOLE_BQ_entry,1,1,BLACKHOLE_BQ,,EF_,"BLACKHOLE","BLACKHOLE"); STGFUN(BLACKHOLE_BQ_entry) { FB_ +#if defined(GRAN) + /* Before overwriting TSO_LINK */ + STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/); +#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(); /* Put ourselves on the blocking queue for this black hole */ - CurrentTSO->why_blocked = BlockedOnBlackHole; - CurrentTSO->block_info.closure = R1.cl; CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue; ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO; + /* jot down why and on what closure we are blocked */ + CurrentTSO->why_blocked = BlockedOnBlackHole; + CurrentTSO->block_info.closure = R1.cl; #ifdef SMP ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info; #endif + /* PAR: dumping of event now done in blockThread -- HWL */ + /* stg_gen_block is too heavyweight, use a specialised one */ BLOCK_NP(1); FE_ } +/* + Revertible black holes are needed in the parallel world, to handle + negative acknowledgements of messages containing updatable closures. + The idea is that when the original message is transmitted, the closure + is turned into a revertible black hole...an object which acts like a + black hole when local threads try to enter it, but which can be reverted + back to the original closure if necessary. + + It's actually a lot like a blocking queue (BQ) entry, because revertible + black holes are initially set up with an empty blocking queue. +*/ + +#if defined(PAR) || defined(GRAN) + +INFO_TABLE(RBH_info, RBH_entry,1,1,RBH,,EF_,0,0); +STGFUN(RBH_entry) +{ + FB_ +# if defined(GRAN) + /* mainly statistics gathering for GranSim simulation */ + STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/); +# endif + + /* exactly the same as a BLACKHOLE_BQ_entry -- HWL */ + /* Put ourselves on the blocking queue for this black hole */ + CurrentTSO->link = ((StgBlockingQueue *)R1.p)->blocking_queue; + ((StgBlockingQueue *)R1.p)->blocking_queue = CurrentTSO; + /* jot down why and on what closure we are blocked */ + CurrentTSO->why_blocked = BlockedOnBlackHole; + CurrentTSO->block_info.closure = 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(RBH_Save_0_info, RBH_Save_0_entry,0,2,CONSTR,,EF_,0,0); +NON_ENTERABLE_ENTRY_CODE(RBH_Save_0); + +INFO_TABLE(RBH_Save_1_info, RBH_Save_1_entry,1,1,CONSTR,,EF_,0,0); +NON_ENTERABLE_ENTRY_CODE(RBH_Save_1); + +INFO_TABLE(RBH_Save_2_info, RBH_Save_2_entry,2,0,CONSTR,,EF_,0,0); +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); +INFO_TABLE(CAF_BLACKHOLE_info, CAF_BLACKHOLE_entry,0,2,CAF_BLACKHOLE,,EF_,"CAF_BLACKHOLE","CAF_BLACKHOLE"); STGFUN(CAF_BLACKHOLE_entry) { FB_ +#if defined(GRAN) + /* mainly statistics gathering for GranSim simulation */ + STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1.p /*Node*/); +#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(); /* Put ourselves on the blocking queue for this black hole */ - CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure; +#if defined(GRAN) || defined(PAR) + /* 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 */ 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 */ ((StgBlockingQueue *)R1.p)->header.info = &BLACKHOLE_BQ_info; - /* stg_gen_block is too heavyweight, use a specialised one */ - BLOCK_NP(1); -#else - JMP_(BLACKHOLE_entry); -#endif + /* PAR: dumping of event now done in blockThread -- HWL */ + /* stg_gen_block is too heavyweight, use a specialised one */ + BLOCK_NP(1); FE_ } @@ -289,7 +672,7 @@ STGFUN(WHITEHOLE_entry) /* ----------------------------------------------------------------------------- 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; @@ -301,18 +684,10 @@ EF_(BCO_entry) { /* ----------------------------------------------------------------------------- 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 -------------------------------------------------------------------------- */ -#define NON_ENTERABLE_ENTRY_CODE(type) \ -STGFUN(type##_entry) \ -{ \ - FB_ \ - DUMP_ERRMSG(#type " object entered!\n"); \ - STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE); \ - FE_ \ -} - -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); /* ----------------------------------------------------------------------------- @@ -331,10 +706,10 @@ 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(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); /* ----------------------------------------------------------------------------- @@ -354,14 +729,14 @@ SET_STATIC_HDR(NO_FINALIZER_closure,NO_FINALIZER_info,0/*CC*/,,EI_) 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); /* ----------------------------------------------------------------------------- @@ -371,10 +746,10 @@ 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); /* ----------------------------------------------------------------------------- @@ -436,7 +811,7 @@ NON_ENTERABLE_ENTRY_CODE(EXCEPTION_CONS); -------------------------------------------------------------------------- */ #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); @@ -451,7 +826,7 @@ NON_ENTERABLE_ENTRY_CODE(MUT_ARR_PTRS_FROZEN); 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); /* ----------------------------------------------------------------------------- @@ -460,15 +835,17 @@ 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 @@ -487,7 +864,7 @@ FN_(dummy_ret_entry) 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*/{} }; /* ----------------------------------------------------------------------------- @@ -503,6 +880,7 @@ SET_STATIC_HDR(dummy_ret_closure,dummy_ret_info,CCS_DONTZuCARE,,EI_) * -------------------------------------------------------------------------- */ +#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) { @@ -512,9 +890,22 @@ 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_ @@ -528,7 +919,7 @@ FN_(forceIO_entry) 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*/{} }; @@ -568,31 +959,6 @@ VEC_POLY_INFO_TABLE(ret_bco,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO, #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. @@ -601,7 +967,7 @@ INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr 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 @@ -613,21 +979,21 @@ static INFO_TBL_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 +#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 \ }