X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FStgMacros.lh;h=44d9a4d92dd6bc53ae0777a5f4550d14ac79b02b;hb=23c94851fb2c98d345d913d35a5a12bbc3a346bd;hp=f7b21b65ae85e0d81ee13e9571f533656bfbf451;hpb=7a3bd641457666e10d0a47be9f22762e03defbf0;p=ghc-hetmet.git diff --git a/ghc/includes/StgMacros.lh b/ghc/includes/StgMacros.lh index f7b21b6..44d9a4d 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,12 @@ 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} %************************************************************************ @@ -466,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) @@ -872,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 @@ -894,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) \ @@ -920,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) \ @@ -1160,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] @@ -1263,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} @@ -1283,17 +1297,17 @@ 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 @@ -1308,7 +1322,7 @@ 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 @@ -1336,18 +1350,18 @@ 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; \ } \ } @@ -1365,18 +1379,18 @@ 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; \ } \ } @@ -1406,11 +1420,11 @@ 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); \ } \ @@ -1453,12 +1467,12 @@ 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); \ @@ -1485,12 +1499,12 @@ 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); \ @@ -1540,12 +1554,12 @@ 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); \ } @@ -1567,12 +1581,12 @@ 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); \ } @@ -1598,12 +1612,12 @@ 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); \ } @@ -1659,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) @@ -1867,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) @@ -1966,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 @@ -2009,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. @@ -2043,7 +2060,6 @@ ED_RO_(vtbl_seq); r = 1; /* Should be unnecessary */ \ }) -#endif /* CONCURRENT */ \end{code} %************************************************************************ @@ -2093,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 { \ @@ -2113,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}