[project @ 1998-02-05 12:23:33 by simonm]
[ghc-hetmet.git] / ghc / includes / StgMacros.lh
index f7b21b6..44d9a4d 100644 (file)
@@ -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}