X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FStgMacros.lh;h=f4234aa12b72334d895425ab3cc35f47178659ec;hb=a6c7e7dc8d0c5626ea29c71c3fc957d33064697b;hp=f7b21b65ae85e0d81ee13e9571f533656bfbf451;hpb=7a3bd641457666e10d0a47be9f22762e03defbf0;p=ghc-hetmet.git diff --git a/ghc/includes/StgMacros.lh b/ghc/includes/StgMacros.lh index f7b21b6..f4234aa 100644 --- a/ghc/includes/StgMacros.lh +++ b/ghc/includes/StgMacros.lh @@ -457,6 +457,8 @@ I_ stg_div PROTO((I_ a, I_ b)); #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} %************************************************************************ @@ -872,7 +874,8 @@ 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" @@ -1160,6 +1163,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 +1272,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 +1292,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 +1317,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 +1345,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 +1374,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 +1415,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 +1462,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 +1494,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 +1549,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 +1576,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 +1607,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 +1668,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 +1877,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,6 +2019,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 +2055,6 @@ ED_RO_(vtbl_seq); r = 1; /* Should be unnecessary */ \ }) -#endif /* CONCURRENT */ \end{code} %************************************************************************ @@ -2093,18 +2104,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 +2126,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}