1 /* -----------------------------------------------------------------------------
2 * $Id: PrimOps.h,v 1.89 2001/12/14 15:26:16 sewardj Exp $
4 * (c) The GHC Team, 1998-2000
6 * Macros for primitive operations in STG-ish C code.
8 * ---------------------------------------------------------------------------*/
10 /* As of 5 Dec 01, this file no longer implements the primops, since they are
11 translated into standard C in compiler/absCSyn/AbsCUtils during the absC
12 flattening pass. Only {add,sub,mul}IntCzh remain untranslated. Most of
13 what is here is now EXTFUN_RTS declarations for the out-of-line primop
14 implementations which live in compiler/rts/PrimOps.hc.
22 #if WORD_SIZE_IN_BITS < 32
23 #error GHC C backend requires 32+-bit words
27 /* -----------------------------------------------------------------------------
28 * Int operations with carry.
29 * -------------------------------------------------------------------------- */
31 /* Multiply with overflow checking.
33 * This is tricky - the usual sign rules for add/subtract don't apply.
35 * On 32-bit machines we use gcc's 'long long' types, finding
36 * overflow with some careful bit-twiddling.
38 * On 64-bit machines where gcc's 'long long' type is also 64-bits,
39 * we use a crude approximation, testing whether either operand is
40 * larger than 32-bits; if neither is, then we go ahead with the
44 #if SIZEOF_VOID_P == 4
46 #ifdef WORDS_BIGENDIAN
59 #define mulIntMayOflo(a,b) \
63 z.l = (StgInt64)a * (StgInt64)b; \
66 if (c == 0 || c == -1) { \
67 c = ((StgWord)((a^b) ^ r)) \
68 >> (BITS_IN (I_) - 1); \
73 /* Careful: the carry calculation above is extremely delicate. Make sure
74 * you test it thoroughly after changing it.
79 #define HALF_INT (((I_)1) << (BITS_IN (I_) / 2))
81 #define stg_abs(a) (((I_)(a)) < 0 ? -((I_)(a)) : ((I_)(a)))
83 #define mulIntMayOflo(a,b) \
86 if (stg_abs(a) >= HALF_INT || \
87 stg_abs(b) >= HALF_INT) { \
97 /* -----------------------------------------------------------------------------
99 -------------------------------------------------------------------------- */
101 /* NOTE: gcdIntzh and gcdIntegerIntzh work only for positive inputs! */
103 /* Some of these are out-of-line: -------- */
105 /* Integer arithmetic */
106 EXTFUN_RTS(plusIntegerzh_fast);
107 EXTFUN_RTS(minusIntegerzh_fast);
108 EXTFUN_RTS(timesIntegerzh_fast);
109 EXTFUN_RTS(gcdIntegerzh_fast);
110 EXTFUN_RTS(quotRemIntegerzh_fast);
111 EXTFUN_RTS(quotIntegerzh_fast);
112 EXTFUN_RTS(remIntegerzh_fast);
113 EXTFUN_RTS(divExactIntegerzh_fast);
114 EXTFUN_RTS(divModIntegerzh_fast);
116 EXTFUN_RTS(cmpIntegerIntzh_fast);
117 EXTFUN_RTS(cmpIntegerzh_fast);
118 EXTFUN_RTS(integer2Intzh_fast);
119 EXTFUN_RTS(integer2Wordzh_fast);
120 EXTFUN_RTS(gcdIntegerIntzh_fast);
121 EXTFUN_RTS(gcdIntzh_fast);
124 EXTFUN_RTS(int2Integerzh_fast);
125 EXTFUN_RTS(word2Integerzh_fast);
127 /* Floating-point decodings */
128 EXTFUN_RTS(decodeFloatzh_fast);
129 EXTFUN_RTS(decodeDoublezh_fast);
132 EXTFUN_RTS(andIntegerzh_fast);
133 EXTFUN_RTS(orIntegerzh_fast);
134 EXTFUN_RTS(xorIntegerzh_fast);
135 EXTFUN_RTS(complementIntegerzh_fast);
138 /* -----------------------------------------------------------------------------
140 -------------------------------------------------------------------------- */
142 #ifdef SUPPORT_LONG_LONGS
145 EXTFUN_RTS(int64ToIntegerzh_fast);
146 EXTFUN_RTS(word64ToIntegerzh_fast);
148 /* The rest are (way!) out of line, implemented in vanilla C. */
149 I_ stg_gtWord64 (StgWord64, StgWord64);
150 I_ stg_geWord64 (StgWord64, StgWord64);
151 I_ stg_eqWord64 (StgWord64, StgWord64);
152 I_ stg_neWord64 (StgWord64, StgWord64);
153 I_ stg_ltWord64 (StgWord64, StgWord64);
154 I_ stg_leWord64 (StgWord64, StgWord64);
156 I_ stg_gtInt64 (StgInt64, StgInt64);
157 I_ stg_geInt64 (StgInt64, StgInt64);
158 I_ stg_eqInt64 (StgInt64, StgInt64);
159 I_ stg_neInt64 (StgInt64, StgInt64);
160 I_ stg_ltInt64 (StgInt64, StgInt64);
161 I_ stg_leInt64 (StgInt64, StgInt64);
163 LW_ stg_remWord64 (StgWord64, StgWord64);
164 LW_ stg_quotWord64 (StgWord64, StgWord64);
166 LI_ stg_remInt64 (StgInt64, StgInt64);
167 LI_ stg_quotInt64 (StgInt64, StgInt64);
168 LI_ stg_negateInt64 (StgInt64);
169 LI_ stg_plusInt64 (StgInt64, StgInt64);
170 LI_ stg_minusInt64 (StgInt64, StgInt64);
171 LI_ stg_timesInt64 (StgInt64, StgInt64);
173 LW_ stg_and64 (StgWord64, StgWord64);
174 LW_ stg_or64 (StgWord64, StgWord64);
175 LW_ stg_xor64 (StgWord64, StgWord64);
176 LW_ stg_not64 (StgWord64);
178 LW_ stg_uncheckedShiftL64 (StgWord64, StgInt);
179 LW_ stg_uncheckedShiftRL64 (StgWord64, StgInt);
180 LI_ stg_uncheckedIShiftL64 (StgInt64, StgInt);
181 LI_ stg_uncheckedIShiftRL64 (StgInt64, StgInt);
182 LI_ stg_uncheckedIShiftRA64 (StgInt64, StgInt);
184 LI_ stg_intToInt64 (StgInt);
185 I_ stg_int64ToInt (StgInt64);
186 LW_ stg_int64ToWord64 (StgInt64);
188 LW_ stg_wordToWord64 (StgWord);
189 W_ stg_word64ToWord (StgWord64);
190 LI_ stg_word64ToInt64 (StgWord64);
192 LI_ stg_integerToInt64 (I_ sa, StgByteArray /* Really: mp_limb_t* */ da);
193 LW_ stg_integerToWord64 (I_ sa, StgByteArray /* Really: mp_limb_t* */ da);
197 /* -----------------------------------------------------------------------------
199 -------------------------------------------------------------------------- */
201 /* We cast to void* instead of StgChar* because this avoids a warning
202 * about increasing the alignment requirements.
204 #define REAL_BYTE_ARR_CTS(a) ((void *) (((StgArrWords *)(a))->payload))
205 #define REAL_PTRS_ARR_CTS(a) ((P_) (((StgMutArrPtrs *)(a))->payload))
208 #define BYTE_ARR_CTS(a) \
209 ({ ASSERT(GET_INFO((StgArrWords *)(a)) == &stg_ARR_WORDS_info); \
210 REAL_BYTE_ARR_CTS(a); })
211 #define PTRS_ARR_CTS(a) \
212 ({ ASSERT((GET_INFO((StgMutArrPtrs *)(a)) == &stg_MUT_ARR_PTRS_FROZEN_info) \
213 || (GET_INFO((StgMutArrPtrs *)(a)) == &stg_MUT_ARR_PTRS_info)); \
214 REAL_PTRS_ARR_CTS(a); })
216 #define BYTE_ARR_CTS(a) REAL_BYTE_ARR_CTS(a)
217 #define PTRS_ARR_CTS(a) REAL_PTRS_ARR_CTS(a)
221 extern I_ genSymZh(void);
222 extern I_ resetGenSymZh(void);
224 /*--- Almost everything in line. */
226 EXTFUN_RTS(unsafeThawArrayzh_fast);
227 EXTFUN_RTS(newByteArrayzh_fast);
228 EXTFUN_RTS(newPinnedByteArrayzh_fast);
229 EXTFUN_RTS(newArrayzh_fast);
231 /* The decode operations are out-of-line because they need to allocate
235 /* We only support IEEE floating point formats. */
236 #include "ieee-flpt.h"
237 EXTFUN_RTS(decodeFloatzh_fast);
238 EXTFUN_RTS(decodeDoublezh_fast);
240 /* grimy low-level support functions defined in StgPrimFloat.c */
241 extern StgDouble __encodeDouble (I_ size, StgByteArray arr, I_ e);
242 extern StgDouble __int_encodeDouble (I_ j, I_ e);
243 extern StgFloat __encodeFloat (I_ size, StgByteArray arr, I_ e);
244 extern StgFloat __int_encodeFloat (I_ j, I_ e);
245 extern void __decodeDouble (MP_INT *man, I_ *_exp, StgDouble dbl);
246 extern void __decodeFloat (MP_INT *man, I_ *_exp, StgFloat flt);
247 extern StgInt isDoubleNaN(StgDouble d);
248 extern StgInt isDoubleInfinite(StgDouble d);
249 extern StgInt isDoubleDenormalized(StgDouble d);
250 extern StgInt isDoubleNegativeZero(StgDouble d);
251 extern StgInt isFloatNaN(StgFloat f);
252 extern StgInt isFloatInfinite(StgFloat f);
253 extern StgInt isFloatDenormalized(StgFloat f);
254 extern StgInt isFloatNegativeZero(StgFloat f);
257 /* -----------------------------------------------------------------------------
260 newMutVar is out of line.
261 -------------------------------------------------------------------------- */
263 EXTFUN_RTS(newMutVarzh_fast);
266 /* -----------------------------------------------------------------------------
269 All out of line, because they either allocate or may block.
270 -------------------------------------------------------------------------- */
272 EXTFUN_RTS(isEmptyMVarzh_fast);
273 EXTFUN_RTS(newMVarzh_fast);
274 EXTFUN_RTS(takeMVarzh_fast);
275 EXTFUN_RTS(putMVarzh_fast);
276 EXTFUN_RTS(tryTakeMVarzh_fast);
277 EXTFUN_RTS(tryPutMVarzh_fast);
280 /* -----------------------------------------------------------------------------
282 -------------------------------------------------------------------------- */
284 EXTFUN_RTS(waitReadzh_fast);
285 EXTFUN_RTS(waitWritezh_fast);
286 EXTFUN_RTS(delayzh_fast);
289 /* -----------------------------------------------------------------------------
290 Primitive I/O, error-handling PrimOps
291 -------------------------------------------------------------------------- */
293 EXTFUN_RTS(catchzh_fast);
294 EXTFUN_RTS(raisezh_fast);
296 extern void stg_exit(I_ n) __attribute__ ((noreturn));
299 /* -----------------------------------------------------------------------------
300 Stable Name / Stable Pointer PrimOps
301 -------------------------------------------------------------------------- */
303 EXTFUN_RTS(makeStableNamezh_fast);
304 EXTFUN_RTS(makeStablePtrzh_fast);
305 EXTFUN_RTS(deRefStablePtrzh_fast);
308 /* -----------------------------------------------------------------------------
309 Concurrency/Exception PrimOps.
310 -------------------------------------------------------------------------- */
312 EXTFUN_RTS(forkzh_fast);
313 EXTFUN_RTS(yieldzh_fast);
314 EXTFUN_RTS(killThreadzh_fast);
315 EXTFUN_RTS(seqzh_fast);
316 EXTFUN_RTS(blockAsyncExceptionszh_fast);
317 EXTFUN_RTS(unblockAsyncExceptionszh_fast);
318 EXTFUN_RTS(myThreadIdzh_fast);
320 extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2);
321 extern int rts_getThreadId(const StgTSO *tso);
324 /* -----------------------------------------------------------------------------
325 Weak Pointer PrimOps.
326 -------------------------------------------------------------------------- */
328 EXTFUN_RTS(mkWeakzh_fast);
329 EXTFUN_RTS(finalizzeWeakzh_fast);
330 EXTFUN_RTS(deRefWeakzh_fast);
333 /* -----------------------------------------------------------------------------
334 Foreign Object PrimOps.
335 -------------------------------------------------------------------------- */
337 EXTFUN_RTS(mkForeignObjzh_fast);
340 /* -----------------------------------------------------------------------------
342 -------------------------------------------------------------------------- */
344 EXTFUN_RTS(newBCOzh_fast);
345 EXTFUN_RTS(mkApUpd0zh_fast);
348 /* -----------------------------------------------------------------------------
349 Signal handling. Not really primops, but called directly from Haskell.
350 -------------------------------------------------------------------------- */
352 #define STG_SIG_DFL (-1)
353 #define STG_SIG_IGN (-2)
354 #define STG_SIG_ERR (-3)
355 #define STG_SIG_HAN (-4)
357 extern StgInt stg_sig_install (StgInt, StgInt, StgStablePtr, sigset_t *);
358 #define stg_sig_default(sig,mask) stg_sig_install(sig,STG_SIG_DFL,0,(sigset_t *)mask)
359 #define stg_sig_ignore(sig,mask) stg_sig_install(sig,STG_SIG_IGN,0,(sigset_t *)mask)
360 #define stg_sig_catch(sig,ptr,mask) stg_sig_install(sig,STG_SIG_HAN,ptr,(sigset_t *)mask)
363 /* ------------------------------------------------------------------------
366 A par in the Haskell code is ultimately translated to a parzh macro
367 (with a case wrapped around it to guarantee that the macro is actually
368 executed; see compiler/prelude/PrimOps.lhs)
369 In GUM and SMP we only add a pointer to the spark pool.
370 In GranSim we call an RTS fct, forwarding additional parameters which
371 supply info on granularity of the computation, size of the result value
372 and the degree of parallelism in the sparked expression.
373 ---------------------------------------------------------------------- */
377 #define parzh(r,node) parAny(r,node,1,0,0,0,0,0)
380 #define parAtzh(r,node,where,identifier,gran_info,size_info,par_info,rest) \
381 parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,1)
384 #define parAtAbszh(r,node,proc,identifier,gran_info,size_info,par_info,rest) \
385 parAT(r,node,proc,identifier,gran_info,size_info,par_info,rest,2)
388 #define parAtRelzh(r,node,proc,identifier,gran_info,size_info,par_info,rest) \
389 parAT(r,node,proc,identifier,gran_info,size_info,par_info,rest,3)
391 //@cindex _parAtForNow_
392 #define parAtForNowzh(r,node,where,identifier,gran_info,size_info,par_info,rest) \
393 parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,0)
395 #define parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,local) \
397 if (closure_SHOULD_SPARK((StgClosure*)node)) { \
401 STGCALL6(newSpark, node,identifier,gran_info,size_info,par_info,local); \
403 case 2: p = where; /* parAtAbs means absolute PE no. expected */ \
405 case 3: p = CurrentProc+where; /* parAtRel means rel PE no. expected */\
407 default: p = where_is(where); /* parAt means closure expected */ \
410 /* update GranSim state according to this spark */ \
411 STGCALL3(GranSimSparkAtAbs, result, (I_)p, identifier); \
416 #define parLocalzh(r,node,identifier,gran_info,size_info,par_info,rest) \
417 parAny(r,node,rest,identifier,gran_info,size_info,par_info,1)
419 //@cindex _parGlobal_
420 #define parGlobalzh(r,node,identifier,gran_info,size_info,par_info,rest) \
421 parAny(r,node,rest,identifier,gran_info,size_info,par_info,0)
423 #define parAny(r,node,rest,identifier,gran_info,size_info,par_info,local) \
425 if (closure_SHOULD_SPARK((StgClosure*)node)) { \
427 result = RET_STGCALL6(rtsSpark*, newSpark, \
428 node,identifier,gran_info,size_info,par_info,local);\
429 STGCALL1(add_to_spark_queue,result); \
430 STGCALL2(GranSimSpark, local,(P_)node); \
434 #define copyablezh(r,node) \
435 /* copyable not yet implemented!! */
437 #define noFollowzh(r,node) \
438 /* noFollow not yet implemented!! */
440 #elif defined(SMP) || defined(PAR)
442 #define parzh(r,node) \
444 extern unsigned int context_switch; \
445 if (closure_SHOULD_SPARK((StgClosure *)node) && \
446 SparkTl < SparkLim) { \
447 *SparkTl++ = (StgClosure *)(node); \
449 r = context_switch = 1; \
451 #else /* !GRAN && !SMP && !PAR */
452 #define parzh(r,node) r = 1
455 /* -----------------------------------------------------------------------------
456 ForeignObj - the C backend still needs this.
457 -------------------------------------------------------------------------- */
458 #define ForeignObj_CLOSURE_DATA(c) (((StgForeignObj *)c)->data)
460 #endif /* PRIMOPS_H */