X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fincludes%2FStgMacros.lh;h=44d9a4d92dd6bc53ae0777a5f4550d14ac79b02b;hb=23c94851fb2c98d345d913d35a5a12bbc3a346bd;hp=54352204f2e8189642fa7bc727dac4c1627420f6;hpb=10521d8418fd3a1cf32882718b5bd28992db36fd;p=ghc-hetmet.git diff --git a/ghc/includes/StgMacros.lh b/ghc/includes/StgMacros.lh index 5435220..44d9a4d 100644 --- a/ghc/includes/StgMacros.lh +++ b/ghc/includes/StgMacros.lh @@ -54,7 +54,15 @@ Mere abbreviations: General things; note: general-but-``machine-dependent'' macros are given in \tr{StgMachDeps.lh}. \begin{code} -#define STG_MAX(a,b) (((a)>=(b)) ? (a) : (b)) +I_ STG_MAX PROTO((I_, I_)); /* GCC -Wall loves prototypes */ + +extern STG_INLINE +I_ +STG_MAX(I_ a, I_ b) { return((a >= b) ? a : b); } +/* NB: the naive #define macro version of STG_MAX + can lead to exponential CPP explosion, if you + have very-nested STG_MAXes. +*/ /* Macros to combine two short words into a single @@ -179,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) @@ -200,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 @@ -224,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) @@ -232,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} %* * %************************************************************************ @@ -271,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); @@ -295,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 { \ @@ -413,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)) @@ -441,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} %************************************************************************ @@ -471,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} %************************************************************************ @@ -487,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) @@ -553,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) @@ -577,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} %************************************************************************ @@ -870,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} @@ -892,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 @@ -914,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) \ @@ -940,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) \ @@ -1012,10 +1000,10 @@ which uses these anyway.) #if ! defined(__GNUC__) || ! defined(__STG_GCC_REGS__) -extern void ASSIGN_DBL PROTO((W_ [], StgDouble)); -extern StgDouble PK_DBL PROTO((W_ [])); -extern void ASSIGN_FLT PROTO((W_ [], StgFloat)); -extern StgFloat PK_FLT PROTO((W_ [])); +void ASSIGN_DBL PROTO((W_ [], StgDouble)); +StgDouble PK_DBL PROTO((W_ [])); +void ASSIGN_FLT PROTO((W_ [], StgFloat)); +StgFloat PK_FLT PROTO((W_ [])); #else /* yes, its __GNUC__ && we really want them */ @@ -1036,6 +1024,12 @@ extern StgFloat PK_FLT PROTO((W_ [])); #else /* ! sparc */ +/* (not very) forward prototype declarations */ +void ASSIGN_DBL PROTO((W_ [], StgDouble)); +StgDouble PK_DBL PROTO((W_ [])); +void ASSIGN_FLT PROTO((W_ [], StgFloat)); +StgFloat PK_FLT PROTO((W_ [])); + extern STG_INLINE void ASSIGN_DBL(W_ p_dest[], StgDouble src) @@ -1122,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} @@ -1188,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] @@ -1291,14 +1277,14 @@ void newArrZh_init PROTO((P_ result, I_ n, P_ init)); %************************************************************************ \begin{code} -ED_(Nil_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) = Nil_closure; \ + SVAR_HEAD(hp) = SVAR_TAIL(hp) = SVAR_VALUE(hp) = PrelBase_Z91Z93_closure; \ r = hp; \ } \end{code} @@ -1306,22 +1292,22 @@ ED_(Nil_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) == Nil_closure) \ + if (SVAR_HEAD(node) == PrelBase_Z91Z93_closure) \ SVAR_HEAD(node) = CurrentTSO; \ else \ TSO_LINK(SVAR_TAIL(node)) = CurrentTSO; \ - TSO_LINK(CurrentTSO) = (P_) Nil_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) = Nil_closure; \ + SVAR_VALUE(node) = PrelBase_Z91Z93_closure; \ } #else @@ -1336,7 +1322,7 @@ extern void Yield PROTO((W_)); } \ SET_INFO_PTR(node, EmptySVar_info); \ r = SVAR_VALUE(node); \ - SVAR_VALUE(node) = Nil_closure; \ + SVAR_VALUE(node) = PrelBase_Z91Z93_closure; \ } #endif @@ -1364,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_) Nil_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 == Nil_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_) Nil_closure; \ - if(SVAR_HEAD(node) == (P_) Nil_closure) \ - SVAR_TAIL(node) = (P_) Nil_closure; \ + TSO_LINK(tso) = (P_) PrelBase_Z91Z93_closure; \ + if(SVAR_HEAD(node) == (P_) PrelBase_Z91Z93_closure) \ + SVAR_TAIL(node) = (P_) PrelBase_Z91Z93_closure; \ } \ } @@ -1393,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_) Nil_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 == Nil_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_) Nil_closure; \ - if(SVAR_HEAD(node) == (P_) Nil_closure) \ - SVAR_TAIL(node) = (P_) Nil_closure; \ + TSO_LINK(tso) = (P_) PrelBase_Z91Z93_closure; \ + if(SVAR_HEAD(node) == (P_) PrelBase_Z91Z93_closure) \ + SVAR_TAIL(node) = (P_) PrelBase_Z91Z93_closure; \ } \ } @@ -1434,11 +1420,11 @@ extern void Yield PROTO((W_)); #define readIVarZh(r, liveness, node) \ { \ if (INFO_PTR(node) != (W_) ImMutArrayOfPtrs_info) { \ - if (SVAR_HEAD(node) == Nil_closure) \ + if (SVAR_HEAD(node) == PrelBase_Z91Z93_closure) \ SVAR_HEAD(node) = CurrentTSO; \ else \ TSO_LINK(SVAR_TAIL(node)) = CurrentTSO; \ - TSO_LINK(CurrentTSO) = (P_) Nil_closure; \ + TSO_LINK(CurrentTSO) = (P_) PrelBase_Z91Z93_closure; \ SVAR_TAIL(node) = CurrentTSO; \ DO_YIELD(liveness << 1); \ } \ @@ -1481,12 +1467,12 @@ extern void Yield PROTO((W_)); EXIT(EXIT_FAILURE); \ } \ tso = SVAR_HEAD(node); \ - if (tso != (P_) Nil_closure) { \ - if (ThreadQueueHd == Nil_closure) \ + if (tso != (P_) PrelBase_Z91Z93_closure) { \ + if (ThreadQueueHd == PrelBase_Z91Z93_closure) \ ThreadQueueHd = tso; \ else \ TSO_LINK(ThreadQueueTl) = tso; \ - while(TSO_LINK(tso) != Nil_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); \ @@ -1513,12 +1499,12 @@ extern void Yield PROTO((W_)); EXIT(EXIT_FAILURE); \ } \ tso = SVAR_HEAD(node); \ - if (tso != (P_) Nil_closure) { \ - if (RunnableThreadsHd == Nil_closure) \ + if (tso != (P_) PrelBase_Z91Z93_closure) { \ + if (RunnableThreadsHd == PrelBase_Z91Z93_closure) \ RunnableThreadsHd = tso; \ else \ TSO_LINK(RunnableThreadsTl) = tso; \ - while(TSO_LINK(tso) != Nil_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); \ @@ -1568,12 +1554,12 @@ extern void Yield PROTO((W_)); #define delayZh(liveness, us) \ { \ - if (WaitingThreadsTl == Nil_closure) \ + if (WaitingThreadsTl == PrelBase_Z91Z93_closure) \ WaitingThreadsHd = CurrentTSO; \ else \ TSO_LINK(WaitingThreadsTl) = CurrentTSO; \ WaitingThreadsTl = CurrentTSO; \ - TSO_LINK(CurrentTSO) = Nil_closure; \ + TSO_LINK(CurrentTSO) = PrelBase_Z91Z93_closure; \ TSO_EVENT(CurrentTSO) = (W_) ((us) < 1 ? 1 : (us)); \ DO_YIELD(liveness << 1); \ } @@ -1593,24 +1579,55 @@ extern void Yield PROTO((W_)); /* ToDo: something for GRAN */ -#define waitZh(liveness, fd) \ +#define waitReadZh(liveness, fd) \ { \ - if (WaitingThreadsTl == Nil_closure) \ + if (WaitingThreadsTl == PrelBase_Z91Z93_closure) \ WaitingThreadsHd = CurrentTSO; \ else \ TSO_LINK(WaitingThreadsTl) = CurrentTSO; \ WaitingThreadsTl = CurrentTSO; \ - TSO_LINK(CurrentTSO) = Nil_closure; \ + TSO_LINK(CurrentTSO) = PrelBase_Z91Z93_closure; \ TSO_EVENT(CurrentTSO) = (W_) (-(fd)); \ DO_YIELD(liveness << 1); \ } #else -#define waitZh(liveness, fd) \ +#define waitReadZh(liveness, fd) \ + { \ + fflush(stdout); \ + fprintf(stderr, "waitRead#: unthreaded build.\n"); \ + EXIT(EXIT_FAILURE); \ + } + +#endif + +#ifdef CONCURRENT + +/* ToDo: something for GRAN */ + +#ifdef HAVE_SYS_TYPES_H +#include +#endif HAVE_SYS_TYPES_H */ + +#define waitWriteZh(liveness, fd) \ + { \ + if (WaitingThreadsTl == PrelBase_Z91Z93_closure) \ + WaitingThreadsHd = CurrentTSO; \ + else \ + TSO_LINK(WaitingThreadsTl) = CurrentTSO; \ + WaitingThreadsTl = CurrentTSO; \ + TSO_LINK(CurrentTSO) = PrelBase_Z91Z93_closure; \ + TSO_EVENT(CurrentTSO) = (W_) (-(fd+FD_SETSIZE)); \ + DO_YIELD(liveness << 1); \ + } + +#else + +#define waitWriteZh(liveness, fd) \ { \ fflush(stdout); \ - fprintf(stderr, "wait#: unthreaded build.\n"); \ + fprintf(stderr, "waitWrite#: unthreaded build.\n"); \ EXIT(EXIT_FAILURE); \ } @@ -1656,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) @@ -1674,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} @@ -1719,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. @@ -1776,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 { \ @@ -1806,6 +1823,7 @@ do { \ \ newSP = SPT_POP(StorageMgrInfo.StablePointerTable); \ SPT_SPTR(StorageMgrInfo.StablePointerTable, newSP) = unstablePtr; \ + CHECK_SPT_CLOSURE( StorageMgrInfo.StablePointerTable ); \ stablePtr = newSP; \ } while (0) @@ -1864,59 +1882,106 @@ Anything with tag >= 0 is in WHNF, so we discard it. \begin{code} #ifdef CONCURRENT -ED_(Nil_closure); +ED_(PrelBase_Z91Z93_closure); ED_(True_closure); #if defined(GRAN) -#define parZh(r,hp,node,rest) \ - PARZh(r,hp,node,rest,0,0) +#define parZh(r,node) \ + PARZh(r,node,1,0,0,0,0,0) -#define parAtZh(r,hp,node,where,identifier,rest) \ - parATZh(r,hp,node,where,identifier,rest,1) +#define parAtZh(r,node,where,identifier,gran_info,size_info,par_info,rest) \ + parATZh(r,node,where,identifier,gran_info,size_info,par_info,rest,1) -#define parAtForNowZh(r,hp,node,where,identifier,rest) \ - parATZh(r,hp,node,where,identifier,rest,0) +#define parAtAbsZh(r,node,proc,identifier,gran_info,size_info,par_info,rest) \ + parATZh(r,node,proc,identifier,gran_info,size_info,par_info,rest,2) -#define parATZh(r,hp,node,where,identifier,rest,local) \ +#define parAtRelZh(r,node,proc,identifier,gran_info,size_info,par_info,rest) \ + parATZh(r,node,proc,identifier,gran_info,size_info,par_info,rest,3) + +#define parAtForNowZh(r,node,where,identifier,gran_info,size_info,par_info,rest) \ + parATZh(r,node,where,identifier,gran_info,size_info,par_info,rest,0) + +#define parATZh(r,node,where,identifier,gran_info,size_info,par_info,rest,local) \ { \ sparkq result; \ if (SHOULD_SPARK(node)) { \ - result = NewSpark((P_)node,identifier,local); \ - SAFESTGCALL3(void,(W_),GranSimSparkAt,result,where,identifier); \ + SaveAllStgRegs(); \ + { sparkq result; \ + result = NewSpark((P_)node,identifier,gran_info,size_info,par_info,local); \ + if (local==2) { /* special case for parAtAbs */ \ + GranSimSparkAtAbs(result,(I_)where,identifier);\ + } else if (local==3) { /* special case for parAtRel */ \ + GranSimSparkAtAbs(result,(I_)(CurrentProc+where),identifier); \ + } else { \ + GranSimSparkAt(result,where,identifier); \ + } \ + context_switch = 1; \ + } \ + RestoreAllStgRegs(); \ } else if (do_qp_prof) { \ I_ tid = threadId++; \ SAFESTGCALL2(void,(I_, P_),QP_Event0,tid,node); \ } \ - r = (rest); \ + r = 1; /* return code for successful spark -- HWL */ \ } -#define parLocalZh(r,hp,node,identifier,rest) \ - PARZh(r,hp,node,rest,identifier,1) +#define parLocalZh(r,node,identifier,gran_info,size_info,par_info,rest) \ + PARZh(r,node,rest,identifier,gran_info,size_info,par_info,1) + +#define parGlobalZh(r,node,identifier,gran_info,size_info,par_info,rest) \ + PARZh(r,node,rest,identifier,gran_info,size_info,par_info,0) -#define parGlobalZh(r,hp,node,identifier,rest) \ - PARZh(r,hp,node,rest,identifier,0) +#if 1 -#define PARZh(r,hp,node,rest,identifier,local) \ +#define PARZh(r,node,rest,identifier,gran_info,size_info,par_info,local) \ +{ \ + if (SHOULD_SPARK(node)) { \ + SaveAllStgRegs(); \ + { sparkq result; \ + result = NewSpark((P_)node,identifier,gran_info,size_info,par_info,local);\ + add_to_spark_queue(result); \ + GranSimSpark(local,(P_)node); \ + context_switch = 1; \ + } \ + RestoreAllStgRegs(); \ + } else if (do_qp_prof) { \ + I_ tid = threadId++; \ + SAFESTGCALL2(void,(I_, P_),QP_Event0,tid,node); \ + } \ + r = 1; /* return code for successful spark -- HWL */ \ +} + +#else + +#define PARZh(r,node,rest,identifier,gran_info,size_info,par_info,local) \ { \ sparkq result; \ if (SHOULD_SPARK(node)) { \ - result = NewSpark((P_)node,identifier,local); \ + result = NewSpark((P_)node,identifier,gran_info,size_info,par_info,local);\ ADD_TO_SPARK_QUEUE(result); \ SAFESTGCALL2(void,(W_),GranSimSpark,local,(P_)node); \ - /* context_switch = 1; not needed any more -- HWL */ \ + /* context_switch = 1; not needed any more -- HWL */ \ } else if (do_qp_prof) { \ I_ tid = threadId++; \ SAFESTGCALL2(void,(I_, P_),QP_Event0,tid,node); \ } \ - r = (rest); \ + r = 1; /* return code for successful spark -- HWL */ \ } +#endif + +#define copyableZh(r,node) \ + /* copyable not yet implemented!! */ + +#define noFollowZh(r,node) \ + /* noFollow not yet implemented!! */ + #else /* !GRAN */ 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 @@ -1958,6 +2023,9 @@ extern I_ required_thread_count; r = 1; /* Should not be necessary */ \ } +#endif /* GRAN */ + +#endif /* CONCURRENT */ \end{code} The following seq# code should only be used in unoptimized code. @@ -1979,8 +2047,8 @@ ED_RO_(vtbl_seq); #define seqZh(r,liveness,node) \ ({ \ __label__ cont; \ - STK_CHK(liveness,0,2,0,0,0,0); \ - SpB -= BREL(2); \ + /* STK_CHK(liveness,0,2,0,0,0,0); */ \ + /* SpB -= BREL(2); */ \ SpB[BREL(0)] = (W_) RetReg; \ SpB[BREL(1)] = (W_) &&cont; \ RetReg = (StgRetAddr) vtbl_seq; \ @@ -1992,23 +2060,26 @@ ED_RO_(vtbl_seq); r = 1; /* Should be unnecessary */ \ }) -#endif /* GRAN */ -#endif /* CONCURRENT */ \end{code} %************************************************************************ %* * -\subsubsection[StgMacros-malloc-ptrs]{Malloc Pointers} +\subsubsection[StgMacros-foreign-objects]{Foreign Objects} %* * %************************************************************************ -This macro is used to construct a MallocPtr on the heap after a ccall. -Since MallocPtr's are like arrays in many ways, this is heavily based -on the stuff for arrays above. +[Based on previous MallocPtr comments -- SOF] + +This macro is used to construct a ForeignObj on the heap. What this does is plug the pointer (which will be in a local -variable), into a fresh heap object and then sets a result (which will -be a register) to point to the fresh heap object. +variable) together with its finalising/free routine, into a fresh heap +object and then sets a result (which will be a register) to point +to the fresh heap object. + +To accommodate per-object finalisation, augment the macro with a +finalisation routine argument. Nothing spectacular, just plug the +pointer to the routine into the ForeignObj -- SOF 4/96 Question: what's this "SET_ACTIVITY" stuff - should I be doing this too? (It's if you want to use the SPAT profiling tools to @@ -2016,42 +2087,54 @@ characterize program behavior by ``activity'' -- tail-calling, heap-checking, etc. -- see Ticky.lh. It is quite specialized. WDP 95/1) +(Swapped first two arguments to make it come into line with what appears +to be `standard' format, return register then liveness mask. -- SOF 4/96) + \begin{code} #ifndef PAR -StgInt eqMallocPtr PROTO((StgMallocPtr p1, StgMallocPtr p2)); -void FreeMallocPtr PROTO((StgMallocPtr mp)); +StgInt eqForeignObj PROTO((StgForeignObj p1, StgForeignObj p2)); -#define constructMallocPtr(liveness, r, mptr) \ -do { \ - P_ result; \ - \ - HEAP_CHK(liveness, _FHS + MallocPtr_SIZE,0); \ - CC_ALLOC(CCC,_FHS + MallocPtr_SIZE,MallocPtr_K); /* cc prof */ \ +#define makeForeignObjZh(r, liveness, mptr, finalise) \ +do { \ + P_ result; \ + \ + HEAP_CHK((W_)liveness, _FHS + ForeignObj_SIZE,0); \ + CC_ALLOC(CCC,_FHS + ForeignObj_SIZE,ForeignObj_K); /* cc prof */ \ \ - result = Hp + 1 - (_FHS + MallocPtr_SIZE); \ - SET_MallocPtr_HDR(result,MallocPtr_info,CCC,_FHS + MallocPtr_SIZE,0); \ - MallocPtr_CLOSURE_DATA(result) = mptr; \ - MallocPtr_CLOSURE_LINK(result) = StorageMgrInfo.MallocPtrList; \ - StorageMgrInfo.MallocPtrList = result; \ + result = Hp + 1 - (_FHS + ForeignObj_SIZE); \ + SET_ForeignObj_HDR(result,ForeignObj_info,CCC,_FHS + ForeignObj_SIZE,0); \ + ForeignObj_CLOSURE_DATA(result) = (P_)mptr; \ + ForeignObj_CLOSURE_FINALISER(result) = (P_)finalise; \ + ForeignObj_CLOSURE_LINK(result) = StorageMgrInfo.ForeignObjList; \ + StorageMgrInfo.ForeignObjList = result; \ + \ \ -/* \ - printf("DEBUG: MallocPtr(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]); \ -*/ \ - CHECK_MallocPtr_CLOSURE( result ); \ - VALIDATE_MallocPtrList( StorageMgrInfo.MallocPtrList ); \ + 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 constructMallocPtr(liveness, r, mptr) \ +#define makeForeignObjZh(r, liveness, mptr, finalise) \ +do { \ + fflush(stdout); \ + fprintf(stderr, "makeForeignObj#: no foreign object support.\n");\ + EXIT(EXIT_FAILURE); \ +} while(0) + +#define writeForeignObjZh(res,datum) \ do { \ fflush(stdout); \ - fprintf(stderr, "constructMallocPtr: no malloc pointer support.\n");\ + fprintf(stderr, "writeForeignObj#: no foreign object support.\n");\ EXIT(EXIT_FAILURE); \ } while(0)