Skip to content

GitLab

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

Remove the implementation of gmp primops from the rts

parent 0f10e070
Hide whitespace changes
Inline Side-by-side
includes/Rts.h
View file @ 1b61c2db
......@@ -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);
......
includes/mkDerivedConstants.c
View file @ 1b61c2db
......@@ -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;
}
rts/Linker.c
View file @ 1b61c2db
......@@ -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
......
rts/PrimOps.cmm
View file @ 1b61c2db
......@@ -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