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)
#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
%************************************************************************
%* *
-\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}
%* *
%************************************************************************
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);
#else /* CONCURRENT */
-extern void ReallyPerformThreadGC PROTO((W_, rtsBool));
+void ReallyPerformThreadGC PROTO((W_, rtsBool));
#define HEAP_OVERFLOW(liveness,n,reenter) \
do { \
#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))
#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}
%************************************************************************
\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))
+#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)
\end{code}
%************************************************************************
\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)
#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}
%************************************************************************
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}
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}
%************************************************************************
\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}
\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
} \
SET_INFO_PTR(node, EmptySVar_info); \
r = SVAR_VALUE(node); \
- SVAR_VALUE(node) = Prelude_Z91Z93_closure; \
+ SVAR_VALUE(node) = PrelBase_Z91Z93_closure; \
}
#endif
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; \
} \
}
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; \
} \
}
#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); \
} \
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); \
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); \
#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); \
}
#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); \
}
#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); \
}
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}
#define deRefStablePtrZh(ri,sp) \
ri = SAFESTGCALL2(I_,(void *, I_, P_),_deRefStablePointer,sp,StorageMgrInfo.StablePointerTable);
-
\end{code}
Declarations for other stable pointer operations.
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 { \
\begin{code}
#ifdef CONCURRENT
-ED_(Prelude_Z91Z93_closure);
+ED_(PrelBase_Z91Z93_closure);
ED_(True_closure);
#if defined(GRAN)
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 { \
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}
projects / ghc-hetmet.git / blobdiff