* Copyright (c) 1994-1998.
*
* $RCSfile: Evaluator.c,v $
- * $Revision: 1.12 $
- * $Date: 1999/04/27 10:07:16 $
+ * $Revision: 1.17 $
+ * $Date: 1999/07/06 16:40:24 $
* ---------------------------------------------------------------------------*/
#include "Rts.h"
* Crude profiling stuff (mainly to assess effect of optimiser)
* ------------------------------------------------------------------------*/
-#if CRUDE_PROFILING
+#ifdef CRUDE_PROFILING
#define M_CPTAB 10000
#define CP_NIL (-1)
/* Macros to save/load local state. */
-#if DEBUG
+#ifdef DEBUG
#define SSS { tSp=Sp = xSp; tSu=Su = xSu; tSpLim=SpLim = xSpLim; }
#define LLL { tSp=xSp = Sp; tSu=xSu = Su; tSpLim=xSpLim = SpLim; }
#else
register StgClosure* obj; /* object currently under evaluation */
char eCount; /* enter counter, for context switching */
-#if DEBUG
+#ifdef DEBUG
/* use the t values to check that Su/Sp/SpLim do not change unexpectedly */
StgPtr tSp = Sp; StgUpdateFrame* tSu = Su; StgPtr tSpLim = SpLim;
#endif
enterLoop:
-#if DEBUG
+#ifdef DEBUG
assert(Sp == tSp);
assert(Su == tSu);
assert(SpLim == tSpLim);
);
#endif
- if (++eCount == 0) {
+ if (
+#ifdef DEBUG
+ 1 ||
+#endif
+ ++eCount == 0) {
if (context_switch) {
xPushCPtr(obj); /* code to restart with */
RETURN(ThreadYielding);
/* Start of the bytecode evaluator */
/* ---------------------------------------------------- */
{
-# if !DEBUG && USE_GCC_LABELS
+# if USE_GCC_LABELS
# define Ins(x) &&l##x
static void *labs[] = { INSTRLIST };
# undef Ins
fprintf(stderr,"Sp = %p\tSu = %p\tpc = %d\t", xSp, xSu, PC);
SSS;
disInstr(bco,PC);
- //{ int i;
- //fprintf(stderr,"\n");
- // for (i = 4; i >= 0; i--)
- // fprintf(stderr, "%d %p\n", i, (StgPtr)(*(Sp+i)));
- // }
+ if (0) { int i;
+ fprintf(stderr,"\n");
+ for (i = 8; i >= 0; i--)
+ fprintf(stderr, "%d %p\n", i, (StgPtr)(*(Sp+i)));
+ }
fprintf(stderr,"\n");
LLL;
);
ASSERT( itbl->type == CONSTR
|| itbl->type == CONSTR_STATIC
|| itbl->type == CONSTR_NOCAF_STATIC
+ || itbl->type == CONSTR_1_0
+ || itbl->type == CONSTR_0_1
+ || itbl->type == CONSTR_2_0
+ || itbl->type == CONSTR_1_1
+ || itbl->type == CONSTR_0_2
);
while (--i>=0) {
xPushCPtr(payloadCPtr(o,i));
IF_DEBUG(evaluator,
fprintf(stderr, "object to enter is a constructor -- "
"jumping directly to return continuation\n" );
- )
+ );
goto bco_entry;
}
goto enterLoop;
}
case BLACKHOLE:
+ case SE_BLACKHOLE:
case CAF_BLACKHOLE:
+ case SE_CAF_BLACKHOLE:
{
/*was StgBlackHole* */
StgBlockingQueue* bh = (StgBlockingQueue*)obj;
xPushWord(payloadWord(ap,i));
}
obj = ap->fun;
-#ifndef LAZY_BLACKHOLING
-#error no no no
+#ifdef EAGER_BLACKHOLING
{
/* superfluous - but makes debugging easier */
StgBlackHole* bh = stgCast(StgBlackHole*,ap);
IF_DEBUG(gccafs,fprintf(stderr,"Eagerly blackholed AP_UPD %p in evaluator\n",bh));
/*printObj(bh); */
}
-#endif /* LAZY_BLACKHOLING */
+#endif /* EAGER_BLACKHOLING */
goto enterLoop;
}
case PAP:
goto enterLoop;
}
case CONSTR:
+ case CONSTR_1_0:
+ case CONSTR_0_1:
+ case CONSTR_2_0:
+ case CONSTR_1_1:
+ case CONSTR_0_2:
case CONSTR_INTLIKE:
case CONSTR_CHARLIKE:
case CONSTR_STATIC:
}
default:
{
- SSS;
- fprintf(stderr, "enterCountI = %d\n", enterCountI);
- fprintf(stderr, "panic: enter: entered unknown closure\n");
- printObj(obj);
- fprintf(stderr, "what it points at is\n");
- printObj( ((StgEvacuated*)obj) ->evacuee);
- LLL;
- exit(1);
- /* formerly ... */
+ //SSS;
+ //fprintf(stderr, "enterCountI = %d\n", enterCountI);
+ //fprintf(stderr, "entering unknown closure -- yielding to sched\n");
+ //printObj(obj);
+ //LLL;
CurrentTSO->whatNext = ThreadEnterGHC;
xPushCPtr(obj); /* code to restart with */
RETURN(ThreadYielding);
static inline StgPtr grabHpUpd( nat size )
{
ASSERT( size >= MIN_UPD_SIZE + sizeofW(StgHeader) );
-#if CRUDE_PROFILING
+#ifdef CRUDE_PROFILING
cp_bill_words ( size );
#endif
return allocate(size);
static inline StgPtr grabHpNonUpd( nat size )
{
ASSERT( size >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
-#if CRUDE_PROFILING
+#ifdef CRUDE_PROFILING
cp_bill_words ( size );
#endif
return allocate(size);
printObj(obj);
fprintf(stderr,"Sp = %p\tSu = %p\n\n", Sp, Su);
);
-#ifndef LAZY_BLACKHOLING
+#ifdef EAGER_BLACKHOLING
ASSERT(get_itbl(Su->updatee)->type == BLACKHOLE
+ || get_itbl(Su->updatee)->type == SE_BLACKHOLE
|| get_itbl(Su->updatee)->type == CAF_BLACKHOLE
+ || get_itbl(Su->updatee)->type == SE_CAF_BLACKHOLE
);
-#endif /* LAZY_BLACKHOLING */
+#endif /* EAGER_BLACKHOLING */
UPD_IND(Su->updatee,obj);
Sp = stgCast(StgStackPtr,Su) + sizeofW(StgUpdateFrame);
Su = Su->link;