now - worth putting them in a file by themselves?? [ADR] */
-#ifndef PAR
+#if !defined(PAR) /* && !defined(GRAN) */
-/* Ditto for Malloc Pointer entry point and info tables. [ADR]
+/* Ditto for Foreign Object entry point and info tables. [ADR]
BTW Will, I copied most of this blindly from above - what's with
this TAG stuff? And what kind of description/ type is wanted here?
*/
-STATICFUN(MallocPtr_entry)
+STATICFUN(ForeignObj_entry)
{
FB_
/* Don't wrap the calls; we're done with STG land */
fflush(stdout);
- fprintf(stderr, "Compiler bug: Entered a Malloc Pointer---this shouldn't happen!\n");
+ fprintf(stderr, "Compiler bug: Entered a ForeignObj---this shouldn't happen!\n");
abort();
FE_
}
-MallocPtr_ITBL(MallocPtr_info,MallocPtr_entry,UpdErr,0,INFO_OTHER_TAG,,,const,EF_,MallocPtr_K,"MALLOC PTR","MallocPtr");
+ForeignObj_ITBL(ForeignObj_info,ForeignObj_entry,UpdErr,0,INFO_OTHER_TAG,,,const,EF_,ForeignObj_K,"FOREIGN_OBJ","ForeignObj");
-/* End of MallocPtr stuff */
+/* End of ForeignObj stuff */
/* Ditto for the unused Stable Pointer info table. [ADR]
*/
-extern void raiseError PROTO((StgStablePtr));
-extern StgStablePtr errorHandler;
+void raiseError PROTO((StgStablePtr));
+extern StgStablePtr errorHandler; /* NB: prone to magic-value-ery (WDP 95/12) */
/* Unused Stable Pointer (ie unused slot in a stable pointer table) */
STATICFUN(UnusedSP_entry)
FE_
}
-STATIC_ITBL(UnusedSP_static_info,UnusedSP_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,IF_,CON_K,"UNUSED STABLE PTR","USP");
+STATIC_ITBL(UnusedSP_info,UnusedSP_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,IF_,CON_K,"UNUSED_STABLE_PTR","USP");
-SET_STATIC_HDR(UnusedSP_closure,UnusedSP_static_info,CC_SUBSUMED,,ED_RO_)
+SET_STATIC_HDR(UnusedSP_closure,UnusedSP_info,CC_SUBSUMED,,ED_RO_)
};
/* Entry point and Info table for Stable Pointer Table. */
+STATICFUN(EmptyStablePointerTable_entry)
+{
+ FB_
+ /* Don't wrap the calls; we're done with STG land */
+ fflush(stdout);
+ fprintf(stderr, "Entered *empty* stable pointer table---this shouldn't happen!\n");
+ abort();
+ FE_
+}
+
STATICFUN(StablePointerTable_entry)
{
FB_
FE_
}
-STATIC_ITBL(EmptyStablePointerTable_static_info,StablePointerTable_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,IF_,SPT_K,"SP_TABLE","SP_TABLE");
+STATIC_ITBL(EmptyStablePointerTable_info,EmptyStablePointerTable_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,IF_,SPT_K,"SP_TABLE","SP_TABLE");
/* ToDo: could put a useful tag in there!!! */
DYN_ITBL(StablePointerTable_info,StablePointerTable_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,IF_,SPT_K,"SP_TABLE","SP_TABLE");
overflow will trigger creation of a table of useful size.
*/
-SET_STATIC_HDR(EmptySPTable_closure,EmptyStablePointerTable_static_info,CC_SUBSUMED,,ED_RO_)
+SET_STATIC_HDR(EmptySPTable_closure,EmptyStablePointerTable_info,CC_SUBSUMED,,ED_RO_)
, (W_) DYN_VHS + 0 + 1 + 0 /* size = DYN_VHS + n + 1 + n with n = 0 */
, (W_) 0 /* number of ptrs */
, (W_) 0 /* top of stack */
/* End of SP stuff */
#endif /* !PAR */
+/* Not a natural home for these, but
+ the following symbols may be referenced in
+ an object file, but never entered
+*/
+P_ PrelGHC_void_closure = (P_) 0xbadbadbaL;
+P_ PrelGHC_ZcCCallable_static_info = (P_) 0xbadbadbaL;
+P_ PrelGHC_ZcCReturnable_static_info = (P_) 0xbadbadbaL;
/* the IoWorld token to start the whole thing off */
/* Question: this is just an amusing hex code isn't it
-- or does it mean something? ADR */
-P_ realWorldZh_closure = (P_) 0xbadbadbaL;
-
-SET_STATIC_HDR(WorldStateToken_closure,SZh_static_info,CC_SUBSUMED/*harmless*/,,ED_RO_)
-, (W_) 0xbadbadbaL
-};
+P_ realWorldZh_closure = (P_)0xbadbadbaL;
#ifndef CONCURRENT
up to date, and is used to load the STG registers.
*/
-#if defined (DO_SPAT_PROFILING)
- SET_ACTIVITY(ACT_REDN); /* init: do this first, so we count the restore insns */
-#endif
-
RestoreAllStgRegs(); /* inline! */
/* ------- STG registers are now valid! -------------------------*/
RetReg = (StgRetAddr) UNVEC(stopThreadDirectReturn,vtbl_stopStgWorld);
/* Put an IoWorld token on the A stack */
- SpA -= AREL(1);
- *SpA = (P_) WorldStateToken_closure;
+ SpB -= BREL(1);
+ (P_)*SpB = (P_) realWorldZh_closure;
Node = (P_) TopClosure; /* Point to the closure for main/errorIO-arg */
ENT_VIA_NODE();
/* Assumes that "TopClosure" has been set already */
{
FB_
+ fflush(stdout);
+ fflush(stderr);
if (ErrorIO_call_count >= 16 /* MAGIC CONSTANT */ ) {
/* Don't wrap the calls; we're done with STG land */
fflush(stdout);
#else
SuA = stackInfo.botA + AREL(1);
SuB = stackInfo.botB + BREL(1);
+ /* HWL */
+ /*
+ SpB = SuB = STKO_BSTK_BOT(StkOReg) + BREL(1);
+ SuA = STKO_ASTK_BOT(StkOReg) + AREL(1);
+ */
+
#endif
break;
default:
/* Don't wrap the calls; we're done with STG land */
fflush(stdout);
- fprintf(stderr,"ErrorIO: %x unknown\n", TSO_TYPE(CurrentTSO));
+ fprintf(stderr,"ErrorIO: %lx unknown\n", TSO_TYPE(CurrentTSO));
EXIT(EXIT_FAILURE);
}
/* Finish stack setup as if for a top-level task and enter the error node */
+ /* Put an IoWorld token on the B stack */
+ SpB -= BREL(1);
+ *SpB = (P_) realWorldZh_closure;
+/*
SpA = SuA - AREL(1);
-
- *SpA = (P_) WorldStateToken_closure;
-
- STKO_LINK(StkOReg) = Nil_closure;
+ *SpA = (P_) realWorldZh_closure;
+*/
+ STKO_LINK(StkOReg) = PrelBase_Z91Z93_closure;
STKO_RETURN(StkOReg) = NULL;
-#ifdef DO_REDN_COUNTING
+#ifdef TICKY_TICKY
STKO_ADEP(StkOReg) = STKO_BDEP(StkOReg) = 0;
#endif
/* Assumes that "TopClosure" has been set already */
{
FB_
+ fflush(stdout);
+ fflush(stderr);
if (ErrorIO_call_count >= 16 /* MAGIC CONSTANT */ ) {
/* Don't wrap the calls; we're done with STG land */
fflush(stdout);
SaveAllStgRegs(); /* inline! */
- if ( initStacks( &StorageMgrInfo ) != 0) {
+ if (! initStacks( &StorageMgrInfo )) {
/* Don't wrap the calls; we're done with STG land */
fflush(stdout);
fprintf(stderr, "initStacks failed!\n");
\end{code}
\begin{code}
-#ifdef PAR
+#if defined(PAR) || defined(GRAN)
STATICFUN(RBH_Save_0_entry)
{
SPEC_N_ITBL(RBH_Save_1_info,RBH_Save_1_entry,UpdErr,0,INFO_OTHER_TAG,2,1,,IF_,INTERNAL_KIND,"RBH-SAVE","RBH_Save_1");
SPEC_N_ITBL(RBH_Save_2_info,RBH_Save_2_entry,UpdErr,0,INFO_OTHER_TAG,2,2,,IF_,INTERNAL_KIND,"RBH-SAVE","RBH_Save_2");
-#endif /* PAR */
+#endif /* PAR || GRAN */
\end{code}
}
/* info table */
-STATIC_ITBL(STK_STUB_static_info,STK_STUB_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,EF_,INTERNAL_KIND,"STK_STUB","STK_STUB");
+STATIC_ITBL(STK_STUB_info,STK_STUB_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,EF_,INTERNAL_KIND,"STK_STUB","STK_STUB");
/* closure */
-SET_STATIC_HDR(STK_STUB_closure,STK_STUB_static_info,CC_SUBSUMED,,EXTDATA_RO)
+SET_STATIC_HDR(STK_STUB_closure,STK_STUB_info,CC_SUBSUMED,,EXTDATA_RO)
, (W_)0, (W_)0
};
-\end{code}
-\begin{code}
-#ifdef GRAN
-STGFUN(Event_Queue_entry) {
+ED_RO_(vtbl_seq);
+
+/*
+STGFUN(seqZhCode)
+{
FB_
- /* Don't wrap the calls; we're done with STG land */
- fflush(stdout);
- fprintf(stderr, "Entered from an event queue!\n");
- abort();
- JMP_(0);
+ __label__ cont;
+ SpB[BREL(0)] = (W_) RetReg;
+ SpB[BREL(1)] = (W_) &&cont;
+ RetReg = (StgRetAddr) vtbl_seq;
+ ENT_VIA_NODE();
+ InfoPtr = (D_)(INFO_PTR(Node));
+ JMP_(ENTRY_CODE(InfoPtr));
+cont:
FE_
}
+*/
-GEN_N_ITBL(Event_Queue_info,Event_Queue_entry,UpdErr,0,INFO_OTHER_TAG,5,2,const,EF_,INTERNAL_KIND,"EventQ","EventQ");
-
-#endif /* GRAN */
\end{code}
-
-
%/****************************************************************
%* *
%* Some GC info tables *
/* Don't wrap the calls; we're done with STG land */
fflush(stdout);
fprintf(stderr,"Entered Forward_Ref_New %lx: Should never occur!\n", (W_) Node);
- abort();
+ EXIT(EXIT_FAILURE); /* abort(); */
FE_
}
FORWARDREF_ITBL(Forward_Ref_New_info,Forward_Ref_New_entry,const/*not static*/,_Evacuate_Old_Forward_Ref);
/* Don't wrap the calls; we're done with STG land */
fflush(stdout);
fprintf(stderr,"Entered Forward_Ref_Old %lx: Should never occur!\n", (W_) Node);
- abort();
+ EXIT(EXIT_FAILURE); /* abort(); */
FE_
}
FORWARDREF_ITBL(Forward_Ref_Old_info,Forward_Ref_Old_entry,const/*not static*/,_Evacuate_New_Forward_Ref);
/* Don't wrap the calls; we're done with STG land */
fflush(stdout);
fprintf(stderr,"Entered OldRoot_Forward_Ref %lx: Should never occur!\n", (W_) Node);
- abort();
+ EXIT(EXIT_FAILURE); /* abort(); */
FE_
}
FORWARDREF_ITBL(OldRoot_Forward_Ref_info,OldRoot_Forward_Ref_entry,const/*not static*/,_Evacuate_OldRoot_Forward);
/* Don't wrap the calls; we're done with STG land */
fflush(stdout);
fprintf(stderr,"Entered Forward_Ref %lx: Should never occur!\n", (W_) Node);
- abort();
+ EXIT(EXIT_FAILURE); /* abort(); */
FE_
}
FORWARDREF_ITBL(Forward_Ref_info,Forward_Ref_entry,const/*not static*/,_Evacuate_Forward_Ref);
ToDo: Explicit cost centres in prelude for Input and Output costs.
\begin{code}
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
STGFUN(startCcRegisteringWorld)
{
CC_DECLARE(CC_CAFs, "CAFs_in_...", "PRELUDE", "PRELUDE", CC_IS_CAF,/*not static*/);
CC_DECLARE(CC_DICTs, "DICTs_in_...", "PRELUDE", "PRELUDE", CC_IS_DICT,/*not static*/);
-START_REGISTER_PRELUDE(_regPrelude);
+START_REGISTER_PRELUDE(_regPrel);
REGISTER_CC(CC_CAFs);
REGISTER_CC(CC_DICTs);
END_REGISTER_CCS()
+
\end{code}
We also need cost centre declarations and registering routines for other
/* _regPrelude is above */
-START_REGISTER_PRELUDE(_regPreludeArray);
-END_REGISTER_CCS()
-
-START_REGISTER_PRELUDE(_regPreludeCore);
+START_REGISTER_PRELUDE(_regPrelGHC);
END_REGISTER_CCS()
-START_REGISTER_PRELUDE(_regPreludeDialogueIO);
-END_REGISTER_CCS()
-
-START_REGISTER_PRELUDE(_regPreludeGlaMisc);
-END_REGISTER_CCS()
-
-START_REGISTER_PRELUDE(_regPreludeGlaST);
-END_REGISTER_CCS()
-
-START_REGISTER_PRELUDE(_regPreludeIOError);
-END_REGISTER_CCS()
-
-START_REGISTER_PRELUDE(_regPreludePS);
-END_REGISTER_CCS()
-
-START_REGISTER_PRELUDE(_regPreludePrimIO);
-END_REGISTER_CCS()
-
-START_REGISTER_PRELUDE(_regPreludeStdIO);
-END_REGISTER_CCS()
#endif
\end{code}
projects / ghc-hetmet.git / blobdiff