X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FEvaluator.c;h=e0a655893230470ca92c46a03631fd69c1b3aee6;hb=f0901617344ad6cb35b10eeaf7093f0e4f23dce9;hp=dba69d3a6d69fe9c66ea4d60fb23938df2f0e150;hpb=b32b2d43b67c42f45105df40ae8af42eeb58078f;p=ghc-hetmet.git

diff --git a/ghc/rts/Evaluator.c b/ghc/rts/Evaluator.c
index dba69d3..e0a6558 100644
--- a/ghc/rts/Evaluator.c
+++ b/ghc/rts/Evaluator.c
@@ -5,8 +5,8 @@
  * Copyright (c) 1994-1998.
  *
  * $RCSfile: Evaluator.c,v $
- * $Revision: 1.43 $
- * $Date: 2000/03/20 04:26:24 $
+ * $Revision: 1.50 $
+ * $Date: 2000/04/27 16:35:30 $
  * ---------------------------------------------------------------------------*/
 
 #include "Rts.h"
@@ -24,6 +24,7 @@
 #include "ForeignCall.h"
 #include "PrimOps.h"   /* for __{encode,decode}{Float,Double} */
 #include "Prelude.h"
+#include "Itimer.h"
 #include "Evaluator.h"
 #include "sainteger.h"
 
@@ -70,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)
@@ -490,6 +491,8 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
 
     enterLoop:
 
+    numEnters++;
+
 #ifdef DEBUG
     assert(gSp == tSp);
     assert(gSu == tSu);
@@ -529,8 +532,13 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 )
 	   cap->rCurrentTSO->why_blocked = BlockedOnDelay;
 	   ACQUIRE_LOCK(&sched_mutex);
 	   
+#if defined(HAVE_SETITIMER) || defined(mingw32_TARGET_OS)
 	   cap->rCurrentTSO->block_info.delay 
 	     = hugsBlock.delay + ticks_since_select;
+#else
+	   cap->rCurrentTSO->block_info.target
+	     = hugsBlock.delay + getourtimeofday();
+#endif
 	   APPEND_TO_BLOCKED_QUEUE(cap->rCurrentTSO);
 	   
 	   RELEASE_LOCK(&sched_mutex);
@@ -682,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);
@@ -1350,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;
         }
@@ -1473,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:
@@ -1782,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 );
    
@@ -1823,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
@@ -2886,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)));
@@ -3515,5 +3526,4 @@ void B__decodeFloat (B* man, I_* exp, StgFloat flt)
 }
 
 #endif	/* FLOATS_AS_DOUBLES */
-
 #endif /* INTERPRETER */