[project @ 1998-11-26 09:17:22 by sof]
[ghc-hetmet.git] / ghc / runtime / main / StgStartup.lhc
index 3bd53e8..57089df 100644 (file)
@@ -106,27 +106,27 @@ IMMUTUPLE_ITBL(ImMutArrayOfPtrs_info,ImMutArrayOfPtrs_entry,UpdErr,0,INFO_OTHER_
 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]
 */
@@ -145,7 +145,7 @@ STATICFUN(UnusedSP_entry)
     FE_
 }
 
-STATIC_ITBL(UnusedSP_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_info,CC_SUBSUMED,,ED_RO_)
 };
@@ -193,15 +193,18 @@ SET_STATIC_HDR(EmptySPTable_closure,EmptyStablePointerTable_info,CC_SUBSUMED,,ED
 /* 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
 
@@ -225,8 +228,8 @@ STGFUN(startStgWorld)
     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();
@@ -307,6 +310,8 @@ STGFUN(ErrorIO_innards)
     /* 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);
@@ -326,6 +331,12 @@ STGFUN(ErrorIO_innards)
 #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;
 
@@ -352,11 +363,14 @@ STGFUN(ErrorIO_innards)
 
     /* 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 TICKY_TICKY
@@ -383,6 +397,8 @@ ErrorIO_innards(STG_NO_ARGS)
     /* 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);
@@ -416,7 +432,7 @@ ErrorIO_innards(STG_NO_ARGS)
 \end{code}  
 
 \begin{code}
-#ifdef PAR
+#if defined(PAR) || defined(GRAN) 
 
 STATICFUN(RBH_Save_0_entry)
 {
@@ -446,7 +462,7 @@ SPEC_N_ITBL(RBH_Save_0_info,RBH_Save_0_entry,UpdErr,0,INFO_OTHER_TAG,2,0,,IF_,IN
 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}
 
 
@@ -489,28 +505,28 @@ STATIC_ITBL(STK_STUB_info,STK_STUB_entry,UpdErr,0,INFO_OTHER_TAG,0,0,const,EF_,I
 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                           *
@@ -542,7 +558,7 @@ STGFUN(Forward_Ref_New_entry) {
     /* 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);
@@ -552,7 +568,7 @@ STGFUN(Forward_Ref_Old_entry) {
     /* 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);
@@ -562,7 +578,7 @@ STGFUN(OldRoot_Forward_Ref_entry) {
     /* 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);
@@ -573,7 +589,7 @@ STGFUN(Forward_Ref_entry) {
     /* 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);
@@ -621,10 +637,11 @@ 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
@@ -638,31 +655,8 @@ END_REGISTER_CCS()
 
 /* _regPrelude is above */
 
-START_REGISTER_PRELUDE(_regPreludeArray);
-END_REGISTER_CCS()
-
-START_REGISTER_PRELUDE(_regPreludeCore);
-END_REGISTER_CCS()
-
-START_REGISTER_PRELUDE(_regPreludeDialogueIO);
+START_REGISTER_PRELUDE(_regPrelGHC);
 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}