* 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"
#include "ForeignCall.h"
#include "PrimOps.h" /* for __{encode,decode}{Float,Double} */
#include "Prelude.h"
+#include "Itimer.h"
#include "Evaluator.h"
#include "sainteger.h"
/* 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)
enterLoop:
+ numEnters++;
+
#ifdef DEBUG
assert(gSp == tSp);
assert(gSu == tSu);
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);
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);
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;
}
+ cap->rCurrentTSO->stack_size,xSu);
LLL;
);
+ cap->rCurrentTSO->what_next = ThreadComplete;
SSS; PopStopFrame(obj); LLL;
+ xPushPtr((P_)obj);
RETURN(ThreadFinished);
}
case RET_BCO:
* thunks which are currently under evaluation.
*/
HaskellObj primRaiseClosure
- = asmClosureOfObject(getHugs_AsmObject_for("primRaise"));
+ = getHugs_BCO_cptr_for("primRaise");
HaskellObj reraiseClosure
= rts_apply ( primRaiseClosure, exception );
(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
#endif
#ifdef PROVIDE_FOREIGN
/* ForeignObj# operations */
- case i_makeForeignObj:
+ case i_mkForeignObj:
{
StgForeignObj *result
= stgCast(StgForeignObj*,allocate(sizeofW(StgForeignObj)));
}
#endif /* FLOATS_AS_DOUBLES */
-
#endif /* INTERPRETER */