* Copyright (c) 1994-1998.
*
* $RCSfile: Evaluator.c,v $
- * $Revision: 1.35 $
- * $Date: 2000/02/24 17:26:12 $
+ * $Revision: 1.38 $
+ * $Date: 2000/03/13 10:39:11 $
* ---------------------------------------------------------------------------*/
#include "Rts.h"
#include "ForeignCall.h"
#include "PrimOps.h" /* for __{encode,decode}{Float,Double} */
#include "Evaluator.h"
+#include "sainteger.h"
#ifdef DEBUG
#include "Printer.h"
#include <ieee754.h> /* These are for primops */
#endif
-#ifdef STANDALONE_INTEGER
-#include "sainteger.h"
-#else
-#error Non-standalone integer not yet supported
-#endif
+
/* An incredibly useful abbreviation.
* Interestingly, there are some uses of END_TSO_QUEUE_closure that
static int enterCountI = 0;
-#ifdef STANDALONE_INTEGER
StgDouble B__encodeDouble (B* s, I_ e);
void B__decodeDouble (B* man, I_* exp, StgDouble dbl);
#if ! FLOATS_AS_DOUBLES
B* IntegerInsideByteArray ( StgPtr );
void SloppifyIntegerEnd ( StgPtr );
#endif
-#endif
}
-#ifdef STANDALONE_INTEGER
StgPtr CreateByteArrayToHoldInteger ( int nbytes )
{
- StgInt words = (nbytes+sizeof(W_)-1)/sizeof(W_);
+ StgWord words = (nbytes+sizeof(W_)-1)/sizeof(W_);
StgWord size = sizeofW(StgArrWords) + words;
StgArrWords* arr = (StgArrWords*)allocate(size);
SET_HDR(arr,&ARR_WORDS_info,CCCS);
arr->words = words;
- ASSERT(nbytes <= arr->words * sizeof(W_));
+ ASSERT((W_)nbytes <= arr->words * sizeof(W_));
#ifdef DEBUG
- {nat i;
+ {StgWord i;
for (i = 0; i < words; ++i) {
arr->payload[i] = 0xdeadbeef;
}}
SloppifyIntegerEnd(p); \
PushPtr(p); \
}
-#endif
}
-void myStackCheck ( Capability* cap )
+static void myStackCheck ( Capability* cap )
{
/* fprintf(stderr, "myStackCheck\n"); */
if (!(gSpLim <= gSp && gSp <= stgCast(StgPtr,gSu))) {
assert(0);
}
while (1) {
- if (!(gSu >= cap->rCurrentTSO->stack
- && gSu <= cap->rCurrentTSO->stack
- + cap->rCurrentTSO->stack_size)) {
+ if (!( (P_)gSu >= (P_)cap->rCurrentTSO->stack
+ &&
+ (P_)gSu <= (P_)(cap->rCurrentTSO->stack
+ + cap->rCurrentTSO->stack_size))) {
fprintf ( stderr, "myStackCheck: gSu out of stack\n" );
assert(0);
}
switch (get_itbl(stgCast(StgClosure*,gSu))->type) {
case CATCH_FRAME:
- gSu = (StgPtr) ((StgCatchFrame*)(gSu))->link;
+ gSu = (StgUpdateFrame*) ((StgCatchFrame*)(gSu))->link;
break;
case UPDATE_FRAME:
- gSu = (StgPtr) ((StgUpdateFrame*)(gSu))->link;
+ gSu = (StgUpdateFrame*) ((StgUpdateFrame*)(gSu))->link;
break;
case SEQ_FRAME:
- gSu = (StgPtr) ((StgSeqFrame*)(gSu))->link;
+ gSu = (StgUpdateFrame*) ((StgSeqFrame*)(gSu))->link;
break;
case STOP_FRAME:
goto postloop;
case i_readStableOffAddr: OP_AI_s(indexStablePtrOffAddrzh(r,x,y)); break;
case i_writeStableOffAddr: OP_AIs_(writeStablePtrOffAddrzh(x,y,z)); break;
-#ifdef STANDALONE_INTEGER
case i_compareInteger:
{
B* x = IntegerInsideByteArray(PopPtr());
IntegerInsideByteArray(PopPtr())
));
break;
-#else
-#error Non-standalone integer not yet implemented
-#endif /* STANDALONE_INTEGER */
case i_gtFloat: OP_FF_B(x>y); break;
case i_geFloat: OP_FF_B(x>=y); break;
case i_tanhFloat: OP_F_F(tanh(x)); break;
case i_powerFloat: OP_FF_F(pow(x,y)); break;
-#ifdef STANDALONE_INTEGER
case i_encodeFloatZ:
{
StgPtr sig = PopPtr();
PushPtr(sig);
}
break;
-#else
-#error encode/decodeFloatZ not yet implemented for GHC ints
-#endif
+
case i_isNaNFloat: OP_F_B(isFloatNaN(x)); break;
case i_isInfiniteFloat: OP_F_B(isFloatInfinite(x)); break;
case i_isNegativeZeroFloat: OP_F_B(isFloatNegativeZero(x)); break;
case i_tanhDouble: OP_D_D(tanh(x)); break;
case i_powerDouble: OP_DD_D(pow(x,y)); break;
-#ifdef STANDALONE_INTEGER
case i_encodeDoubleZ:
{
StgPtr sig = PopPtr();
PushPtr(sig);
}
break;
-#else
-#error encode/decodeDoubleZ not yet implemented for GHC ints
-#endif
+
case i_isNaNDouble: OP_D_B(isDoubleNaN(x)); break;
case i_isInfiniteDouble: OP_D_B(isDoubleInfinite(x)); break;
case i_isNegativeZeroDouble: OP_D_B(isDoubleNegativeZero(x)); break;
StgBCO** bco,
Capability* cap )
{
- if (combined)
- barf("enterBCO_primop1 in combined mode");
+ if (combined) {
+ /* A small concession: we need to allow ccalls,
+ even in combined mode.
+ */
+ if (primop2code != i_ccall_ccall_IO &&
+ primop2code != i_ccall_stdcall_IO)
+ barf("enterBCO_primop2 in combined mode");
+ }
switch (primop2code) {
case i_raise: /* raise#{err} */
*/
PushCPtr((StgClosure*)(*bco));
*return2 = ThreadBlocked;
- return (void*)(1+(NULL));
+ return (void*)(1+(char*)(NULL));
} else {
PushCPtr(mvar->value);
break;
}
-#if 1
-#if 0
-ToDo: another way out of the problem might be to add an explicit
-continuation to primTakeMVar: takeMVar v = primTakeMVar v takeMVar.
-The problem with this plan is that now I dont know how much to chop
-off the stack.
-#endif
-#endif
case i_delay:
case i_waitRead:
case i_waitWrite:
case INT_REP:
PushTaggedInt(*((int*)arg));
return ARG_SIZE(INT_TAG);
-#ifdef TODO_STANDALONE_INTEGER
+#if 0
case INTEGER_REP:
PushTaggedInteger(*((mpz_ptr*)arg));
return ARG_SIZE(INTEGER_TAG);
case INT_REP:
*((int*)res) = PopTaggedInt();
return ARG_SIZE(INT_TAG);
-#ifdef TODO_STANDALONE_INTEGER
+#if 0
case INTEGER_REP:
*((mpz_ptr*)res) = PopTaggedInteger();
return ARG_SIZE(INTEGER_TAG);
case INT_REP:
sz += sizeof(StgWord) * ARG_SIZE(INT_TAG);
break;
-#ifdef TODO_STANDALONE_INTEGER
+#if 0
case INTEGER_REP:
sz += sizeof(StgWord) * ARG_SIZE(INTEGER_TAG);
break;
* (ghc/rts/StgPrimFloat.c)
* ---------------------------------------------------------------------------*/
-#ifdef STANDALONE_INTEGER
-
#if IEEE_FLOATING_POINT
#define MY_DMINEXP ((DBL_MIN_EXP) - (DBL_MANT_DIG) - 1)
/* DMINEXP is defined in values.h on Linux (for example) */
#endif /* FLOATS_AS_DOUBLES */
-#endif /* STANDALONE_INTEGER */
-
#endif /* INTERPRETER */