[project @ 2000-04-27 16:35:29 by sewardj]

[ghc-hetmet.git] / ghc / rts / Evaluator.c

diff --git a/ghc/rts/Evaluator.c b/ghc/rts/Evaluator.c
index b7906f7..e0a6558 100644 (file)
--- a/ghc/rts/Evaluator.c
+++ b/ghc/rts/Evaluator.c
@@ -5,8 +5,8 @@
  * Copyright (c) 1994-1998.
  *
  * $RCSfile: Evaluator.c,v $
- * $Revision: 1.46 $
- * $Date: 2000/04/03 15:24:21 $
+ * $Revision: 1.50 $
+ * $Date: 2000/04/27 16:35:30 $
  * ---------------------------------------------------------------------------*/
 
 #include "Rts.h"
@@ -71,8 +71,8 @@
 /* Make it possible for the evaluator to get hold of bytecode
    for a given function by name.  Useful but a hack.  Sigh.
  */
-extern void* getHugs_AsmObject_for ( char* s );
-extern int /*Bool*/ combined;
+extern void* /* StgClosure* */ getHugs_BCO_cptr_for ( char* s );
+extern int   /* Bool */ combined;
 
 /* --------------------------------------------------------------------------
  * Crude profiling stuff (mainly to assess effect of optimiser)
@@ -491,6 +491,8 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
 
     enterLoop:
 
+    numEnters++;
+
 #ifdef DEBUG
     assert(gSp == tSp);
     assert(gSu == tSu);
@@ -688,8 +690,12 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
                                      xPopUpdateFrame(obj);
                                      break;
                                 case STOP_FRAME:
+                                     barf("STOP frame during pap update");
+#if 0
+                                    cap->rCurrentTSO->what_next = ThreadComplete;
                                      SSS; PopStopFrame(obj); LLL;
                                      RETURN(ThreadFinished);
+#endif
                                 case SEQ_FRAME:
                                      SSS; PopSeqFrame(); LLL;
                                      ASSERT(xSp != (P_)xSu);
@@ -1356,22 +1362,19 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
                 xPushCPtr(obj); /* code to restart with */
                 RETURN(StackOverflow);
             }
-            /* ToDo: look for xSp==xSu && stackInt(0) == UPD_FRAME 
-               and insert an indirection immediately */
             SSS; bh = (StgBlockingQueue*)grabHpUpd(BLACKHOLE_sizeW()); LLL;
             SET_INFO(bh,&CAF_BLACKHOLE_info);
             bh->blocking_queue = EndTSOQueue;
             IF_DEBUG(gccafs,
-                     fprintf(stderr,"Created CAF_BLACKHOLE %p for CAF %p in evaluator\n",bh,caf));
+                     fprintf(stderr,"Created CAF_BLACKHOLE %p for CAF %p"
+                                    " in evaluator\n",bh,caf));
             SET_INFO(caf,&CAF_ENTERED_info);
             caf->value = (StgClosure*)bh;
-            if (caf->mut_link == NULL) { 
-               SSS; recordOldToNewPtrs((StgMutClosure*)caf); LLL; 
-            }
+
+            SSS; newCAF_made_by_Hugs(caf); LLL;
+
             xPushUpdateFrame(bh,0);
             xSp -= sizeofW(StgUpdateFrame);
-            caf->link = enteredCAFs;
-            enteredCAFs = caf;
             obj = caf->body;
             goto enterLoop;
         }
@@ -1479,7 +1482,9 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
                                                 + cap->rCurrentTSO->stack_size,xSu);
                                  LLL;
                                  );
+                        cap->rCurrentTSO->what_next = ThreadComplete;
                         SSS; PopStopFrame(obj); LLL;
+                        xPushPtr((P_)obj);
                         RETURN(ThreadFinished);
                     }
                 case RET_BCO:
@@ -1788,7 +1793,7 @@ static inline StgClosure* raiseAnError ( StgClosure* exception )
      * thunks which are currently under evaluation.
      */
     HaskellObj primRaiseClosure
-       = asmClosureOfObject(getHugs_AsmObject_for("primRaise"));
+       = getHugs_BCO_cptr_for("primRaise");
     HaskellObj reraiseClosure
        = rts_apply ( primRaiseClosure, exception );
    
@@ -1829,9 +1834,9 @@ static StgClosure* makeErrorCall ( const char* msg )
       (thinks: probably not so, but anyway ...)
    */
    HaskellObj error 
-      = asmClosureOfObject(getHugs_AsmObject_for("error"));
+      = getHugs_BCO_cptr_for("error");
    HaskellObj unpack
-      = asmClosureOfObject(getHugs_AsmObject_for("hugsprimUnpackString"));
+      = getHugs_BCO_cptr_for("hugsprimUnpackString");
    HaskellObj thunk
       = rts_apply ( unpack, rts_mkAddr ( (void*)msg ) );
    thunk
@@ -2892,7 +2897,7 @@ static void* enterBCO_primop2 ( int primop2code,
 #endif
 #ifdef PROVIDE_FOREIGN
                 /* ForeignObj# operations */
-        case i_makeForeignObj:
+        case i_mkForeignObj:
             {
                 StgForeignObj *result 
                     = stgCast(StgForeignObj*,allocate(sizeofW(StgForeignObj)));
@@ -3521,5 +3526,4 @@ void B__decodeFloat (B* man, I_* exp, StgFloat flt)
 }
 
 #endif /* FLOATS_AS_DOUBLES */
-
 #endif /* INTERPRETER */