[project @ 1998-11-26 09:17:22 by sof]

[ghc-hetmet.git] / ghc / runtime / main / StgStartup.lhc

diff --git a/ghc/runtime/main/StgStartup.lhc b/ghc/runtime/main/StgStartup.lhc
index e0f26a7..57089df 100644 (file)
--- a/ghc/runtime/main/StgStartup.lhc
+++ b/ghc/runtime/main/StgStartup.lhc
@@ -193,16 +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;
-P_ GHC_void_closure = (P_) 0xbadbadbaL;
-
-SET_STATIC_HDR(WorldStateToken_closure,STBase_SZh_static_info,CC_SUBSUMED/*harmless*/,,ED_RO_)
-, (W_) 0xbadbadbaL
-};
+P_ realWorldZh_closure = (P_)0xbadbadbaL;
 
 #ifndef CONCURRENT
 
@@ -226,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();
@@ -308,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);
@@ -359,10 +363,13 @@ 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;
-
+    *SpA = (P_) realWorldZh_closure;
+*/
     STKO_LINK(StkOReg) = PrelBase_Z91Z93_closure;
     STKO_RETURN(StkOReg) = NULL;
 
@@ -390,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);
@@ -496,6 +505,26 @@ 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
 };
+
+
+ED_RO_(vtbl_seq);
+
+/*
+STGFUN(seqZhCode)
+{
+    FB_
+    __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_
+}
+*/
+
 \end{code}
 
 %/****************************************************************
@@ -626,14 +655,7 @@ END_REGISTER_CCS()
 
 /* _regPrelude is above */
 
-START_REGISTER_PRELUDE(_regGHCbase);
-END_REGISTER_CCS()
-
-/* OLD: START_REGISTER_PRELUDE(_regGHCerr); */
-START_REGISTER_PRELUDE(_regGHC);
-END_REGISTER_CCS()
-
-START_REGISTER_PRELUDE(_regPreludeGlaST);
+START_REGISTER_PRELUDE(_regPrelGHC);
 END_REGISTER_CCS()
 
 #endif