X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FStgMacros.lh;h=fbbc2e48e90ddc745a07fcd8ca6fb82549b28a10;hb=967cc47f37cb93a5e2b6df7822c9a646f0428247;hp=3c5d48adcbbe121173ec4036e9e60b88941ee1e7;hpb=045da280ff3bbb04822101886e32c7b846dc7ab6;p=ghc-hetmet.git diff --git a/ghc/includes/StgMacros.lh b/ghc/includes/StgMacros.lh index 3c5d48a..fbbc2e4 100644 --- a/ghc/includes/StgMacros.lh +++ b/ghc/includes/StgMacros.lh @@ -232,7 +232,7 @@ I_ StackOverflow PROTO((W_, W_)); do { \ DO_ASTK_HWM(); /* ticky-ticky profiling */ \ DO_BSTK_HWM(); \ - if (STKS_OVERFLOW_OP((a_headroom) + 1, (b_headroom) + 1)) { \ + if (STKS_OVERFLOW_OP(((a_headroom) + 1), ((b_headroom) + 1))) { \ STACK_OVERFLOW(liveness_mask,a_headroom,b_headroom,spa,spb,ret_type,reenter);\ } \ }while(0) @@ -454,9 +454,11 @@ I_ stg_div PROTO((I_ a, I_ b)); #define ZmZh(r,a,b) r=(a)-(b) #define ZtZh(r,a,b) r=(a)*(b) #define quotIntZh(r,a,b) r=(a)/(b) +/* ZdZh not used??? --SDM */ #define ZdZh(r,a,b) r=ULTRASAFESTGCALL2(I_,(void *, I_, I_),stg_div,(a),(b)) #define remIntZh(r,a,b) r=(a)%(b) #define negateIntZh(r,a) r=-(a) + /* Ever used ? -- SOF */ #define absIntZh(a) r=(( (a) >= 0 ) ? (a) : (-(a))) \end{code} @@ -468,19 +470,27 @@ I_ stg_div PROTO((I_ a, I_ b)); %************************************************************************ \begin{code} +#define quotWordZh(r,a,b) r=((W_)a)/((W_)b) +#define remWordZh(r,a,b) r=((W_)a)%((W_)b) + #define andZh(r,a,b) r=(a)&(b) #define orZh(r,a,b) r=(a)|(b) +#define xorZh(r,a,b) r=(a)^(b) #define notZh(r,a) r=~(a) #define shiftLZh(r,a,b) r=(a)<<(b) -#define shiftRAZh(r,a,b) r=(a)>>(b) #define shiftRLZh(r,a,b) r=(a)>>(b) #define iShiftLZh(r,a,b) r=(a)<<(b) +/* Right shifting of signed quantities is not portable in C, so + the behaviour you'll get from using these primops depends + on the whatever your C compiler is doing. ToDo: fix. -- sof 8/98 +*/ #define iShiftRAZh(r,a,b) r=(a)>>(b) #define iShiftRLZh(r,a,b) r=(a)>>(b) #define int2WordZh(r,a) r=(W_)(a) #define word2IntZh(r,a) r=(I_)(a) + \end{code} %************************************************************************ @@ -562,6 +572,65 @@ I_ stg_div PROTO((I_ a, I_ b)); #define ZtZtZhZh(r,a,b) r=(StgDouble) SAFESTGCALL2(StgDouble,(void *, StgDouble,StgDouble),pow,a,b) \end{code} + +%************************************************************************ +%* * +\subsubsection[StgMacros-64-primops]{Primitive @Int64#@ and @Word64#@ ops} +%* * +%************************************************************************ + +Apart from the Integer casting primops, all primops over 64-bit (i.e., long long) +@Int64#@ and @Word64#@s are defined out-of-line. We just give the prototype +of these primops here: + +\begin{code} +#ifdef HAVE_LONG_LONG +I_ stg_gtWord64 PROTO((StgWord64, StgWord64)); +I_ stg_geWord64 PROTO((StgWord64, StgWord64)); +I_ stg_eqWord64 PROTO((StgWord64, StgWord64)); +I_ stg_neWord64 PROTO((StgWord64, StgWord64)); +I_ stg_ltWord64 PROTO((StgWord64, StgWord64)); +I_ stg_leWord64 PROTO((StgWord64, StgWord64)); + +I_ stg_gtInt64 PROTO((StgInt64, StgInt64)); +I_ stg_geInt64 PROTO((StgInt64, StgInt64)); +I_ stg_eqInt64 PROTO((StgInt64, StgInt64)); +I_ stg_neInt64 PROTO((StgInt64, StgInt64)); +I_ stg_ltInt64 PROTO((StgInt64, StgInt64)); +I_ stg_leInt64 PROTO((StgInt64, StgInt64)); + +LW_ stg_remWord64 PROTO((StgWord64, StgWord64)); +LW_ stg_quotWord64 PROTO((StgWord64, StgWord64)); + +LI_ stg_remInt64 PROTO((StgInt64, StgInt64)); +LI_ stg_quotInt64 PROTO((StgInt64, StgInt64)); +LI_ stg_negateInt64 PROTO((StgInt64)); +LI_ stg_plusInt64 PROTO((StgInt64, StgInt64)); +LI_ stg_minusInt64 PROTO((StgInt64, StgInt64)); +LI_ stg_timesInt64 PROTO((StgInt64, StgInt64)); + +LW_ stg_and64 PROTO((StgWord64, StgWord64)); +LW_ stg_or64 PROTO((StgWord64, StgWord64)); +LW_ stg_xor64 PROTO((StgWord64, StgWord64)); +LW_ stg_not64 PROTO((StgWord64)); + +LW_ stg_shiftL64 PROTO((StgWord64, StgInt)); +LW_ stg_shiftRL64 PROTO((StgWord64, StgInt)); +LI_ stg_iShiftL64 PROTO((StgInt64, StgInt)); +LI_ stg_iShiftRL64 PROTO((StgInt64, StgInt)); +LI_ stg_iShiftRA64 PROTO((StgInt64, StgInt)); + +LI_ stg_intToInt64 PROTO((StgInt)); +I_ stg_int64ToInt PROTO((StgInt64)); +LW_ stg_int64ToWord64 PROTO((StgInt64)); + +LW_ stg_wordToWord64 PROTO((StgWord)); +W_ stg_word64ToWord PROTO((StgWord64)); +LI_ stg_word64ToInt64 PROTO((StgWord64)); +#endif +\end{code} + + %************************************************************************ %* * \subsubsection[StgMacros-integer-primops]{Primitive @Integer@-related ops (GMP stuff)} @@ -814,6 +883,81 @@ Coercions: (dr) = (B_)(hp); /* dr is an StgByteArray */ \ } +#define integer2WordZh(r, hp, aa,sa,da) \ +{ MP_INT arg; \ + /* Does not allocate memory */ \ + \ + arg.alloc = (aa); \ + arg.size = (sa); \ + arg.d = (unsigned long int *) (BYTE_ARR_CTS(da)); \ + \ + (r) = SAFESTGCALL1(I_,(void *, MP_INT *),mpz_get_ui,&arg); \ +} + +#define integerToInt64Zh(r, hp, aa,sa,da) \ +{ unsigned long int* d; \ + StgInt64 res; \ + /* Allocates memory. Chummy with gmp rep. */ \ + \ + d = (unsigned long int *) (BYTE_ARR_CTS(da)); \ + \ + if ( (aa) == 0) { (res)=(LI_)0; } \ + else if ( (aa) == 1) { (res)=(LI_)d[0]; } \ + else { (res)=(LI_)d[0] + (LI_)d[1] * 0x100000000LL; } \ + (r)=(LI_)( (sa) < 0 ? -res : res); \ +} + +#define integerToWord64Zh(r, hp, aa,sa,da) \ +{ unsigned long int* d; \ + StgWord64 res; \ + /* Allocates memory. Chummy with gmp rep. */ \ + \ + d = (unsigned long int *) (BYTE_ARR_CTS(da)); \ + \ + if ( (aa) == 0) { (res)=(LW_)0; } \ + else if ( (aa) == 1) { (res)=(LW_)d[0]; } \ + else { (res)=(LW_)d[0] + (LW_)d[1] * 0x100000000ULL; } \ + (r) = (res); \ +} + +#define int64ToIntegerZh(ar,sr,dr, hp, li) \ +{ StgInt64 val; /* to snaffle arg to avoid aliasing */ \ + StgWord hi; \ + int neg=0; \ + \ + val = (li); /* snaffle... */ \ + \ + SET_DATA_HDR((hp),ArrayOfData_info,CCC,DATA_VHS+MIN_MP_INT_SIZE,0); \ + \ + if ( val < 0LL ) { \ + neg = 1; \ + val = -val; \ + } \ + hi = (W_)((LW_)val / 0x100000000ULL); \ + if ((LW_)(val) >= 0x100000000ULL) { (sr) = 2; (ar) = 2; (hp)[DATA_HS] = ((W_)val); (hp)[DATA_HS+1] = (hi); } \ + else if ((val) != 0) { (sr) = 1; (ar) = 1; (hp)[DATA_HS] = ((W_)val); } \ + else /* val==0 */ { (sr) = 0; (ar) = 1; } \ + (sr) = ( neg ? -(sr) : (sr) ); \ + (dr) = (B_)(hp); /* dr is an StgByteArray */ \ +} + +#define word64ToIntegerZh(ar,sr,dr, hp, lw) \ +{ StgWord64 val; /* to snaffle arg to avoid aliasing */ \ + StgWord hi; \ + \ + val = (lw); /* snaffle... */ \ + \ + SET_DATA_HDR((hp),ArrayOfData_info,CCC,DATA_VHS+MIN_MP_INT_SIZE,0); \ + \ + hi = (W_)((LW_)val / 0x100000000ULL); \ + if ((val) >= 0x100000000ULL ) { (sr) = 2; (ar) = 2; (hp)[DATA_HS] = ((W_)val); (hp)[DATA_HS+1] = (hi); } \ + else if ((val) != 0) { (sr) = 1; (ar) = 1; (hp)[DATA_HS] = ((W_)val); } \ + else /* val==0 */ { (sr) = 0; (ar) = 1; } \ + (dr) = (B_)(hp); /* dr is an StgByteArray */ \ +} + + + \end{code} Then there are a few oddments to make life easier: @@ -880,7 +1024,7 @@ Some floating-point format info, made with the \tr{enquire} program /* yes, it is IEEE floating point */ #include "ieee-flpt.h" -#if alpha_dec_osf1_TARGET \ +#if alpha_TARGET_ARCH \ || i386_TARGET_ARCH \ || mipsel_TARGET_ARCH @@ -897,7 +1041,7 @@ Some floating-point format info, made with the \tr{enquire} program \end{code} \begin{code} -#if alpha_dec_osf1_TARGET +#if alpha_TARGET_ARCH #define encodeFloatZh(r, hp, aa,sa,da, expon) encodeDoubleZh(r, hp, aa,sa,da, expon) #else #define encodeFloatZh(r, hp, aa,sa,da, expon) \ @@ -923,7 +1067,7 @@ Some floating-point format info, made with the \tr{enquire} program r = SAFESTGCALL2(StgDouble,(void *, MP_INT *, I_), __encodeDouble,&arg,(expon));\ } -#if alpha_dec_osf1_TARGET +#if alpha_TARGET_ARCH #define decodeFloatZh(exponr, ar,sr,dr, hp, f) decodeDoubleZh(exponr, ar,sr,dr, hp, f) #else #define decodeFloatZh(exponr, ar,sr,dr, hp, f) \ @@ -1076,6 +1220,49 @@ PK_FLT(W_ p_src[]) #endif /* __GNUC__ */ #endif /* not __m68k__ */ + +#if HAVE_LONG_LONG +extern STG_INLINE +void +ASSIGN_Word64(W_ p_dest[], StgWord64 src) +{ + word64_thing y; + y.w = src; + p_dest[0] = y.wu.dhi; + p_dest[1] = y.wu.dlo; +} + +extern STG_INLINE +StgWord64 +PK_Word64(W_ p_src[]) +{ + word64_thing y; + y.wu.dhi = p_src[0]; + y.wu.dlo = p_src[1]; + return(y.w); +} + +extern STG_INLINE +void +ASSIGN_Int64(W_ p_dest[], StgInt64 src) +{ + int64_thing y; + y.i = src; + p_dest[0] = y.iu.dhi; + p_dest[1] = y.iu.dlo; +} + +extern STG_INLINE +StgInt64 +PK_Int64(W_ p_src[]) +{ + int64_thing y; + y.iu.dhi = p_src[0]; + y.iu.dlo = p_src[1]; + return(y.i); +} +#endif + \end{code} %************************************************************************ @@ -1138,42 +1325,72 @@ of one ptr (not bytes). #define readArrayZh(r,a,i) r=((PP_) PTRS_ARR_CTS(a))[(i)] -#define readCharArrayZh(r,a,i) indexCharOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define readIntArrayZh(r,a,i) indexIntOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define readAddrArrayZh(r,a,i) indexAddrOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define readFloatArrayZh(r,a,i) indexFloatOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define readDoubleArrayZh(r,a,i) indexDoubleOffAddrZh(r,BYTE_ARR_CTS(a),i) +#define readCharArrayZh(r,a,i) indexCharOffAddrZh(r,BYTE_ARR_CTS(a),i) +#define readIntArrayZh(r,a,i) indexIntOffAddrZh(r,BYTE_ARR_CTS(a),i) +#define readStablePtrArrayZh(r,a,i) indexStablePtrOffAddrZh(r,BYTE_ARR_CTS(a),i) +#define readWordArrayZh(r,a,i) indexWordOffAddrZh(r,BYTE_ARR_CTS(a),i) +#define readInt64ArrayZh(r,a,i) indexInt64OffAddrZh(r,BYTE_ARR_CTS(a),i) +#define readWord64ArrayZh(r,a,i) indexWord64OffAddrZh(r,BYTE_ARR_CTS(a),i) +#define readAddrArrayZh(r,a,i) indexAddrOffAddrZh(r,BYTE_ARR_CTS(a),i) +#define readFloatArrayZh(r,a,i) indexFloatOffAddrZh(r,BYTE_ARR_CTS(a),i) +#define readDoubleArrayZh(r,a,i) indexDoubleOffAddrZh(r,BYTE_ARR_CTS(a),i) /* result ("r") arg ignored in write macros! */ #define writeArrayZh(a,i,v) ((PP_) PTRS_ARR_CTS(a))[(i)]=(v) -#define writeCharArrayZh(a,i,v) ((C_ *)(BYTE_ARR_CTS(a)))[i] = (v) -#define writeIntArrayZh(a,i,v) ((I_ *)(BYTE_ARR_CTS(a)))[i] = (v) -#define writeAddrArrayZh(a,i,v) ((PP_)(BYTE_ARR_CTS(a)))[i] = (v) -#define writeFloatArrayZh(a,i,v) \ - ASSIGN_FLT((P_) (((StgFloat *)(BYTE_ARR_CTS(a))) + i),v) -#define writeDoubleArrayZh(a,i,v) \ - ASSIGN_DBL((P_) (((StgDouble *)(BYTE_ARR_CTS(a))) + i),v) +#define writeCharArrayZh(a,i,v) ((C_ *)(BYTE_ARR_CTS(a)))[i] = (v) +#define writeIntArrayZh(a,i,v) ((I_ *)(BYTE_ARR_CTS(a)))[i] = (v) +#define writeStablePtrArrayZh(a,i,v) ((StgStablePtr *)(BYTE_ARR_CTS(a)))[i] = (v) +#define writeWordArrayZh(a,i,v) ((W_ *)(BYTE_ARR_CTS(a)))[i] = (v) +#define writeInt64ArrayZh(a,i,v) ((LI_ *)(BYTE_ARR_CTS(a)))[i] = (v) +#define writeWord64ArrayZh(a,i,v) ((LW_ *)(BYTE_ARR_CTS(a)))[i] = (v) +#define writeAddrArrayZh(a,i,v) ((PP_)(BYTE_ARR_CTS(a)))[i] = (v) +#define writeFloatArrayZh(a,i,v) ASSIGN_FLT((P_) (((StgFloat *)(BYTE_ARR_CTS(a))) + i),v) +#define writeDoubleArrayZh(a,i,v) ASSIGN_DBL((P_) (((StgDouble *)(BYTE_ARR_CTS(a))) + i),v) #define indexArrayZh(r,a,i) r=((PP_) PTRS_ARR_CTS(a))[(i)] -#define indexCharArrayZh(r,a,i) indexCharOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define indexIntArrayZh(r,a,i) indexIntOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define indexAddrArrayZh(r,a,i) indexAddrOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define indexFloatArrayZh(r,a,i) indexFloatOffAddrZh(r,BYTE_ARR_CTS(a),i) -#define indexDoubleArrayZh(r,a,i) indexDoubleOffAddrZh(r,BYTE_ARR_CTS(a),i) - -#define indexCharOffForeignObjZh(r,fo,i) indexCharOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexIntOffForeignObjZh(r,fo,i) indexIntOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexAddrOffForeignObjZh(r,fo,i) indexAddrOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexFloatOffForeignObjZh(r,fo,i) indexFloatOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexDoubleOffForeignObjZh(r,fo,i) indexDoubleOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexCharArrayZh(r,a,i) indexCharOffAddrZh(r,BYTE_ARR_CTS(a),i) +#define indexIntArrayZh(r,a,i) indexIntOffAddrZh(r,BYTE_ARR_CTS(a),i) +#define indexStablePtrArrayZh(r,a,i) indexStablePtrOffAddrZh(r,BYTE_ARR_CTS(a),i) +#define indexWordArrayZh(r,a,i) indexWordOffAddrZh(r,BYTE_ARR_CTS(a),i) +#define indexAddrArrayZh(r,a,i) indexAddrOffAddrZh(r,BYTE_ARR_CTS(a),i) +#define indexFloatArrayZh(r,a,i) indexFloatOffAddrZh(r,BYTE_ARR_CTS(a),i) +#define indexDoubleArrayZh(r,a,i) indexDoubleOffAddrZh(r,BYTE_ARR_CTS(a),i) +#define indexInt64ArrayZh(r,a,i) indexInt64OffAddrZh(r,BYTE_ARR_CTS(a),i) +#define indexWord64ArrayZh(r,a,i) indexWord64OffAddrZh(r,BYTE_ARR_CTS(a),i) + +#define indexCharOffForeignObjZh(r,fo,i) indexCharOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexIntOffForeignObjZh(r,fo,i) indexIntOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexStablePtrOffForeignObjZh(r,fo,i) indexStablePtrOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexWordOffForeignObjZh(r,fo,i) indexWordOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexAddrOffForeignObjZh(r,fo,i) indexAddrOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexFloatOffForeignObjZh(r,fo,i) indexFloatOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexDoubleOffForeignObjZh(r,fo,i) indexDoubleOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexInt64OffForeignObjZh(r,fo,i) indexInt64OffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexWord64OffForeignObjZh(r,fo,i) indexWord64OffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i) + +#define indexCharOffAddrZh(r,a,i) r= ((C_ *)(a))[i] +#define indexIntOffAddrZh(r,a,i) r= ((I_ *)(a))[i] +#define indexStablePtrOffAddrZh(r,a,i) r= ((StgStablePtr *)(a))[i] +#define indexWordOffAddrZh(r,a,i) r= ((W_ *)(a))[i] +#define indexAddrOffAddrZh(r,a,i) r= ((PP_)(a))[i] +#define indexFloatOffAddrZh(r,a,i) r= PK_FLT((P_) (((StgFloat *)(a)) + i)) +#define indexDoubleOffAddrZh(r,a,i) r= PK_DBL((P_) (((StgDouble *)(a)) + i)) +#define indexInt64OffAddrZh(r,a,i) r= ((LI_ *)(a))[i] +#define indexWord64OffAddrZh(r,a,i) r= ((LW_ *)(a))[i] + +#define writeCharOffAddrZh(a,i,v) ((C_ *)(a))[i] = (v) +#define writeIntOffAddrZh(a,i,v) ((I_ *)(a))[i] = (v) +#define writeStablePtrOffAddrZh(a,i,v) ((StgStablePtr *)(a))[i] = (v) +#define writeWordOffAddrZh(a,i,v) ((W_ *)(a))[i] = (v) +#define writeAddrOffAddrZh(a,i,v) ((PP_)(a))[i] = (v) +#define writeForeignObjOffAddrZh(a,i,v) ((PP_)(a))[i] = ForeignObj_CLOSURE_DATA(v) +#define writeFloatOffAddrZh(a,i,v) ASSIGN_FLT((P_) (((StgFloat *)(a)) + i),v) +#define writeDoubleOffAddrZh(a,i,v) ASSIGN_DBL((P_) (((StgDouble *)(a)) + i),v) +#define writeInt64OffAddrZh(a,i,v) ((LI_ *)(a))[i] = (v) +#define writeWord64OffAddrZh(a,i,v) ((LW_ *)(a))[i] = (v) -#define indexCharOffAddrZh(r,a,i) r= ((C_ *)(a))[i] -#define indexIntOffAddrZh(r,a,i) r= ((I_ *)(a))[i] -#define indexAddrOffAddrZh(r,a,i) r= ((PP_)(a))[i] -#define indexFloatOffAddrZh(r,a,i) r= PK_FLT((P_) (((StgFloat *)(a)) + i)) -#define indexDoubleOffAddrZh(r,a,i) r= PK_DBL((P_) (((StgDouble *)(a)) + i)) /* Freezing arrays-of-ptrs requires changing an info table, for the benefit of the generational collector. It needs to scavenge mutable @@ -1188,6 +1405,9 @@ of one ptr (not bytes). }while(0) #define unsafeFreezeByteArrayZh(r,a) r=(B_)(a) + +#define sizeofByteArrayZh(r,a) r=(W_)sizeof(W_)*(W_)(DATA_CLOSURE_SIZE(a)-DATA_VHS) +#define sizeofMutableByteArrayZh(r,a) r=(W_)sizeof(W_)*(W_)(DATA_CLOSURE_SIZE(a)-DATA_VHS) \end{code} Now the \tr{newArr*} ops: @@ -1215,11 +1435,15 @@ NOTE: the above may now be OLD (WDP 94/02/10) For char arrays, the size is in {\em BYTES}. \begin{code} -#define newCharArrayZh(r,liveness,n) newByteArray(r,liveness,(n) * sizeof(C_)) -#define newIntArrayZh(r,liveness,n) newByteArray(r,liveness,(n) * sizeof(I_)) -#define newAddrArrayZh(r,liveness,n) newByteArray(r,liveness,(n) * sizeof(P_)) -#define newFloatArrayZh(r,liveness,n) newByteArray(r,liveness,(n) * sizeof(StgFloat)) -#define newDoubleArrayZh(r,liveness,n) newByteArray(r,liveness,(n) * sizeof(StgDouble)) +#define newCharArrayZh(r,liveness,n) newByteArray(r,liveness,(n) * sizeof(C_)) +#define newIntArrayZh(r,liveness,n) newByteArray(r,liveness,(n) * sizeof(I_)) +#define newStablePtrArrayZh(r,liveness,n) newByteArray(r,liveness,(n) * sizeof(StgStablePtr)) +#define newWordArrayZh(r,liveness,n) newByteArray(r,liveness,(n) * sizeof(W_)) +#define newInt64ArrayZh(r,liveness,n) newByteArray(r,liveness,(n) * sizeof(LI_)) +#define newWord64ArrayZh(r,liveness,n) newByteArray(r,liveness,(n) * sizeof(LW_)) +#define newAddrArrayZh(r,liveness,n) newByteArray(r,liveness,(n) * sizeof(P_)) +#define newFloatArrayZh(r,liveness,n) newByteArray(r,liveness,(n) * sizeof(StgFloat)) +#define newDoubleArrayZh(r,liveness,n) newByteArray(r,liveness,(n) * sizeof(StgDouble)) #define newByteArray(r,liveness,n) \ { \ @@ -1274,6 +1498,8 @@ void newArrZh_init PROTO((P_ result, I_ n, P_ init)); \begin{code} ED_(PrelBase_Z91Z93_closure); +#define sameMVarZh(r,a,b) r=(I_)((a)==(b)) + #define newSynchVarZh(r, hp) \ { \ ALLOC_PRIM(MUTUPLE_HS,3,0,MUTUPLE_HS+3) /* ticky ticky */; \ @@ -1648,6 +1874,7 @@ EXTFUN(__std_entry_error__); JMP_(ErrorIO_innards); \ } while(0) +/* These are now, I believe, unused. (8/98 SOF) */ #if !defined(CALLER_SAVES_SYSTEM) /* can use the macros */ #define stg_getc(stream) getc((FILE *) (stream)) @@ -1758,6 +1985,9 @@ EXTFUN(startEnterFloat); void enterStablePtr PROTO((StgStablePtr stableIndex, StgFunPtr startCode)); +char* createAdjustor PROTO((int cc,StgStablePtr hptr, StgFunPtr wptr)); +void freeAdjustor PROTO((void* ptr)); + #endif /* !PAR */ IF_RTS(extern I_ ErrorIO_call_count;) @@ -1976,7 +2206,7 @@ ED_(True_closure); extern I_ required_thread_count; #ifdef PAR -#define COUNT_SPARK TSO_GLOBALSPARKS(CurrentTSO)++ +#define COUNT_SPARK TSO_GLOBALSPARKS(CurrentTSO)++; sparksCreated++ #else #define COUNT_SPARK #endif @@ -2019,10 +2249,19 @@ extern I_ required_thread_count; } #endif /* GRAN */ + +#endif /* CONCURRENT */ \end{code} The following seq# code should only be used in unoptimized code. Be warned: it's a potential bug-farm. +[SOF 8/98: + Yes, it completely fails to work for function values, since a PAP + closure will be constructed when the arg satisfaction check fails. + This PAP closure will add the magic values that gets pushed on the B stack + before entering the 'seqee' (new word!), as Jim is just about to tell + us about. Let's hear what he's got to say: +] First we push two words on the B stack: the current value of RetReg (which may or may not be live), and a continuation snatched largely out @@ -2033,6 +2272,11 @@ polymorphic seq return point, the two words are popped off the B stack, RetReg is restored, and we jump to the continuation, completing the primop and going on our merry way. +[ To workaround the shortcoming of not being able to deal with partially + applied values, we explicitly prohibit this at the Haskell source level + (i.e., we don't define an Eval instance for (->) ). +] + \begin{code} ED_RO_(vtbl_seq); @@ -2053,7 +2297,6 @@ ED_RO_(vtbl_seq); r = 1; /* Should be unnecessary */ \ }) -#endif /* CONCURRENT */ \end{code} %************************************************************************ @@ -2088,6 +2331,7 @@ to be `standard' format, return register then liveness mask. -- SOF 4/96) #ifndef PAR StgInt eqForeignObj PROTO((StgForeignObj p1, StgForeignObj p2)); +StgInt eqStablePtr PROTO((StgStablePtr p1, StgStablePtr p2)); #define makeForeignObjZh(r, liveness, mptr, finalise) \ do { \