X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FStgMacros.lh;h=44d9a4d92dd6bc53ae0777a5f4550d14ac79b02b;hb=23c94851fb2c98d345d913d35a5a12bbc3a346bd;hp=baefd8076df0b34980a64b460a36944494bc3f3c;hpb=a7e6cdbfc4f27c2e0ab9c12ebe6431c246c74c6d;p=ghc-hetmet.git diff --git a/ghc/includes/StgMacros.lh b/ghc/includes/StgMacros.lh index baefd80..44d9a4d 100644 --- a/ghc/includes/StgMacros.lh +++ b/ghc/includes/StgMacros.lh @@ -187,7 +187,7 @@ words of A stack and @b@ words of B stack. If not, it calls NB: args @a@ and @b@ are pre-direction-ified! \begin{code} -extern I_ SqueezeUpdateFrames PROTO((P_, P_, P_)); +I_ SqueezeUpdateFrames PROTO((P_, P_, P_)); int sanityChk_StkO (P_ stko); /* ToDo: move to a sane place */ #if ! defined(CONCURRENT) @@ -208,7 +208,7 @@ extern void StackOverflow(STG_NO_ARGS) STG_NORETURN; #else /* threaded */ -extern I_ StackOverflow PROTO((W_, W_)); +I_ StackOverflow PROTO((W_, W_)); /* * On a uniprocessor, we do *NOT* context switch on a stack overflow @@ -232,7 +232,7 @@ extern 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) @@ -240,37 +240,6 @@ do { \ %************************************************************************ %* * -\subsubsection[StgMacros-arity-chks]{Arity checks (for debugging)} -%* * -%************************************************************************ - -This is a debugging feature. Each call to fast-entry-point code sets -@ExpectedArity@ to some value, and the callee then checks that the -value is as expected. - -\begin{code} -#if defined(__DO_ARITY_CHKS__) - -extern I_ ExpectedArity; -extern void ArityError PROTO((I_)) STG_NORETURN; - -#define SET_ARITY(n) do { ExpectedArity = (n); } while(0) -#define CHK_ARITY(n) \ - do { \ - if (ExpectedArity != (n)) { \ - ULTRASAFESTGCALL1(void,(void *, I_),ArityError,n); \ - }}while(0) - -#else /* ! __DO_ARITY_CHKS__: normal case */ - -#define SET_ARITY(n) /* nothing */ -#define CHK_ARITY(n) /* nothing */ - -#endif /* ! __DO_ARITY_CHKS__ */ -\end{code} - -%************************************************************************ -%* * \subsubsection[StgMacros-heap-chks]{Heap-overflow checks} %* * %************************************************************************ @@ -279,7 +248,7 @@ Please see the general discussion/commentary about ``what really happens in a GC,'' in \tr{SMinterface.lh}. \begin{code} -extern void PerformGC PROTO((W_)); +void PerformGC PROTO((W_)); void RealPerformGC PROTO((W_ liveness, W_ reqsize, W_ always_reenter_node, rtsBool do_full_collection)); void checkInCCallGC(STG_NO_ARGS); @@ -303,7 +272,7 @@ void StgPerformGarbageCollection(STG_NO_ARGS); #else /* CONCURRENT */ -extern void ReallyPerformThreadGC PROTO((W_, rtsBool)); +void ReallyPerformThreadGC PROTO((W_, rtsBool)); #define HEAP_OVERFLOW(liveness,n,reenter) \ do { \ @@ -421,12 +390,13 @@ even for 8-bit chars). #define ltCharZh(r,a,b) r=(I_)((a)< (b)) #define leCharZh(r,a,b) r=(I_)((a)<=(b)) -#define gtIntZh(r,a,b) r=(I_)((a) >(b)) -#define geIntZh(r,a,b) r=(I_)((a)>=(b)) -#define eqIntZh(r,a,b) r=(I_)((a)==(b)) -#define neIntZh(r,a,b) r=(I_)((a)!=(b)) -#define ltIntZh(r,a,b) r=(I_)((a) <(b)) -#define leIntZh(r,a,b) r=(I_)((a)<=(b)) +/* Int comparisons: >#, >=# etc */ +#define ZgZh(r,a,b) r=(I_)((a) >(b)) +#define ZgZeZh(r,a,b) r=(I_)((a)>=(b)) +#define ZeZeZh(r,a,b) r=(I_)((a)==(b)) +#define ZdZeZh(r,a,b) r=(I_)((a)!=(b)) +#define ZlZh(r,a,b) r=(I_)((a) <(b)) +#define ZlZeZh(r,a,b) r=(I_)((a)<=(b)) #define gtWordZh(r,a,b) r=(I_)((a) >(b)) #define geWordZh(r,a,b) r=(I_)((a)>=(b)) @@ -449,12 +419,13 @@ even for 8-bit chars). #define ltFloatZh(r,a,b) r=(I_)((a)< (b)) #define leFloatZh(r,a,b) r=(I_)((a)<=(b)) -#define gtDoubleZh(r,a,b) r=(I_)((a)> (b)) -#define geDoubleZh(r,a,b) r=(I_)((a)>=(b)) -#define eqDoubleZh(r,a,b) r=(I_)((a)==(b)) -#define neDoubleZh(r,a,b) r=(I_)((a)!=(b)) -#define ltDoubleZh(r,a,b) r=(I_)((a)< (b)) -#define leDoubleZh(r,a,b) r=(I_)((a)<=(b)) +/* Double comparisons: >##, >=#@ etc */ +#define ZgZhZh(r,a,b) r=(I_)((a) >(b)) +#define ZgZeZhZh(r,a,b) r=(I_)((a)>=(b)) +#define ZeZeZhZh(r,a,b) r=(I_)((a)==(b)) +#define ZdZeZhZh(r,a,b) r=(I_)((a)!=(b)) +#define ZlZhZh(r,a,b) r=(I_)((a) <(b)) +#define ZlZeZhZh(r,a,b) r=(I_)((a)<=(b)) \end{code} %************************************************************************ @@ -479,13 +450,16 @@ even for 8-bit chars). \begin{code} I_ stg_div PROTO((I_ a, I_ b)); -#define plusIntZh(r,a,b) r=(a)+(b) -#define minusIntZh(r,a,b) r=(a)-(b) -#define timesIntZh(r,a,b) r=(a)*(b) +#define ZpZh(r,a,b) r=(a)+(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) -#define divIntZh(r,a,b) r=ULTRASAFESTGCALL2(I_,(void *, I_, I_),stg_div,(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} %************************************************************************ @@ -495,8 +469,12 @@ 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) @@ -561,10 +539,10 @@ I_ stg_div PROTO((I_ a, I_ b)); %************************************************************************ \begin{code} -#define plusDoubleZh(r,a,b) r=(a)+(b) -#define minusDoubleZh(r,a,b) r=(a)-(b) -#define timesDoubleZh(r,a,b) r=(a)*(b) -#define divideDoubleZh(r,a,b) r=(a)/(b) +#define ZpZhZh(r,a,b) r=(a)+(b) +#define ZmZhZh(r,a,b) r=(a)-(b) +#define ZtZhZh(r,a,b) r=(a)*(b) +#define ZdZhZh(r,a,b) r=(a)/(b) #define negateDoubleZh(r,a) r=-(a) #define int2DoubleZh(r,a) r=(StgDouble)(a) @@ -585,7 +563,8 @@ I_ stg_div PROTO((I_ a, I_ b)); #define sinhDoubleZh(r,a) r=(StgDouble) SAFESTGCALL1(StgDouble,(void *, StgDouble),sinh,a) #define coshDoubleZh(r,a) r=(StgDouble) SAFESTGCALL1(StgDouble,(void *, StgDouble),cosh,a) #define tanhDoubleZh(r,a) r=(StgDouble) SAFESTGCALL1(StgDouble,(void *, StgDouble),tanh,a) -#define powerDoubleZh(r,a,b) r=(StgDouble) SAFESTGCALL2(StgDouble,(void *, StgDouble,StgDouble),pow,a,b) +/* Power: **## */ +#define ZtZtZhZh(r,a,b) r=(StgDouble) SAFESTGCALL2(StgDouble,(void *, StgDouble,StgDouble),pow,a,b) \end{code} %************************************************************************ @@ -878,12 +857,12 @@ Encoding and decoding float-ish things is pretty Integer-ish. We use these pretty magical support functions, essentially stolen from Lennart: \begin{code} StgFloat __encodeFloat PROTO((MP_INT *, I_)); -void __decodeFloat PROTO((MP_INT * /*result1*/, +void __decodeFloat PROTO((MP_INT * /*result1*/, I_ * /*result2*/, StgFloat)); StgDouble __encodeDouble PROTO((MP_INT *, I_)); -void __decodeDouble PROTO((MP_INT * /*result1*/, +void __decodeDouble PROTO((MP_INT * /*result1*/, I_ * /*result2*/, StgDouble)); \end{code} @@ -900,12 +879,13 @@ Some floating-point format info, made with the \tr{enquire} program || m68k_TARGET_ARCH \ || mipsel_TARGET_ARCH \ || mipseb_TARGET_ARCH \ - || powerpc_TARGET_ARCH + || powerpc_TARGET_ARCH \ + || rs6000_TARGET_ARCH /* 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 @@ -922,7 +902,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) \ @@ -948,7 +928,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) \ @@ -1136,20 +1116,6 @@ extern I_ genSymZh(STG_NO_ARGS); extern I_ resetGenSymZh(STG_NO_ARGS); extern I_ incSeqWorldZh(STG_NO_ARGS); -/* sigh again: without these some (notably "float") willnae work */ -extern I_ long2bytes__ PROTO((long, unsigned char *)); -extern I_ int2bytes__ PROTO((int, unsigned char *)); -extern I_ short2bytes__ PROTO((short, unsigned char *)); -extern I_ float2bytes__ PROTO((float, unsigned char *)); -extern I_ double2bytes__ PROTO((double, unsigned char *)); - -/* these may not be necessary; and they create warnings (WDP) */ -extern I_ bytes2long__ PROTO((P_, I_ *)); -extern I_ bytes2int__ PROTO((P_, I_ *)); -extern I_ bytes2short__ PROTO((P_, I_ *)); -extern I_ bytes2float__ PROTO((P_, StgFloat *)); -extern I_ bytes2double__ PROTO((P_, StgDouble *)); - extern I_ byteArrayHasNUL__ PROTO((const char *, I_)); \end{code} @@ -1202,6 +1168,12 @@ of one ptr (not bytes). #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 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] @@ -1305,14 +1277,14 @@ void newArrZh_init PROTO((P_ result, I_ n, P_ init)); %************************************************************************ \begin{code} -ED_(Prelude_Z91Z93_closure); +ED_(PrelBase_Z91Z93_closure); #define newSynchVarZh(r, hp) \ { \ ALLOC_PRIM(MUTUPLE_HS,3,0,MUTUPLE_HS+3) /* ticky ticky */; \ CC_ALLOC(CCC,MUTUPLE_HS+3,ARR_K); /* cc prof */ \ SET_SVAR_HDR(hp,EmptySVar_info,CCC); \ - SVAR_HEAD(hp) = SVAR_TAIL(hp) = SVAR_VALUE(hp) = Prelude_Z91Z93_closure; \ + SVAR_HEAD(hp) = SVAR_TAIL(hp) = SVAR_VALUE(hp) = PrelBase_Z91Z93_closure; \ r = hp; \ } \end{code} @@ -1320,22 +1292,22 @@ ED_(Prelude_Z91Z93_closure); \begin{code} #ifdef CONCURRENT -extern void Yield PROTO((W_)); +void Yield PROTO((W_)); #define takeMVarZh(r, liveness, node) \ { \ while (INFO_PTR(node) != (W_) FullSVar_info) { \ - if (SVAR_HEAD(node) == Prelude_Z91Z93_closure) \ + if (SVAR_HEAD(node) == PrelBase_Z91Z93_closure) \ SVAR_HEAD(node) = CurrentTSO; \ else \ TSO_LINK(SVAR_TAIL(node)) = CurrentTSO; \ - TSO_LINK(CurrentTSO) = (P_) Prelude_Z91Z93_closure; \ + TSO_LINK(CurrentTSO) = (P_) PrelBase_Z91Z93_closure; \ SVAR_TAIL(node) = CurrentTSO; \ DO_YIELD(liveness << 1); \ } \ SET_INFO_PTR(node, EmptySVar_info); \ r = SVAR_VALUE(node); \ - SVAR_VALUE(node) = Prelude_Z91Z93_closure; \ + SVAR_VALUE(node) = PrelBase_Z91Z93_closure; \ } #else @@ -1350,7 +1322,7 @@ extern void Yield PROTO((W_)); } \ SET_INFO_PTR(node, EmptySVar_info); \ r = SVAR_VALUE(node); \ - SVAR_VALUE(node) = Prelude_Z91Z93_closure; \ + SVAR_VALUE(node) = PrelBase_Z91Z93_closure; \ } #endif @@ -1378,18 +1350,18 @@ extern void Yield PROTO((W_)); SET_INFO_PTR(node, FullSVar_info); \ SVAR_VALUE(node) = value; \ tso = SVAR_HEAD(node); \ - if (tso != (P_) Prelude_Z91Z93_closure) { \ + if (tso != (P_) PrelBase_Z91Z93_closure) { \ if (DO_QP_PROF) \ STGCALL3(void,(void *, char *, P_, P_),QP_Event2,do_qp_prof > 1 ? "RA" : "RG",tso,CurrentTSO); \ - if (ThreadQueueHd == Prelude_Z91Z93_closure) \ + if (ThreadQueueHd == PrelBase_Z91Z93_closure) \ ThreadQueueHd = tso; \ else \ TSO_LINK(ThreadQueueTl) = tso; \ ThreadQueueTl = tso; \ SVAR_HEAD(node) = TSO_LINK(tso); \ - TSO_LINK(tso) = (P_) Prelude_Z91Z93_closure; \ - if(SVAR_HEAD(node) == (P_) Prelude_Z91Z93_closure) \ - SVAR_TAIL(node) = (P_) Prelude_Z91Z93_closure; \ + TSO_LINK(tso) = (P_) PrelBase_Z91Z93_closure; \ + if(SVAR_HEAD(node) == (P_) PrelBase_Z91Z93_closure) \ + SVAR_TAIL(node) = (P_) PrelBase_Z91Z93_closure; \ } \ } @@ -1407,18 +1379,18 @@ extern void Yield PROTO((W_)); SET_INFO_PTR(node, FullSVar_info); \ SVAR_VALUE(node) = value; \ tso = SVAR_HEAD(node); \ - if (tso != (P_) Prelude_Z91Z93_closure) { \ + if (tso != (P_) PrelBase_Z91Z93_closure) { \ if (DO_QP_PROF) \ STGCALL3(void,(void *, char *, P_, P_),QP_Event2,do_qp_prof > 1 ? "RA" : "RG",tso,CurrentTSO); \ - if (RunnableThreadsHd == Prelude_Z91Z93_closure) \ + if (RunnableThreadsHd == PrelBase_Z91Z93_closure) \ RunnableThreadsHd = tso; \ else \ TSO_LINK(RunnableThreadsTl) = tso; \ RunnableThreadsTl = tso; \ SVAR_HEAD(node) = TSO_LINK(tso); \ - TSO_LINK(tso) = (P_) Prelude_Z91Z93_closure; \ - if(SVAR_HEAD(node) == (P_) Prelude_Z91Z93_closure) \ - SVAR_TAIL(node) = (P_) Prelude_Z91Z93_closure; \ + TSO_LINK(tso) = (P_) PrelBase_Z91Z93_closure; \ + if(SVAR_HEAD(node) == (P_) PrelBase_Z91Z93_closure) \ + SVAR_TAIL(node) = (P_) PrelBase_Z91Z93_closure; \ } \ } @@ -1448,11 +1420,11 @@ extern void Yield PROTO((W_)); #define readIVarZh(r, liveness, node) \ { \ if (INFO_PTR(node) != (W_) ImMutArrayOfPtrs_info) { \ - if (SVAR_HEAD(node) == Prelude_Z91Z93_closure) \ + if (SVAR_HEAD(node) == PrelBase_Z91Z93_closure) \ SVAR_HEAD(node) = CurrentTSO; \ else \ TSO_LINK(SVAR_TAIL(node)) = CurrentTSO; \ - TSO_LINK(CurrentTSO) = (P_) Prelude_Z91Z93_closure; \ + TSO_LINK(CurrentTSO) = (P_) PrelBase_Z91Z93_closure; \ SVAR_TAIL(node) = CurrentTSO; \ DO_YIELD(liveness << 1); \ } \ @@ -1495,12 +1467,12 @@ extern void Yield PROTO((W_)); EXIT(EXIT_FAILURE); \ } \ tso = SVAR_HEAD(node); \ - if (tso != (P_) Prelude_Z91Z93_closure) { \ - if (ThreadQueueHd == Prelude_Z91Z93_closure) \ + if (tso != (P_) PrelBase_Z91Z93_closure) { \ + if (ThreadQueueHd == PrelBase_Z91Z93_closure) \ ThreadQueueHd = tso; \ else \ TSO_LINK(ThreadQueueTl) = tso; \ - while(TSO_LINK(tso) != Prelude_Z91Z93_closure) { \ + while(TSO_LINK(tso) != PrelBase_Z91Z93_closure) { \ if (DO_QP_PROF) \ STGCALL3(void,(void *, char *, P_, P_),QP_Event2,do_qp_prof > 1 ? "RA" : "RG",tso,CurrentTSO); \ tso = TSO_LINK(tso); \ @@ -1527,12 +1499,12 @@ extern void Yield PROTO((W_)); EXIT(EXIT_FAILURE); \ } \ tso = SVAR_HEAD(node); \ - if (tso != (P_) Prelude_Z91Z93_closure) { \ - if (RunnableThreadsHd == Prelude_Z91Z93_closure) \ + if (tso != (P_) PrelBase_Z91Z93_closure) { \ + if (RunnableThreadsHd == PrelBase_Z91Z93_closure) \ RunnableThreadsHd = tso; \ else \ TSO_LINK(RunnableThreadsTl) = tso; \ - while(TSO_LINK(tso) != Prelude_Z91Z93_closure) { \ + while(TSO_LINK(tso) != PrelBase_Z91Z93_closure) { \ if (DO_QP_PROF) \ STGCALL3(void,(void *, char *, P_, P_),QP_Event2,do_qp_prof > 1 ? "RA" : "RG",tso,CurrentTSO); \ tso = TSO_LINK(tso); \ @@ -1582,12 +1554,12 @@ extern void Yield PROTO((W_)); #define delayZh(liveness, us) \ { \ - if (WaitingThreadsTl == Prelude_Z91Z93_closure) \ + if (WaitingThreadsTl == PrelBase_Z91Z93_closure) \ WaitingThreadsHd = CurrentTSO; \ else \ TSO_LINK(WaitingThreadsTl) = CurrentTSO; \ WaitingThreadsTl = CurrentTSO; \ - TSO_LINK(CurrentTSO) = Prelude_Z91Z93_closure; \ + TSO_LINK(CurrentTSO) = PrelBase_Z91Z93_closure; \ TSO_EVENT(CurrentTSO) = (W_) ((us) < 1 ? 1 : (us)); \ DO_YIELD(liveness << 1); \ } @@ -1609,12 +1581,12 @@ extern void Yield PROTO((W_)); #define waitReadZh(liveness, fd) \ { \ - if (WaitingThreadsTl == Prelude_Z91Z93_closure) \ + if (WaitingThreadsTl == PrelBase_Z91Z93_closure) \ WaitingThreadsHd = CurrentTSO; \ else \ TSO_LINK(WaitingThreadsTl) = CurrentTSO; \ WaitingThreadsTl = CurrentTSO; \ - TSO_LINK(CurrentTSO) = Prelude_Z91Z93_closure; \ + TSO_LINK(CurrentTSO) = PrelBase_Z91Z93_closure; \ TSO_EVENT(CurrentTSO) = (W_) (-(fd)); \ DO_YIELD(liveness << 1); \ } @@ -1640,12 +1612,12 @@ extern void Yield PROTO((W_)); #define waitWriteZh(liveness, fd) \ { \ - if (WaitingThreadsTl == Prelude_Z91Z93_closure) \ + if (WaitingThreadsTl == PrelBase_Z91Z93_closure) \ WaitingThreadsHd = CurrentTSO; \ else \ TSO_LINK(WaitingThreadsTl) = CurrentTSO; \ WaitingThreadsTl = CurrentTSO; \ - TSO_LINK(CurrentTSO) = Prelude_Z91Z93_closure; \ + TSO_LINK(CurrentTSO) = PrelBase_Z91Z93_closure; \ TSO_EVENT(CurrentTSO) = (W_) (-(fd+FD_SETSIZE)); \ DO_YIELD(liveness << 1); \ } @@ -1701,7 +1673,8 @@ IF_RTS(void blockVtAlrmSignal(STG_NO_ARGS);) IF_RTS(void unblockVtAlrmSignal(STG_NO_ARGS);) IF_RTS(void AwaitEvent(I_ delta);) -#ifdef _POSIX_SOURCE +#if defined(_POSIX_SOURCE) && !defined(nextstep3_TARGET_OS) + /* For nextstep3_TARGET_OS comment see stgdefs.h. CaS */ extern I_ sig_install PROTO((I_, I_, sigset_t *)); #define stg_sig_ignore(s,m) SAFESTGCALL3(I_,(void *, I_, I_),sig_install,s,STG_SIG_IGN,(sigset_t *)m) #define stg_sig_default(s,m) SAFESTGCALL3(I_,(void *, I_, I_),sig_install,s,STG_SIG_DFL,(sigset_t *)m) @@ -1719,12 +1692,12 @@ extern I_ sig_install PROTO((I_, I_)); StgInt getErrorHandler(STG_NO_ARGS); #ifndef PAR -void raiseError PROTO((StgStablePtr handler)); +void raiseError PROTO((StgStablePtr handler)); StgInt catchError PROTO((StgStablePtr newErrorHandler)); #endif void decrementErrorCount(STG_NO_ARGS); -#define stg_catchError(sp) SAFESTGCALL1(I_,(void *, StgStablePtr),catchError,sp) +#define stg_catchError(sp) SAFESTGCALL1(I_,(void *, StgStablePtr),catchError,sp) #define stg_decrementErrorCount() SAFESTGCALL0(void,(void *),decrementErrorCount) \end{code} @@ -1764,7 +1737,6 @@ extern StgPtr _deRefStablePointer PROTO((StgInt, StgPtr)); #define deRefStablePtrZh(ri,sp) \ ri = SAFESTGCALL2(I_,(void *, I_, P_),_deRefStablePointer,sp,StorageMgrInfo.StablePointerTable); - \end{code} Declarations for other stable pointer operations. @@ -1821,7 +1793,7 @@ consider context switching...) any strictly increasing expression will do here */ #define CalcNewNoSPtrs( i ) ((i)*2 + 100) -extern void enlargeSPTable PROTO((P_, P_)); +void enlargeSPTable PROTO((P_, P_)); #define makeStablePtrZh(stablePtr,liveness,unstablePtr) \ do { \ @@ -1910,7 +1882,7 @@ Anything with tag >= 0 is in WHNF, so we discard it. \begin{code} #ifdef CONCURRENT -ED_(Prelude_Z91Z93_closure); +ED_(PrelBase_Z91Z93_closure); ED_(True_closure); #if defined(GRAN) @@ -2009,7 +1981,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 @@ -2052,6 +2024,8 @@ extern I_ required_thread_count; } #endif /* GRAN */ + +#endif /* CONCURRENT */ \end{code} The following seq# code should only be used in unoptimized code. @@ -2086,7 +2060,6 @@ ED_RO_(vtbl_seq); r = 1; /* Should be unnecessary */ \ }) -#endif /* CONCURRENT */ \end{code} %************************************************************************ @@ -2136,18 +2109,20 @@ do { \ ForeignObj_CLOSURE_LINK(result) = StorageMgrInfo.ForeignObjList; \ StorageMgrInfo.ForeignObjList = result; \ \ -/* \ - printf("DEBUG: ForeignObj(0x%x) = <0x%x, 0x%x, 0x%x, 0x%x>\n", \ + \ + /*fprintf(stderr,"DEBUG: ForeignObj(0x%x) = <0x%x, 0x%x, 0x%x, 0x%x>\n", \ result, \ result[0],result[1], \ - result[2],result[3]); \ -*/ \ + result[2],result[3]);*/ \ + \ CHECK_ForeignObj_CLOSURE( result ); \ VALIDATE_ForeignObjList( StorageMgrInfo.ForeignObjList ); \ \ (r) = (P_) result; \ } while (0) +#define writeForeignObjZh(res,datum) ((PP_) ForeignObj_CLOSURE_DATA(res)) = ((P_)datum) + #else #define makeForeignObjZh(r, liveness, mptr, finalise) \ do { \ @@ -2156,6 +2131,13 @@ do { \ EXIT(EXIT_FAILURE); \ } while(0) +#define writeForeignObjZh(res,datum) \ +do { \ + fflush(stdout); \ + fprintf(stderr, "writeForeignObj#: no foreign object support.\n");\ + EXIT(EXIT_FAILURE); \ +} while(0) + #endif /* !PAR */ \end{code}