Commit 1b61c2db authored by Duncan Coutts's avatar Duncan Coutts

Remove the implementation of gmp primops from the rts

parent 0f10e070
......@@ -205,7 +205,6 @@ DLL_IMPORT_RTS extern char *prog_name;
extern void stackOverflow(void);
extern void __decodeDouble (MP_INT *man, I_ *_exp, StgDouble dbl);
extern void __decodeDouble_2Int (I_ *man_sign, W_ *man_high, W_ *man_low, I_ *exp, StgDouble dbl);
extern void __decodeFloat_Int (I_ *man, I_ *exp, StgFloat flt);
......
......@@ -422,11 +422,5 @@ main(int argc, char *argv[])
struct_field(StgAsyncIOResult, errCode);
#endif
struct_size(MP_INT);
struct_field(MP_INT,_mp_alloc);
struct_field(MP_INT,_mp_size);
struct_field(MP_INT,_mp_d);
ctype(mp_limb_t);
return 0;
}
......@@ -537,23 +537,6 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(stg_ap_pppppp_ret)
#endif
/* On Windows, we link libgmp.a statically into libHSrts.dll */
#ifdef mingw32_HOST_OS
#define GMP_SYMS \
SymI_HasProto(__gmpz_cmp) \
SymI_HasProto(__gmpz_cmp_si) \
SymI_HasProto(__gmpz_cmp_ui) \
SymI_HasProto(__gmpz_get_si) \
SymI_HasProto(__gmpz_get_ui)
#else
#define GMP_SYMS \
SymE_HasProto(__gmpz_cmp) \
SymE_HasProto(__gmpz_cmp_si) \
SymE_HasProto(__gmpz_cmp_ui) \
SymE_HasProto(__gmpz_get_si) \
SymE_HasProto(__gmpz_get_ui)
#endif
#define RTS_SYMBOLS \
Maybe_Stable_Names \
SymI_HasProto(StgReturn) \
......@@ -591,13 +574,11 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(OutOfHeapHook) \
SymI_HasProto(StackOverflowHook) \
SymI_HasProto(addDLL) \
GMP_SYMS \
SymI_HasProto(__int_encodeDouble) \
SymI_HasProto(__word_encodeDouble) \
SymI_HasProto(__2Int_encodeDouble) \
SymI_HasProto(__int_encodeFloat) \
SymI_HasProto(__word_encodeFloat) \
SymI_HasProto(andIntegerzh_fast) \
SymI_HasProto(atomicallyzh_fast) \
SymI_HasProto(barf) \
SymI_HasProto(debugBelch) \
......@@ -611,11 +592,7 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(checkzh_fast) \
SymI_HasProto(closure_flags) \
SymI_HasProto(cmp_thread) \
SymI_HasProto(cmpIntegerzh_fast) \
SymI_HasProto(cmpIntegerIntzh_fast) \
SymI_HasProto(complementIntegerzh_fast) \
SymI_HasProto(createAdjustor) \
SymI_HasProto(decodeDoublezh_fast) \
SymI_HasProto(decodeDoublezu2Intzh_fast) \
SymI_HasProto(decodeFloatzuIntzh_fast) \
SymI_HasProto(defaultsHook) \
......@@ -623,8 +600,6 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(deRefWeakzh_fast) \
SymI_HasProto(deRefStablePtrzh_fast) \
SymI_HasProto(dirty_MUT_VAR) \
SymI_HasProto(divExactIntegerzh_fast) \
SymI_HasProto(divModIntegerzh_fast) \
SymI_HasProto(forkzh_fast) \
SymI_HasProto(forkOnzh_fast) \
SymI_HasProto(forkProcess) \
......@@ -633,9 +608,6 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(freeStablePtr) \
SymI_HasProto(getOrSetTypeableStore) \
SymI_HasProto(getOrSetSignalHandlerStore) \
SymI_HasProto(gcdIntegerzh_fast) \
SymI_HasProto(gcdIntegerIntzh_fast) \
SymI_HasProto(gcdIntzh_fast) \
SymI_HasProto(genSymZh) \
SymI_HasProto(genericRaise) \
SymI_HasProto(getProgArgv) \
......@@ -654,9 +626,6 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(unpackClosurezh_fast) \
SymI_HasProto(getApStackValzh_fast) \
SymI_HasProto(getSparkzh_fast) \
SymI_HasProto(int2Integerzh_fast) \
SymI_HasProto(integer2Intzh_fast) \
SymI_HasProto(integer2Wordzh_fast) \
SymI_HasProto(isCurrentThreadBoundzh_fast) \
SymI_HasProto(isDoubleDenormalized) \
SymI_HasProto(isDoubleInfinite) \
......@@ -673,7 +642,6 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(insertSymbol) \
SymI_HasProto(lookupSymbol) \
SymI_HasProto(makeStablePtrzh_fast) \
SymI_HasProto(minusIntegerzh_fast) \
SymI_HasProto(mkApUpd0zh_fast) \
SymI_HasProto(myThreadIdzh_fast) \
SymI_HasProto(labelThreadzh_fast) \
......@@ -689,20 +657,15 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(newPinnedByteArrayzh_fast) \
SymI_HasProto(newAlignedPinnedByteArrayzh_fast) \
SymI_HasProto(newSpark) \
SymI_HasProto(orIntegerzh_fast) \
SymI_HasProto(performGC) \
SymI_HasProto(performMajorGC) \
SymI_HasProto(plusIntegerzh_fast) \
SymI_HasProto(prog_argc) \
SymI_HasProto(prog_argv) \
SymI_HasProto(putMVarzh_fast) \
SymI_HasProto(quotIntegerzh_fast) \
SymI_HasProto(quotRemIntegerzh_fast) \
SymI_HasProto(raisezh_fast) \
SymI_HasProto(raiseIOzh_fast) \
SymI_HasProto(readTVarzh_fast) \
SymI_HasProto(readTVarIOzh_fast) \
SymI_HasProto(remIntegerzh_fast) \
SymI_HasProto(resetNonBlockingFd) \
SymI_HasProto(resumeThread) \
SymI_HasProto(resolveObjs) \
......@@ -833,7 +796,6 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(suspendThread) \
SymI_HasProto(takeMVarzh_fast) \
SymI_HasProto(threadStatuszh_fast) \
SymI_HasProto(timesIntegerzh_fast) \
SymI_HasProto(tryPutMVarzh_fast) \
SymI_HasProto(tryTakeMVarzh_fast) \
SymI_HasProto(unblockAsyncExceptionszh_fast) \
......@@ -841,9 +803,7 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(unsafeThawArrayzh_fast) \
SymI_HasProto(waitReadzh_fast) \
SymI_HasProto(waitWritezh_fast) \
SymI_HasProto(word2Integerzh_fast) \
SymI_HasProto(writeTVarzh_fast) \
SymI_HasProto(xorIntegerzh_fast) \
SymI_HasProto(yieldzh_fast) \
SymI_NeedsProto(stg_interp_constr_entry) \
SymI_HasProto(alloc_blocks) \
......@@ -862,13 +822,6 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(traceCcszh_fast) \
RTS_USER_SIGNALS_SYMBOLS
#ifdef SUPPORT_LONG_LONGS
#define RTS_LONG_LONG_SYMS \
SymI_HasProto(int64ToIntegerzh_fast) \
SymI_HasProto(word64ToIntegerzh_fast)
#else
#define RTS_LONG_LONG_SYMS /* nothing */
#endif
// 64-bit support functions in libgcc.a
#if defined(__GNUC__) && SIZEOF_VOID_P <= 4
......@@ -916,7 +869,6 @@ typedef struct _RtsSymbolVal {
#define SymI_HasProto_redirect(vvv,xxx) /**/
RTS_SYMBOLS
RTS_RET_SYMBOLS
RTS_LONG_LONG_SYMS
RTS_POSIX_ONLY_SYMBOLS
RTS_MINGW_ONLY_SYMBOLS
RTS_CYGWIN_ONLY_SYMBOLS
......@@ -952,7 +904,6 @@ RTS_LIBFFI_SYMBOLS
static RtsSymbolVal rtsSyms[] = {
RTS_SYMBOLS
RTS_RET_SYMBOLS
RTS_LONG_LONG_SYMS
RTS_POSIX_ONLY_SYMBOLS
RTS_MINGW_ONLY_SYMBOLS
RTS_CYGWIN_ONLY_SYMBOLS
......
......@@ -28,24 +28,6 @@
#include "Cmm.h"
#ifdef __PIC__
#ifndef mingw32_HOST_OS
import __gmpz_init;
import __gmpz_add;
import __gmpz_sub;
import __gmpz_mul;
import __gmpz_gcd;
import __gmpn_gcd_1;
import __gmpn_cmp;
import __gmpz_tdiv_q;
import __gmpz_tdiv_r;
import __gmpz_tdiv_qr;
import __gmpz_fdiv_qr;
import __gmpz_divexact;
import __gmpz_and;
import __gmpz_xor;
import __gmpz_ior;
import __gmpz_com;
#endif
import pthread_mutex_lock;
import pthread_mutex_unlock;
#endif
......@@ -470,470 +452,9 @@ deRefWeakzh_fast
}
/* -----------------------------------------------------------------------------
Arbitrary-precision Integer operations.
There are some assumptions in this code that mp_limb_t == W_. This is
the case for all the platforms that GHC supports, currently.
Floating point operations.
-------------------------------------------------------------------------- */
int2Integerzh_fast
{
/* arguments: R1 = Int# */
W_ val, s, p; /* to avoid aliasing */
val = R1;
ALLOC_PRIM( SIZEOF_StgArrWords + WDS(1), NO_PTRS, int2Integerzh_fast );
p = Hp - SIZEOF_StgArrWords;
SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
StgArrWords_words(p) = 1;
/* mpz_set_si is inlined here, makes things simpler */
if (%lt(val,0)) {
s = -1;
Hp(0) = -val;
} else {
if (%gt(val,0)) {
s = 1;
Hp(0) = val;
} else {
s = 0;
}
}
/* returns (# size :: Int#,
data :: ByteArray#
#)
*/
RET_NP(s,p);
}
word2Integerzh_fast
{
/* arguments: R1 = Word# */
W_ val, s, p; /* to avoid aliasing */
val = R1;
ALLOC_PRIM( SIZEOF_StgArrWords + WDS(1), NO_PTRS, word2Integerzh_fast);
p = Hp - SIZEOF_StgArrWords;
SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
StgArrWords_words(p) = 1;
if (val != 0) {
s = 1;
W_[Hp] = val;
} else {
s = 0;
}
/* returns (# size :: Int#,
data :: ByteArray# #)
*/
RET_NP(s,p);
}
/*
* 'long long' primops for converting to/from Integers.
*/
#ifdef SUPPORT_LONG_LONGS
int64ToIntegerzh_fast
{
/* arguments: L1 = Int64# */
L_ val;
W_ hi, lo, s, neg, words_needed, p;
val = L1;
neg = 0;
hi = TO_W_(val >> 32);
lo = TO_W_(val);
if ( hi == 0 || (hi == 0xFFFFFFFF && lo != 0) ) {
// minimum is one word
words_needed = 1;
} else {
words_needed = 2;
}
ALLOC_PRIM( SIZEOF_StgArrWords + WDS(words_needed),
NO_PTRS, int64ToIntegerzh_fast );
p = Hp - SIZEOF_StgArrWords - WDS(words_needed) + WDS(1);
SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
StgArrWords_words(p) = words_needed;
if ( %lt(hi,0) ) {
neg = 1;
lo = -lo;
if(lo == 0) {
hi = -hi;
} else {
hi = -hi - 1;
}
}
if ( words_needed == 2 ) {
s = 2;
Hp(-1) = lo;
Hp(0) = hi;
} else {
if ( lo != 0 ) {
s = 1;
Hp(0) = lo;
} else /* val==0 */ {
s = 0;
}
}
if ( neg != 0 ) {
s = -s;
}
/* returns (# size :: Int#,
data :: ByteArray# #)
*/
RET_NP(s,p);
}
word64ToIntegerzh_fast
{
/* arguments: L1 = Word64# */
L_ val;
W_ hi, lo, s, words_needed, p;
val = L1;
hi = TO_W_(val >> 32);
lo = TO_W_(val);
if ( hi != 0 ) {
words_needed = 2;
} else {
words_needed = 1;
}
ALLOC_PRIM( SIZEOF_StgArrWords + WDS(words_needed),
NO_PTRS, word64ToIntegerzh_fast );
p = Hp - SIZEOF_StgArrWords - WDS(words_needed) + WDS(1);
SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
StgArrWords_words(p) = words_needed;
if ( hi != 0 ) {
s = 2;
Hp(-1) = lo;
Hp(0) = hi;
} else {
if ( lo != 0 ) {
s = 1;
Hp(0) = lo;
} else /* val==0 */ {
s = 0;
}
}
/* returns (# size :: Int#,
data :: ByteArray# #)
*/
RET_NP(s,p);
}
#endif /* SUPPORT_LONG_LONGS */
#define GMP_TAKE2_RET1(name,mp_fun) \
name \
{ \
CInt s1, s2; \
W_ d1, d2; \
W_ mp_tmp1; \
W_ mp_tmp2; \
W_ mp_result1; \
W_ mp_result2; \
\
/* call doYouWantToGC() */ \
MAYBE_GC(R2_PTR & R4_PTR, name); \
\
STK_CHK_GEN( 4 * SIZEOF_MP_INT, R2_PTR & R4_PTR, name ); \
\
s1 = W_TO_INT(R1); \
d1 = R2; \
s2 = W_TO_INT(R3); \
d2 = R4; \
\
mp_tmp1 = Sp - 1 * SIZEOF_MP_INT; \
mp_tmp2 = Sp - 2 * SIZEOF_MP_INT; \
mp_result1 = Sp - 3 * SIZEOF_MP_INT; \
mp_result2 = Sp - 4 * SIZEOF_MP_INT; \
MP_INT__mp_alloc(mp_tmp1) = W_TO_INT(StgArrWords_words(d1)); \
MP_INT__mp_size(mp_tmp1) = (s1); \
MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(d1); \
MP_INT__mp_alloc(mp_tmp2) = W_TO_INT(StgArrWords_words(d2)); \
MP_INT__mp_size(mp_tmp2) = (s2); \
MP_INT__mp_d(mp_tmp2) = BYTE_ARR_CTS(d2); \
\
foreign "C" __gmpz_init(mp_result1 "ptr") []; \
\
/* Perform the operation */ \
foreign "C" mp_fun(mp_result1 "ptr",mp_tmp1 "ptr",mp_tmp2 "ptr") []; \
\
RET_NP(TO_W_(MP_INT__mp_size(mp_result1)), \
MP_INT__mp_d(mp_result1) - SIZEOF_StgArrWords); \
}
#define GMP_TAKE1_RET1(name,mp_fun) \
name \
{ \
CInt s1; \
W_ d1; \
W_ mp_tmp1; \
W_ mp_result1; \
\
/* call doYouWantToGC() */ \
MAYBE_GC(R2_PTR, name); \
\
STK_CHK_GEN( 2 * SIZEOF_MP_INT, R2_PTR, name ); \
\
d1 = R2; \
s1 = W_TO_INT(R1); \
\
mp_tmp1 = Sp - 1 * SIZEOF_MP_INT; \
mp_result1 = Sp - 2 * SIZEOF_MP_INT; \
MP_INT__mp_alloc(mp_tmp1) = W_TO_INT(StgArrWords_words(d1)); \
MP_INT__mp_size(mp_tmp1) = (s1); \
MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(d1); \
\
foreign "C" __gmpz_init(mp_result1 "ptr") []; \
\
/* Perform the operation */ \
foreign "C" mp_fun(mp_result1 "ptr",mp_tmp1 "ptr") []; \
\
RET_NP(TO_W_(MP_INT__mp_size(mp_result1)), \
MP_INT__mp_d(mp_result1) - SIZEOF_StgArrWords); \
}
#define GMP_TAKE2_RET2(name,mp_fun) \
name \
{ \
CInt s1, s2; \
W_ d1, d2; \
W_ mp_tmp1; \
W_ mp_tmp2; \
W_ mp_result1; \
W_ mp_result2; \
\
/* call doYouWantToGC() */ \
MAYBE_GC(R2_PTR & R4_PTR, name); \
\
STK_CHK_GEN( 4 * SIZEOF_MP_INT, R2_PTR & R4_PTR, name ); \
\
s1 = W_TO_INT(R1); \
d1 = R2; \
s2 = W_TO_INT(R3); \
d2 = R4; \
\
mp_tmp1 = Sp - 1 * SIZEOF_MP_INT; \
mp_tmp2 = Sp - 2 * SIZEOF_MP_INT; \
mp_result1 = Sp - 3 * SIZEOF_MP_INT; \
mp_result2 = Sp - 4 * SIZEOF_MP_INT; \
MP_INT__mp_alloc(mp_tmp1) = W_TO_INT(StgArrWords_words(d1)); \
MP_INT__mp_size(mp_tmp1) = (s1); \
MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(d1); \
MP_INT__mp_alloc(mp_tmp2) = W_TO_INT(StgArrWords_words(d2)); \
MP_INT__mp_size(mp_tmp2) = (s2); \
MP_INT__mp_d(mp_tmp2) = BYTE_ARR_CTS(d2); \
\
foreign "C" __gmpz_init(mp_result1 "ptr") []; \
foreign "C" __gmpz_init(mp_result2 "ptr") []; \
\
/* Perform the operation */ \
foreign "C" mp_fun(mp_result1 "ptr",mp_result2 "ptr",mp_tmp1 "ptr",mp_tmp2 "ptr") []; \
\
RET_NPNP(TO_W_(MP_INT__mp_size(mp_result1)), \
MP_INT__mp_d(mp_result1) - SIZEOF_StgArrWords, \
TO_W_(MP_INT__mp_size(mp_result2)), \
MP_INT__mp_d(mp_result2) - SIZEOF_StgArrWords); \
}
GMP_TAKE2_RET1(plusIntegerzh_fast, __gmpz_add)
GMP_TAKE2_RET1(minusIntegerzh_fast, __gmpz_sub)
GMP_TAKE2_RET1(timesIntegerzh_fast, __gmpz_mul)
GMP_TAKE2_RET1(gcdIntegerzh_fast, __gmpz_gcd)
GMP_TAKE2_RET1(quotIntegerzh_fast, __gmpz_tdiv_q)
GMP_TAKE2_RET1(remIntegerzh_fast, __gmpz_tdiv_r)
GMP_TAKE2_RET1(divExactIntegerzh_fast, __gmpz_divexact)
GMP_TAKE2_RET1(andIntegerzh_fast, __gmpz_and)
GMP_TAKE2_RET1(orIntegerzh_fast, __gmpz_ior)
GMP_TAKE2_RET1(xorIntegerzh_fast, __gmpz_xor)
GMP_TAKE1_RET1(complementIntegerzh_fast, __gmpz_com)
GMP_TAKE2_RET2(quotRemIntegerzh_fast, __gmpz_tdiv_qr)
GMP_TAKE2_RET2(divModIntegerzh_fast, __gmpz_fdiv_qr)
gcdIntzh_fast
{
/* R1 = the first Int#; R2 = the second Int# */
W_ r;
W_ mp_tmp_w;
STK_CHK_GEN( 1 * SIZEOF_MP_INT, NO_PTRS, gcdIntzh_fast );
mp_tmp_w = Sp - 1 * SIZEOF_MP_INT;
W_[mp_tmp_w] = R1;
(r) = foreign "C" __gmpn_gcd_1(mp_tmp_w "ptr", 1, R2) [];
R1 = r;
/* Result parked in R1, return via info-pointer at TOS */
jump %ENTRY_CODE(Sp(0));
}
gcdIntegerIntzh_fast
{
/* R1 = s1; R2 = d1; R3 = the int */
W_ s1;
(s1) = foreign "C" __gmpn_gcd_1( BYTE_ARR_CTS(R2) "ptr", R1, R3) [];
R1 = s1;
/* Result parked in R1, return via info-pointer at TOS */
jump %ENTRY_CODE(Sp(0));
}
cmpIntegerIntzh_fast
{
/* R1 = s1; R2 = d1; R3 = the int */
W_ usize, vsize, v_digit, u_digit;
usize = R1;
vsize = 0;
v_digit = R3;
// paraphrased from __gmpz_cmp_si() in the GMP sources
if (%gt(v_digit,0)) {
vsize = 1;
} else {
if (%lt(v_digit,0)) {
vsize = -1;
v_digit = -v_digit;
}
}
if (usize != vsize) {
R1 = usize - vsize;
jump %ENTRY_CODE(Sp(0));
}
if (usize == 0) {
R1 = 0;
jump %ENTRY_CODE(Sp(0));
}
u_digit = W_[BYTE_ARR_CTS(R2)];
if (u_digit == v_digit) {
R1 = 0;
jump %ENTRY_CODE(Sp(0));
}
if (%gtu(u_digit,v_digit)) { // NB. unsigned: these are mp_limb_t's
R1 = usize;
} else {
R1 = -usize;
}
jump %ENTRY_CODE(Sp(0));
}
cmpIntegerzh_fast
{
/* R1 = s1; R2 = d1; R3 = s2; R4 = d2 */
W_ usize, vsize, size, up, vp;
CInt cmp;
// paraphrased from __gmpz_cmp() in the GMP sources
usize = R1;
vsize = R3;
if (usize != vsize) {
R1 = usize - vsize;
jump %ENTRY_CODE(Sp(0));
}
if (usize == 0) {
R1 = 0;
jump %ENTRY_CODE(Sp(0));
}
if (%lt(usize,0)) { // NB. not <, which is unsigned
size = -usize;
} else {
size = usize;
}
up = BYTE_ARR_CTS(R2);
vp = BYTE_ARR_CTS(R4);
(cmp) = foreign "C" __gmpn_cmp(up "ptr", vp "ptr", size) [];
if (cmp == 0 :: CInt) {
R1 = 0;
jump %ENTRY_CODE(Sp(0));
}
if (%lt(cmp,0 :: CInt) == %lt(usize,0)) {
R1 = 1;
} else {
R1 = (-1);
}
/* Result parked in R1, return via info-pointer at TOS */
jump %ENTRY_CODE(Sp(0));
}
integer2Intzh_fast
{
/* R1 = s; R2 = d */
W_ r, s;
s = R1;
if (s == 0) {