X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=ghc%2Fincludes%2FPrimOps.h;h=ecc82bc1c02d1957705085b59dabc0a136831357;hp=e48f54bb555cb35c83594b8b0d64cd4bfd10714c;hb=d89872a45b581ba3f086c636126a44d97ef45be6;hpb=d11e681f219f6e38c2e5bc87adfb66f82de5ea65 diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h index e48f54b..ecc82bc 100644 --- a/ghc/includes/PrimOps.h +++ b/ghc/includes/PrimOps.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.h,v 1.86 2001/12/05 17:35:14 sewardj Exp $ + * $Id: PrimOps.h,v 1.102 2003/06/19 10:42:24 simonmar Exp $ * * (c) The GHC Team, 1998-2000 * @@ -28,66 +28,31 @@ * Int operations with carry. * -------------------------------------------------------------------------- */ -/* With some bit-twiddling, we can define int{Add,Sub}Czh portably in - * C, and without needing any comparisons. This may not be the - * fastest way to do it - if you have better code, please send it! --SDM - * - * Return : r = a + b, c = 0 if no overflow, 1 on overflow. - * - * We currently don't make use of the r value if c is != 0 (i.e. - * overflow), we just convert to big integers and try again. This - * could be improved by making r and c the correct values for - * plugging into a new J#. - */ -#define addIntCzh(r,c,a,b) \ -{ r = ((I_)(a)) + ((I_)(b)); \ - c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \ - >> (BITS_IN (I_) - 1); \ -} - - -#define subIntCzh(r,c,a,b) \ -{ r = ((I_)(a)) - ((I_)(b)); \ - c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \ - >> (BITS_IN (I_) - 1); \ -} - /* Multiply with overflow checking. * - * This is slightly more tricky - the usual sign rules for add/subtract - * don't apply. - * - * On x86 hardware we use a hand-crafted assembly fragment to do the job. + * This is tricky - the usual sign rules for add/subtract don't apply. * - * On other 32-bit machines we use gcc's 'long long' types, finding + * On 32-bit machines we use gcc's 'long long' types, finding * overflow with some careful bit-twiddling. * * On 64-bit machines where gcc's 'long long' type is also 64-bits, * we use a crude approximation, testing whether either operand is * larger than 32-bits; if neither is, then we go ahead with the * multiplication. + * + * Return non-zero if there is any possibility that the signed multiply + * of a and b might overflow. Return zero only if you are absolutely sure + * that it won't overflow. If in doubt, return non-zero. */ -#if i386_TARGET_ARCH - -#define mulIntCzh(r,c,a,b) \ -{ \ - __asm__("xorl %1,%1\n\t \ - imull %2,%3\n\t \ - jno 1f\n\t \ - movl $1,%1\n\t \ - 1:" \ - : "=r" (r), "=&r" (c) : "r" (a), "0" (b)); \ -} - -#elif SIZEOF_VOID_P == 4 +#if SIZEOF_VOID_P == 4 #ifdef WORDS_BIGENDIAN -#define C 0 -#define R 1 +#define RTS_CARRY_IDX__ 0 +#define RTS_REM_IDX__ 1 #else -#define C 1 -#define R 0 +#define RTS_CARRY_IDX__ 1 +#define RTS_REM_IDX__ 0 #endif typedef union { @@ -95,17 +60,20 @@ typedef union { StgInt32 i[2]; } long_long_u ; -#define mulIntCzh(r,c,a,b) \ -{ \ +#define mulIntMayOflo(a,b) \ +({ \ + StgInt32 r, c; \ long_long_u z; \ z.l = (StgInt64)a * (StgInt64)b; \ - r = z.i[R]; \ - c = z.i[C]; \ + r = z.i[RTS_REM_IDX__]; \ + c = z.i[RTS_CARRY_IDX__]; \ if (c == 0 || c == -1) { \ c = ((StgWord)((a^b) ^ r)) \ >> (BITS_IN (I_) - 1); \ } \ -} + c; \ +}) + /* Careful: the carry calculation above is extremely delicate. Make sure * you test it thoroughly after changing it. */ @@ -116,16 +84,17 @@ typedef union { #define stg_abs(a) (((I_)(a)) < 0 ? -((I_)(a)) : ((I_)(a))) -#define mulIntCzh(r,c,a,b) \ -{ \ +#define mulIntMayOflo(a,b) \ +({ \ + I_ c; \ if (stg_abs(a) >= HALF_INT || \ stg_abs(b) >= HALF_INT) { \ c = 1; \ } else { \ - r = ((I_)(a)) * ((I_)(b)); \ c = 0; \ } \ -} + c; \ +}) #endif @@ -180,53 +149,6 @@ EXTFUN_RTS(complementIntegerzh_fast); EXTFUN_RTS(int64ToIntegerzh_fast); EXTFUN_RTS(word64ToIntegerzh_fast); -/* The rest are (way!) out of line, implemented in vanilla C. */ -I_ stg_gtWord64 (StgWord64, StgWord64); -I_ stg_geWord64 (StgWord64, StgWord64); -I_ stg_eqWord64 (StgWord64, StgWord64); -I_ stg_neWord64 (StgWord64, StgWord64); -I_ stg_ltWord64 (StgWord64, StgWord64); -I_ stg_leWord64 (StgWord64, StgWord64); - -I_ stg_gtInt64 (StgInt64, StgInt64); -I_ stg_geInt64 (StgInt64, StgInt64); -I_ stg_eqInt64 (StgInt64, StgInt64); -I_ stg_neInt64 (StgInt64, StgInt64); -I_ stg_ltInt64 (StgInt64, StgInt64); -I_ stg_leInt64 (StgInt64, StgInt64); - -LW_ stg_remWord64 (StgWord64, StgWord64); -LW_ stg_quotWord64 (StgWord64, StgWord64); - -LI_ stg_remInt64 (StgInt64, StgInt64); -LI_ stg_quotInt64 (StgInt64, StgInt64); -LI_ stg_negateInt64 (StgInt64); -LI_ stg_plusInt64 (StgInt64, StgInt64); -LI_ stg_minusInt64 (StgInt64, StgInt64); -LI_ stg_timesInt64 (StgInt64, StgInt64); - -LW_ stg_and64 (StgWord64, StgWord64); -LW_ stg_or64 (StgWord64, StgWord64); -LW_ stg_xor64 (StgWord64, StgWord64); -LW_ stg_not64 (StgWord64); - -LW_ stg_shiftL64 (StgWord64, StgInt); -LW_ stg_shiftRL64 (StgWord64, StgInt); -LI_ stg_iShiftL64 (StgInt64, StgInt); -LI_ stg_iShiftRL64 (StgInt64, StgInt); -LI_ stg_iShiftRA64 (StgInt64, StgInt); - -LI_ stg_intToInt64 (StgInt); -I_ stg_int64ToInt (StgInt64); -LW_ stg_int64ToWord64 (StgInt64); - -LW_ stg_wordToWord64 (StgWord); -W_ stg_word64ToWord (StgWord64); -LI_ stg_word64ToInt64 (StgWord64); - -LI_ stg_integerToInt64 (I_ sa, StgByteArray /* Really: mp_limb_t* */ da); -LW_ stg_integerToWord64 (I_ sa, StgByteArray /* Really: mp_limb_t* */ da); - #endif /* ----------------------------------------------------------------------------- @@ -296,7 +218,7 @@ extern StgInt isFloatNegativeZero(StgFloat f); -------------------------------------------------------------------------- */ EXTFUN_RTS(newMutVarzh_fast); - +EXTFUN_RTS(atomicModifyMutVarzh_fast); /* ----------------------------------------------------------------------------- MVar PrimOps. @@ -319,6 +241,10 @@ EXTFUN_RTS(tryPutMVarzh_fast); EXTFUN_RTS(waitReadzh_fast); EXTFUN_RTS(waitWritezh_fast); EXTFUN_RTS(delayzh_fast); +#ifdef mingw32_TARGET_OS +EXTFUN_RTS(asyncReadzh_fast); +EXTFUN_RTS(asyncWritezh_fast); +#endif /* ----------------------------------------------------------------------------- @@ -327,8 +253,9 @@ EXTFUN_RTS(delayzh_fast); EXTFUN_RTS(catchzh_fast); EXTFUN_RTS(raisezh_fast); +EXTFUN_RTS(raiseIOzh_fast); -extern void stg_exit(I_ n) __attribute__ ((noreturn)); +extern void stg_exit(int n) __attribute__ ((noreturn)); /* ----------------------------------------------------------------------------- @@ -345,16 +272,17 @@ EXTFUN_RTS(deRefStablePtrzh_fast); -------------------------------------------------------------------------- */ EXTFUN_RTS(forkzh_fast); +EXTFUN_RTS(forkProcesszh_fast); EXTFUN_RTS(yieldzh_fast); EXTFUN_RTS(killThreadzh_fast); EXTFUN_RTS(seqzh_fast); EXTFUN_RTS(blockAsyncExceptionszh_fast); EXTFUN_RTS(unblockAsyncExceptionszh_fast); EXTFUN_RTS(myThreadIdzh_fast); +EXTFUN_RTS(labelThreadzh_fast); -extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2); -extern int rts_getThreadId(const StgTSO *tso); - +extern int cmp_thread(StgPtr tso1, StgPtr tso2); +extern int rts_getThreadId(StgPtr tso); /* ----------------------------------------------------------------------------- Weak Pointer PrimOps. @@ -373,27 +301,23 @@ EXTFUN_RTS(mkForeignObjzh_fast); /* ----------------------------------------------------------------------------- - BCOs and BCO linkery + Constructor tags -------------------------------------------------------------------------- */ -EXTFUN_RTS(newBCOzh_fast); -EXTFUN_RTS(mkApUpd0zh_fast); - +/* + * This macro is only used when compiling unregisterised code (see + * AbsCUtils.dsCOpStmt for motivation & the Story). + */ +#ifndef TABLES_NEXT_TO_CODE +# define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info)) +#endif /* ----------------------------------------------------------------------------- - Signal handling. Not really primops, but called directly from Haskell. + BCOs and BCO linkery -------------------------------------------------------------------------- */ -#define STG_SIG_DFL (-1) -#define STG_SIG_IGN (-2) -#define STG_SIG_ERR (-3) -#define STG_SIG_HAN (-4) - -extern StgInt stg_sig_install (StgInt, StgInt, StgStablePtr, sigset_t *); -#define stg_sig_default(sig,mask) stg_sig_install(sig,STG_SIG_DFL,0,(sigset_t *)mask) -#define stg_sig_ignore(sig,mask) stg_sig_install(sig,STG_SIG_IGN,0,(sigset_t *)mask) -#define stg_sig_catch(sig,ptr,mask) stg_sig_install(sig,STG_SIG_HAN,ptr,(sigset_t *)mask) - +EXTFUN_RTS(newBCOzh_fast); +EXTFUN_RTS(mkApUpd0zh_fast); /* ------------------------------------------------------------------------ Parallel PrimOps @@ -487,4 +411,9 @@ extern StgInt stg_sig_install (StgInt, StgInt, StgStablePtr, sigset_t *); #define parzh(r,node) r = 1 #endif +/* ----------------------------------------------------------------------------- + ForeignObj - the C backend still needs this. + -------------------------------------------------------------------------- */ +#define ForeignObj_CLOSURE_DATA(c) (((StgForeignObj *)c)->data) + #endif /* PRIMOPS_H */