-/* Creating and destroying an adjustor thunk.
- I cannot make myself create a separate .h file
- for these two (sof.)
-
-*/
-extern void* createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr);
-extern void freeHaskellFunctionPtr(void* ptr);
+/* -----------------------------------------------------------------------------
+ Integer multiply with overflow
+ -------------------------------------------------------------------------- */
+
+/* Multiply with overflow checking.
+ *
+ * This is tricky - the usual sign rules for add/subtract don't apply.
+ *
+ * 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 SIZEOF_VOID_P == 4
+
+#ifdef WORDS_BIGENDIAN
+#define RTS_CARRY_IDX__ 0
+#define RTS_REM_IDX__ 1
+#else
+#define RTS_CARRY_IDX__ 1
+#define RTS_REM_IDX__ 0
+#endif
+
+typedef union {
+ StgInt64 l;
+ StgInt32 i[2];
+} long_long_u ;
+
+#define mulIntMayOflo(a,b) \
+({ \
+ StgInt32 r, c; \
+ long_long_u z; \
+ z.l = (StgInt64)a * (StgInt64)b; \
+ 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.
+ */
+
+#else
+
+#define HALF_INT (((I_)1) << (BITS_IN (I_) / 2))
+
+#define stg_abs(a) (((I_)(a)) < 0 ? -((I_)(a)) : ((I_)(a)))
+
+#define mulIntMayOflo(a,b) \
+({ \
+ I_ c; \
+ if (stg_abs(a) >= HALF_INT || \
+ stg_abs(b) >= HALF_INT) { \
+ c = 1; \
+ } else { \
+ c = 0; \
+ } \
+ c; \
+})
+#endif