commit e09e6368f9d85f2baf328edd75de7bd0d8712f12
parent 7e3c12424c595583a28bf2292d6b8d22fbe24f9d
Author: Andres Navarro <canavarro82@gmail.com>
Date: Tue, 13 Dec 2011 21:23:07 -0300
Bugfix: properly rooted the environment in standalone interpreter -r switch (dorfile). More indent adjusting.
Diffstat:
14 files changed, 2736 insertions(+), 2739 deletions(-)
diff --git a/TODO b/TODO
@@ -1,13 +1,9 @@
* Release 0.3
** modules:
*** simple modules (something inspired in r7rs) (r7rs)
-*** add modules support to the interpreter (r7rs)
** documentation:
*** update the manual with the current features
*** add a section to the manual with the interpreter usage
-** refactor
-*** convert all tabs to spaces (use sed)
-
* Release 0.4+
** refactor:
*** clean stand alone interpreter
diff --git a/src/imath.c b/src/imath.c
@@ -38,29 +38,29 @@
/* {{{ Constants */
-const mp_result MP_OK = 0; /* no error, all is well */
-const mp_result MP_FALSE = 0; /* boolean false */
-const mp_result MP_TRUE = -1; /* boolean true */
-const mp_result MP_MEMORY = -2; /* out of memory */
+const mp_result MP_OK = 0; /* no error, all is well */
+const mp_result MP_FALSE = 0; /* boolean false */
+const mp_result MP_TRUE = -1; /* boolean true */
+const mp_result MP_MEMORY = -2; /* out of memory */
const mp_result MP_RANGE = -3; /* argument out of range */
-const mp_result MP_UNDEF = -4; /* result undefined */
-const mp_result MP_TRUNC = -5; /* output truncated */
+const mp_result MP_UNDEF = -4; /* result undefined */
+const mp_result MP_TRUNC = -5; /* output truncated */
const mp_result MP_BADARG = -6; /* invalid null argument */
const mp_result MP_MINERR = -6;
const mp_sign MP_NEG = 1; /* value is strictly negative */
-const mp_sign MP_ZPOS = 0; /* value is non-negative */
+const mp_sign MP_ZPOS = 0; /* value is non-negative */
STATIC const char *s_unknown_err = "unknown result code";
STATIC const char *s_error_msg[] = {
- "error code 0",
- "boolean true",
- "out of memory",
- "argument out of range",
- "result undefined",
- "output truncated",
- "invalid argument",
- NULL
+ "error code 0",
+ "boolean true",
+ "out of memory",
+ "argument out of range",
+ "result undefined",
+ "output truncated",
+ "invalid argument",
+ NULL
};
/* }}} */
@@ -80,66 +80,66 @@ STATIC const char *s_error_msg[] = {
The use of this table eliminates a dependency upon linkage against
the standard math libraries.
- */
+*/
STATIC const double s_log2[] = {
- 0.000000000, 0.000000000, 1.000000000, 0.630929754, /* 0 1 2 3 */
- 0.500000000, 0.430676558, 0.386852807, 0.356207187, /* 4 5 6 7 */
- 0.333333333, 0.315464877, 0.301029996, 0.289064826, /* 8 9 10 11 */
- 0.278942946, 0.270238154, 0.262649535, 0.255958025, /* 12 13 14 15 */
- 0.250000000, 0.244650542, 0.239812467, 0.235408913, /* 16 17 18 19 */
- 0.231378213, 0.227670249, 0.224243824, 0.221064729, /* 20 21 22 23 */
- 0.218104292, 0.215338279, 0.212746054, 0.210309918, /* 24 25 26 27 */
- 0.208014598, 0.205846832, 0.203795047, 0.201849087, /* 28 29 30 31 */
- 0.200000000, 0.198239863, 0.196561632, 0.194959022, /* 32 33 34 35 */
- 0.193426404, /* 36 */
+ 0.000000000, 0.000000000, 1.000000000, 0.630929754, /* 0 1 2 3 */
+ 0.500000000, 0.430676558, 0.386852807, 0.356207187, /* 4 5 6 7 */
+ 0.333333333, 0.315464877, 0.301029996, 0.289064826, /* 8 9 10 11 */
+ 0.278942946, 0.270238154, 0.262649535, 0.255958025, /* 12 13 14 15 */
+ 0.250000000, 0.244650542, 0.239812467, 0.235408913, /* 16 17 18 19 */
+ 0.231378213, 0.227670249, 0.224243824, 0.221064729, /* 20 21 22 23 */
+ 0.218104292, 0.215338279, 0.212746054, 0.210309918, /* 24 25 26 27 */
+ 0.208014598, 0.205846832, 0.203795047, 0.201849087, /* 28 29 30 31 */
+ 0.200000000, 0.198239863, 0.196561632, 0.194959022, /* 32 33 34 35 */
+ 0.193426404, /* 36 */
};
/* }}} */
/* {{{ Various macros */
/* Return the number of digits needed to represent a static value */
-#define MP_VALUE_DIGITS(V) \
-((sizeof(V)+(sizeof(mp_digit)-1))/sizeof(mp_digit))
+#define MP_VALUE_DIGITS(V) \
+ ((sizeof(V)+(sizeof(mp_digit)-1))/sizeof(mp_digit))
/* Round precision P to nearest word boundary */
#define ROUND_PREC(P) ((mp_size)(2*(((P)+1)/2)))
/* Set array P of S digits to zero */
-#define ZERO(P, S) \
-do{ \
- mp_size i__ = (S) * sizeof(mp_digit); \
- mp_digit *p__ = (P); \
- memset(p__, 0, i__); \
-} while(0)
+#define ZERO(P, S) \
+ do{ \
+ mp_size i__ = (S) * sizeof(mp_digit); \
+ mp_digit *p__ = (P); \
+ memset(p__, 0, i__); \
+ } while(0)
/* Copy S digits from array P to array Q */
-#define COPY(P, Q, S) \
-do{ \
- mp_size i__ = (S) * sizeof(mp_digit); \
- mp_digit *p__ = (P), *q__ = (Q); \
- memcpy(q__, p__, i__); \
-} while(0)
+#define COPY(P, Q, S) \
+ do{ \
+ mp_size i__ = (S) * sizeof(mp_digit); \
+ mp_digit *p__ = (P), *q__ = (Q); \
+ memcpy(q__, p__, i__); \
+ } while(0)
/* Reverse N elements of type T in array A */
-#define REV(T, A, N) \
-do{ \
- T *u_ = (A), *v_ = u_ + (N) - 1; \
- while (u_ < v_) { \
- T xch = *u_; \
- *u_++ = *v_; \
- *v_-- = xch; \
- } \
-} while(0)
-
-#define CLAMP(Z) \
-do{ \
- mp_int z_ = (Z); \
- mp_size uz_ = MP_USED(z_); \
- mp_digit *dz_ = MP_DIGITS(z_) + uz_ -1; \
- while (uz_ > 1 && (*dz_-- == 0)) \
- --uz_; \
- MP_USED(z_) = uz_; \
-} while(0)
+#define REV(T, A, N) \
+ do{ \
+ T *u_ = (A), *v_ = u_ + (N) - 1; \
+ while (u_ < v_) { \
+ T xch = *u_; \
+ *u_++ = *v_; \
+ *v_-- = xch; \
+ } \
+ } while(0)
+
+#define CLAMP(Z) \
+ do{ \
+ mp_int z_ = (Z); \
+ mp_size uz_ = MP_USED(z_); \
+ mp_digit *dz_ = MP_DIGITS(z_) + uz_ -1; \
+ while (uz_ > 1 && (*dz_-- == 0)) \
+ --uz_; \
+ MP_USED(z_) = uz_; \
+ } while(0)
/* Select min/max. Do not provide expressions for which multiple
evaluation would be problematic, e.g. x++ */
@@ -148,52 +148,52 @@ do{ \
/* Exchange lvalues A and B of type T, e.g.
SWAP(int, x, y) where x and y are variables of type int. */
-#define SWAP(T, A, B) \
-do{ \
- T t_ = (A); \
- A = (B); \
- B = t_; \
-} while(0)
+#define SWAP(T, A, B) \
+ do{ \
+ T t_ = (A); \
+ A = (B); \
+ B = t_; \
+ } while(0)
/* Used to set up and access simple temp stacks within functions. */
#define TEMP(K) (temp + (K))
-#define SETUP(E, C) \
-do{ \
- if ((res = (E)) != MP_OK) \
- goto CLEANUP; \
- ++(C); \
-} while(0)
+#define SETUP(E, C) \
+ do{ \
+ if ((res = (E)) != MP_OK) \
+ goto CLEANUP; \
+ ++(C); \
+ } while(0)
/* Compare value to zero. */
-#define CMPZ(Z) \
-(((Z)->used==1&&(Z)->digits[0]==0)?0:((Z)->sign==MP_NEG)?-1:1)
+#define CMPZ(Z) \
+ (((Z)->used==1&&(Z)->digits[0]==0)?0:((Z)->sign==MP_NEG)?-1:1)
/* Multiply X by Y into Z, ignoring signs. Requires that Z have
enough storage preallocated to hold the result. */
-#define UMUL(K, X, Y, Z) \
-do{ \
- mp_size ua_ = MP_USED(X), ub_ = MP_USED(Y); \
- mp_size o_ = ua_ + ub_; \
- ZERO(MP_DIGITS(Z), o_); \
- (void) s_kmul((K), MP_DIGITS(X), MP_DIGITS(Y), MP_DIGITS(Z), ua_, ub_); \
- MP_USED(Z) = o_; \
- CLAMP(Z); \
-} while(0)
+#define UMUL(K, X, Y, Z) \
+ do{ \
+ mp_size ua_ = MP_USED(X), ub_ = MP_USED(Y); \
+ mp_size o_ = ua_ + ub_; \
+ ZERO(MP_DIGITS(Z), o_); \
+ (void) s_kmul((K), MP_DIGITS(X), MP_DIGITS(Y), MP_DIGITS(Z), ua_, ub_); \
+ MP_USED(Z) = o_; \
+ CLAMP(Z); \
+ } while(0)
/* Square X into Z. Requires that Z have enough storage to hold the
result. */
-#define USQR(K, X, Z) \
-do{ \
- mp_size ua_ = MP_USED(X), o_ = ua_ + ua_; \
- ZERO(MP_DIGITS(Z), o_); \
- (void) s_ksqr((K), MP_DIGITS(X), MP_DIGITS(Z), ua_); \
- MP_USED(Z) = o_; \
- CLAMP(Z); \
-} while(0)
-
-#define UPPER_HALF(W) ((mp_word)((W) >> MP_DIGIT_BIT))
-#define LOWER_HALF(W) ((mp_digit)(W))
-#define HIGH_BIT_SET(W) ((W) >> (MP_WORD_BIT - 1))
+#define USQR(K, X, Z) \
+ do{ \
+ mp_size ua_ = MP_USED(X), o_ = ua_ + ua_; \
+ ZERO(MP_DIGITS(Z), o_); \
+ (void) s_ksqr((K), MP_DIGITS(X), MP_DIGITS(Z), ua_); \
+ MP_USED(Z) = o_; \
+ CLAMP(Z); \
+ } while(0)
+
+#define UPPER_HALF(W) ((mp_word)((W) >> MP_DIGIT_BIT))
+#define LOWER_HALF(W) ((mp_digit)(W))
+#define HIGH_BIT_SET(W) ((W) >> (MP_WORD_BIT - 1))
#define ADD_WILL_OVERFLOW(W, V) ((MP_WORD_MAX - (V)) < (W))
/* }}} */
@@ -227,96 +227,96 @@ STATIC void s_free(klisp_State *K, void *ptr, mp_size size);
STATIC int s_pad(klisp_State *K, mp_int z, mp_size min);
/* Fill in a "fake" mp_int on the stack with a given value */
-STATIC void s_fake(mp_int z, mp_small value, mp_digit vbuf[]);
+STATIC void s_fake(mp_int z, mp_small value, mp_digit vbuf[]);
/* Compare two runs of digits of given length, returns <0, 0, >0 */
-STATIC int s_cdig(mp_digit *da, mp_digit *db, mp_size len);
+STATIC int s_cdig(mp_digit *da, mp_digit *db, mp_size len);
/* Pack the unsigned digits of v into array t */
-STATIC int s_vpack(mp_small v, mp_digit t[]);
+STATIC int s_vpack(mp_small v, mp_digit t[]);
/* Compare magnitudes of a and b, returns <0, 0, >0 */
-STATIC int s_ucmp(mp_int a, mp_int b);
+STATIC int s_ucmp(mp_int a, mp_int b);
/* Compare magnitudes of a and v, returns <0, 0, >0 */
-STATIC int s_vcmp(mp_int a, mp_small v);
+STATIC int s_vcmp(mp_int a, mp_small v);
/* Unsigned magnitude addition; assumes dc is big enough.
Carry out is returned (no memory allocated). */
STATIC mp_digit s_uadd(mp_digit *da, mp_digit *db, mp_digit *dc,
- mp_size size_a, mp_size size_b);
+ mp_size size_a, mp_size size_b);
/* Unsigned magnitude subtraction. Assumes dc is big enough. */
-STATIC void s_usub(mp_digit *da, mp_digit *db, mp_digit *dc,
- mp_size size_a, mp_size size_b);
+STATIC void s_usub(mp_digit *da, mp_digit *db, mp_digit *dc,
+ mp_size size_a, mp_size size_b);
/* Unsigned recursive multiplication. Assumes dc is big enough. */
-STATIC int s_kmul(klisp_State *K, mp_digit *da, mp_digit *db,
- mp_digit *dc, mp_size size_a, mp_size size_b);
+STATIC int s_kmul(klisp_State *K, mp_digit *da, mp_digit *db,
+ mp_digit *dc, mp_size size_a, mp_size size_b);
/* Unsigned magnitude multiplication. Assumes dc is big enough. */
-STATIC void s_umul(mp_digit *da, mp_digit *db, mp_digit *dc,
- mp_size size_a, mp_size size_b);
+STATIC void s_umul(mp_digit *da, mp_digit *db, mp_digit *dc,
+ mp_size size_a, mp_size size_b);
/* Unsigned recursive squaring. Assumes dc is big enough. */
/* Andres Navarro: allocs temporaries */
-STATIC int s_ksqr(klisp_State *K, mp_digit *da, mp_digit *dc,
- mp_size size_a);
+STATIC int s_ksqr(klisp_State *K, mp_digit *da, mp_digit *dc,
+ mp_size size_a);
/* Unsigned magnitude squaring. Assumes dc is big enough. */
-STATIC void s_usqr(mp_digit *da, mp_digit *dc, mp_size size_a);
+STATIC void s_usqr(mp_digit *da, mp_digit *dc, mp_size size_a);
/* Single digit addition. Assumes a is big enough. */
-STATIC void s_dadd(mp_int a, mp_digit b);
+STATIC void s_dadd(mp_int a, mp_digit b);
/* Single digit multiplication. Assumes a is big enough. */
-STATIC void s_dmul(mp_int a, mp_digit b);
+STATIC void s_dmul(mp_int a, mp_digit b);
/* Single digit multiplication on buffers; assumes dc is big enough. */
-STATIC void s_dbmul(mp_digit *da, mp_digit b, mp_digit *dc,
- mp_size size_a);
+STATIC void s_dbmul(mp_digit *da, mp_digit b, mp_digit *dc,
+ mp_size size_a);
/* Single digit division. Replaces a with the quotient,
returns the remainder. */
STATIC mp_digit s_ddiv(mp_int a, mp_digit b);
/* Quick division by a power of 2, replaces z (no allocation) */
-STATIC void s_qdiv(mp_int z, mp_size p2);
+STATIC void s_qdiv(mp_int z, mp_size p2);
/* Quick remainder by a power of 2, replaces z (no allocation) */
-STATIC void s_qmod(mp_int z, mp_size p2);
+STATIC void s_qmod(mp_int z, mp_size p2);
/* Quick multiplication by a power of 2, replaces z.
Allocates if necessary; returns false in case this fails. */
-STATIC int s_qmul(klisp_State *K, mp_int z, mp_size p2);
+STATIC int s_qmul(klisp_State *K, mp_int z, mp_size p2);
/* Quick subtraction from a power of 2, replaces z.
Allocates if necessary; returns false in case this fails. */
-STATIC int s_qsub(klisp_State *K, mp_int z, mp_size p2);
+STATIC int s_qsub(klisp_State *K, mp_int z, mp_size p2);
/* Return maximum k such that 2^k divides z. */
-STATIC int s_dp2k(mp_int z);
+STATIC int s_dp2k(mp_int z);
/* Return k >= 0 such that z = 2^k, or -1 if there is no such k. */
-STATIC int s_isp2(mp_int z);
+STATIC int s_isp2(mp_int z);
/* Set z to 2^k. May allocate; returns false in case this fails. */
-STATIC int s_2expt(klisp_State *K, mp_int z, mp_small k);
+STATIC int s_2expt(klisp_State *K, mp_int z, mp_small k);
/* Normalize a and b for division, returns normalization constant */
-STATIC int s_norm(klisp_State *K, mp_int a, mp_int b);
+STATIC int s_norm(klisp_State *K, mp_int a, mp_int b);
/* Compute constant mu for Barrett reduction, given modulus m, result
replaces z, m is untouched. */
STATIC mp_result s_brmu(klisp_State *K, mp_int z, mp_int m);
/* Reduce a modulo m, using Barrett's algorithm. */
-STATIC int s_reduce(klisp_State *K, mp_int x, mp_int m, mp_int mu,
- mp_int q1, mp_int q2);
+STATIC int s_reduce(klisp_State *K, mp_int x, mp_int m, mp_int mu,
+ mp_int q1, mp_int q2);
/* Modular exponentiation, using Barrett reduction */
STATIC mp_result s_embar(klisp_State *K, mp_int a, mp_int b, mp_int m,
- mp_int mu, mp_int c);
+ mp_int mu, mp_int c);
/* Unsigned magnitude division. Assumes |a| > |b|. Allocates
temporaries; overwrites a with quotient, b with remainder. */
@@ -324,7 +324,7 @@ STATIC mp_result s_udiv(klisp_State *K, mp_int a, mp_int b);
/* Compute the number of digits in radix r required to represent the
given value. Does not account for sign flags, terminators, etc. */
-STATIC int s_outlen(mp_int z, mp_size r);
+STATIC int s_outlen(mp_int z, mp_size r);
/* Guess how many digits of precision will be needed to represent a
radix r value of the specified number of digits. Returns a value
@@ -333,13 +333,13 @@ STATIC mp_size s_inlen(int len, mp_size r);
/* Convert a character to a digit value in radix r, or
-1 if out of range */
-STATIC int s_ch2val(char c, int r);
+STATIC int s_ch2val(char c, int r);
/* Convert a digit value to a character */
-STATIC char s_val2ch(int v, int caps);
+STATIC char s_val2ch(int v, int caps);
/* Take 2's complement of a buffer in place */
-STATIC void s_2comp(unsigned char *buf, int len);
+STATIC void s_2comp(unsigned char *buf, int len);
/* Convert a value to binary, ignoring sign. On input, *limpos is the
bound on how many bytes should be written to buf; on output, *limpos
@@ -348,24 +348,24 @@ STATIC mp_result s_tobin(mp_int z, unsigned char *buf, int *limpos, int pad);
#if DEBUG
/* Dump a representation of the mp_int to standard output */
-void s_print(char *tag, mp_int z);
-void s_print_buf(char *tag, mp_digit *buf, mp_size num);
+void s_print(char *tag, mp_int z);
+void s_print_buf(char *tag, mp_digit *buf, mp_size num);
#endif
/* {{{ mp_int_init(z) */
mp_result mp_int_init(mp_int z)
{
- if(z == NULL)
- return MP_BADARG;
+ if(z == NULL)
+ return MP_BADARG;
- z->single = 0;
- z->digits = &(z->single);
- z->alloc = 1;
- z->used = 1;
- z->sign = MP_ZPOS;
+ z->single = 0;
+ z->digits = &(z->single);
+ z->alloc = 1;
+ z->used = 1;
+ z->sign = MP_ZPOS;
- return MP_OK;
+ return MP_OK;
}
/* }}} */
@@ -374,12 +374,12 @@ mp_result mp_int_init(mp_int z)
mp_int mp_int_alloc(klisp_State *K)
{
- mp_int out = klispM_new(K, mpz_t);
+ mp_int out = klispM_new(K, mpz_t);
- if(out != NULL)
- mp_int_init(out);
+ if(out != NULL)
+ mp_int_init(out);
- return out;
+ return out;
}
/* }}} */
@@ -388,24 +388,24 @@ mp_int mp_int_alloc(klisp_State *K)
mp_result mp_int_init_size(klisp_State *K, mp_int z, mp_size prec)
{
- CHECK(z != NULL);
+ CHECK(z != NULL);
- if(prec == 0)
- prec = default_precision;
- else if(prec == 1)
- return mp_int_init(z);
- else
- prec = (mp_size) ROUND_PREC(prec);
+ if(prec == 0)
+ prec = default_precision;
+ else if(prec == 1)
+ return mp_int_init(z);
+ else
+ prec = (mp_size) ROUND_PREC(prec);
- if((MP_DIGITS(z) = s_alloc(K, prec)) == NULL)
- return MP_MEMORY;
+ if((MP_DIGITS(z) = s_alloc(K, prec)) == NULL)
+ return MP_MEMORY;
- z->digits[0] = 0;
- MP_USED(z) = 1;
- MP_ALLOC(z) = prec;
- MP_SIGN(z) = MP_ZPOS;
+ z->digits[0] = 0;
+ MP_USED(z) = 1;
+ MP_ALLOC(z) = prec;
+ MP_SIGN(z) = MP_ZPOS;
- return MP_OK;
+ return MP_OK;
}
/* }}} */
@@ -414,27 +414,27 @@ mp_result mp_int_init_size(klisp_State *K, mp_int z, mp_size prec)
mp_result mp_int_init_copy(klisp_State *K, mp_int z, mp_int old)
{
- mp_result res;
- mp_size uold;
+ mp_result res;
+ mp_size uold;
- CHECK(z != NULL && old != NULL);
+ CHECK(z != NULL && old != NULL);
- uold = MP_USED(old);
- if(uold == 1) {
- mp_int_init(z);
- }
- else {
- mp_size target = MAX(uold, default_precision);
+ uold = MP_USED(old);
+ if(uold == 1) {
+ mp_int_init(z);
+ }
+ else {
+ mp_size target = MAX(uold, default_precision);
- if((res = mp_int_init_size(K, z, target)) != MP_OK)
- return res;
- }
+ if((res = mp_int_init_size(K, z, target)) != MP_OK)
+ return res;
+ }
- MP_USED(z) = uold;
- MP_SIGN(z) = MP_SIGN(old);
- COPY(MP_DIGITS(old), MP_DIGITS(z), uold);
+ MP_USED(z) = uold;
+ MP_SIGN(z) = MP_SIGN(old);
+ COPY(MP_DIGITS(old), MP_DIGITS(z), uold);
- return MP_OK;
+ return MP_OK;
}
/* }}} */
@@ -443,11 +443,11 @@ mp_result mp_int_init_copy(klisp_State *K, mp_int z, mp_int old)
mp_result mp_int_init_value(klisp_State *K, mp_int z, mp_small value)
{
- mpz_t vtmp;
- mp_digit vbuf[MP_VALUE_DIGITS(value)];
+ mpz_t vtmp;
+ mp_digit vbuf[MP_VALUE_DIGITS(value)];
- s_fake(&vtmp, value, vbuf);
- return mp_int_init_copy(K, z, &vtmp);
+ s_fake(&vtmp, value, vbuf);
+ return mp_int_init_copy(K, z, &vtmp);
}
/* }}} */
@@ -456,39 +456,39 @@ mp_result mp_int_init_value(klisp_State *K, mp_int z, mp_small value)
mp_result mp_int_set_value(klisp_State *K, mp_int z, mp_small value)
{
- mpz_t vtmp;
- mp_digit vbuf[MP_VALUE_DIGITS(value)];
+ mpz_t vtmp;
+ mp_digit vbuf[MP_VALUE_DIGITS(value)];
- s_fake(&vtmp, value, vbuf);
- return mp_int_copy(K, &vtmp, z);
+ s_fake(&vtmp, value, vbuf);
+ return mp_int_copy(K, &vtmp, z);
}
/* }}} */
/* {{{ mp_int_clear(z) */
-void mp_int_clear(klisp_State *K, mp_int z)
+void mp_int_clear(klisp_State *K, mp_int z)
{
- if(z == NULL)
- return;
+ if(z == NULL)
+ return;
- if(MP_DIGITS(z) != NULL) {
- if((void *) MP_DIGITS(z) != (void *) &MP_SINGLE(z))
- s_free(K, MP_DIGITS(z), MP_ALLOC(z));
- MP_DIGITS(z) = NULL;
- }
+ if(MP_DIGITS(z) != NULL) {
+ if((void *) MP_DIGITS(z) != (void *) &MP_SINGLE(z))
+ s_free(K, MP_DIGITS(z), MP_ALLOC(z));
+ MP_DIGITS(z) = NULL;
+ }
}
/* }}} */
/* {{{ mp_int_free(z) */
-void mp_int_free(klisp_State *K, mp_int z)
+void mp_int_free(klisp_State *K, mp_int z)
{
- NRCHECK(z != NULL);
+ NRCHECK(z != NULL);
- mp_int_clear(K, z);
- klispM_free(K, z); /* note: NOT s_free() */
+ mp_int_clear(K, z);
+ klispM_free(K, z); /* note: NOT s_free() */
}
/* }}} */
@@ -497,57 +497,57 @@ void mp_int_free(klisp_State *K, mp_int z)
mp_result mp_int_copy(klisp_State *K, mp_int a, mp_int c)
{
- CHECK(a != NULL && c != NULL);
+ CHECK(a != NULL && c != NULL);
- if(a != c) {
- mp_size ua = MP_USED(a);
- mp_digit *da, *dc;
+ if(a != c) {
+ mp_size ua = MP_USED(a);
+ mp_digit *da, *dc;
- if(!s_pad(K, c, ua))
- return MP_MEMORY;
+ if(!s_pad(K, c, ua))
+ return MP_MEMORY;
- da = MP_DIGITS(a); dc = MP_DIGITS(c);
- COPY(da, dc, ua);
+ da = MP_DIGITS(a); dc = MP_DIGITS(c);
+ COPY(da, dc, ua);
- MP_USED(c) = ua;
- MP_SIGN(c) = MP_SIGN(a);
- }
+ MP_USED(c) = ua;
+ MP_SIGN(c) = MP_SIGN(a);
+ }
- return MP_OK;
+ return MP_OK;
}
/* }}} */
/* {{{ mp_int_swap(a, c) */
-void mp_int_swap(mp_int a, mp_int c)
+void mp_int_swap(mp_int a, mp_int c)
{
- if(a != c) {
- mpz_t tmp = *a;
+ if(a != c) {
+ mpz_t tmp = *a;
- *a = *c;
- *c = tmp;
- /* Andres Navarro: bugfix */
- /* correct if digits was pointing to single */
- if (a->digits == &c->single)
- a->digits = &a->single;
- if (c->digits == &a->single)
- c->digits = &c->single;
- /* Andres Navarro: /bugfix */
- }
+ *a = *c;
+ *c = tmp;
+ /* Andres Navarro: bugfix */
+ /* correct if digits was pointing to single */
+ if (a->digits == &c->single)
+ a->digits = &a->single;
+ if (c->digits == &a->single)
+ c->digits = &c->single;
+ /* Andres Navarro: /bugfix */
+ }
}
/* }}} */
/* {{{ mp_int_zero(z) */
-void mp_int_zero(mp_int z)
+void mp_int_zero(mp_int z)
{
- NRCHECK(z != NULL);
+ NRCHECK(z != NULL);
- z->digits[0] = 0;
- MP_USED(z) = 1;
- MP_SIGN(z) = MP_ZPOS;
+ z->digits[0] = 0;
+ MP_USED(z) = 1;
+ MP_SIGN(z) = MP_ZPOS;
}
/* }}} */
@@ -556,15 +556,15 @@ void mp_int_zero(mp_int z)
mp_result mp_int_abs(klisp_State *K, mp_int a, mp_int c)
{
- mp_result res;
+ mp_result res;
- CHECK(a != NULL && c != NULL);
+ CHECK(a != NULL && c != NULL);
- if((res = mp_int_copy(K, a, c)) != MP_OK)
- return res;
+ if((res = mp_int_copy(K, a, c)) != MP_OK)
+ return res;
- MP_SIGN(c) = MP_ZPOS;
- return MP_OK;
+ MP_SIGN(c) = MP_ZPOS;
+ return MP_OK;
}
/* }}} */
@@ -573,17 +573,17 @@ mp_result mp_int_abs(klisp_State *K, mp_int a, mp_int c)
mp_result mp_int_neg(klisp_State *K, mp_int a, mp_int c)
{
- mp_result res;
+ mp_result res;
- CHECK(a != NULL && c != NULL);
+ CHECK(a != NULL && c != NULL);
- if((res = mp_int_copy(K, a, c)) != MP_OK)
- return res;
+ if((res = mp_int_copy(K, a, c)) != MP_OK)
+ return res;
- if(CMPZ(c) != 0)
- MP_SIGN(c) = 1 - MP_SIGN(a);
+ if(CMPZ(c) != 0)
+ MP_SIGN(c) = 1 - MP_SIGN(a);
- return MP_OK;
+ return MP_OK;
}
/* }}} */
@@ -592,67 +592,67 @@ mp_result mp_int_neg(klisp_State *K, mp_int a, mp_int c)
mp_result mp_int_add(klisp_State *K, mp_int a, mp_int b, mp_int c)
{
- mp_size ua, ub, uc, max;
-
- CHECK(a != NULL && b != NULL && c != NULL);
+ mp_size ua, ub, uc, max;
- ua = MP_USED(a); ub = MP_USED(b); uc = MP_USED(c);
- max = MAX(ua, ub);
+ CHECK(a != NULL && b != NULL && c != NULL);
- if(MP_SIGN(a) == MP_SIGN(b)) {
- /* Same sign -- add magnitudes, preserve sign of addends */
- mp_digit carry;
+ ua = MP_USED(a); ub = MP_USED(b); uc = MP_USED(c);
+ max = MAX(ua, ub);
- if(!s_pad(K, c, max))
- return MP_MEMORY;
+ if(MP_SIGN(a) == MP_SIGN(b)) {
+ /* Same sign -- add magnitudes, preserve sign of addends */
+ mp_digit carry;
- carry = s_uadd(MP_DIGITS(a), MP_DIGITS(b), MP_DIGITS(c), ua, ub);
- uc = max;
+ if(!s_pad(K, c, max))
+ return MP_MEMORY;
- if(carry) {
- if(!s_pad(K, c, max + 1))
- return MP_MEMORY;
+ carry = s_uadd(MP_DIGITS(a), MP_DIGITS(b), MP_DIGITS(c), ua, ub);
+ uc = max;
- c->digits[max] = carry;
- ++uc;
- }
+ if(carry) {
+ if(!s_pad(K, c, max + 1))
+ return MP_MEMORY;
- MP_USED(c) = uc;
- MP_SIGN(c) = MP_SIGN(a);
+ c->digits[max] = carry;
+ ++uc;
+ }
- }
- else {
- /* Different signs -- subtract magnitudes, preserve sign of greater */
- mp_int x, y;
- int cmp = s_ucmp(a, b); /* magnitude comparision, sign ignored */
+ MP_USED(c) = uc;
+ MP_SIGN(c) = MP_SIGN(a);
- /* Set x to max(a, b), y to min(a, b) to simplify later code.
- A special case yields zero for equal magnitudes.
- */
- if(cmp == 0) {
- mp_int_zero(c);
- return MP_OK;
- }
- else if(cmp < 0) {
- x = b; y = a;
- }
+ }
else {
- x = a; y = b;
- }
-
- if(!s_pad(K, c, MP_USED(x)))
- return MP_MEMORY;
-
- /* Subtract smaller from larger */
- s_usub(MP_DIGITS(x), MP_DIGITS(y), MP_DIGITS(c), MP_USED(x), MP_USED(y));
- MP_USED(c) = MP_USED(x);
- CLAMP(c);
+ /* Different signs -- subtract magnitudes, preserve sign of greater */
+ mp_int x, y;
+ int cmp = s_ucmp(a, b); /* magnitude comparision, sign ignored */
+
+ /* Set x to max(a, b), y to min(a, b) to simplify later code.
+ A special case yields zero for equal magnitudes.
+ */
+ if(cmp == 0) {
+ mp_int_zero(c);
+ return MP_OK;
+ }
+ else if(cmp < 0) {
+ x = b; y = a;
+ }
+ else {
+ x = a; y = b;
+ }
+
+ if(!s_pad(K, c, MP_USED(x)))
+ return MP_MEMORY;
+
+ /* Subtract smaller from larger */
+ s_usub(MP_DIGITS(x), MP_DIGITS(y), MP_DIGITS(c), MP_USED(x), MP_USED(y));
+ MP_USED(c) = MP_USED(x);
+ CLAMP(c);
- /* Give result the sign of the larger */
- MP_SIGN(c) = MP_SIGN(x);
- }
+ /* Give result the sign of the larger */
+ MP_SIGN(c) = MP_SIGN(x);
+ }
- return MP_OK;
+ return MP_OK;
}
/* }}} */
@@ -661,12 +661,12 @@ mp_result mp_int_add(klisp_State *K, mp_int a, mp_int b, mp_int c)
mp_result mp_int_add_value(klisp_State *K, mp_int a, mp_small value, mp_int c)
{
- mpz_t vtmp;
- mp_digit vbuf[MP_VALUE_DIGITS(value)];
+ mpz_t vtmp;
+ mp_digit vbuf[MP_VALUE_DIGITS(value)];
- s_fake(&vtmp, value, vbuf);
+ s_fake(&vtmp, value, vbuf);
- return mp_int_add(K, a, &vtmp, c);
+ return mp_int_add(K, a, &vtmp, c);
}
/* }}} */
@@ -675,62 +675,62 @@ mp_result mp_int_add_value(klisp_State *K, mp_int a, mp_small value, mp_int c)
mp_result mp_int_sub(klisp_State *K, mp_int a, mp_int b, mp_int c)
{
- mp_size ua, ub, uc, max;
-
- CHECK(a != NULL && b != NULL && c != NULL);
+ mp_size ua, ub, uc, max;
- ua = MP_USED(a); ub = MP_USED(b); uc = MP_USED(c);
- max = MAX(ua, ub);
+ CHECK(a != NULL && b != NULL && c != NULL);
- if(MP_SIGN(a) != MP_SIGN(b)) {
- /* Different signs -- add magnitudes and keep sign of a */
- mp_digit carry;
+ ua = MP_USED(a); ub = MP_USED(b); uc = MP_USED(c);
+ max = MAX(ua, ub);
- if(!s_pad(K, c, max))
- return MP_MEMORY;
+ if(MP_SIGN(a) != MP_SIGN(b)) {
+ /* Different signs -- add magnitudes and keep sign of a */
+ mp_digit carry;
- carry = s_uadd(MP_DIGITS(a), MP_DIGITS(b), MP_DIGITS(c), ua, ub);
- uc = max;
+ if(!s_pad(K, c, max))
+ return MP_MEMORY;
- if(carry) {
- if(!s_pad(K, c, max + 1))
- return MP_MEMORY;
+ carry = s_uadd(MP_DIGITS(a), MP_DIGITS(b), MP_DIGITS(c), ua, ub);
+ uc = max;
- c->digits[max] = carry;
- ++uc;
- }
+ if(carry) {
+ if(!s_pad(K, c, max + 1))
+ return MP_MEMORY;
- MP_USED(c) = uc;
- MP_SIGN(c) = MP_SIGN(a);
+ c->digits[max] = carry;
+ ++uc;
+ }
- }
- else {
- /* Same signs -- subtract magnitudes */
- mp_int x, y;
- mp_sign osign;
- int cmp = s_ucmp(a, b);
+ MP_USED(c) = uc;
+ MP_SIGN(c) = MP_SIGN(a);
- if(!s_pad(K, c, max))
- return MP_MEMORY;
-
- if(cmp >= 0) {
- x = a; y = b; osign = MP_ZPOS;
}
else {
- x = b; y = a; osign = MP_NEG;
- }
+ /* Same signs -- subtract magnitudes */
+ mp_int x, y;
+ mp_sign osign;
+ int cmp = s_ucmp(a, b);
- if(MP_SIGN(a) == MP_NEG && cmp != 0)
- osign = 1 - osign;
+ if(!s_pad(K, c, max))
+ return MP_MEMORY;
- s_usub(MP_DIGITS(x), MP_DIGITS(y), MP_DIGITS(c), MP_USED(x), MP_USED(y));
- MP_USED(c) = MP_USED(x);
- CLAMP(c);
+ if(cmp >= 0) {
+ x = a; y = b; osign = MP_ZPOS;
+ }
+ else {
+ x = b; y = a; osign = MP_NEG;
+ }
- MP_SIGN(c) = osign;
- }
+ if(MP_SIGN(a) == MP_NEG && cmp != 0)
+ osign = 1 - osign;
+
+ s_usub(MP_DIGITS(x), MP_DIGITS(y), MP_DIGITS(c), MP_USED(x), MP_USED(y));
+ MP_USED(c) = MP_USED(x);
+ CLAMP(c);
+
+ MP_SIGN(c) = osign;
+ }
- return MP_OK;
+ return MP_OK;
}
/* }}} */
@@ -739,12 +739,12 @@ mp_result mp_int_sub(klisp_State *K, mp_int a, mp_int b, mp_int c)
mp_result mp_int_sub_value(klisp_State *K, mp_int a, mp_small value, mp_int c)
{
- mpz_t vtmp;
- mp_digit vbuf[MP_VALUE_DIGITS(value)];
+ mpz_t vtmp;
+ mp_digit vbuf[MP_VALUE_DIGITS(value)];
- s_fake(&vtmp, value, vbuf);
+ s_fake(&vtmp, value, vbuf);
- return mp_int_sub(K, a, &vtmp, c);
+ return mp_int_sub(K, a, &vtmp, c);
}
/* }}} */
@@ -753,60 +753,60 @@ mp_result mp_int_sub_value(klisp_State *K, mp_int a, mp_small value, mp_int c)
mp_result mp_int_mul(klisp_State *K, mp_int a, mp_int b, mp_int c)
{
- mp_digit *out;
- mp_size osize, ua, ub, p = 0;
- mp_sign osign;
+ mp_digit *out;
+ mp_size osize, ua, ub, p = 0;
+ mp_sign osign;
- CHECK(a != NULL && b != NULL && c != NULL);
+ CHECK(a != NULL && b != NULL && c != NULL);
- /* If either input is zero, we can shortcut multiplication */
- if(mp_int_compare_zero(a) == 0 || mp_int_compare_zero(b) == 0) {
- mp_int_zero(c);
- return MP_OK;
- }
+ /* If either input is zero, we can shortcut multiplication */
+ if(mp_int_compare_zero(a) == 0 || mp_int_compare_zero(b) == 0) {
+ mp_int_zero(c);
+ return MP_OK;
+ }
- /* Output is positive if inputs have same sign, otherwise negative */
- osign = (MP_SIGN(a) == MP_SIGN(b)) ? MP_ZPOS : MP_NEG;
-
- /* If the output is not identical to any of the inputs, we'll write
- the results directly; otherwise, allocate a temporary space. */
- ua = MP_USED(a); ub = MP_USED(b);
- osize = MAX(ua, ub);
- osize = 4 * ((osize + 1) / 2);
-
- if(c == a || c == b) {
- p = ROUND_PREC(osize);
- p = MAX(p, default_precision);
-
- if((out = s_alloc(K, p)) == NULL)
- return MP_MEMORY;
- }
- else {
- if(!s_pad(K, c, osize))
- return MP_MEMORY;
+ /* Output is positive if inputs have same sign, otherwise negative */
+ osign = (MP_SIGN(a) == MP_SIGN(b)) ? MP_ZPOS : MP_NEG;
+
+ /* If the output is not identical to any of the inputs, we'll write
+ the results directly; otherwise, allocate a temporary space. */
+ ua = MP_USED(a); ub = MP_USED(b);
+ osize = MAX(ua, ub);
+ osize = 4 * ((osize + 1) / 2);
+
+ if(c == a || c == b) {
+ p = ROUND_PREC(osize);
+ p = MAX(p, default_precision);
+
+ if((out = s_alloc(K, p)) == NULL)
+ return MP_MEMORY;
+ }
+ else {
+ if(!s_pad(K, c, osize))
+ return MP_MEMORY;
- out = MP_DIGITS(c);
- }
- ZERO(out, osize);
-
- if(!s_kmul(K, MP_DIGITS(a), MP_DIGITS(b), out, ua, ub))
- return MP_MEMORY;
-
- /* If we allocated a new buffer, get rid of whatever memory c was
- already using, and fix up its fields to reflect that.
- */
- if(out != MP_DIGITS(c)) {
- if((void *) MP_DIGITS(c) != (void *) &MP_SINGLE(c))
- s_free(K, MP_DIGITS(c), MP_ALLOC(c));
- MP_DIGITS(c) = out;
- MP_ALLOC(c) = p;
- }
-
- MP_USED(c) = osize; /* might not be true, but we'll fix it ... */
- CLAMP(c); /* ... right here */
- MP_SIGN(c) = osign;
+ out = MP_DIGITS(c);
+ }
+ ZERO(out, osize);
+
+ if(!s_kmul(K, MP_DIGITS(a), MP_DIGITS(b), out, ua, ub))
+ return MP_MEMORY;
+
+ /* If we allocated a new buffer, get rid of whatever memory c was
+ already using, and fix up its fields to reflect that.
+ */
+ if(out != MP_DIGITS(c)) {
+ if((void *) MP_DIGITS(c) != (void *) &MP_SINGLE(c))
+ s_free(K, MP_DIGITS(c), MP_ALLOC(c));
+ MP_DIGITS(c) = out;
+ MP_ALLOC(c) = p;
+ }
+
+ MP_USED(c) = osize; /* might not be true, but we'll fix it ... */
+ CLAMP(c); /* ... right here */
+ MP_SIGN(c) = osign;
- return MP_OK;
+ return MP_OK;
}
/* }}} */
@@ -814,14 +814,14 @@ mp_result mp_int_mul(klisp_State *K, mp_int a, mp_int b, mp_int c)
/* {{{ mp_int_mul_value(a, value, c) */
mp_result mp_int_mul_value(klisp_State *K, mp_int a, mp_small value,
- mp_int c)
+ mp_int c)
{
- mpz_t vtmp;
- mp_digit vbuf[MP_VALUE_DIGITS(value)];
+ mpz_t vtmp;
+ mp_digit vbuf[MP_VALUE_DIGITS(value)];
- s_fake(&vtmp, value, vbuf);
+ s_fake(&vtmp, value, vbuf);
- return mp_int_mul(K, a, &vtmp, c);
+ return mp_int_mul(K, a, &vtmp, c);
}
/* }}} */
@@ -830,16 +830,16 @@ mp_result mp_int_mul_value(klisp_State *K, mp_int a, mp_small value,
mp_result mp_int_mul_pow2(klisp_State *K, mp_int a, mp_small p2, mp_int c)
{
- mp_result res;
- CHECK(a != NULL && c != NULL && p2 >= 0);
+ mp_result res;
+ CHECK(a != NULL && c != NULL && p2 >= 0);
- if((res = mp_int_copy(K, a, c)) != MP_OK)
- return res;
+ if((res = mp_int_copy(K, a, c)) != MP_OK)
+ return res;
- if(s_qmul(K, c, (mp_size) p2))
- return MP_OK;
- else
- return MP_MEMORY;
+ if(s_qmul(K, c, (mp_size) p2))
+ return MP_OK;
+ else
+ return MP_MEMORY;
}
/* }}} */
@@ -848,45 +848,45 @@ mp_result mp_int_mul_pow2(klisp_State *K, mp_int a, mp_small p2, mp_int c)
mp_result mp_int_sqr(klisp_State *K, mp_int a, mp_int c)
{
- mp_digit *out;
- mp_size osize, p = 0;
-
- CHECK(a != NULL && c != NULL);
-
- /* Get a temporary buffer big enough to hold the result */
- osize = (mp_size) 4 * ((MP_USED(a) + 1) / 2);
- if(a == c) {
- p = ROUND_PREC(osize);
- p = MAX(p, default_precision);
-
- if((out = s_alloc(K, p)) == NULL)
- return MP_MEMORY;
- }
- else {
- if(!s_pad(K, c, osize))
- return MP_MEMORY;
-
- out = MP_DIGITS(c);
- }
- ZERO(out, osize);
-
- s_ksqr(K, MP_DIGITS(a), out, MP_USED(a));
-
- /* Get rid of whatever memory c was already using, and fix up its
- fields to reflect the new digit array it's using
- */
- if(out != MP_DIGITS(c)) {
- if((void *) MP_DIGITS(c) != (void *) &MP_SINGLE(c))
- s_free(K, MP_DIGITS(c), MP_ALLOC(c));
- MP_DIGITS(c) = out;
- MP_ALLOC(c) = p;
- }
-
- MP_USED(c) = osize; /* might not be true, but we'll fix it ... */
- CLAMP(c); /* ... right here */
- MP_SIGN(c) = MP_ZPOS;
+ mp_digit *out;
+ mp_size osize, p = 0;
+
+ CHECK(a != NULL && c != NULL);
+
+ /* Get a temporary buffer big enough to hold the result */
+ osize = (mp_size) 4 * ((MP_USED(a) + 1) / 2);
+ if(a == c) {
+ p = ROUND_PREC(osize);
+ p = MAX(p, default_precision);
+
+ if((out = s_alloc(K, p)) == NULL)
+ return MP_MEMORY;
+ }
+ else {
+ if(!s_pad(K, c, osize))
+ return MP_MEMORY;
+
+ out = MP_DIGITS(c);
+ }
+ ZERO(out, osize);
+
+ s_ksqr(K, MP_DIGITS(a), out, MP_USED(a));
+
+ /* Get rid of whatever memory c was already using, and fix up its
+ fields to reflect the new digit array it's using
+ */
+ if(out != MP_DIGITS(c)) {
+ if((void *) MP_DIGITS(c) != (void *) &MP_SINGLE(c))
+ s_free(K, MP_DIGITS(c), MP_ALLOC(c));
+ MP_DIGITS(c) = out;
+ MP_ALLOC(c) = p;
+ }
+
+ MP_USED(c) = osize; /* might not be true, but we'll fix it ... */
+ CLAMP(c); /* ... right here */
+ MP_SIGN(c) = MP_ZPOS;
- return MP_OK;
+ return MP_OK;
}
/* }}} */
@@ -895,103 +895,103 @@ mp_result mp_int_sqr(klisp_State *K, mp_int a, mp_int c)
mp_result mp_int_div(klisp_State *K, mp_int a, mp_int b, mp_int q, mp_int r)
{
- int cmp, last = 0, lg;
- mp_result res = MP_OK;
- mpz_t temp[2];
- mp_int qout, rout;
- mp_sign sa = MP_SIGN(a), sb = MP_SIGN(b);
+ int cmp, last = 0, lg;
+ mp_result res = MP_OK;
+ mpz_t temp[2];
+ mp_int qout, rout;
+ mp_sign sa = MP_SIGN(a), sb = MP_SIGN(b);
- CHECK(a != NULL && b != NULL && q != r);
+ CHECK(a != NULL && b != NULL && q != r);
- if(CMPZ(b) == 0)
- return MP_UNDEF;
- else if((cmp = s_ucmp(a, b)) < 0) {
- /* If |a| < |b|, no division is required:
- q = 0, r = a
- */
- if(r && (res = mp_int_copy(K, a, r)) != MP_OK)
- return res;
-
- if(q)
- mp_int_zero(q);
-
- return MP_OK;
- }
- else if(cmp == 0) {
- /* If |a| = |b|, no division is required:
- q = 1 or -1, r = 0
- */
- if(r)
- mp_int_zero(r);
-
- if(q) {
- mp_int_zero(q);
- q->digits[0] = 1;
-
- if(sa != sb)
- MP_SIGN(q) = MP_NEG;
- }
-
- return MP_OK;
- }
-
- /* When |a| > |b|, real division is required. We need someplace to
- store quotient and remainder, but q and r are allowed to be NULL
- or to overlap with the inputs.
- */
- if((lg = s_isp2(b)) < 0) {
- if(q && b != q) {
- if((res = mp_int_copy(K, a, q)) != MP_OK)
- goto CLEANUP;
- else
- qout = q;
+ if(CMPZ(b) == 0)
+ return MP_UNDEF;
+ else if((cmp = s_ucmp(a, b)) < 0) {
+ /* If |a| < |b|, no division is required:
+ q = 0, r = a
+ */
+ if(r && (res = mp_int_copy(K, a, r)) != MP_OK)
+ return res;
+
+ if(q)
+ mp_int_zero(q);
+
+ return MP_OK;
+ }
+ else if(cmp == 0) {
+ /* If |a| = |b|, no division is required:
+ q = 1 or -1, r = 0
+ */
+ if(r)
+ mp_int_zero(r);
+
+ if(q) {
+ mp_int_zero(q);
+ q->digits[0] = 1;
+
+ if(sa != sb)
+ MP_SIGN(q) = MP_NEG;
+ }
+
+ return MP_OK;
}
- else {
- qout = TEMP(last);
- SETUP(mp_int_init_copy(K, TEMP(last), a), last);
- }
- if(r && a != r) {
- if((res = mp_int_copy(K, b, r)) != MP_OK)
- goto CLEANUP;
- else
- rout = r;
+ /* When |a| > |b|, real division is required. We need someplace to
+ store quotient and remainder, but q and r are allowed to be NULL
+ or to overlap with the inputs.
+ */
+ if((lg = s_isp2(b)) < 0) {
+ if(q && b != q) {
+ if((res = mp_int_copy(K, a, q)) != MP_OK)
+ goto CLEANUP;
+ else
+ qout = q;
+ }
+ else {
+ qout = TEMP(last);
+ SETUP(mp_int_init_copy(K, TEMP(last), a), last);
+ }
+
+ if(r && a != r) {
+ if((res = mp_int_copy(K, b, r)) != MP_OK)
+ goto CLEANUP;
+ else
+ rout = r;
+ }
+ else {
+ rout = TEMP(last);
+ SETUP(mp_int_init_copy(K, TEMP(last), b), last);
+ }
+
+ if((res = s_udiv(K, qout, rout)) != MP_OK) goto CLEANUP;
}
else {
- rout = TEMP(last);
- SETUP(mp_int_init_copy(K, TEMP(last), b), last);
- }
+ if(q && (res = mp_int_copy(K, a, q)) != MP_OK) goto CLEANUP;
+ if(r && (res = mp_int_copy(K, a, r)) != MP_OK) goto CLEANUP;
- if((res = s_udiv(K, qout, rout)) != MP_OK) goto CLEANUP;
- }
- else {
- if(q && (res = mp_int_copy(K, a, q)) != MP_OK) goto CLEANUP;
- if(r && (res = mp_int_copy(K, a, r)) != MP_OK) goto CLEANUP;
-
- if(q) s_qdiv(q, (mp_size) lg); qout = q;
- if(r) s_qmod(r, (mp_size) lg); rout = r;
- }
+ if(q) s_qdiv(q, (mp_size) lg); qout = q;
+ if(r) s_qmod(r, (mp_size) lg); rout = r;
+ }
- /* Recompute signs for output */
- if(rout) {
- MP_SIGN(rout) = sa;
- if(CMPZ(rout) == 0)
- MP_SIGN(rout) = MP_ZPOS;
- }
- if(qout) {
- MP_SIGN(qout) = (sa == sb) ? MP_ZPOS : MP_NEG;
- if(CMPZ(qout) == 0)
- MP_SIGN(qout) = MP_ZPOS;
- }
+ /* Recompute signs for output */
+ if(rout) {
+ MP_SIGN(rout) = sa;
+ if(CMPZ(rout) == 0)
+ MP_SIGN(rout) = MP_ZPOS;
+ }
+ if(qout) {
+ MP_SIGN(qout) = (sa == sb) ? MP_ZPOS : MP_NEG;
+ if(CMPZ(qout) == 0)
+ MP_SIGN(qout) = MP_ZPOS;
+ }
- if(q && (res = mp_int_copy(K, qout, q)) != MP_OK) goto CLEANUP;
- if(r && (res = mp_int_copy(K, rout, r)) != MP_OK) goto CLEANUP;
+ if(q && (res = mp_int_copy(K, qout, q)) != MP_OK) goto CLEANUP;
+ if(r && (res = mp_int_copy(K, rout, r)) != MP_OK) goto CLEANUP;
- CLEANUP:
- while(--last >= 0)
- mp_int_clear(K, TEMP(last));
+CLEANUP:
+ while(--last >= 0)
+ mp_int_clear(K, TEMP(last));
- return res;
+ return res;
}
/* }}} */
@@ -1000,31 +1000,31 @@ mp_result mp_int_div(klisp_State *K, mp_int a, mp_int b, mp_int q, mp_int r)
mp_result mp_int_mod(klisp_State *K, mp_int a, mp_int m, mp_int c)
{
- mp_result res;
- mpz_t tmp;
- mp_int out;
+ mp_result res;
+ mpz_t tmp;
+ mp_int out;
- if(m == c) {
- mp_int_init(&tmp);
- out = &tmp;
- }
- else {
- out = c;
- }
+ if(m == c) {
+ mp_int_init(&tmp);
+ out = &tmp;
+ }
+ else {
+ out = c;
+ }
- if((res = mp_int_div(K, a, m, NULL, out)) != MP_OK)
- goto CLEANUP;
+ if((res = mp_int_div(K, a, m, NULL, out)) != MP_OK)
+ goto CLEANUP;
- if(CMPZ(out) < 0)
- res = mp_int_add(K, out, m, c);
- else
- res = mp_int_copy(K, out, c);
+ if(CMPZ(out) < 0)
+ res = mp_int_add(K, out, m, c);
+ else
+ res = mp_int_copy(K, out, c);
- CLEANUP:
- if(out != c)
- mp_int_clear(K, &tmp);
+CLEANUP:
+ if(out != c)
+ mp_int_clear(K, &tmp);
- return res;
+ return res;
}
/* }}} */
@@ -1032,24 +1032,24 @@ mp_result mp_int_mod(klisp_State *K, mp_int a, mp_int m, mp_int c)
/* {{{ mp_int_div_value(a, value, q, r) */
mp_result mp_int_div_value(klisp_State *K, mp_int a, mp_small value,
- mp_int q, mp_small *r)
+ mp_int q, mp_small *r)
{
- mpz_t vtmp, rtmp;
- mp_digit vbuf[MP_VALUE_DIGITS(value)];
- mp_result res;
+ mpz_t vtmp, rtmp;
+ mp_digit vbuf[MP_VALUE_DIGITS(value)];
+ mp_result res;
- mp_int_init(&rtmp);
- s_fake(&vtmp, value, vbuf);
+ mp_int_init(&rtmp);
+ s_fake(&vtmp, value, vbuf);
- if((res = mp_int_div(K, a, &vtmp, q, &rtmp)) != MP_OK)
- goto CLEANUP;
+ if((res = mp_int_div(K, a, &vtmp, q, &rtmp)) != MP_OK)
+ goto CLEANUP;
- if(r)
- (void) mp_int_to_int(&rtmp, r); /* can't fail */
+ if(r)
+ (void) mp_int_to_int(&rtmp, r); /* can't fail */
- CLEANUP:
- mp_int_clear(K, &rtmp);
- return res;
+CLEANUP:
+ mp_int_clear(K, &rtmp);
+ return res;
}
/* }}} */
@@ -1057,19 +1057,19 @@ mp_result mp_int_div_value(klisp_State *K, mp_int a, mp_small value,
/* {{{ mp_int_div_pow2(a, p2, q, r) */
mp_result mp_int_div_pow2(klisp_State *K, mp_int a, mp_small p2, mp_int q,
- mp_int r)
+ mp_int r)
{
- mp_result res = MP_OK;
+ mp_result res = MP_OK;
- CHECK(a != NULL && p2 >= 0 && q != r);
+ CHECK(a != NULL && p2 >= 0 && q != r);
- if(q != NULL && (res = mp_int_copy(K, a, q)) == MP_OK)
- s_qdiv(q, (mp_size) p2);
+ if(q != NULL && (res = mp_int_copy(K, a, q)) == MP_OK)
+ s_qdiv(q, (mp_size) p2);
- if(res == MP_OK && r != NULL && (res = mp_int_copy(K, a, r)) == MP_OK)
- s_qmod(r, (mp_size) p2);
+ if(res == MP_OK && r != NULL && (res = mp_int_copy(K, a, r)) == MP_OK)
+ s_qmod(r, (mp_size) p2);
- return res;
+ return res;
}
/* }}} */
@@ -1078,34 +1078,34 @@ mp_result mp_int_div_pow2(klisp_State *K, mp_int a, mp_small p2, mp_int q,
mp_result mp_int_expt(klisp_State *K, mp_int a, mp_small b, mp_int c)
{
- mpz_t t;
- mp_result res;
- unsigned int v = abs(b);
+ mpz_t t;
+ mp_result res;
+ unsigned int v = abs(b);
- CHECK(c != NULL);
+ CHECK(c != NULL);
- CHECK(b >= 0 && c != NULL);
+ CHECK(b >= 0 && c != NULL);
- if((res = mp_int_init_copy(K, &t, a)) != MP_OK)
- return res;
+ if((res = mp_int_init_copy(K, &t, a)) != MP_OK)
+ return res;
- (void) mp_int_set_value(K, c, 1);
- while(v != 0) {
- if(v & 1) {
- if((res = mp_int_mul(K, c, &t, c)) != MP_OK)
- goto CLEANUP;
- }
+ (void) mp_int_set_value(K, c, 1);
+ while(v != 0) {
+ if(v & 1) {
+ if((res = mp_int_mul(K, c, &t, c)) != MP_OK)
+ goto CLEANUP;
+ }
- v >>= 1;
- if(v == 0) break;
+ v >>= 1;
+ if(v == 0) break;
- if((res = mp_int_sqr(K, &t, &t)) != MP_OK)
- goto CLEANUP;
- }
+ if((res = mp_int_sqr(K, &t, &t)) != MP_OK)
+ goto CLEANUP;
+ }
- CLEANUP:
- mp_int_clear(K, &t);
- return res;
+CLEANUP:
+ mp_int_clear(K, &t);
+ return res;
}
/* }}} */
@@ -1114,32 +1114,32 @@ mp_result mp_int_expt(klisp_State *K, mp_int a, mp_small b, mp_int c)
mp_result mp_int_expt_value(klisp_State *K, mp_small a, mp_small b, mp_int c)
{
- mpz_t t;
- mp_result res;
- unsigned int v = abs(b);
+ mpz_t t;
+ mp_result res;
+ unsigned int v = abs(b);
- CHECK(b >= 0 && c != NULL);
+ CHECK(b >= 0 && c != NULL);
- if((res = mp_int_init_value(K, &t, a)) != MP_OK)
- return res;
+ if((res = mp_int_init_value(K, &t, a)) != MP_OK)
+ return res;
- (void) mp_int_set_value(K, c, 1);
- while(v != 0) {
- if(v & 1) {
- if((res = mp_int_mul(K, c, &t, c)) != MP_OK)
- goto CLEANUP;
- }
+ (void) mp_int_set_value(K, c, 1);
+ while(v != 0) {
+ if(v & 1) {
+ if((res = mp_int_mul(K, c, &t, c)) != MP_OK)
+ goto CLEANUP;
+ }
- v >>= 1;
- if(v == 0) break;
+ v >>= 1;
+ if(v == 0) break;
- if((res = mp_int_sqr(K, &t, &t)) != MP_OK)
- goto CLEANUP;
- }
+ if((res = mp_int_sqr(K, &t, &t)) != MP_OK)
+ goto CLEANUP;
+ }
- CLEANUP:
- mp_int_clear(K, &t);
- return res;
+CLEANUP:
+ mp_int_clear(K, &t);
+ return res;
}
/* }}} */
@@ -1148,120 +1148,120 @@ mp_result mp_int_expt_value(klisp_State *K, mp_small a, mp_small b, mp_int c)
mp_result mp_int_expt_full(klisp_State *K, mp_int a, mp_int b, mp_int c)
{
- mpz_t t;
- mp_result res;
- int ix, jx;
+ mpz_t t;
+ mp_result res;
+ int ix, jx;
- CHECK(a != NULL && b != NULL && c != NULL);
+ CHECK(a != NULL && b != NULL && c != NULL);
- if ((res = mp_int_init_copy(K, &t, a)) != MP_OK)
- return res;
+ if ((res = mp_int_init_copy(K, &t, a)) != MP_OK)
+ return res;
- (void) mp_int_set_value(K, c, 1);
- for (ix = 0; ix < MP_USED(b); ++ix) {
- mp_digit d = b->digits[ix];
+ (void) mp_int_set_value(K, c, 1);
+ for (ix = 0; ix < MP_USED(b); ++ix) {
+ mp_digit d = b->digits[ix];
- for (jx = 0; jx < MP_DIGIT_BIT; ++jx) {
- if (d & 1) {
- if ((res = mp_int_mul(K, c, &t, c)) != MP_OK)
- goto CLEANUP;
- }
+ for (jx = 0; jx < MP_DIGIT_BIT; ++jx) {
+ if (d & 1) {
+ if ((res = mp_int_mul(K, c, &t, c)) != MP_OK)
+ goto CLEANUP;
+ }
- d >>= 1;
- if (d == 0 && ix + 1 == MP_USED(b))
- break;
- if ((res = mp_int_sqr(K, &t, &t)) != MP_OK)
- goto CLEANUP;
+ d >>= 1;
+ if (d == 0 && ix + 1 == MP_USED(b))
+ break;
+ if ((res = mp_int_sqr(K, &t, &t)) != MP_OK)
+ goto CLEANUP;
+ }
}
- }
- CLEANUP:
- mp_int_clear(K, &t);
- return res;
+CLEANUP:
+ mp_int_clear(K, &t);
+ return res;
}
/* }}} */
/* {{{ mp_int_compare(a, b) */
-int mp_int_compare(mp_int a, mp_int b)
+int mp_int_compare(mp_int a, mp_int b)
{
- mp_sign sa;
+ mp_sign sa;
- CHECK(a != NULL && b != NULL);
+ CHECK(a != NULL && b != NULL);
- sa = MP_SIGN(a);
- if(sa == MP_SIGN(b)) {
- int cmp = s_ucmp(a, b);
+ sa = MP_SIGN(a);
+ if(sa == MP_SIGN(b)) {
+ int cmp = s_ucmp(a, b);
- /* If they're both zero or positive, the normal comparison
- applies; if both negative, the sense is reversed. */
- if(sa == MP_ZPOS)
- return cmp;
- else
- return -cmp;
+ /* If they're both zero or positive, the normal comparison
+ applies; if both negative, the sense is reversed. */
+ if(sa == MP_ZPOS)
+ return cmp;
+ else
+ return -cmp;
- }
- else {
- if(sa == MP_ZPOS)
- return 1;
- else
- return -1;
- }
+ }
+ else {
+ if(sa == MP_ZPOS)
+ return 1;
+ else
+ return -1;
+ }
}
/* }}} */
/* {{{ mp_int_compare_unsigned(a, b) */
-int mp_int_compare_unsigned(mp_int a, mp_int b)
+int mp_int_compare_unsigned(mp_int a, mp_int b)
{
- NRCHECK(a != NULL && b != NULL);
+ NRCHECK(a != NULL && b != NULL);
- return s_ucmp(a, b);
+ return s_ucmp(a, b);
}
/* }}} */
/* {{{ mp_int_compare_zero(z) */
-int mp_int_compare_zero(mp_int z)
+int mp_int_compare_zero(mp_int z)
{
- NRCHECK(z != NULL);
+ NRCHECK(z != NULL);
- if(MP_USED(z) == 1 && z->digits[0] == 0)
- return 0;
- else if(MP_SIGN(z) == MP_ZPOS)
- return 1;
- else
- return -1;
+ if(MP_USED(z) == 1 && z->digits[0] == 0)
+ return 0;
+ else if(MP_SIGN(z) == MP_ZPOS)
+ return 1;
+ else
+ return -1;
}
/* }}} */
/* {{{ mp_int_compare_value(z, value) */
-int mp_int_compare_value(mp_int z, mp_small value)
+int mp_int_compare_value(mp_int z, mp_small value)
{
- mp_sign vsign = (value < 0) ? MP_NEG : MP_ZPOS;
- int cmp;
+ mp_sign vsign = (value < 0) ? MP_NEG : MP_ZPOS;
+ int cmp;
- CHECK(z != NULL);
+ CHECK(z != NULL);
- if(vsign == MP_SIGN(z)) {
- cmp = s_vcmp(z, value);
+ if(vsign == MP_SIGN(z)) {
+ cmp = s_vcmp(z, value);
- if(vsign == MP_ZPOS)
- return cmp;
- else
- return -cmp;
- }
- else {
- if(value < 0)
- return 1;
- else
- return -1;
- }
+ if(vsign == MP_ZPOS)
+ return cmp;
+ else
+ return -cmp;
+ }
+ else {
+ if(value < 0)
+ return 1;
+ else
+ return -1;
+ }
}
/* }}} */
@@ -1269,48 +1269,48 @@ int mp_int_compare_value(mp_int z, mp_small value)
/* {{{ mp_int_exptmod(a, b, m, c) */
mp_result mp_int_exptmod(klisp_State *K, mp_int a, mp_int b, mp_int m,
- mp_int c)
+ mp_int c)
{
- mp_result res;
- mp_size um;
- mpz_t temp[3];
- mp_int s;
- int last = 0;
-
- CHECK(a != NULL && b != NULL && c != NULL && m != NULL);
-
- /* Zero moduli and negative exponents are not considered. */
- if(CMPZ(m) == 0)
- return MP_UNDEF;
- if(CMPZ(b) < 0)
- return MP_RANGE;
-
- um = MP_USED(m);
- SETUP(mp_int_init_size(K, TEMP(0), 2 * um), last);
- SETUP(mp_int_init_size(K, TEMP(1), 2 * um), last);
-
- if(c == b || c == m) {
- SETUP(mp_int_init_size(K, TEMP(2), 2 * um), last);
- s = TEMP(2);
- }
- else {
- s = c;
- }
+ mp_result res;
+ mp_size um;
+ mpz_t temp[3];
+ mp_int s;
+ int last = 0;
+
+ CHECK(a != NULL && b != NULL && c != NULL && m != NULL);
+
+ /* Zero moduli and negative exponents are not considered. */
+ if(CMPZ(m) == 0)
+ return MP_UNDEF;
+ if(CMPZ(b) < 0)
+ return MP_RANGE;
+
+ um = MP_USED(m);
+ SETUP(mp_int_init_size(K, TEMP(0), 2 * um), last);
+ SETUP(mp_int_init_size(K, TEMP(1), 2 * um), last);
+
+ if(c == b || c == m) {
+ SETUP(mp_int_init_size(K, TEMP(2), 2 * um), last);
+ s = TEMP(2);
+ }
+ else {
+ s = c;
+ }
- if((res = mp_int_mod(K, a, m, TEMP(0))) != MP_OK) goto CLEANUP;
+ if((res = mp_int_mod(K, a, m, TEMP(0))) != MP_OK) goto CLEANUP;
- if((res = s_brmu(K, TEMP(1), m)) != MP_OK) goto CLEANUP;
+ if((res = s_brmu(K, TEMP(1), m)) != MP_OK) goto CLEANUP;
- if((res = s_embar(K, TEMP(0), b, m, TEMP(1), s)) != MP_OK)
- goto CLEANUP;
+ if((res = s_embar(K, TEMP(0), b, m, TEMP(1), s)) != MP_OK)
+ goto CLEANUP;
- res = mp_int_copy(K, s, c);
+ res = mp_int_copy(K, s, c);
- CLEANUP:
- while(--last >= 0)
- mp_int_clear(K, TEMP(last));
+CLEANUP:
+ while(--last >= 0)
+ mp_int_clear(K, TEMP(last));
- return res;
+ return res;
}
/* }}} */
@@ -1318,14 +1318,14 @@ mp_result mp_int_exptmod(klisp_State *K, mp_int a, mp_int b, mp_int m,
/* {{{ mp_int_exptmod_evalue(a, value, m, c) */
mp_result mp_int_exptmod_evalue(klisp_State *K, mp_int a, mp_small value,
- mp_int m, mp_int c)
+ mp_int m, mp_int c)
{
- mpz_t vtmp;
- mp_digit vbuf[MP_VALUE_DIGITS(value)];
+ mpz_t vtmp;
+ mp_digit vbuf[MP_VALUE_DIGITS(value)];
- s_fake(&vtmp, value, vbuf);
+ s_fake(&vtmp, value, vbuf);
- return mp_int_exptmod(K, a, &vtmp, m, c);
+ return mp_int_exptmod(K, a, &vtmp, m, c);
}
/* }}} */
@@ -1333,14 +1333,14 @@ mp_result mp_int_exptmod_evalue(klisp_State *K, mp_int a, mp_small value,
/* {{{ mp_int_exptmod_bvalue(v, b, m, c) */
mp_result mp_int_exptmod_bvalue(klisp_State *K, mp_small value, mp_int b,
- mp_int m, mp_int c)
+ mp_int m, mp_int c)
{
- mpz_t vtmp;
- mp_digit vbuf[MP_VALUE_DIGITS(value)];
+ mpz_t vtmp;
+ mp_digit vbuf[MP_VALUE_DIGITS(value)];
- s_fake(&vtmp, value, vbuf);
+ s_fake(&vtmp, value, vbuf);
- return mp_int_exptmod(K, &vtmp, b, m, c);
+ return mp_int_exptmod(K, &vtmp, b, m, c);
}
/* }}} */
@@ -1348,45 +1348,45 @@ mp_result mp_int_exptmod_bvalue(klisp_State *K, mp_small value, mp_int b,
/* {{{ mp_int_exptmod_known(a, b, m, mu, c) */
mp_result mp_int_exptmod_known(klisp_State *K, mp_int a, mp_int b, mp_int m,
- mp_int mu, mp_int c)
+ mp_int mu, mp_int c)
{
- mp_result res;
- mp_size um;
- mpz_t temp[2];
- mp_int s;
- int last = 0;
+ mp_result res;
+ mp_size um;
+ mpz_t temp[2];
+ mp_int s;
+ int last = 0;
- CHECK(a && b && m && c);
+ CHECK(a && b && m && c);
- /* Zero moduli and negative exponents are not considered. */
- if(CMPZ(m) == 0)
- return MP_UNDEF;
- if(CMPZ(b) < 0)
- return MP_RANGE;
+ /* Zero moduli and negative exponents are not considered. */
+ if(CMPZ(m) == 0)
+ return MP_UNDEF;
+ if(CMPZ(b) < 0)
+ return MP_RANGE;
- um = MP_USED(m);
- SETUP(mp_int_init_size(K, TEMP(0), 2 * um), last);
+ um = MP_USED(m);
+ SETUP(mp_int_init_size(K, TEMP(0), 2 * um), last);
- if(c == b || c == m) {
- SETUP(mp_int_init_size(K, TEMP(1), 2 * um), last);
- s = TEMP(1);
- }
- else {
- s = c;
- }
+ if(c == b || c == m) {
+ SETUP(mp_int_init_size(K, TEMP(1), 2 * um), last);
+ s = TEMP(1);
+ }
+ else {
+ s = c;
+ }
- if((res = mp_int_mod(K, a, m, TEMP(0))) != MP_OK) goto CLEANUP;
+ if((res = mp_int_mod(K, a, m, TEMP(0))) != MP_OK) goto CLEANUP;
- if((res = s_embar(K, TEMP(0), b, m, mu, s)) != MP_OK)
- goto CLEANUP;
+ if((res = s_embar(K, TEMP(0), b, m, mu, s)) != MP_OK)
+ goto CLEANUP;
- res = mp_int_copy(K, s, c);
+ res = mp_int_copy(K, s, c);
- CLEANUP:
- while(--last >= 0)
- mp_int_clear(K, TEMP(last));
+CLEANUP:
+ while(--last >= 0)
+ mp_int_clear(K, TEMP(last));
- return res;
+ return res;
}
/* }}} */
@@ -1395,9 +1395,9 @@ mp_result mp_int_exptmod_known(klisp_State *K, mp_int a, mp_int b, mp_int m,
mp_result mp_int_redux_const(klisp_State *K, mp_int m, mp_int c)
{
- CHECK(m != NULL && c != NULL && m != c);
+ CHECK(m != NULL && c != NULL && m != c);
- return s_brmu(K, c, m);
+ return s_brmu(K, c, m);
}
/* }}} */
@@ -1406,48 +1406,48 @@ mp_result mp_int_redux_const(klisp_State *K, mp_int m, mp_int c)
mp_result mp_int_invmod(klisp_State *K, mp_int a, mp_int m, mp_int c)
{
- mp_result res;
- mp_sign sa;
- int last = 0;
- mpz_t temp[2];
+ mp_result res;
+ mp_sign sa;
+ int last = 0;
+ mpz_t temp[2];
- CHECK(a != NULL && m != NULL && c != NULL);
+ CHECK(a != NULL && m != NULL && c != NULL);
- if(CMPZ(a) == 0 || CMPZ(m) <= 0)
- return MP_RANGE;
+ if(CMPZ(a) == 0 || CMPZ(m) <= 0)
+ return MP_RANGE;
- sa = MP_SIGN(a); /* need this for the result later */
+ sa = MP_SIGN(a); /* need this for the result later */
- for(last = 0; last < 2; ++last)
- mp_int_init(TEMP(last));
+ for(last = 0; last < 2; ++last)
+ mp_int_init(TEMP(last));
- if((res = mp_int_egcd(K, a, m, TEMP(0), TEMP(1), NULL)) != MP_OK)
- goto CLEANUP;
+ if((res = mp_int_egcd(K, a, m, TEMP(0), TEMP(1), NULL)) != MP_OK)
+ goto CLEANUP;
- if(mp_int_compare_value(TEMP(0), 1) != 0) {
- res = MP_UNDEF;
- goto CLEANUP;
- }
+ if(mp_int_compare_value(TEMP(0), 1) != 0) {
+ res = MP_UNDEF;
+ goto CLEANUP;
+ }
- /* It is first necessary to constrain the value to the proper range */
- if((res = mp_int_mod(K, TEMP(1), m, TEMP(1))) != MP_OK)
- goto CLEANUP;
+ /* It is first necessary to constrain the value to the proper range */
+ if((res = mp_int_mod(K, TEMP(1), m, TEMP(1))) != MP_OK)
+ goto CLEANUP;
- /* Now, if 'a' was originally negative, the value we have is
- actually the magnitude of the negative representative; to get the
- positive value we have to subtract from the modulus. Otherwise,
- the value is okay as it stands.
- */
- if(sa == MP_NEG)
- res = mp_int_sub(K, m, TEMP(1), c);
- else
- res = mp_int_copy(K, TEMP(1), c);
+ /* Now, if 'a' was originally negative, the value we have is
+ actually the magnitude of the negative representative; to get the
+ positive value we have to subtract from the modulus. Otherwise,
+ the value is okay as it stands.
+ */
+ if(sa == MP_NEG)
+ res = mp_int_sub(K, m, TEMP(1), c);
+ else
+ res = mp_int_copy(K, TEMP(1), c);
- CLEANUP:
- while(--last >= 0)
- mp_int_clear(K, TEMP(last));
+CLEANUP:
+ while(--last >= 0)
+ mp_int_clear(K, TEMP(last));
- return res;
+ return res;
}
/* }}} */
@@ -1457,76 +1457,76 @@ mp_result mp_int_invmod(klisp_State *K, mp_int a, mp_int m, mp_int c)
/* Binary GCD algorithm due to Josef Stein, 1961 */
mp_result mp_int_gcd(klisp_State *K, mp_int a, mp_int b, mp_int c)
{
- int ca, cb, k = 0;
- mpz_t u, v, t;
- mp_result res;
-
- CHECK(a != NULL && b != NULL && c != NULL);
-
- ca = CMPZ(a);
- cb = CMPZ(b);
- if(ca == 0 && cb == 0)
- return MP_UNDEF;
- else if(ca == 0)
- return mp_int_abs(K, b, c);
- else if(cb == 0)
- return mp_int_abs(K, a, c);
-
- mp_int_init(&t);
- if((res = mp_int_init_copy(K, &u, a)) != MP_OK)
- goto U;
- if((res = mp_int_init_copy(K, &v, b)) != MP_OK)
- goto V;
-
- MP_SIGN(&u) = MP_ZPOS; MP_SIGN(&v) = MP_ZPOS;
-
- { /* Divide out common factors of 2 from u and v */
- int div2_u = s_dp2k(&u), div2_v = s_dp2k(&v);
+ int ca, cb, k = 0;
+ mpz_t u, v, t;
+ mp_result res;
+
+ CHECK(a != NULL && b != NULL && c != NULL);
+
+ ca = CMPZ(a);
+ cb = CMPZ(b);
+ if(ca == 0 && cb == 0)
+ return MP_UNDEF;
+ else if(ca == 0)
+ return mp_int_abs(K, b, c);
+ else if(cb == 0)
+ return mp_int_abs(K, a, c);
+
+ mp_int_init(&t);
+ if((res = mp_int_init_copy(K, &u, a)) != MP_OK)
+ goto U;
+ if((res = mp_int_init_copy(K, &v, b)) != MP_OK)
+ goto V;
+
+ MP_SIGN(&u) = MP_ZPOS; MP_SIGN(&v) = MP_ZPOS;
+
+ { /* Divide out common factors of 2 from u and v */
+ int div2_u = s_dp2k(&u), div2_v = s_dp2k(&v);
- k = MIN(div2_u, div2_v);
- s_qdiv(&u, (mp_size) k);
- s_qdiv(&v, (mp_size) k);
- }
+ k = MIN(div2_u, div2_v);
+ s_qdiv(&u, (mp_size) k);
+ s_qdiv(&v, (mp_size) k);
+ }
- if(mp_int_is_odd(&u)) {
- if((res = mp_int_neg(K, &v, &t)) != MP_OK)
- goto CLEANUP;
- }
- else {
- if((res = mp_int_copy(K, &u, &t)) != MP_OK)
- goto CLEANUP;
- }
-
- for(;;) {
- s_qdiv(&t, s_dp2k(&t));
-
- if(CMPZ(&t) > 0) {
- if((res = mp_int_copy(K, &t, &u)) != MP_OK)
- goto CLEANUP;
+ if(mp_int_is_odd(&u)) {
+ if((res = mp_int_neg(K, &v, &t)) != MP_OK)
+ goto CLEANUP;
}
else {
- if((res = mp_int_neg(K, &t, &v)) != MP_OK)
- goto CLEANUP;
+ if((res = mp_int_copy(K, &u, &t)) != MP_OK)
+ goto CLEANUP;
}
- if((res = mp_int_sub(K, &u, &v, &t)) != MP_OK)
- goto CLEANUP;
+ for(;;) {
+ s_qdiv(&t, s_dp2k(&t));
+
+ if(CMPZ(&t) > 0) {
+ if((res = mp_int_copy(K, &t, &u)) != MP_OK)
+ goto CLEANUP;
+ }
+ else {
+ if((res = mp_int_neg(K, &t, &v)) != MP_OK)
+ goto CLEANUP;
+ }
- if(CMPZ(&t) == 0)
- break;
- }
+ if((res = mp_int_sub(K, &u, &v, &t)) != MP_OK)
+ goto CLEANUP;
- if((res = mp_int_abs(K, &u, c)) != MP_OK)
- goto CLEANUP;
- if(!s_qmul(K, c, (mp_size) k))
- res = MP_MEMORY;
+ if(CMPZ(&t) == 0)
+ break;
+ }
+
+ if((res = mp_int_abs(K, &u, c)) != MP_OK)
+ goto CLEANUP;
+ if(!s_qmul(K, c, (mp_size) k))
+ res = MP_MEMORY;
- CLEANUP:
- mp_int_clear(K, &v);
- V: mp_int_clear(K, &u);
- U: mp_int_clear(K, &t);
+CLEANUP:
+ mp_int_clear(K, &v);
+V: mp_int_clear(K, &u);
+U: mp_int_clear(K, &t);
- return res;
+ return res;
}
/* }}} */
@@ -1536,116 +1536,116 @@ mp_result mp_int_gcd(klisp_State *K, mp_int a, mp_int b, mp_int c)
/* This is the binary GCD algorithm again, but this time we keep track
of the elementary matrix operations as we go, so we can get values
x and y satisfying c = ax + by.
- */
+*/
mp_result mp_int_egcd(klisp_State *K, mp_int a, mp_int b, mp_int c,
- mp_int x, mp_int y)
+ mp_int x, mp_int y)
{
- int k, last = 0, ca, cb;
- mpz_t temp[8];
- mp_result res;
+ int k, last = 0, ca, cb;
+ mpz_t temp[8];
+ mp_result res;
- CHECK(a != NULL && b != NULL && c != NULL &&
- (x != NULL || y != NULL));
-
- ca = CMPZ(a);
- cb = CMPZ(b);
- if(ca == 0 && cb == 0)
- return MP_UNDEF;
- else if(ca == 0) {
- if((res = mp_int_abs(K, b, c)) != MP_OK) return res;
- mp_int_zero(x); (void) mp_int_set_value(K, y, 1); return MP_OK;
- }
- else if(cb == 0) {
- if((res = mp_int_abs(K, a, c)) != MP_OK) return res;
- (void) mp_int_set_value(K, x, 1); mp_int_zero(y); return MP_OK;
- }
-
- /* Initialize temporaries:
- A:0, B:1, C:2, D:3, u:4, v:5, ou:6, ov:7 */
- for(last = 0; last < 4; ++last)
- mp_int_init(TEMP(last));
- TEMP(0)->digits[0] = 1;
- TEMP(3)->digits[0] = 1;
-
- SETUP(mp_int_init_copy(K, TEMP(4), a), last);
- SETUP(mp_int_init_copy(K, TEMP(5), b), last);
-
- /* We will work with absolute values here */
- MP_SIGN(TEMP(4)) = MP_ZPOS;
- MP_SIGN(TEMP(5)) = MP_ZPOS;
-
- { /* Divide out common factors of 2 from u and v */
- int div2_u = s_dp2k(TEMP(4)), div2_v = s_dp2k(TEMP(5));
-
- k = MIN(div2_u, div2_v);
- s_qdiv(TEMP(4), k);
- s_qdiv(TEMP(5), k);
- }
-
- SETUP(mp_int_init_copy(K, TEMP(6), TEMP(4)), last);
- SETUP(mp_int_init_copy(K, TEMP(7), TEMP(5)), last);
-
- for(;;) {
- while(mp_int_is_even(TEMP(4))) {
- s_qdiv(TEMP(4), 1);
-
- if(mp_int_is_odd(TEMP(0)) || mp_int_is_odd(TEMP(1))) {
- if((res = mp_int_add(K, TEMP(0), TEMP(7), TEMP(0))) != MP_OK)
- goto CLEANUP;
- if((res = mp_int_sub(K, TEMP(1), TEMP(6), TEMP(1))) != MP_OK)
- goto CLEANUP;
- }
-
- s_qdiv(TEMP(0), 1);
- s_qdiv(TEMP(1), 1);
+ CHECK(a != NULL && b != NULL && c != NULL &&
+ (x != NULL || y != NULL));
+
+ ca = CMPZ(a);
+ cb = CMPZ(b);
+ if(ca == 0 && cb == 0)
+ return MP_UNDEF;
+ else if(ca == 0) {
+ if((res = mp_int_abs(K, b, c)) != MP_OK) return res;
+ mp_int_zero(x); (void) mp_int_set_value(K, y, 1); return MP_OK;
+ }
+ else if(cb == 0) {
+ if((res = mp_int_abs(K, a, c)) != MP_OK) return res;
+ (void) mp_int_set_value(K, x, 1); mp_int_zero(y); return MP_OK;
}
-
- while(mp_int_is_even(TEMP(5))) {
- s_qdiv(TEMP(5), 1);
- if(mp_int_is_odd(TEMP(2)) || mp_int_is_odd(TEMP(3))) {
- if((res = mp_int_add(K, TEMP(2), TEMP(7), TEMP(2))) != MP_OK)
- goto CLEANUP;
- if((res = mp_int_sub(K, TEMP(3), TEMP(6), TEMP(3))) != MP_OK)
- goto CLEANUP;
- }
+ /* Initialize temporaries:
+ A:0, B:1, C:2, D:3, u:4, v:5, ou:6, ov:7 */
+ for(last = 0; last < 4; ++last)
+ mp_int_init(TEMP(last));
+ TEMP(0)->digits[0] = 1;
+ TEMP(3)->digits[0] = 1;
+
+ SETUP(mp_int_init_copy(K, TEMP(4), a), last);
+ SETUP(mp_int_init_copy(K, TEMP(5), b), last);
+
+ /* We will work with absolute values here */
+ MP_SIGN(TEMP(4)) = MP_ZPOS;
+ MP_SIGN(TEMP(5)) = MP_ZPOS;
- s_qdiv(TEMP(2), 1);
- s_qdiv(TEMP(3), 1);
+ { /* Divide out common factors of 2 from u and v */
+ int div2_u = s_dp2k(TEMP(4)), div2_v = s_dp2k(TEMP(5));
+
+ k = MIN(div2_u, div2_v);
+ s_qdiv(TEMP(4), k);
+ s_qdiv(TEMP(5), k);
}
- if(mp_int_compare(TEMP(4), TEMP(5)) >= 0) {
- if((res = mp_int_sub(K, TEMP(4), TEMP(5), TEMP(4))) != MP_OK) goto CLEANUP;
- if((res = mp_int_sub(K, TEMP(0), TEMP(2), TEMP(0))) != MP_OK) goto CLEANUP;
- if((res = mp_int_sub(K, TEMP(1), TEMP(3), TEMP(1))) != MP_OK) goto CLEANUP;
- }
- else {
- if((res = mp_int_sub(K, TEMP(5), TEMP(4), TEMP(5))) != MP_OK) goto CLEANUP;
- if((res = mp_int_sub(K, TEMP(2), TEMP(0), TEMP(2))) != MP_OK) goto CLEANUP;
- if((res = mp_int_sub(K, TEMP(3), TEMP(1), TEMP(3))) != MP_OK) goto CLEANUP;
- }
-
- if(CMPZ(TEMP(4)) == 0) {
- if(x && (res = mp_int_copy(K, TEMP(2), x)) != MP_OK) goto CLEANUP;
- if(y && (res = mp_int_copy(K, TEMP(3), y)) != MP_OK) goto CLEANUP;
- if(c) {
- if(!s_qmul(K, TEMP(5), k)) {
- res = MP_MEMORY;
- goto CLEANUP;
- }
+ SETUP(mp_int_init_copy(K, TEMP(6), TEMP(4)), last);
+ SETUP(mp_int_init_copy(K, TEMP(7), TEMP(5)), last);
+
+ for(;;) {
+ while(mp_int_is_even(TEMP(4))) {
+ s_qdiv(TEMP(4), 1);
+
+ if(mp_int_is_odd(TEMP(0)) || mp_int_is_odd(TEMP(1))) {
+ if((res = mp_int_add(K, TEMP(0), TEMP(7), TEMP(0))) != MP_OK)
+ goto CLEANUP;
+ if((res = mp_int_sub(K, TEMP(1), TEMP(6), TEMP(1))) != MP_OK)
+ goto CLEANUP;
+ }
+
+ s_qdiv(TEMP(0), 1);
+ s_qdiv(TEMP(1), 1);
+ }
+
+ while(mp_int_is_even(TEMP(5))) {
+ s_qdiv(TEMP(5), 1);
+
+ if(mp_int_is_odd(TEMP(2)) || mp_int_is_odd(TEMP(3))) {
+ if((res = mp_int_add(K, TEMP(2), TEMP(7), TEMP(2))) != MP_OK)
+ goto CLEANUP;
+ if((res = mp_int_sub(K, TEMP(3), TEMP(6), TEMP(3))) != MP_OK)
+ goto CLEANUP;
+ }
+
+ s_qdiv(TEMP(2), 1);
+ s_qdiv(TEMP(3), 1);
+ }
+
+ if(mp_int_compare(TEMP(4), TEMP(5)) >= 0) {
+ if((res = mp_int_sub(K, TEMP(4), TEMP(5), TEMP(4))) != MP_OK) goto CLEANUP;
+ if((res = mp_int_sub(K, TEMP(0), TEMP(2), TEMP(0))) != MP_OK) goto CLEANUP;
+ if((res = mp_int_sub(K, TEMP(1), TEMP(3), TEMP(1))) != MP_OK) goto CLEANUP;
+ }
+ else {
+ if((res = mp_int_sub(K, TEMP(5), TEMP(4), TEMP(5))) != MP_OK) goto CLEANUP;
+ if((res = mp_int_sub(K, TEMP(2), TEMP(0), TEMP(2))) != MP_OK) goto CLEANUP;
+ if((res = mp_int_sub(K, TEMP(3), TEMP(1), TEMP(3))) != MP_OK) goto CLEANUP;
+ }
+
+ if(CMPZ(TEMP(4)) == 0) {
+ if(x && (res = mp_int_copy(K, TEMP(2), x)) != MP_OK) goto CLEANUP;
+ if(y && (res = mp_int_copy(K, TEMP(3), y)) != MP_OK) goto CLEANUP;
+ if(c) {
+ if(!s_qmul(K, TEMP(5), k)) {
+ res = MP_MEMORY;
+ goto CLEANUP;
+ }
- res = mp_int_copy(K, TEMP(5), c);
- }
+ res = mp_int_copy(K, TEMP(5), c);
+ }
- break;
+ break;
+ }
}
- }
- CLEANUP:
- while(--last >= 0)
- mp_int_clear(K, TEMP(last));
+CLEANUP:
+ while(--last >= 0)
+ mp_int_clear(K, TEMP(last));
- return res;
+ return res;
}
/* }}} */
@@ -1654,57 +1654,57 @@ mp_result mp_int_egcd(klisp_State *K, mp_int a, mp_int b, mp_int c,
mp_result mp_int_lcm(klisp_State *K, mp_int a, mp_int b, mp_int c)
{
- mpz_t lcm;
- mp_result res;
-
- CHECK(a != NULL && b != NULL && c != NULL);
+ mpz_t lcm;
+ mp_result res;
- /* Since a * b = gcd(a, b) * lcm(a, b), we can compute
- lcm(a, b) = (a / gcd(a, b)) * b.
-
- This formulation insures everything works even if the input
- variables share space.
- */
- if((res = mp_int_init(&lcm)) != MP_OK)
- return res;
- if((res = mp_int_gcd(K, a, b, &lcm)) != MP_OK)
- goto CLEANUP;
- if((res = mp_int_div(K, a, &lcm, &lcm, NULL)) != MP_OK)
- goto CLEANUP;
- if((res = mp_int_mul(K, &lcm, b, &lcm)) != MP_OK)
- goto CLEANUP;
+ CHECK(a != NULL && b != NULL && c != NULL);
- res = mp_int_copy(K, &lcm, c);
+ /* Since a * b = gcd(a, b) * lcm(a, b), we can compute
+ lcm(a, b) = (a / gcd(a, b)) * b.
- CLEANUP:
+ This formulation insures everything works even if the input
+ variables share space.
+ */
+ if((res = mp_int_init(&lcm)) != MP_OK)
+ return res;
+ if((res = mp_int_gcd(K, a, b, &lcm)) != MP_OK)
+ goto CLEANUP;
+ if((res = mp_int_div(K, a, &lcm, &lcm, NULL)) != MP_OK)
+ goto CLEANUP;
+ if((res = mp_int_mul(K, &lcm, b, &lcm)) != MP_OK)
+ goto CLEANUP;
+
+ res = mp_int_copy(K, &lcm, c);
+
+CLEANUP:
mp_int_clear(K, &lcm);
- return res;
+ return res;
}
/* }}} */
/* {{{ mp_int_divisible_value(a, v) */
-int mp_int_divisible_value(klisp_State *K, mp_int a, mp_small v)
+int mp_int_divisible_value(klisp_State *K, mp_int a, mp_small v)
{
- mp_small rem = 0;
+ mp_small rem = 0;
- if(mp_int_div_value(K, a, v, NULL, &rem) != MP_OK)
- return 0;
+ if(mp_int_div_value(K, a, v, NULL, &rem) != MP_OK)
+ return 0;
- return rem == 0;
+ return rem == 0;
}
/* }}} */
/* {{{ mp_int_is_pow2(z) */
-int mp_int_is_pow2(mp_int z)
+int mp_int_is_pow2(mp_int z)
{
- CHECK(z != NULL);
+ CHECK(z != NULL);
- return s_isp2(z);
+ return s_isp2(z);
}
/* }}} */
@@ -1714,73 +1714,73 @@ int mp_int_is_pow2(mp_int z)
/* Implementation of Newton's root finding method, based loosely on a
patch contributed by Hal Finkel <half@halssoftware.com>
modified by M. J. Fromberger.
- */
+*/
mp_result mp_int_root(klisp_State *K, mp_int a, mp_small b, mp_int c)
{
- mp_result res = MP_OK;
- mpz_t temp[5];
- int last = 0;
- int flips = 0;
+ mp_result res = MP_OK;
+ mpz_t temp[5];
+ int last = 0;
+ int flips = 0;
- CHECK(a != NULL && c != NULL && b > 0);
+ CHECK(a != NULL && c != NULL && b > 0);
- if(b == 1) {
- return mp_int_copy(K, a, c);
- }
- if(MP_SIGN(a) == MP_NEG) {
- if(b % 2 == 0)
- return MP_UNDEF; /* root does not exist for negative a with even b */
- else
- flips = 1;
- }
-
- SETUP(mp_int_init_copy(K, TEMP(last), a), last);
- SETUP(mp_int_init_copy(K, TEMP(last), a), last);
- SETUP(mp_int_init(TEMP(last)), last);
- SETUP(mp_int_init(TEMP(last)), last);
- SETUP(mp_int_init(TEMP(last)), last);
-
- (void) mp_int_abs(K, TEMP(0), TEMP(0));
- (void) mp_int_abs(K, TEMP(1), TEMP(1));
-
- for(;;) {
- if((res = mp_int_expt(K, TEMP(1), b, TEMP(2))) != MP_OK)
- goto CLEANUP;
-
- if(mp_int_compare_unsigned(TEMP(2), TEMP(0)) <= 0)
- break;
-
- if((res = mp_int_sub(K, TEMP(2), TEMP(0), TEMP(2))) != MP_OK)
- goto CLEANUP;
- if((res = mp_int_expt(K, TEMP(1), b - 1, TEMP(3))) != MP_OK)
- goto CLEANUP;
- if((res = mp_int_mul_value(K, TEMP(3), b, TEMP(3))) != MP_OK)
- goto CLEANUP;
- if((res = mp_int_div(K, TEMP(2), TEMP(3), TEMP(4), NULL)) != MP_OK)
- goto CLEANUP;
- if((res = mp_int_sub(K, TEMP(1), TEMP(4), TEMP(4))) != MP_OK)
- goto CLEANUP;
-
- if(mp_int_compare_unsigned(TEMP(1), TEMP(4)) == 0) {
- if((res = mp_int_sub_value(K, TEMP(4), 1, TEMP(4))) != MP_OK)
- goto CLEANUP;
- }
- if((res = mp_int_copy(K, TEMP(4), TEMP(1))) != MP_OK)
- goto CLEANUP;
- }
+ if(b == 1) {
+ return mp_int_copy(K, a, c);
+ }
+ if(MP_SIGN(a) == MP_NEG) {
+ if(b % 2 == 0)
+ return MP_UNDEF; /* root does not exist for negative a with even b */
+ else
+ flips = 1;
+ }
+
+ SETUP(mp_int_init_copy(K, TEMP(last), a), last);
+ SETUP(mp_int_init_copy(K, TEMP(last), a), last);
+ SETUP(mp_int_init(TEMP(last)), last);
+ SETUP(mp_int_init(TEMP(last)), last);
+ SETUP(mp_int_init(TEMP(last)), last);
+
+ (void) mp_int_abs(K, TEMP(0), TEMP(0));
+ (void) mp_int_abs(K, TEMP(1), TEMP(1));
+
+ for(;;) {
+ if((res = mp_int_expt(K, TEMP(1), b, TEMP(2))) != MP_OK)
+ goto CLEANUP;
+
+ if(mp_int_compare_unsigned(TEMP(2), TEMP(0)) <= 0)
+ break;
+
+ if((res = mp_int_sub(K, TEMP(2), TEMP(0), TEMP(2))) != MP_OK)
+ goto CLEANUP;
+ if((res = mp_int_expt(K, TEMP(1), b - 1, TEMP(3))) != MP_OK)
+ goto CLEANUP;
+ if((res = mp_int_mul_value(K, TEMP(3), b, TEMP(3))) != MP_OK)
+ goto CLEANUP;
+ if((res = mp_int_div(K, TEMP(2), TEMP(3), TEMP(4), NULL)) != MP_OK)
+ goto CLEANUP;
+ if((res = mp_int_sub(K, TEMP(1), TEMP(4), TEMP(4))) != MP_OK)
+ goto CLEANUP;
+
+ if(mp_int_compare_unsigned(TEMP(1), TEMP(4)) == 0) {
+ if((res = mp_int_sub_value(K, TEMP(4), 1, TEMP(4))) != MP_OK)
+ goto CLEANUP;
+ }
+ if((res = mp_int_copy(K, TEMP(4), TEMP(1))) != MP_OK)
+ goto CLEANUP;
+ }
- if((res = mp_int_copy(K, TEMP(1), c)) != MP_OK)
- goto CLEANUP;
+ if((res = mp_int_copy(K, TEMP(1), c)) != MP_OK)
+ goto CLEANUP;
- /* If the original value of a was negative, flip the output sign. */
- if(flips)
- (void) mp_int_neg(K, c, c); /* cannot fail */
+ /* If the original value of a was negative, flip the output sign. */
+ if(flips)
+ (void) mp_int_neg(K, c, c); /* cannot fail */
- CLEANUP:
- while(--last >= 0)
- mp_int_clear(K, TEMP(last));
+CLEANUP:
+ while(--last >= 0)
+ mp_int_clear(K, TEMP(last));
- return res;
+ return res;
}
/* }}} */
@@ -1789,32 +1789,32 @@ mp_result mp_int_root(klisp_State *K, mp_int a, mp_small b, mp_int c)
mp_result mp_int_to_int(mp_int z, mp_small *out)
{
- mp_usmall uv = 0;
- mp_size uz;
- mp_digit *dz;
- mp_sign sz;
-
- CHECK(z != NULL);
-
- /* Make sure the value is representable as an int */
- sz = MP_SIGN(z);
- if((sz == MP_ZPOS && mp_int_compare_value(z, MP_SMALL_MAX) > 0) ||
- mp_int_compare_value(z, MP_SMALL_MIN) < 0)
- return MP_RANGE;
-
- uz = MP_USED(z);
- dz = MP_DIGITS(z) + uz - 1;
+ mp_usmall uv = 0;
+ mp_size uz;
+ mp_digit *dz;
+ mp_sign sz;
+
+ CHECK(z != NULL);
+
+ /* Make sure the value is representable as an int */
+ sz = MP_SIGN(z);
+ if((sz == MP_ZPOS && mp_int_compare_value(z, MP_SMALL_MAX) > 0) ||
+ mp_int_compare_value(z, MP_SMALL_MIN) < 0)
+ return MP_RANGE;
+
+ uz = MP_USED(z);
+ dz = MP_DIGITS(z) + uz - 1;
- while(uz > 0) {
- uv <<= MP_DIGIT_BIT/2;
- uv = (uv << (MP_DIGIT_BIT/2)) | *dz--;
- --uz;
- }
+ while(uz > 0) {
+ uv <<= MP_DIGIT_BIT/2;
+ uv = (uv << (MP_DIGIT_BIT/2)) | *dz--;
+ --uz;
+ }
- if(out)
- *out = (sz == MP_NEG) ? -(mp_small)uv : (mp_small)uv;
+ if(out)
+ *out = (sz == MP_NEG) ? -(mp_small)uv : (mp_small)uv;
- return MP_OK;
+ return MP_OK;
}
/* }}} */
@@ -1823,31 +1823,31 @@ mp_result mp_int_to_int(mp_int z, mp_small *out)
mp_result mp_int_to_uint(mp_int z, mp_usmall *out)
{
- mp_usmall uv = 0;
- mp_size uz;
- mp_digit *dz;
- mp_sign sz;
+ mp_usmall uv = 0;
+ mp_size uz;
+ mp_digit *dz;
+ mp_sign sz;
- CHECK(z != NULL);
-
- /* Make sure the value is representable as an int */
- sz = MP_SIGN(z);
- if(!(sz == MP_ZPOS && mp_int_compare_value(z, UINT_MAX) <= 0))
- return MP_RANGE;
-
- uz = MP_USED(z);
- dz = MP_DIGITS(z) + uz - 1;
+ CHECK(z != NULL);
+
+ /* Make sure the value is representable as an int */
+ sz = MP_SIGN(z);
+ if(!(sz == MP_ZPOS && mp_int_compare_value(z, UINT_MAX) <= 0))
+ return MP_RANGE;
+
+ uz = MP_USED(z);
+ dz = MP_DIGITS(z) + uz - 1;
- while(uz > 0) {
- uv <<= MP_DIGIT_BIT/2;
- uv = (uv << (MP_DIGIT_BIT/2)) | *dz--;
- --uz;
- }
+ while(uz > 0) {
+ uv <<= MP_DIGIT_BIT/2;
+ uv = (uv << (MP_DIGIT_BIT/2)) | *dz--;
+ --uz;
+ }
- if(out)
- *out = uv;
+ if(out)
+ *out = uv;
- return MP_OK;
+ return MP_OK;
}
/* }}} */
@@ -1855,59 +1855,59 @@ mp_result mp_int_to_uint(mp_int z, mp_usmall *out)
/* {{{ mp_int_to_string(z, radix, str, limit) */
mp_result mp_int_to_string(klisp_State *K, mp_int z, mp_size radix,
- char *str, int limit)
+ char *str, int limit)
{
- mp_result res;
- int cmp = 0;
-
- CHECK(z != NULL && str != NULL && limit >= 2);
+ mp_result res;
+ int cmp = 0;
- if(radix < MP_MIN_RADIX || radix > MP_MAX_RADIX)
- return MP_RANGE;
+ CHECK(z != NULL && str != NULL && limit >= 2);
- if(CMPZ(z) == 0) {
- *str++ = s_val2ch(0, 0); /* changed to lowercase, Andres Navarro */
- }
- else {
- mpz_t tmp;
- char *h, *t;
-
- if((res = mp_int_init_copy(K, &tmp, z)) != MP_OK)
- return res;
-
- if(MP_SIGN(z) == MP_NEG) {
- *str++ = '-';
- --limit;
- }
- h = str;
+ if(radix < MP_MIN_RADIX || radix > MP_MAX_RADIX)
+ return MP_RANGE;
- /* Generate digits in reverse order until finished or limit reached */
- for(/* */; limit > 0; --limit) {
- mp_digit d;
-
- if((cmp = CMPZ(&tmp)) == 0)
- break;
-
- d = s_ddiv(&tmp, (mp_digit)radix);
- *str++ = s_val2ch(d, 0); /* changed to lowercase, Andres Navarro */
- }
- t = str - 1;
-
- /* Put digits back in correct output order */
- while(h < t) {
- char tc = *h;
- *h++ = *t;
- *t-- = tc;
+ if(CMPZ(z) == 0) {
+ *str++ = s_val2ch(0, 0); /* changed to lowercase, Andres Navarro */
+ }
+ else {
+ mpz_t tmp;
+ char *h, *t;
+
+ if((res = mp_int_init_copy(K, &tmp, z)) != MP_OK)
+ return res;
+
+ if(MP_SIGN(z) == MP_NEG) {
+ *str++ = '-';
+ --limit;
+ }
+ h = str;
+
+ /* Generate digits in reverse order until finished or limit reached */
+ for(/* */; limit > 0; --limit) {
+ mp_digit d;
+
+ if((cmp = CMPZ(&tmp)) == 0)
+ break;
+
+ d = s_ddiv(&tmp, (mp_digit)radix);
+ *str++ = s_val2ch(d, 0); /* changed to lowercase, Andres Navarro */
+ }
+ t = str - 1;
+
+ /* Put digits back in correct output order */
+ while(h < t) {
+ char tc = *h;
+ *h++ = *t;
+ *t-- = tc;
+ }
+
+ mp_int_clear(K, &tmp);
}
- mp_int_clear(K, &tmp);
- }
-
- *str = '\0';
- if(cmp == 0)
- return MP_OK;
- else
- return MP_TRUNC;
+ *str = '\0';
+ if(cmp == 0)
+ return MP_OK;
+ else
+ return MP_TRUNC;
}
/* }}} */
@@ -1916,20 +1916,20 @@ mp_result mp_int_to_string(klisp_State *K, mp_int z, mp_size radix,
mp_result mp_int_string_len(mp_int z, mp_size radix)
{
- int len;
+ int len;
- CHECK(z != NULL);
+ CHECK(z != NULL);
- if(radix < MP_MIN_RADIX || radix > MP_MAX_RADIX)
- return MP_RANGE;
+ if(radix < MP_MIN_RADIX || radix > MP_MAX_RADIX)
+ return MP_RANGE;
- len = s_outlen(z, radix) + 1; /* for terminator */
+ len = s_outlen(z, radix) + 1; /* for terminator */
- /* Allow for sign marker on negatives */
- if(MP_SIGN(z) == MP_NEG)
- len += 1;
+ /* Allow for sign marker on negatives */
+ if(MP_SIGN(z) == MP_NEG)
+ len += 1;
- return len;
+ return len;
}
/* }}} */
@@ -1938,9 +1938,9 @@ mp_result mp_int_string_len(mp_int z, mp_size radix)
/* Read zero-terminated string into z */
mp_result mp_int_read_string(klisp_State *K, mp_int z, mp_size radix,
- const char *str)
+ const char *str)
{
- return mp_int_read_cstring(K, z, radix, str, NULL);
+ return mp_int_read_cstring(K, z, radix, str, NULL);
}
/* }}} */
@@ -1948,64 +1948,64 @@ mp_result mp_int_read_string(klisp_State *K, mp_int z, mp_size radix,
/* {{{ mp_int_read_cstring(z, radix, *str, **end) */
mp_result mp_int_read_cstring(klisp_State *K, mp_int z, mp_size radix,
- const char *str, char **end)
+ const char *str, char **end)
{
- int ch;
-
- CHECK(z != NULL && str != NULL);
-
- if(radix < MP_MIN_RADIX || radix > MP_MAX_RADIX)
- return MP_RANGE;
-
- /* Skip leading whitespace */
- while(isspace((int)*str))
- ++str;
-
- /* Handle leading sign tag (+/-, positive default) */
- switch(*str) {
- case '-':
- MP_SIGN(z) = MP_NEG;
- ++str;
- break;
- case '+':
- ++str; /* fallthrough */
- default:
- MP_SIGN(z) = MP_ZPOS;
- break;
- }
+ int ch;
+
+ CHECK(z != NULL && str != NULL);
+
+ if(radix < MP_MIN_RADIX || radix > MP_MAX_RADIX)
+ return MP_RANGE;
+
+ /* Skip leading whitespace */
+ while(isspace((int)*str))
+ ++str;
+
+ /* Handle leading sign tag (+/-, positive default) */
+ switch(*str) {
+ case '-':
+ MP_SIGN(z) = MP_NEG;
+ ++str;
+ break;
+ case '+':
+ ++str; /* fallthrough */
+ default:
+ MP_SIGN(z) = MP_ZPOS;
+ break;
+ }
- /* Skip leading zeroes */
- while((ch = s_ch2val(*str, radix)) == 0)
- ++str;
+ /* Skip leading zeroes */
+ while((ch = s_ch2val(*str, radix)) == 0)
+ ++str;
- /* Make sure there is enough space for the value */
- if(!s_pad(K, z, s_inlen(strlen(str), radix)))
- return MP_MEMORY;
+ /* Make sure there is enough space for the value */
+ if(!s_pad(K, z, s_inlen(strlen(str), radix)))
+ return MP_MEMORY;
- MP_USED(z) = 1; z->digits[0] = 0;
+ MP_USED(z) = 1; z->digits[0] = 0;
- while(*str != '\0' && ((ch = s_ch2val(*str, radix)) >= 0)) {
- s_dmul(z, (mp_digit)radix);
- s_dadd(z, (mp_digit)ch);
- ++str;
- }
+ while(*str != '\0' && ((ch = s_ch2val(*str, radix)) >= 0)) {
+ s_dmul(z, (mp_digit)radix);
+ s_dadd(z, (mp_digit)ch);
+ ++str;
+ }
- CLAMP(z);
+ CLAMP(z);
- /* Override sign for zero, even if negative specified. */
- if(CMPZ(z) == 0)
- MP_SIGN(z) = MP_ZPOS;
+ /* Override sign for zero, even if negative specified. */
+ if(CMPZ(z) == 0)
+ MP_SIGN(z) = MP_ZPOS;
- if(end != NULL)
- *end = (char *)str;
-
- /* Return a truncation error if the string has unprocessed
- characters remaining, so the caller can tell if the whole string
- was done */
- if(*str != '\0')
- return MP_TRUNC;
- else
- return MP_OK;
+ if(end != NULL)
+ *end = (char *)str;
+
+ /* Return a truncation error if the string has unprocessed
+ characters remaining, so the caller can tell if the whole string
+ was done */
+ if(*str != '\0')
+ return MP_TRUNC;
+ else
+ return MP_OK;
}
/* }}} */
@@ -2014,25 +2014,25 @@ mp_result mp_int_read_cstring(klisp_State *K, mp_int z, mp_size radix,
mp_result mp_int_count_bits(mp_int z)
{
- mp_size nbits = 0, uz;
- mp_digit d;
+ mp_size nbits = 0, uz;
+ mp_digit d;
- CHECK(z != NULL);
+ CHECK(z != NULL);
- uz = MP_USED(z);
- if(uz == 1 && z->digits[0] == 0)
- return 1;
+ uz = MP_USED(z);
+ if(uz == 1 && z->digits[0] == 0)
+ return 1;
- --uz;
- nbits = uz * MP_DIGIT_BIT;
- d = z->digits[uz];
+ --uz;
+ nbits = uz * MP_DIGIT_BIT;
+ d = z->digits[uz];
- while(d != 0) {
- d >>= 1;
- ++nbits;
- }
+ while(d != 0) {
+ d >>= 1;
+ ++nbits;
+ }
- return nbits;
+ return nbits;
}
/* }}} */
@@ -2040,21 +2040,21 @@ mp_result mp_int_count_bits(mp_int z)
/* {{{ mp_int_to_binary(z, buf, limit) */
mp_result mp_int_to_binary(klisp_State *K, mp_int z, unsigned char *buf,
- int limit)
+ int limit)
{
- static const int PAD_FOR_2C = 1;
+ static const int PAD_FOR_2C = 1;
- mp_result res;
- int limpos = limit;
+ mp_result res;
+ int limpos = limit;
- CHECK(z != NULL && buf != NULL);
+ CHECK(z != NULL && buf != NULL);
- res = s_tobin(z, buf, &limpos, PAD_FOR_2C);
+ res = s_tobin(z, buf, &limpos, PAD_FOR_2C);
- if(MP_SIGN(z) == MP_NEG)
- s_2comp(buf, limpos);
+ if(MP_SIGN(z) == MP_NEG)
+ s_2comp(buf, limpos);
- return res;
+ return res;
}
/* }}} */
@@ -2062,39 +2062,39 @@ mp_result mp_int_to_binary(klisp_State *K, mp_int z, unsigned char *buf,
/* {{{ mp_int_read_binary(z, buf, len) */
mp_result mp_int_read_binary(klisp_State *K, mp_int z, unsigned char *buf,
- int len)
+ int len)
{
- mp_size need, i;
- unsigned char *tmp;
- mp_digit *dz;
+ mp_size need, i;
+ unsigned char *tmp;
+ mp_digit *dz;
- CHECK(z != NULL && buf != NULL && len > 0);
+ CHECK(z != NULL && buf != NULL && len > 0);
- /* Figure out how many digits are needed to represent this value */
- need = ((len * CHAR_BIT) + (MP_DIGIT_BIT - 1)) / MP_DIGIT_BIT;
- if(!s_pad(K, z, need))
- return MP_MEMORY;
+ /* Figure out how many digits are needed to represent this value */
+ need = ((len * CHAR_BIT) + (MP_DIGIT_BIT - 1)) / MP_DIGIT_BIT;
+ if(!s_pad(K, z, need))
+ return MP_MEMORY;
- mp_int_zero(z);
+ mp_int_zero(z);
- /* If the high-order bit is set, take the 2's complement before
- reading the value (it will be restored afterward) */
- if(buf[0] >> (CHAR_BIT - 1)) {
- MP_SIGN(z) = MP_NEG;
- s_2comp(buf, len);
- }
+ /* If the high-order bit is set, take the 2's complement before
+ reading the value (it will be restored afterward) */
+ if(buf[0] >> (CHAR_BIT - 1)) {
+ MP_SIGN(z) = MP_NEG;
+ s_2comp(buf, len);
+ }
- dz = MP_DIGITS(z);
- for(tmp = buf, i = len; i > 0; --i, ++tmp) {
- s_qmul(K, z, (mp_size) CHAR_BIT);
- *dz |= *tmp;
- }
+ dz = MP_DIGITS(z);
+ for(tmp = buf, i = len; i > 0; --i, ++tmp) {
+ s_qmul(K, z, (mp_size) CHAR_BIT);
+ *dz |= *tmp;
+ }
- /* Restore 2's complement if we took it before */
- if(MP_SIGN(z) == MP_NEG)
- s_2comp(buf, len);
+ /* Restore 2's complement if we took it before */
+ if(MP_SIGN(z) == MP_NEG)
+ s_2comp(buf, len);
- return MP_OK;
+ return MP_OK;
}
/* }}} */
@@ -2103,21 +2103,21 @@ mp_result mp_int_read_binary(klisp_State *K, mp_int z, unsigned char *buf,
mp_result mp_int_binary_len(mp_int z)
{
- mp_result res = mp_int_count_bits(z);
- int bytes = mp_int_unsigned_len(z);
+ mp_result res = mp_int_count_bits(z);
+ int bytes = mp_int_unsigned_len(z);
- if(res <= 0)
- return res;
+ if(res <= 0)
+ return res;
- bytes = (res + (CHAR_BIT - 1)) / CHAR_BIT;
+ bytes = (res + (CHAR_BIT - 1)) / CHAR_BIT;
- /* If the highest-order bit falls exactly on a byte boundary, we
- need to pad with an extra byte so that the sign will be read
- correctly when reading it back in. */
- if(bytes * CHAR_BIT == res)
- ++bytes;
+ /* If the highest-order bit falls exactly on a byte boundary, we
+ need to pad with an extra byte so that the sign will be read
+ correctly when reading it back in. */
+ if(bytes * CHAR_BIT == res)
+ ++bytes;
- return bytes;
+ return bytes;
}
/* }}} */
@@ -2125,13 +2125,13 @@ mp_result mp_int_binary_len(mp_int z)
/* {{{ mp_int_to_unsigned(z, buf, limit) */
mp_result mp_int_to_unsigned(klisp_State *K, mp_int z, unsigned char *buf,
- int limit)
+ int limit)
{
- static const int NO_PADDING = 0;
+ static const int NO_PADDING = 0;
- CHECK(z != NULL && buf != NULL);
+ CHECK(z != NULL && buf != NULL);
- return s_tobin(z, buf, &limit, NO_PADDING);
+ return s_tobin(z, buf, &limit, NO_PADDING);
}
/* }}} */
@@ -2140,26 +2140,26 @@ mp_result mp_int_to_unsigned(klisp_State *K, mp_int z, unsigned char *buf,
mp_result mp_int_read_unsigned(klisp_State *K, mp_int z, unsigned char *buf, int len)
{
- mp_size need, i;
- unsigned char *tmp;
- mp_digit *dz;
+ mp_size need, i;
+ unsigned char *tmp;
+ mp_digit *dz;
- CHECK(z != NULL && buf != NULL && len > 0);
+ CHECK(z != NULL && buf != NULL && len > 0);
- /* Figure out how many digits are needed to represent this value */
- need = ((len * CHAR_BIT) + (MP_DIGIT_BIT - 1)) / MP_DIGIT_BIT;
- if(!s_pad(K, z, need))
- return MP_MEMORY;
+ /* Figure out how many digits are needed to represent this value */
+ need = ((len * CHAR_BIT) + (MP_DIGIT_BIT - 1)) / MP_DIGIT_BIT;
+ if(!s_pad(K, z, need))
+ return MP_MEMORY;
- mp_int_zero(z);
+ mp_int_zero(z);
- dz = MP_DIGITS(z);
- for(tmp = buf, i = len; i > 0; --i, ++tmp) {
- (void) s_qmul(K, z, CHAR_BIT);
- *dz |= *tmp;
- }
+ dz = MP_DIGITS(z);
+ for(tmp = buf, i = len; i > 0; --i, ++tmp) {
+ (void) s_qmul(K, z, CHAR_BIT);
+ *dz |= *tmp;
+ }
- return MP_OK;
+ return MP_OK;
}
/* }}} */
@@ -2168,15 +2168,15 @@ mp_result mp_int_read_unsigned(klisp_State *K, mp_int z, unsigned char *buf, int
mp_result mp_int_unsigned_len(mp_int z)
{
- mp_result res = mp_int_count_bits(z);
- int bytes;
+ mp_result res = mp_int_count_bits(z);
+ int bytes;
- if(res <= 0)
- return res;
+ if(res <= 0)
+ return res;
- bytes = (res + (CHAR_BIT - 1)) / CHAR_BIT;
+ bytes = (res + (CHAR_BIT - 1)) / CHAR_BIT;
- return bytes;
+ return bytes;
}
/* }}} */
@@ -2185,43 +2185,43 @@ mp_result mp_int_unsigned_len(mp_int z)
const char *mp_error_string(mp_result res)
{
- int ix;
- if(res > 0)
- return s_unknown_err;
+ int ix;
+ if(res > 0)
+ return s_unknown_err;
- res = -res;
- for(ix = 0; ix < res && s_error_msg[ix] != NULL; ++ix)
- ;
+ res = -res;
+ for(ix = 0; ix < res && s_error_msg[ix] != NULL; ++ix)
+ ;
- if(s_error_msg[ix] != NULL)
- return s_error_msg[ix];
- else
- return s_unknown_err;
+ if(s_error_msg[ix] != NULL)
+ return s_error_msg[ix];
+ else
+ return s_unknown_err;
}
/* }}} */
/*------------------------------------------------------------------------*/
-/* Private functions for internal use. These make assumptions. */
+/* Private functions for internal use. These make assumptions. */
/* {{{ s_alloc(num) */
STATIC mp_digit *s_alloc(klisp_State *K, mp_size num)
{
- mp_digit *out = klispM_malloc(K, num * sizeof(mp_digit));
+ mp_digit *out = klispM_malloc(K, num * sizeof(mp_digit));
- assert(out != NULL); /* for debugging */
+ assert(out != NULL); /* for debugging */
#if DEBUG > 1
- {
- mp_digit v = (mp_digit) 0xdeadbeef;
- int ix;
+ {
+ mp_digit v = (mp_digit) 0xdeadbeef;
+ int ix;
- for(ix = 0; ix < num; ++ix)
- out[ix] = v;
- }
+ for(ix = 0; ix < num; ++ix)
+ out[ix] = v;
+ }
#endif
- return out;
+ return out;
}
/* }}} */
@@ -2229,23 +2229,23 @@ STATIC mp_digit *s_alloc(klisp_State *K, mp_size num)
/* {{{ s_realloc(old, osize, nsize) */
STATIC mp_digit *s_realloc(klisp_State *K, mp_digit *old, mp_size osize,
- mp_size nsize)
+ mp_size nsize)
{
#if DEBUG > 1
- mp_digit *new = s_alloc(K, nsize);
- int ix;
+ mp_digit *new = s_alloc(K, nsize);
+ int ix;
- for(ix = 0; ix < nsize; ++ix)
- new[ix] = (mp_digit) 0xdeadbeef;
+ for(ix = 0; ix < nsize; ++ix)
+ new[ix] = (mp_digit) 0xdeadbeef;
- memcpy(new, old, osize * sizeof(mp_digit));
+ memcpy(new, old, osize * sizeof(mp_digit));
#else
- mp_digit *new = klispM_realloc_(K, old, osize * sizeof(mp_digit),
- nsize * sizeof(mp_digit));
+ mp_digit *new = klispM_realloc_(K, old, osize * sizeof(mp_digit),
+ nsize * sizeof(mp_digit));
- assert(new != NULL); /* for debugging */
+ assert(new != NULL); /* for debugging */
#endif
- return new;
+ return new;
}
/* }}} */
@@ -2254,122 +2254,122 @@ STATIC mp_digit *s_realloc(klisp_State *K, mp_digit *old, mp_size osize,
STATIC void s_free(klisp_State *K, void *ptr, mp_size size)
{
- klispM_freemem(K, ptr, size * sizeof(mp_digit));
+ klispM_freemem(K, ptr, size * sizeof(mp_digit));
}
/* }}} */
/* {{{ s_pad(z, min) */
-STATIC int s_pad(klisp_State *K, mp_int z, mp_size min)
+STATIC int s_pad(klisp_State *K, mp_int z, mp_size min)
{
- if(MP_ALLOC(z) < min) {
- mp_size nsize = ROUND_PREC(min);
- mp_digit *tmp;
+ if(MP_ALLOC(z) < min) {
+ mp_size nsize = ROUND_PREC(min);
+ mp_digit *tmp;
- if((void *)z->digits == (void *)&(z->single)) {
- if((tmp = s_alloc(K, nsize)) == NULL)
- return 0;
+ if((void *)z->digits == (void *)&(z->single)) {
+ if((tmp = s_alloc(K, nsize)) == NULL)
+ return 0;
- COPY(MP_DIGITS(z), tmp, MP_USED(z));
- } else if((tmp = s_realloc(K, MP_DIGITS(z), MP_ALLOC(z), nsize)) == NULL)
- return 0;
+ COPY(MP_DIGITS(z), tmp, MP_USED(z));
+ } else if((tmp = s_realloc(K, MP_DIGITS(z), MP_ALLOC(z), nsize)) == NULL)
+ return 0;
- MP_DIGITS(z) = tmp;
- MP_ALLOC(z) = nsize;
- }
+ MP_DIGITS(z) = tmp;
+ MP_ALLOC(z) = nsize;
+ }
- return 1;
+ return 1;
}
/* }}} */
/* {{{ s_fake(z, value, vbuf) */
-STATIC void s_fake(mp_int z, mp_small value, mp_digit vbuf[])
+STATIC void s_fake(mp_int z, mp_small value, mp_digit vbuf[])
{
- mp_size uv = (mp_size) s_vpack(value, vbuf);
+ mp_size uv = (mp_size) s_vpack(value, vbuf);
- z->used = uv;
- z->alloc = MP_VALUE_DIGITS(value);
- z->sign = (value < 0) ? MP_NEG : MP_ZPOS;
- z->digits = vbuf;
+ z->used = uv;
+ z->alloc = MP_VALUE_DIGITS(value);
+ z->sign = (value < 0) ? MP_NEG : MP_ZPOS;
+ z->digits = vbuf;
}
/* }}} */
/* {{{ s_cdig(da, db, len) */
-STATIC int s_cdig(mp_digit *da, mp_digit *db, mp_size len)
+STATIC int s_cdig(mp_digit *da, mp_digit *db, mp_size len)
{
- mp_digit *dat = da + len - 1, *dbt = db + len - 1;
+ mp_digit *dat = da + len - 1, *dbt = db + len - 1;
- for(/* */; len != 0; --len, --dat, --dbt) {
- if(*dat > *dbt)
- return 1;
- else if(*dat < *dbt)
- return -1;
- }
+ for(/* */; len != 0; --len, --dat, --dbt) {
+ if(*dat > *dbt)
+ return 1;
+ else if(*dat < *dbt)
+ return -1;
+ }
- return 0;
+ return 0;
}
/* }}} */
/* {{{ s_vpack(v, t[]) */
-STATIC int s_vpack(mp_small v, mp_digit t[])
+STATIC int s_vpack(mp_small v, mp_digit t[])
{
- mp_usmall uv = (mp_usmall) ((v < 0) ? -v : v);
- int ndig = 0;
+ mp_usmall uv = (mp_usmall) ((v < 0) ? -v : v);
+ int ndig = 0;
- if(uv == 0)
- t[ndig++] = 0;
- else {
- while(uv != 0) {
- t[ndig++] = (mp_digit) uv;
- uv >>= MP_DIGIT_BIT/2;
- uv >>= MP_DIGIT_BIT/2;
+ if(uv == 0)
+ t[ndig++] = 0;
+ else {
+ while(uv != 0) {
+ t[ndig++] = (mp_digit) uv;
+ uv >>= MP_DIGIT_BIT/2;
+ uv >>= MP_DIGIT_BIT/2;
+ }
}
- }
- return ndig;
+ return ndig;
}
/* }}} */
/* {{{ s_ucmp(a, b) */
-STATIC int s_ucmp(mp_int a, mp_int b)
+STATIC int s_ucmp(mp_int a, mp_int b)
{
- mp_size ua = MP_USED(a), ub = MP_USED(b);
+ mp_size ua = MP_USED(a), ub = MP_USED(b);
- if(ua > ub)
- return 1;
- else if(ub > ua)
- return -1;
- else
- return s_cdig(MP_DIGITS(a), MP_DIGITS(b), ua);
+ if(ua > ub)
+ return 1;
+ else if(ub > ua)
+ return -1;
+ else
+ return s_cdig(MP_DIGITS(a), MP_DIGITS(b), ua);
}
/* }}} */
/* {{{ s_vcmp(a, v) */
-STATIC int s_vcmp(mp_int a, mp_small v)
+STATIC int s_vcmp(mp_int a, mp_small v)
{
- mp_digit vdig[MP_VALUE_DIGITS(v)];
- int ndig = 0;
- mp_size ua = MP_USED(a);
+ mp_digit vdig[MP_VALUE_DIGITS(v)];
+ int ndig = 0;
+ mp_size ua = MP_USED(a);
- ndig = s_vpack(v, vdig);
+ ndig = s_vpack(v, vdig);
- if(ua > ndig)
- return 1;
- else if(ua < ndig)
- return -1;
- else
- return s_cdig(MP_DIGITS(a), vdig, ndig);
+ if(ua > ndig)
+ return 1;
+ else if(ua < ndig)
+ return -1;
+ else
+ return s_cdig(MP_DIGITS(a), vdig, ndig);
}
/* }}} */
@@ -2377,373 +2377,373 @@ STATIC int s_vcmp(mp_int a, mp_small v)
/* {{{ s_uadd(da, db, dc, size_a, size_b) */
STATIC mp_digit s_uadd(mp_digit *da, mp_digit *db, mp_digit *dc,
- mp_size size_a, mp_size size_b)
+ mp_size size_a, mp_size size_b)
{
- mp_size pos;
- mp_word w = 0;
+ mp_size pos;
+ mp_word w = 0;
- /* Insure that da is the longer of the two to simplify later code */
- if(size_b > size_a) {
- SWAP(mp_digit *, da, db);
- SWAP(mp_size, size_a, size_b);
- }
+ /* Insure that da is the longer of the two to simplify later code */
+ if(size_b > size_a) {
+ SWAP(mp_digit *, da, db);
+ SWAP(mp_size, size_a, size_b);
+ }
- /* Add corresponding digits until the shorter number runs out */
- for(pos = 0; pos < size_b; ++pos, ++da, ++db, ++dc) {
- w = w + (mp_word) *da + (mp_word) *db;
- *dc = LOWER_HALF(w);
- w = UPPER_HALF(w);
- }
+ /* Add corresponding digits until the shorter number runs out */
+ for(pos = 0; pos < size_b; ++pos, ++da, ++db, ++dc) {
+ w = w + (mp_word) *da + (mp_word) *db;
+ *dc = LOWER_HALF(w);
+ w = UPPER_HALF(w);
+ }
- /* Propagate carries as far as necessary */
- for(/* */; pos < size_a; ++pos, ++da, ++dc) {
- w = w + *da;
+ /* Propagate carries as far as necessary */
+ for(/* */; pos < size_a; ++pos, ++da, ++dc) {
+ w = w + *da;
- *dc = LOWER_HALF(w);
- w = UPPER_HALF(w);
- }
+ *dc = LOWER_HALF(w);
+ w = UPPER_HALF(w);
+ }
- /* Return carry out */
- return (mp_digit)w;
+ /* Return carry out */
+ return (mp_digit)w;
}
/* }}} */
/* {{{ s_usub(da, db, dc, size_a, size_b) */
-STATIC void s_usub(mp_digit *da, mp_digit *db, mp_digit *dc,
- mp_size size_a, mp_size size_b)
+STATIC void s_usub(mp_digit *da, mp_digit *db, mp_digit *dc,
+ mp_size size_a, mp_size size_b)
{
- mp_size pos;
- mp_word w = 0;
+ mp_size pos;
+ mp_word w = 0;
- /* We assume that |a| >= |b| so this should definitely hold */
- assert(size_a >= size_b);
+ /* We assume that |a| >= |b| so this should definitely hold */
+ assert(size_a >= size_b);
- /* Subtract corresponding digits and propagate borrow */
- for(pos = 0; pos < size_b; ++pos, ++da, ++db, ++dc) {
- w = ((mp_word)MP_DIGIT_MAX + 1 + /* MP_RADIX */
- (mp_word)*da) - w - (mp_word)*db;
+ /* Subtract corresponding digits and propagate borrow */
+ for(pos = 0; pos < size_b; ++pos, ++da, ++db, ++dc) {
+ w = ((mp_word)MP_DIGIT_MAX + 1 + /* MP_RADIX */
+ (mp_word)*da) - w - (mp_word)*db;
- *dc = LOWER_HALF(w);
- w = (UPPER_HALF(w) == 0);
- }
+ *dc = LOWER_HALF(w);
+ w = (UPPER_HALF(w) == 0);
+ }
- /* Finish the subtraction for remaining upper digits of da */
- for(/* */; pos < size_a; ++pos, ++da, ++dc) {
- w = ((mp_word)MP_DIGIT_MAX + 1 + /* MP_RADIX */
- (mp_word)*da) - w;
+ /* Finish the subtraction for remaining upper digits of da */
+ for(/* */; pos < size_a; ++pos, ++da, ++dc) {
+ w = ((mp_word)MP_DIGIT_MAX + 1 + /* MP_RADIX */
+ (mp_word)*da) - w;
- *dc = LOWER_HALF(w);
- w = (UPPER_HALF(w) == 0);
- }
+ *dc = LOWER_HALF(w);
+ w = (UPPER_HALF(w) == 0);
+ }
- /* If there is a borrow out at the end, it violates the precondition */
- assert(w == 0);
+ /* If there is a borrow out at the end, it violates the precondition */
+ assert(w == 0);
}
/* }}} */
/* {{{ s_kmul(da, db, dc, size_a, size_b) */
-STATIC int s_kmul(klisp_State *K, mp_digit *da, mp_digit *db,
- mp_digit *dc, mp_size size_a, mp_size size_b)
-{
- mp_size bot_size;
-
- /* Make sure b is the smaller of the two input values */
- if(size_b > size_a) {
- SWAP(mp_digit *, da, db);
- SWAP(mp_size, size_a, size_b);
- }
-
- /* Insure that the bottom is the larger half in an odd-length split;
- the code below relies on this being true.
- */
- bot_size = (size_a + 1) / 2;
-
- /* If the values are big enough to bother with recursion, use the
- Karatsuba algorithm to compute the product; otherwise use the
- normal multiplication algorithm
- */
- if(multiply_threshold &&
- size_a >= multiply_threshold &&
- size_b > bot_size) {
-
- mp_digit *t1, *t2, *t3, carry;
-
- mp_digit *a_top = da + bot_size;
- mp_digit *b_top = db + bot_size;
-
- mp_size at_size = size_a - bot_size;
- mp_size bt_size = size_b - bot_size;
- mp_size buf_size = 2 * bot_size;
-
- /* Do a single allocation for all three temporary buffers needed;
- each buffer must be big enough to hold the product of two
- bottom halves, and one buffer needs space for the completed
- product; twice the space is plenty.
- */
- if((t1 = s_alloc(K, 4 * buf_size)) == NULL) return 0;
- t2 = t1 + buf_size;
- t3 = t2 + buf_size;
- ZERO(t1, 4 * buf_size);
-
- /* t1 and t2 are initially used as temporaries to compute the inner product
- (a1 + a0)(b1 + b0) = a1b1 + a1b0 + a0b1 + a0b0
- */
- carry = s_uadd(da, a_top, t1, bot_size, at_size); /* t1 = a1 + a0 */
- t1[bot_size] = carry;
-
- carry = s_uadd(db, b_top, t2, bot_size, bt_size); /* t2 = b1 + b0 */
- t2[bot_size] = carry;
-
- /* t3 = t1 * t2 */
- (void) s_kmul(K, t1, t2, t3, bot_size + 1, bot_size + 1);
-
- /* Now we'll get t1 = a0b0 and t2 = a1b1, and subtract them out so that
- we're left with only the pieces we want: t3 = a1b0 + a0b1
- */
- ZERO(t1, buf_size);
- ZERO(t2, buf_size);
- (void) s_kmul(K, da, db, t1, bot_size, bot_size); /* t1 = a0 * b0 */
- (void) s_kmul(K, a_top, b_top, t2, at_size, bt_size); /* t2 = a1 * b1 */
-
- /* Subtract out t1 and t2 to get the inner product */
- s_usub(t3, t1, t3, buf_size + 2, buf_size);
- s_usub(t3, t2, t3, buf_size + 2, buf_size);
-
- /* Assemble the output value */
- COPY(t1, dc, buf_size);
- carry = s_uadd(t3, dc + bot_size, dc + bot_size,
- buf_size + 1, buf_size);
- assert(carry == 0);
+STATIC int s_kmul(klisp_State *K, mp_digit *da, mp_digit *db,
+ mp_digit *dc, mp_size size_a, mp_size size_b)
+{
+ mp_size bot_size;
+
+ /* Make sure b is the smaller of the two input values */
+ if(size_b > size_a) {
+ SWAP(mp_digit *, da, db);
+ SWAP(mp_size, size_a, size_b);
+ }
+
+ /* Insure that the bottom is the larger half in an odd-length split;
+ the code below relies on this being true.
+ */
+ bot_size = (size_a + 1) / 2;
+
+ /* If the values are big enough to bother with recursion, use the
+ Karatsuba algorithm to compute the product; otherwise use the
+ normal multiplication algorithm
+ */
+ if(multiply_threshold &&
+ size_a >= multiply_threshold &&
+ size_b > bot_size) {
+
+ mp_digit *t1, *t2, *t3, carry;
+
+ mp_digit *a_top = da + bot_size;
+ mp_digit *b_top = db + bot_size;
+
+ mp_size at_size = size_a - bot_size;
+ mp_size bt_size = size_b - bot_size;
+ mp_size buf_size = 2 * bot_size;
+
+ /* Do a single allocation for all three temporary buffers needed;
+ each buffer must be big enough to hold the product of two
+ bottom halves, and one buffer needs space for the completed
+ product; twice the space is plenty.
+ */
+ if((t1 = s_alloc(K, 4 * buf_size)) == NULL) return 0;
+ t2 = t1 + buf_size;
+ t3 = t2 + buf_size;
+ ZERO(t1, 4 * buf_size);
+
+ /* t1 and t2 are initially used as temporaries to compute the inner product
+ (a1 + a0)(b1 + b0) = a1b1 + a1b0 + a0b1 + a0b0
+ */
+ carry = s_uadd(da, a_top, t1, bot_size, at_size); /* t1 = a1 + a0 */
+ t1[bot_size] = carry;
+
+ carry = s_uadd(db, b_top, t2, bot_size, bt_size); /* t2 = b1 + b0 */
+ t2[bot_size] = carry;
+
+ /* t3 = t1 * t2 */
+ (void) s_kmul(K, t1, t2, t3, bot_size + 1, bot_size + 1);
+
+ /* Now we'll get t1 = a0b0 and t2 = a1b1, and subtract them out so that
+ we're left with only the pieces we want: t3 = a1b0 + a0b1
+ */
+ ZERO(t1, buf_size);
+ ZERO(t2, buf_size);
+ (void) s_kmul(K, da, db, t1, bot_size, bot_size); /* t1 = a0 * b0 */
+ (void) s_kmul(K, a_top, b_top, t2, at_size, bt_size); /* t2 = a1 * b1 */
+
+ /* Subtract out t1 and t2 to get the inner product */
+ s_usub(t3, t1, t3, buf_size + 2, buf_size);
+ s_usub(t3, t2, t3, buf_size + 2, buf_size);
+
+ /* Assemble the output value */
+ COPY(t1, dc, buf_size);
+ carry = s_uadd(t3, dc + bot_size, dc + bot_size,
+ buf_size + 1, buf_size);
+ assert(carry == 0);
- carry = s_uadd(t2, dc + 2*bot_size, dc + 2*bot_size,
- buf_size, buf_size);
- assert(carry == 0);
+ carry = s_uadd(t2, dc + 2*bot_size, dc + 2*bot_size,
+ buf_size, buf_size);
+ assert(carry == 0);
- /* note t2 and t3 are just internal pointers to t1 */
- s_free(K, t1, 4 * buf_size);
- }
- else {
- s_umul(da, db, dc, size_a, size_b);
- }
+ /* note t2 and t3 are just internal pointers to t1 */
+ s_free(K, t1, 4 * buf_size);
+ }
+ else {
+ s_umul(da, db, dc, size_a, size_b);
+ }
- return 1;
+ return 1;
}
/* }}} */
/* {{{ s_umul(da, db, dc, size_a, size_b) */
-STATIC void s_umul(mp_digit *da, mp_digit *db, mp_digit *dc,
- mp_size size_a, mp_size size_b)
+STATIC void s_umul(mp_digit *da, mp_digit *db, mp_digit *dc,
+ mp_size size_a, mp_size size_b)
{
- mp_size a, b;
- mp_word w;
+ mp_size a, b;
+ mp_word w;
- for(a = 0; a < size_a; ++a, ++dc, ++da) {
- mp_digit *dct = dc;
- mp_digit *dbt = db;
+ for(a = 0; a < size_a; ++a, ++dc, ++da) {
+ mp_digit *dct = dc;
+ mp_digit *dbt = db;
- if(*da == 0)
- continue;
+ if(*da == 0)
+ continue;
- w = 0;
- for(b = 0; b < size_b; ++b, ++dbt, ++dct) {
- w = (mp_word)*da * (mp_word)*dbt + w + (mp_word)*dct;
+ w = 0;
+ for(b = 0; b < size_b; ++b, ++dbt, ++dct) {
+ w = (mp_word)*da * (mp_word)*dbt + w + (mp_word)*dct;
- *dct = LOWER_HALF(w);
- w = UPPER_HALF(w);
- }
+ *dct = LOWER_HALF(w);
+ w = UPPER_HALF(w);
+ }
- *dct = (mp_digit)w;
- }
+ *dct = (mp_digit)w;
+ }
}
/* }}} */
/* {{{ s_ksqr(da, dc, size_a) */
-STATIC int s_ksqr(klisp_State *K, mp_digit *da, mp_digit *dc,
- mp_size size_a)
-{
- if(multiply_threshold && size_a > multiply_threshold) {
- mp_size bot_size = (size_a + 1) / 2;
- mp_digit *a_top = da + bot_size;
- mp_digit *t1, *t2, *t3, carry;
- mp_size at_size = size_a - bot_size;
- mp_size buf_size = 2 * bot_size;
-
- if((t1 = s_alloc(K, 4 * buf_size)) == NULL) return 0;
- t2 = t1 + buf_size;
- t3 = t2 + buf_size;
- ZERO(t1, 4 * buf_size);
-
- (void) s_ksqr(K, da, t1, bot_size); /* t1 = a0 ^ 2 */
- (void) s_ksqr(K, a_top, t2, at_size); /* t2 = a1 ^ 2 */
-
- (void) s_kmul(K, da, a_top, t3, bot_size, at_size); /* t3 = a0 * a1 */
-
- /* Quick multiply t3 by 2, shifting left (can't overflow) */
- {
- int i, top = bot_size + at_size;
- mp_word w, save = 0;
-
- for(i = 0; i < top; ++i) {
- w = t3[i];
- w = (w << 1) | save;
- t3[i] = LOWER_HALF(w);
- save = UPPER_HALF(w);
- }
- t3[i] = LOWER_HALF(save);
+STATIC int s_ksqr(klisp_State *K, mp_digit *da, mp_digit *dc,
+ mp_size size_a)
+{
+ if(multiply_threshold && size_a > multiply_threshold) {
+ mp_size bot_size = (size_a + 1) / 2;
+ mp_digit *a_top = da + bot_size;
+ mp_digit *t1, *t2, *t3, carry;
+ mp_size at_size = size_a - bot_size;
+ mp_size buf_size = 2 * bot_size;
+
+ if((t1 = s_alloc(K, 4 * buf_size)) == NULL) return 0;
+ t2 = t1 + buf_size;
+ t3 = t2 + buf_size;
+ ZERO(t1, 4 * buf_size);
+
+ (void) s_ksqr(K, da, t1, bot_size); /* t1 = a0 ^ 2 */
+ (void) s_ksqr(K, a_top, t2, at_size); /* t2 = a1 ^ 2 */
+
+ (void) s_kmul(K, da, a_top, t3, bot_size, at_size); /* t3 = a0 * a1 */
+
+ /* Quick multiply t3 by 2, shifting left (can't overflow) */
+ {
+ int i, top = bot_size + at_size;
+ mp_word w, save = 0;
+
+ for(i = 0; i < top; ++i) {
+ w = t3[i];
+ w = (w << 1) | save;
+ t3[i] = LOWER_HALF(w);
+ save = UPPER_HALF(w);
+ }
+ t3[i] = LOWER_HALF(save);
+ }
+
+ /* Assemble the output value */
+ COPY(t1, dc, 2 * bot_size);
+ carry = s_uadd(t3, dc + bot_size, dc + bot_size,
+ buf_size + 1, buf_size);
+ assert(carry == 0);
+
+ carry = s_uadd(t2, dc + 2*bot_size, dc + 2*bot_size,
+ buf_size, buf_size);
+ assert(carry == 0);
+
+ /* note that t2 and t2 are internal pointers only */
+ s_free(K, t1, 4 * buf_size);
+ }
+ else {
+ s_usqr(da, dc, size_a);
}
- /* Assemble the output value */
- COPY(t1, dc, 2 * bot_size);
- carry = s_uadd(t3, dc + bot_size, dc + bot_size,
- buf_size + 1, buf_size);
- assert(carry == 0);
-
- carry = s_uadd(t2, dc + 2*bot_size, dc + 2*bot_size,
- buf_size, buf_size);
- assert(carry == 0);
-
- /* note that t2 and t2 are internal pointers only */
- s_free(K, t1, 4 * buf_size);
- }
- else {
- s_usqr(da, dc, size_a);
- }
-
- return 1;
+ return 1;
}
/* }}} */
/* {{{ s_usqr(da, dc, size_a) */
-STATIC void s_usqr(mp_digit *da, mp_digit *dc, mp_size size_a)
+STATIC void s_usqr(mp_digit *da, mp_digit *dc, mp_size size_a)
{
- mp_size i, j;
- mp_word w;
+ mp_size i, j;
+ mp_word w;
- for(i = 0; i < size_a; ++i, dc += 2, ++da) {
- mp_digit *dct = dc, *dat = da;
+ for(i = 0; i < size_a; ++i, dc += 2, ++da) {
+ mp_digit *dct = dc, *dat = da;
- if(*da == 0)
- continue;
+ if(*da == 0)
+ continue;
- /* Take care of the first digit, no rollover */
- w = (mp_word)*dat * (mp_word)*dat + (mp_word)*dct;
- *dct = LOWER_HALF(w);
- w = UPPER_HALF(w);
- ++dat; ++dct;
+ /* Take care of the first digit, no rollover */
+ w = (mp_word)*dat * (mp_word)*dat + (mp_word)*dct;
+ *dct = LOWER_HALF(w);
+ w = UPPER_HALF(w);
+ ++dat; ++dct;
- for(j = i + 1; j < size_a; ++j, ++dat, ++dct) {
- mp_word t = (mp_word)*da * (mp_word)*dat;
- mp_word u = w + (mp_word)*dct, ov = 0;
+ for(j = i + 1; j < size_a; ++j, ++dat, ++dct) {
+ mp_word t = (mp_word)*da * (mp_word)*dat;
+ mp_word u = w + (mp_word)*dct, ov = 0;
- /* Check if doubling t will overflow a word */
- if(HIGH_BIT_SET(t))
- ov = 1;
+ /* Check if doubling t will overflow a word */
+ if(HIGH_BIT_SET(t))
+ ov = 1;
- w = t + t;
+ w = t + t;
- /* Check if adding u to w will overflow a word */
- if(ADD_WILL_OVERFLOW(w, u))
- ov = 1;
+ /* Check if adding u to w will overflow a word */
+ if(ADD_WILL_OVERFLOW(w, u))
+ ov = 1;
- w += u;
+ w += u;
- *dct = LOWER_HALF(w);
- w = UPPER_HALF(w);
- if(ov) {
- w += MP_DIGIT_MAX; /* MP_RADIX */
- ++w;
- }
- }
+ *dct = LOWER_HALF(w);
+ w = UPPER_HALF(w);
+ if(ov) {
+ w += MP_DIGIT_MAX; /* MP_RADIX */
+ ++w;
+ }
+ }
- w = w + *dct;
- *dct = (mp_digit)w;
- while((w = UPPER_HALF(w)) != 0) {
- ++dct; w = w + *dct;
- *dct = LOWER_HALF(w);
- }
+ w = w + *dct;
+ *dct = (mp_digit)w;
+ while((w = UPPER_HALF(w)) != 0) {
+ ++dct; w = w + *dct;
+ *dct = LOWER_HALF(w);
+ }
- assert(w == 0);
- }
+ assert(w == 0);
+ }
}
/* }}} */
/* {{{ s_dadd(a, b) */
-STATIC void s_dadd(mp_int a, mp_digit b)
+STATIC void s_dadd(mp_int a, mp_digit b)
{
- mp_word w = 0;
- mp_digit *da = MP_DIGITS(a);
- mp_size ua = MP_USED(a);
+ mp_word w = 0;
+ mp_digit *da = MP_DIGITS(a);
+ mp_size ua = MP_USED(a);
- w = (mp_word)*da + b;
- *da++ = LOWER_HALF(w);
- w = UPPER_HALF(w);
+ w = (mp_word)*da + b;
+ *da++ = LOWER_HALF(w);
+ w = UPPER_HALF(w);
- for(ua -= 1; ua > 0; --ua, ++da) {
- w = (mp_word)*da + w;
+ for(ua -= 1; ua > 0; --ua, ++da) {
+ w = (mp_word)*da + w;
- *da = LOWER_HALF(w);
- w = UPPER_HALF(w);
- }
+ *da = LOWER_HALF(w);
+ w = UPPER_HALF(w);
+ }
- if(w) {
- *da = (mp_digit)w;
- MP_USED(a) += 1;
- }
+ if(w) {
+ *da = (mp_digit)w;
+ MP_USED(a) += 1;
+ }
}
/* }}} */
/* {{{ s_dmul(a, b) */
-STATIC void s_dmul(mp_int a, mp_digit b)
+STATIC void s_dmul(mp_int a, mp_digit b)
{
- mp_word w = 0;
- mp_digit *da = MP_DIGITS(a);
- mp_size ua = MP_USED(a);
+ mp_word w = 0;
+ mp_digit *da = MP_DIGITS(a);
+ mp_size ua = MP_USED(a);
- while(ua > 0) {
- w = (mp_word)*da * b + w;
- *da++ = LOWER_HALF(w);
- w = UPPER_HALF(w);
- --ua;
- }
+ while(ua > 0) {
+ w = (mp_word)*da * b + w;
+ *da++ = LOWER_HALF(w);
+ w = UPPER_HALF(w);
+ --ua;
+ }
- if(w) {
- *da = (mp_digit)w;
- MP_USED(a) += 1;
- }
+ if(w) {
+ *da = (mp_digit)w;
+ MP_USED(a) += 1;
+ }
}
/* }}} */
/* {{{ s_dbmul(da, b, dc, size_a) */
-STATIC void s_dbmul(mp_digit *da, mp_digit b, mp_digit *dc, mp_size size_a)
+STATIC void s_dbmul(mp_digit *da, mp_digit b, mp_digit *dc, mp_size size_a)
{
- mp_word w = 0;
+ mp_word w = 0;
- while(size_a > 0) {
- w = (mp_word)*da++ * (mp_word)b + w;
+ while(size_a > 0) {
+ w = (mp_word)*da++ * (mp_word)b + w;
- *dc++ = LOWER_HALF(w);
- w = UPPER_HALF(w);
- --size_a;
- }
+ *dc++ = LOWER_HALF(w);
+ w = UPPER_HALF(w);
+ --size_a;
+ }
- if(w)
- *dc = LOWER_HALF(w);
+ if(w)
+ *dc = LOWER_HALF(w);
}
/* }}} */
@@ -2752,155 +2752,155 @@ STATIC void s_dbmul(mp_digit *da, mp_digit b, mp_digit *dc, mp_size size_a)
STATIC mp_digit s_ddiv(mp_int a, mp_digit b)
{
- mp_word w = 0, qdigit;
- mp_size ua = MP_USED(a);
- mp_digit *da = MP_DIGITS(a) + ua - 1;
+ mp_word w = 0, qdigit;
+ mp_size ua = MP_USED(a);
+ mp_digit *da = MP_DIGITS(a) + ua - 1;
- for(/* */; ua > 0; --ua, --da) {
- w = (w << MP_DIGIT_BIT) | *da;
-
- if(w >= b) {
- qdigit = w / b;
- w = w % b;
- }
- else {
- qdigit = 0;
+ for(/* */; ua > 0; --ua, --da) {
+ w = (w << MP_DIGIT_BIT) | *da;
+
+ if(w >= b) {
+ qdigit = w / b;
+ w = w % b;
+ }
+ else {
+ qdigit = 0;
+ }
+
+ *da = (mp_digit)qdigit;
}
-
- *da = (mp_digit)qdigit;
- }
- CLAMP(a);
- return (mp_digit)w;
+ CLAMP(a);
+ return (mp_digit)w;
}
/* }}} */
/* {{{ s_qdiv(z, p2) */
-STATIC void s_qdiv(mp_int z, mp_size p2)
+STATIC void s_qdiv(mp_int z, mp_size p2)
{
- mp_size ndig = p2 / MP_DIGIT_BIT, nbits = p2 % MP_DIGIT_BIT;
- mp_size uz = MP_USED(z);
+ mp_size ndig = p2 / MP_DIGIT_BIT, nbits = p2 % MP_DIGIT_BIT;
+ mp_size uz = MP_USED(z);
- if(ndig) {
- mp_size mark;
- mp_digit *to, *from;
+ if(ndig) {
+ mp_size mark;
+ mp_digit *to, *from;
- if(ndig >= uz) {
- mp_int_zero(z);
- return;
- }
+ if(ndig >= uz) {
+ mp_int_zero(z);
+ return;
+ }
- to = MP_DIGITS(z); from = to + ndig;
+ to = MP_DIGITS(z); from = to + ndig;
- for(mark = ndig; mark < uz; ++mark)
- *to++ = *from++;
+ for(mark = ndig; mark < uz; ++mark)
+ *to++ = *from++;
- MP_USED(z) = uz - ndig;
- }
+ MP_USED(z) = uz - ndig;
+ }
- if(nbits) {
- mp_digit d = 0, *dz, save;
- mp_size up = MP_DIGIT_BIT - nbits;
+ if(nbits) {
+ mp_digit d = 0, *dz, save;
+ mp_size up = MP_DIGIT_BIT - nbits;
- uz = MP_USED(z);
- dz = MP_DIGITS(z) + uz - 1;
+ uz = MP_USED(z);
+ dz = MP_DIGITS(z) + uz - 1;
- for(/* */; uz > 0; --uz, --dz) {
- save = *dz;
+ for(/* */; uz > 0; --uz, --dz) {
+ save = *dz;
- *dz = (*dz >> nbits) | (d << up);
- d = save;
- }
+ *dz = (*dz >> nbits) | (d << up);
+ d = save;
+ }
- CLAMP(z);
- }
+ CLAMP(z);
+ }
- if(MP_USED(z) == 1 && z->digits[0] == 0)
- MP_SIGN(z) = MP_ZPOS;
+ if(MP_USED(z) == 1 && z->digits[0] == 0)
+ MP_SIGN(z) = MP_ZPOS;
}
/* }}} */
/* {{{ s_qmod(z, p2) */
-STATIC void s_qmod(mp_int z, mp_size p2)
+STATIC void s_qmod(mp_int z, mp_size p2)
{
- mp_size start = p2 / MP_DIGIT_BIT + 1, rest = p2 % MP_DIGIT_BIT;
- mp_size uz = MP_USED(z);
- mp_digit mask = (1 << rest) - 1;
+ mp_size start = p2 / MP_DIGIT_BIT + 1, rest = p2 % MP_DIGIT_BIT;
+ mp_size uz = MP_USED(z);
+ mp_digit mask = (1 << rest) - 1;
- if(start <= uz) {
- MP_USED(z) = start;
- z->digits[start - 1] &= mask;
- CLAMP(z);
- }
+ if(start <= uz) {
+ MP_USED(z) = start;
+ z->digits[start - 1] &= mask;
+ CLAMP(z);
+ }
}
/* }}} */
/* {{{ s_qmul(z, p2) */
-STATIC int s_qmul(klisp_State *K, mp_int z, mp_size p2)
+STATIC int s_qmul(klisp_State *K, mp_int z, mp_size p2)
{
- mp_size uz, need, rest, extra, i;
- mp_digit *from, *to, d;
+ mp_size uz, need, rest, extra, i;
+ mp_digit *from, *to, d;
- if(p2 == 0)
- return 1;
-
- uz = MP_USED(z);
- need = p2 / MP_DIGIT_BIT; rest = p2 % MP_DIGIT_BIT;
+ if(p2 == 0)
+ return 1;
- /* Figure out if we need an extra digit at the top end; this occurs
- if the topmost `rest' bits of the high-order digit of z are not
- zero, meaning they will be shifted off the end if not preserved */
- extra = 0;
- if(rest != 0) {
- mp_digit *dz = MP_DIGITS(z) + uz - 1;
+ uz = MP_USED(z);
+ need = p2 / MP_DIGIT_BIT; rest = p2 % MP_DIGIT_BIT;
- if((*dz >> (MP_DIGIT_BIT - rest)) != 0)
- extra = 1;
- }
+ /* Figure out if we need an extra digit at the top end; this occurs
+ if the topmost `rest' bits of the high-order digit of z are not
+ zero, meaning they will be shifted off the end if not preserved */
+ extra = 0;
+ if(rest != 0) {
+ mp_digit *dz = MP_DIGITS(z) + uz - 1;
- if(!s_pad(K, z, uz + need + extra))
- return 0;
+ if((*dz >> (MP_DIGIT_BIT - rest)) != 0)
+ extra = 1;
+ }
- /* If we need to shift by whole digits, do that in one pass, then
- to back and shift by partial digits.
- */
- if(need > 0) {
- from = MP_DIGITS(z) + uz - 1;
- to = from + need;
+ if(!s_pad(K, z, uz + need + extra))
+ return 0;
- for(i = 0; i < uz; ++i)
- *to-- = *from--;
+ /* If we need to shift by whole digits, do that in one pass, then
+ to back and shift by partial digits.
+ */
+ if(need > 0) {
+ from = MP_DIGITS(z) + uz - 1;
+ to = from + need;
- ZERO(MP_DIGITS(z), need);
- uz += need;
- }
+ for(i = 0; i < uz; ++i)
+ *to-- = *from--;
- if(rest) {
- d = 0;
- for(i = need, from = MP_DIGITS(z) + need; i < uz; ++i, ++from) {
- mp_digit save = *from;
-
- *from = (*from << rest) | (d >> (MP_DIGIT_BIT - rest));
- d = save;
+ ZERO(MP_DIGITS(z), need);
+ uz += need;
}
- d >>= (MP_DIGIT_BIT - rest);
- if(d != 0) {
- *from = d;
- uz += extra;
+ if(rest) {
+ d = 0;
+ for(i = need, from = MP_DIGITS(z) + need; i < uz; ++i, ++from) {
+ mp_digit save = *from;
+
+ *from = (*from << rest) | (d >> (MP_DIGIT_BIT - rest));
+ d = save;
+ }
+
+ d >>= (MP_DIGIT_BIT - rest);
+ if(d != 0) {
+ *from = d;
+ uz += extra;
+ }
}
- }
- MP_USED(z) = uz;
- CLAMP(z);
+ MP_USED(z) = uz;
+ CLAMP(z);
- return 1;
+ return 1;
}
/* }}} */
@@ -2909,130 +2909,130 @@ STATIC int s_qmul(klisp_State *K, mp_int z, mp_size p2)
/* Compute z = 2^p2 - |z|; requires that 2^p2 >= |z|
The sign of the result is always zero/positive.
- */
-STATIC int s_qsub(klisp_State *K, mp_int z, mp_size p2)
+*/
+STATIC int s_qsub(klisp_State *K, mp_int z, mp_size p2)
{
- mp_digit hi = (1 << (p2 % MP_DIGIT_BIT)), *zp;
- mp_size tdig = (p2 / MP_DIGIT_BIT), pos;
- mp_word w = 0;
+ mp_digit hi = (1 << (p2 % MP_DIGIT_BIT)), *zp;
+ mp_size tdig = (p2 / MP_DIGIT_BIT), pos;
+ mp_word w = 0;
- if(!s_pad(K, z, tdig + 1))
- return 0;
+ if(!s_pad(K, z, tdig + 1))
+ return 0;
- for(pos = 0, zp = MP_DIGITS(z); pos < tdig; ++pos, ++zp) {
- w = ((mp_word) MP_DIGIT_MAX + 1) - w - (mp_word)*zp;
+ for(pos = 0, zp = MP_DIGITS(z); pos < tdig; ++pos, ++zp) {
+ w = ((mp_word) MP_DIGIT_MAX + 1) - w - (mp_word)*zp;
- *zp = LOWER_HALF(w);
- w = UPPER_HALF(w) ? 0 : 1;
- }
+ *zp = LOWER_HALF(w);
+ w = UPPER_HALF(w) ? 0 : 1;
+ }
- w = ((mp_word) MP_DIGIT_MAX + 1 + hi) - w - (mp_word)*zp;
- *zp = LOWER_HALF(w);
+ w = ((mp_word) MP_DIGIT_MAX + 1 + hi) - w - (mp_word)*zp;
+ *zp = LOWER_HALF(w);
- assert(UPPER_HALF(w) != 0); /* no borrow out should be possible */
+ assert(UPPER_HALF(w) != 0); /* no borrow out should be possible */
- MP_SIGN(z) = MP_ZPOS;
- CLAMP(z);
+ MP_SIGN(z) = MP_ZPOS;
+ CLAMP(z);
- return 1;
+ return 1;
}
/* }}} */
/* {{{ s_dp2k(z) */
-STATIC int s_dp2k(mp_int z)
+STATIC int s_dp2k(mp_int z)
{
- int k = 0;
- mp_digit *dp = MP_DIGITS(z), d;
+ int k = 0;
+ mp_digit *dp = MP_DIGITS(z), d;
- if(MP_USED(z) == 1 && *dp == 0)
- return 1;
+ if(MP_USED(z) == 1 && *dp == 0)
+ return 1;
- while(*dp == 0) {
- k += MP_DIGIT_BIT;
- ++dp;
- }
+ while(*dp == 0) {
+ k += MP_DIGIT_BIT;
+ ++dp;
+ }
- d = *dp;
- while((d & 1) == 0) {
- d >>= 1;
- ++k;
- }
+ d = *dp;
+ while((d & 1) == 0) {
+ d >>= 1;
+ ++k;
+ }
- return k;
+ return k;
}
/* }}} */
/* {{{ s_isp2(z) */
-STATIC int s_isp2(mp_int z)
+STATIC int s_isp2(mp_int z)
{
- mp_size uz = MP_USED(z), k = 0;
- mp_digit *dz = MP_DIGITS(z), d;
+ mp_size uz = MP_USED(z), k = 0;
+ mp_digit *dz = MP_DIGITS(z), d;
- while(uz > 1) {
- if(*dz++ != 0)
- return -1;
- k += MP_DIGIT_BIT;
- --uz;
- }
+ while(uz > 1) {
+ if(*dz++ != 0)
+ return -1;
+ k += MP_DIGIT_BIT;
+ --uz;
+ }
- d = *dz;
- while(d > 1) {
- if(d & 1)
- return -1;
- ++k; d >>= 1;
- }
+ d = *dz;
+ while(d > 1) {
+ if(d & 1)
+ return -1;
+ ++k; d >>= 1;
+ }
- return (int) k;
+ return (int) k;
}
/* }}} */
/* {{{ s_2expt(z, k) */
-STATIC int s_2expt(klisp_State *K, mp_int z, mp_small k)
+STATIC int s_2expt(klisp_State *K, mp_int z, mp_small k)
{
- mp_size ndig, rest;
- mp_digit *dz;
+ mp_size ndig, rest;
+ mp_digit *dz;
- ndig = (k + MP_DIGIT_BIT) / MP_DIGIT_BIT;
- rest = k % MP_DIGIT_BIT;
+ ndig = (k + MP_DIGIT_BIT) / MP_DIGIT_BIT;
+ rest = k % MP_DIGIT_BIT;
- if(!s_pad(K, z, ndig))
- return 0;
+ if(!s_pad(K, z, ndig))
+ return 0;
- dz = MP_DIGITS(z);
- ZERO(dz, ndig);
- *(dz + ndig - 1) = (1 << rest);
- MP_USED(z) = ndig;
+ dz = MP_DIGITS(z);
+ ZERO(dz, ndig);
+ *(dz + ndig - 1) = (1 << rest);
+ MP_USED(z) = ndig;
- return 1;
+ return 1;
}
/* }}} */
/* {{{ s_norm(a, b) */
-STATIC int s_norm(klisp_State *K, mp_int a, mp_int b)
+STATIC int s_norm(klisp_State *K, mp_int a, mp_int b)
{
- mp_digit d = b->digits[MP_USED(b) - 1];
- int k = 0;
+ mp_digit d = b->digits[MP_USED(b) - 1];
+ int k = 0;
- while(d < (mp_digit) (1 << (MP_DIGIT_BIT - 1))) { /* d < (MP_RADIX / 2) */
- d <<= 1;
- ++k;
- }
+ while(d < (mp_digit) (1 << (MP_DIGIT_BIT - 1))) { /* d < (MP_RADIX / 2) */
+ d <<= 1;
+ ++k;
+ }
- /* These multiplications can't fail */
- if(k != 0) {
- (void) s_qmul(K, a, (mp_size) k);
- (void) s_qmul(K, b, (mp_size) k);
- }
+ /* These multiplications can't fail */
+ if(k != 0) {
+ (void) s_qmul(K, a, (mp_size) k);
+ (void) s_qmul(K, b, (mp_size) k);
+ }
- return k;
+ return k;
}
/* }}} */
@@ -3041,61 +3041,61 @@ STATIC int s_norm(klisp_State *K, mp_int a, mp_int b)
STATIC mp_result s_brmu(klisp_State *K, mp_int z, mp_int m)
{
- mp_size um = MP_USED(m) * 2;
+ mp_size um = MP_USED(m) * 2;
- if(!s_pad(K, z, um))
- return MP_MEMORY;
+ if(!s_pad(K, z, um))
+ return MP_MEMORY;
- s_2expt(K, z, MP_DIGIT_BIT * um);
- return mp_int_div(K, z, m, z, NULL);
+ s_2expt(K, z, MP_DIGIT_BIT * um);
+ return mp_int_div(K, z, m, z, NULL);
}
/* }}} */
/* {{{ s_reduce(x, m, mu, q1, q2) */
-STATIC int s_reduce(klisp_State *K, mp_int x, mp_int m, mp_int mu,
- mp_int q1, mp_int q2)
+STATIC int s_reduce(klisp_State *K, mp_int x, mp_int m, mp_int mu,
+ mp_int q1, mp_int q2)
{
- mp_size um = MP_USED(m), umb_p1, umb_m1;
+ mp_size um = MP_USED(m), umb_p1, umb_m1;
- umb_p1 = (um + 1) * MP_DIGIT_BIT;
- umb_m1 = (um - 1) * MP_DIGIT_BIT;
+ umb_p1 = (um + 1) * MP_DIGIT_BIT;
+ umb_m1 = (um - 1) * MP_DIGIT_BIT;
- if(mp_int_copy(K, x, q1) != MP_OK)
- return 0;
+ if(mp_int_copy(K, x, q1) != MP_OK)
+ return 0;
- /* Compute q2 = floor((floor(x / b^(k-1)) * mu) / b^(k+1)) */
- s_qdiv(q1, umb_m1);
- UMUL(K, q1, mu, q2);
- s_qdiv(q2, umb_p1);
-
- /* Set x = x mod b^(k+1) */
- s_qmod(x, umb_p1);
-
- /* Now, q is a guess for the quotient a / m.
- Compute x - q * m mod b^(k+1), replacing x. This may be off
- by a factor of 2m, but no more than that.
- */
- UMUL(K, q2, m, q1);
- s_qmod(q1, umb_p1);
- (void) mp_int_sub(K, x, q1, x); /* can't fail */
-
- /* The result may be < 0; if it is, add b^(k+1) to pin it in the
- proper range. */
- if((CMPZ(x) < 0) && !s_qsub(K, x, umb_p1))
- return 0;
+ /* Compute q2 = floor((floor(x / b^(k-1)) * mu) / b^(k+1)) */
+ s_qdiv(q1, umb_m1);
+ UMUL(K, q1, mu, q2);
+ s_qdiv(q2, umb_p1);
+
+ /* Set x = x mod b^(k+1) */
+ s_qmod(x, umb_p1);
- /* If x > m, we need to back it off until it is in range.
- This will be required at most twice. */
- if(mp_int_compare(x, m) >= 0) {
- (void) mp_int_sub(K, x, m, x);
- if(mp_int_compare(x, m) >= 0)
- (void) mp_int_sub(K, x, m, x);
- }
+ /* Now, q is a guess for the quotient a / m.
+ Compute x - q * m mod b^(k+1), replacing x. This may be off
+ by a factor of 2m, but no more than that.
+ */
+ UMUL(K, q2, m, q1);
+ s_qmod(q1, umb_p1);
+ (void) mp_int_sub(K, x, q1, x); /* can't fail */
+
+ /* The result may be < 0; if it is, add b^(k+1) to pin it in the
+ proper range. */
+ if((CMPZ(x) < 0) && !s_qsub(K, x, umb_p1))
+ return 0;
- /* At this point, x has been properly reduced. */
- return 1;
+ /* If x > m, we need to back it off until it is in range.
+ This will be required at most twice. */
+ if(mp_int_compare(x, m) >= 0) {
+ (void) mp_int_sub(K, x, m, x);
+ if(mp_int_compare(x, m) >= 0)
+ (void) mp_int_sub(K, x, m, x);
+ }
+
+ /* At this point, x has been properly reduced. */
+ return 1;
}
/* }}} */
@@ -3105,77 +3105,77 @@ STATIC int s_reduce(klisp_State *K, mp_int x, mp_int m, mp_int mu,
/* Perform modular exponentiation using Barrett's method, where mu is
the reduction constant for m. Assumes a < m, b > 0. */
STATIC mp_result s_embar(klisp_State *K, mp_int a, mp_int b, mp_int m,
- mp_int mu, mp_int c)
+ mp_int mu, mp_int c)
{
- mp_digit *db, *dbt, umu, d;
- mpz_t temp[3];
- mp_result res;
- int last = 0;
+ mp_digit *db, *dbt, umu, d;
+ mpz_t temp[3];
+ mp_result res;
+ int last = 0;
- umu = MP_USED(mu); db = MP_DIGITS(b); dbt = db + MP_USED(b) - 1;
+ umu = MP_USED(mu); db = MP_DIGITS(b); dbt = db + MP_USED(b) - 1;
- while(last < 3) {
- SETUP(mp_int_init_size(K, TEMP(last), 4 * umu), last);
- ZERO(MP_DIGITS(TEMP(last - 1)), MP_ALLOC(TEMP(last - 1)));
- }
+ while(last < 3) {
+ SETUP(mp_int_init_size(K, TEMP(last), 4 * umu), last);
+ ZERO(MP_DIGITS(TEMP(last - 1)), MP_ALLOC(TEMP(last - 1)));
+ }
- (void) mp_int_set_value(K, c, 1);
+ (void) mp_int_set_value(K, c, 1);
- /* Take care of low-order digits */
- while(db < dbt) {
- int i;
+ /* Take care of low-order digits */
+ while(db < dbt) {
+ int i;
- for(d = *db, i = MP_DIGIT_BIT; i > 0; --i, d >>= 1) {
- if(d & 1) {
- /* The use of a second temporary avoids allocation */
- UMUL(K, c, a, TEMP(0));
- if(!s_reduce(K, TEMP(0), m, mu, TEMP(1), TEMP(2))) {
- res = MP_MEMORY; goto CLEANUP;
- }
- mp_int_copy(K, TEMP(0), c);
- }
+ for(d = *db, i = MP_DIGIT_BIT; i > 0; --i, d >>= 1) {
+ if(d & 1) {
+ /* The use of a second temporary avoids allocation */
+ UMUL(K, c, a, TEMP(0));
+ if(!s_reduce(K, TEMP(0), m, mu, TEMP(1), TEMP(2))) {
+ res = MP_MEMORY; goto CLEANUP;
+ }
+ mp_int_copy(K, TEMP(0), c);
+ }
- USQR(K, a, TEMP(0));
- assert(MP_SIGN(TEMP(0)) == MP_ZPOS);
- if(!s_reduce(K, TEMP(0), m, mu, TEMP(1), TEMP(2))) {
- res = MP_MEMORY; goto CLEANUP;
- }
- assert(MP_SIGN(TEMP(0)) == MP_ZPOS);
- mp_int_copy(K, TEMP(0), a);
+ USQR(K, a, TEMP(0));
+ assert(MP_SIGN(TEMP(0)) == MP_ZPOS);
+ if(!s_reduce(K, TEMP(0), m, mu, TEMP(1), TEMP(2))) {
+ res = MP_MEMORY; goto CLEANUP;
+ }
+ assert(MP_SIGN(TEMP(0)) == MP_ZPOS);
+ mp_int_copy(K, TEMP(0), a);
- }
+ }
- ++db;
- }
-
- /* Take care of highest-order digit */
- d = *dbt;
- for(;;) {
- if(d & 1) {
- UMUL(K, c, a, TEMP(0));
- if(!s_reduce(K, TEMP(0), m, mu, TEMP(1), TEMP(2))) {
- res = MP_MEMORY; goto CLEANUP;
- }
- mp_int_copy(K, TEMP(0), c);
+ ++db;
}
-
- d >>= 1;
- if(!d) break;
- USQR(K, a, TEMP(0));
- if(!s_reduce(K, TEMP(0), m, mu, TEMP(1), TEMP(2))) {
- res = MP_MEMORY; goto CLEANUP;
+ /* Take care of highest-order digit */
+ d = *dbt;
+ for(;;) {
+ if(d & 1) {
+ UMUL(K, c, a, TEMP(0));
+ if(!s_reduce(K, TEMP(0), m, mu, TEMP(1), TEMP(2))) {
+ res = MP_MEMORY; goto CLEANUP;
+ }
+ mp_int_copy(K, TEMP(0), c);
+ }
+
+ d >>= 1;
+ if(!d) break;
+
+ USQR(K, a, TEMP(0));
+ if(!s_reduce(K, TEMP(0), m, mu, TEMP(1), TEMP(2))) {
+ res = MP_MEMORY; goto CLEANUP;
+ }
+ (void) mp_int_copy(K, TEMP(0), a);
}
- (void) mp_int_copy(K, TEMP(0), a);
- }
- CLEANUP:
- while(--last >= 0)
- mp_int_clear(K, TEMP(last));
+CLEANUP:
+ while(--last >= 0)
+ mp_int_clear(K, TEMP(last));
- return res;
+ return res;
}
/* }}} */
@@ -3184,112 +3184,112 @@ STATIC mp_result s_embar(klisp_State *K, mp_int a, mp_int b, mp_int m,
/* Precondition: a >= b and b > 0
Postcondition: a' = a / b, b' = a % b
- */
+*/
STATIC mp_result s_udiv(klisp_State *K, mp_int a, mp_int b)
{
- mpz_t q, r, t;
- mp_size ua, ub, qpos = 0;
- mp_digit *da, btop;
- mp_result res = MP_OK;
- int k, skip = 0;
-
- /* Force signs to positive */
- MP_SIGN(a) = MP_ZPOS;
- MP_SIGN(b) = MP_ZPOS;
-
- /* Normalize, per Knuth */
- k = s_norm(K, a, b);
-
- ua = MP_USED(a); ub = MP_USED(b); btop = b->digits[ub - 1];
- if((res = mp_int_init_size(K, &q, ua)) != MP_OK) return res;
- if((res = mp_int_init_size(K, &t, ua + 1)) != MP_OK) goto CLEANUP;
-
- da = MP_DIGITS(a);
- r.digits = da + ua - 1; /* The contents of r are shared with a */
- r.used = 1;
- r.sign = MP_ZPOS;
- r.alloc = MP_ALLOC(a);
- ZERO(t.digits, t.alloc);
-
- /* Solve for quotient digits, store in q.digits in reverse order */
- while(r.digits >= da) {
- assert(qpos <= q.alloc);
-
- if(s_ucmp(b, &r) > 0) {
- r.digits -= 1;
- r.used += 1;
-
- if(++skip > 1 && qpos > 0)
- q.digits[qpos++] = 0;
-
- CLAMP(&r);
+ mpz_t q, r, t;
+ mp_size ua, ub, qpos = 0;
+ mp_digit *da, btop;
+ mp_result res = MP_OK;
+ int k, skip = 0;
+
+ /* Force signs to positive */
+ MP_SIGN(a) = MP_ZPOS;
+ MP_SIGN(b) = MP_ZPOS;
+
+ /* Normalize, per Knuth */
+ k = s_norm(K, a, b);
+
+ ua = MP_USED(a); ub = MP_USED(b); btop = b->digits[ub - 1];
+ if((res = mp_int_init_size(K, &q, ua)) != MP_OK) return res;
+ if((res = mp_int_init_size(K, &t, ua + 1)) != MP_OK) goto CLEANUP;
+
+ da = MP_DIGITS(a);
+ r.digits = da + ua - 1; /* The contents of r are shared with a */
+ r.used = 1;
+ r.sign = MP_ZPOS;
+ r.alloc = MP_ALLOC(a);
+ ZERO(t.digits, t.alloc);
+
+ /* Solve for quotient digits, store in q.digits in reverse order */
+ while(r.digits >= da) {
+ assert(qpos <= q.alloc);
+
+ if(s_ucmp(b, &r) > 0) {
+ r.digits -= 1;
+ r.used += 1;
+
+ if(++skip > 1 && qpos > 0)
+ q.digits[qpos++] = 0;
+
+ CLAMP(&r);
+ }
+ else {
+ mp_word pfx = r.digits[r.used - 1];
+ mp_word qdigit;
+
+ // Bugfix (was pfx <= btop in imath <= 1.17) Andres Navarro
+ if(r.used > 1 && pfx < btop) {
+ pfx <<= MP_DIGIT_BIT / 2;
+ pfx <<= MP_DIGIT_BIT / 2;
+ pfx |= r.digits[r.used - 2];
+ }
+
+ qdigit = pfx / btop;
+ if(qdigit > MP_DIGIT_MAX) {
+ qdigit = MP_DIGIT_MAX;
+ }
+
+ s_dbmul(MP_DIGITS(b), (mp_digit) qdigit, t.digits, ub);
+ t.used = ub + 1; CLAMP(&t);
+ while(s_ucmp(&t, &r) > 0) {
+ --qdigit;
+ (void) mp_int_sub(K, &t, b, &t); /* cannot fail */
+ }
+
+ s_usub(r.digits, t.digits, r.digits, r.used, t.used);
+ CLAMP(&r);
+
+ q.digits[qpos++] = (mp_digit) qdigit;
+ ZERO(t.digits, t.used);
+ skip = 0;
+ }
}
- else {
- mp_word pfx = r.digits[r.used - 1];
- mp_word qdigit;
-
- // Bugfix (was pfx <= btop in imath <= 1.17) Andres Navarro
- if(r.used > 1 && pfx < btop) {
- pfx <<= MP_DIGIT_BIT / 2;
- pfx <<= MP_DIGIT_BIT / 2;
- pfx |= r.digits[r.used - 2];
- }
-
- qdigit = pfx / btop;
- if(qdigit > MP_DIGIT_MAX) {
- qdigit = MP_DIGIT_MAX;
- }
-
- s_dbmul(MP_DIGITS(b), (mp_digit) qdigit, t.digits, ub);
- t.used = ub + 1; CLAMP(&t);
- while(s_ucmp(&t, &r) > 0) {
- --qdigit;
- (void) mp_int_sub(K, &t, b, &t); /* cannot fail */
- }
-
- s_usub(r.digits, t.digits, r.digits, r.used, t.used);
- CLAMP(&r);
-
- q.digits[qpos++] = (mp_digit) qdigit;
- ZERO(t.digits, t.used);
- skip = 0;
- }
- }
-
- /* Put quotient digits in the correct order, and discard extra zeroes */
- q.used = qpos;
- REV(mp_digit, q.digits, qpos);
- CLAMP(&q);
-
- /* Denormalize the remainder */
- CLAMP(a);
- if(k != 0)
- s_qdiv(a, k);
+
+ /* Put quotient digits in the correct order, and discard extra zeroes */
+ q.used = qpos;
+ REV(mp_digit, q.digits, qpos);
+ CLAMP(&q);
+
+ /* Denormalize the remainder */
+ CLAMP(a);
+ if(k != 0)
+ s_qdiv(a, k);
- mp_int_copy(K, a, b); /* ok: 0 <= r < b */
- mp_int_copy(K, &q, a); /* ok: q <= a */
+ mp_int_copy(K, a, b); /* ok: 0 <= r < b */
+ mp_int_copy(K, &q, a); /* ok: q <= a */
- mp_int_clear(K, &t);
- CLEANUP:
- mp_int_clear(K, &q);
- return res;
+ mp_int_clear(K, &t);
+CLEANUP:
+ mp_int_clear(K, &q);
+ return res;
}
/* }}} */
/* {{{ s_outlen(z, r) */
-STATIC int s_outlen(mp_int z, mp_size r)
+STATIC int s_outlen(mp_int z, mp_size r)
{
- mp_result bits;
- double raw;
+ mp_result bits;
+ double raw;
- assert(r >= MP_MIN_RADIX && r <= MP_MAX_RADIX);
+ assert(r >= MP_MIN_RADIX && r <= MP_MAX_RADIX);
- bits = mp_int_count_bits(z);
- raw = (double)bits * s_log2[r];
+ bits = mp_int_count_bits(z);
+ raw = (double)bits * s_log2[r];
- return (int)(raw + 0.999999);
+ return (int)(raw + 0.999999);
}
/* }}} */
@@ -3298,70 +3298,70 @@ STATIC int s_outlen(mp_int z, mp_size r)
STATIC mp_size s_inlen(int len, mp_size r)
{
- double raw = (double)len / s_log2[r];
- mp_size bits = (mp_size)(raw + 0.5);
+ double raw = (double)len / s_log2[r];
+ mp_size bits = (mp_size)(raw + 0.5);
- return (mp_size)((bits + (MP_DIGIT_BIT - 1)) / MP_DIGIT_BIT);
+ return (mp_size)((bits + (MP_DIGIT_BIT - 1)) / MP_DIGIT_BIT);
}
/* }}} */
/* {{{ s_ch2val(c, r) */
-STATIC int s_ch2val(char c, int r)
+STATIC int s_ch2val(char c, int r)
{
- int out;
+ int out;
- if(isdigit((unsigned char) c))
- out = c - '0';
- else if(r > 10 && isalpha((unsigned char) c))
- out = toupper(c) - 'A' + 10;
- else
- return -1;
+ if(isdigit((unsigned char) c))
+ out = c - '0';
+ else if(r > 10 && isalpha((unsigned char) c))
+ out = toupper(c) - 'A' + 10;
+ else
+ return -1;
- return (out >= r) ? -1 : out;
+ return (out >= r) ? -1 : out;
}
/* }}} */
/* {{{ s_val2ch(v, caps) */
-STATIC char s_val2ch(int v, int caps)
+STATIC char s_val2ch(int v, int caps)
{
- assert(v >= 0);
+ assert(v >= 0);
- if(v < 10)
- return v + '0';
- else {
- char out = (v - 10) + 'a';
+ if(v < 10)
+ return v + '0';
+ else {
+ char out = (v - 10) + 'a';
- if(caps)
- return toupper(out);
- else
- return out;
- }
+ if(caps)
+ return toupper(out);
+ else
+ return out;
+ }
}
/* }}} */
/* {{{ s_2comp(buf, len) */
-STATIC void s_2comp(unsigned char *buf, int len)
+STATIC void s_2comp(unsigned char *buf, int len)
{
- int i;
- unsigned short s = 1;
+ int i;
+ unsigned short s = 1;
- for(i = len - 1; i >= 0; --i) {
- unsigned char c = ~buf[i];
+ for(i = len - 1; i >= 0; --i) {
+ unsigned char c = ~buf[i];
- s = c + s;
- c = s & UCHAR_MAX;
- s >>= CHAR_BIT;
+ s = c + s;
+ c = s & UCHAR_MAX;
+ s >>= CHAR_BIT;
- buf[i] = c;
- }
+ buf[i] = c;
+ }
- /* last carry out is ignored */
+ /* last carry out is ignored */
}
/* }}} */
@@ -3370,44 +3370,44 @@ STATIC void s_2comp(unsigned char *buf, int len)
STATIC mp_result s_tobin(mp_int z, unsigned char *buf, int *limpos, int pad)
{
- mp_size uz;
- mp_digit *dz;
- int pos = 0, limit = *limpos;
+ mp_size uz;
+ mp_digit *dz;
+ int pos = 0, limit = *limpos;
- uz = MP_USED(z); dz = MP_DIGITS(z);
- while(uz > 0 && pos < limit) {
- mp_digit d = *dz++;
- int i;
+ uz = MP_USED(z); dz = MP_DIGITS(z);
+ while(uz > 0 && pos < limit) {
+ mp_digit d = *dz++;
+ int i;
- for(i = sizeof(mp_digit); i > 0 && pos < limit; --i) {
- buf[pos++] = (unsigned char)d;
- d >>= CHAR_BIT;
+ for(i = sizeof(mp_digit); i > 0 && pos < limit; --i) {
+ buf[pos++] = (unsigned char)d;
+ d >>= CHAR_BIT;
- /* Don't write leading zeroes */
- if(d == 0 && uz == 1)
- i = 0; /* exit loop without signaling truncation */
- }
+ /* Don't write leading zeroes */
+ if(d == 0 && uz == 1)
+ i = 0; /* exit loop without signaling truncation */
+ }
- /* Detect truncation (loop exited with pos >= limit) */
- if(i > 0) break;
+ /* Detect truncation (loop exited with pos >= limit) */
+ if(i > 0) break;
- --uz;
- }
+ --uz;
+ }
- if(pad != 0 && (buf[pos - 1] >> (CHAR_BIT - 1))) {
- if(pos < limit)
- buf[pos++] = 0;
- else
- uz = 1;
- }
+ if(pad != 0 && (buf[pos - 1] >> (CHAR_BIT - 1))) {
+ if(pos < limit)
+ buf[pos++] = 0;
+ else
+ uz = 1;
+ }
- /* Digits are in reverse order, fix that */
- REV(unsigned char, buf, pos);
+ /* Digits are in reverse order, fix that */
+ REV(unsigned char, buf, pos);
- /* Return the number of bytes actually written */
- *limpos = pos;
+ /* Return the number of bytes actually written */
+ *limpos = pos;
- return (uz == 0) ? MP_OK : MP_TRUNC;
+ return (uz == 0) ? MP_OK : MP_TRUNC;
}
/* }}} */
@@ -3415,30 +3415,30 @@ STATIC mp_result s_tobin(mp_int z, unsigned char *buf, int *limpos, int pad)
/* {{{ s_print(tag, z) */
#if DEBUG
-void s_print(char *tag, mp_int z)
+void s_print(char *tag, mp_int z)
{
- int i;
+ int i;
- fprintf(stderr, "%s: %c ", tag,
- (MP_SIGN(z) == MP_NEG) ? '-' : '+');
+ fprintf(stderr, "%s: %c ", tag,
+ (MP_SIGN(z) == MP_NEG) ? '-' : '+');
- for(i = MP_USED(z) - 1; i >= 0; --i)
- fprintf(stderr, "%0*X", (int)(MP_DIGIT_BIT / 4), z->digits[i]);
+ for(i = MP_USED(z) - 1; i >= 0; --i)
+ fprintf(stderr, "%0*X", (int)(MP_DIGIT_BIT / 4), z->digits[i]);
- fputc('\n', stderr);
+ fputc('\n', stderr);
}
-void s_print_buf(char *tag, mp_digit *buf, mp_size num)
+void s_print_buf(char *tag, mp_digit *buf, mp_size num)
{
- int i;
+ int i;
- fprintf(stderr, "%s: ", tag);
+ fprintf(stderr, "%s: ", tag);
- for(i = num - 1; i >= 0; --i)
- fprintf(stderr, "%0*X", (int)(MP_DIGIT_BIT / 4), buf[i]);
+ for(i = num - 1; i >= 0; --i)
+ fprintf(stderr, "%0*X", (int)(MP_DIGIT_BIT / 4), buf[i]);
- fputc('\n', stderr);
+ fputc('\n', stderr);
}
#endif
diff --git a/src/imath.h b/src/imath.h
@@ -34,39 +34,39 @@ extern "C" {
#endif
#if USE_C99
-typedef unsigned char mp_sign;
-typedef uint32_t mp_size;
-typedef int mp_result;
-typedef int32_t mp_small; /* must be a signed type */
-typedef uint32_t mp_usmall; /* must be an unsigned type */
-typedef uint32_t mp_digit;
-typedef uint64_t mp_word;
+ typedef unsigned char mp_sign;
+ typedef uint32_t mp_size;
+ typedef int mp_result;
+ typedef int32_t mp_small; /* must be a signed type */
+ typedef uint32_t mp_usmall; /* must be an unsigned type */
+ typedef uint32_t mp_digit;
+ typedef uint64_t mp_word;
#else /* USE_C99 */
-typedef unsigned char mp_sign;
-typedef unsigned int mp_size;
-typedef int mp_result;
-typedef long mp_small; /* must be a signed type */
-typedef unsigned long mp_usmall; /* must be an unsigned type */
+ typedef unsigned char mp_sign;
+ typedef unsigned int mp_size;
+ typedef int mp_result;
+ typedef long mp_small; /* must be a signed type */
+ typedef unsigned long mp_usmall; /* must be an unsigned type */
#ifdef USE_LONG_LONG
-typedef unsigned int mp_digit;
-typedef unsigned long long mp_word;
+ typedef unsigned int mp_digit;
+ typedef unsigned long long mp_word;
#else /* USE_LONG_LONG */
-typedef unsigned short mp_digit;
-typedef unsigned int mp_word;
+ typedef unsigned short mp_digit;
+ typedef unsigned int mp_word;
#endif /* USE_LONG_LONG */
#endif /* USE_C99 */
/* Andres Navarro: Use kobject type instead */
-typedef Bigint mpz_t, *mp_int;
+ typedef Bigint mpz_t, *mp_int;
#if 0
-typedef struct mpz {
- mp_digit single;
- mp_digit *digits;
- mp_size alloc;
- mp_size used;
- mp_sign sign;
-} mpz_t, *mp_int;
+ typedef struct mpz {
+ mp_digit single;
+ mp_digit *digits;
+ mp_size alloc;
+ mp_size used;
+ mp_sign sign;
+ } mpz_t, *mp_int;
#endif
#define MP_SINGLE(Z) ((Z)->single) /* added to correct check in mp_int_clear */
@@ -75,18 +75,18 @@ typedef struct mpz {
#define MP_USED(Z) ((Z)->used)
#define MP_SIGN(Z) ((Z)->sign)
-extern const mp_result MP_OK;
-extern const mp_result MP_FALSE;
-extern const mp_result MP_TRUE;
-extern const mp_result MP_MEMORY;
-extern const mp_result MP_RANGE;
-extern const mp_result MP_UNDEF;
-extern const mp_result MP_TRUNC;
-extern const mp_result MP_BADARG;
-extern const mp_result MP_MINERR;
+ extern const mp_result MP_OK;
+ extern const mp_result MP_FALSE;
+ extern const mp_result MP_TRUE;
+ extern const mp_result MP_MEMORY;
+ extern const mp_result MP_RANGE;
+ extern const mp_result MP_UNDEF;
+ extern const mp_result MP_TRUNC;
+ extern const mp_result MP_BADARG;
+ extern const mp_result MP_MINERR;
#define MP_DIGIT_BIT (sizeof(mp_digit) * CHAR_BIT)
-#define MP_WORD_BIT (sizeof(mp_word) * CHAR_BIT)
+#define MP_WORD_BIT (sizeof(mp_word) * CHAR_BIT)
/* Andres Navarro: USE_C99 */
#ifdef USE_C99
#define MP_SMALL_MIN INT32_MIN
@@ -103,16 +103,16 @@ extern const mp_result MP_MINERR;
#ifdef USE_LONG_LONG
# ifndef ULONG_LONG_MAX
# ifdef ULLONG_MAX
-# define ULONG_LONG_MAX ULLONG_MAX
+# define ULONG_LONG_MAX ULLONG_MAX
# else
-# error "Maximum value of unsigned long long not defined!"
+# error "Maximum value of unsigned long long not defined!"
# endif
# endif
# define MP_DIGIT_MAX (UINT_MAX * 1ULL)
# define MP_WORD_MAX ULONG_LONG_MAX
#else /* USE_LONG_LONG */
# define MP_DIGIT_MAX (USHRT_MAX * 1UL)
-# define MP_WORD_MAX (UINT_MAX * 1UL)
+# define MP_WORD_MAX (UINT_MAX * 1UL)
#endif /* USE_LONG_LONG */
#endif /* USE_C99 */
@@ -122,174 +122,174 @@ extern const mp_result MP_MINERR;
/* Values with fewer than this many significant digits use the
standard multiplication algorithm; otherwise, a recursive algorithm
is used. Choose a value to suit your platform.
- */
+*/
#define MP_MULT_THRESH 22
#define MP_DEFAULT_PREC 8 /* default memory allocation, in digits */
-extern const mp_sign MP_NEG;
-extern const mp_sign MP_ZPOS;
+ extern const mp_sign MP_NEG;
+ extern const mp_sign MP_ZPOS;
#define mp_int_is_odd(Z) ((Z)->digits[0] & 1)
#define mp_int_is_even(Z) !((Z)->digits[0] & 1)
/* NOTE: this doesn't use the allocator */
-mp_result mp_int_init(mp_int z);
-mp_int mp_int_alloc(klisp_State *K);
-mp_result mp_int_init_size(klisp_State *K, mp_int z, mp_size prec);
-mp_result mp_int_init_copy(klisp_State *K, mp_int z, mp_int old);
-mp_result mp_int_init_value(klisp_State *K, mp_int z, mp_small value);
-mp_result mp_int_set_value(klisp_State *K, mp_int z, mp_small value);
-void mp_int_clear(klisp_State *K, mp_int z);
-void mp_int_free(klisp_State *K, mp_int z);
-
-mp_result mp_int_copy(klisp_State *K, mp_int a, mp_int c); /* c = a */
+ mp_result mp_int_init(mp_int z);
+ mp_int mp_int_alloc(klisp_State *K);
+ mp_result mp_int_init_size(klisp_State *K, mp_int z, mp_size prec);
+ mp_result mp_int_init_copy(klisp_State *K, mp_int z, mp_int old);
+ mp_result mp_int_init_value(klisp_State *K, mp_int z, mp_small value);
+ mp_result mp_int_set_value(klisp_State *K, mp_int z, mp_small value);
+ void mp_int_clear(klisp_State *K, mp_int z);
+ void mp_int_free(klisp_State *K, mp_int z);
+
+ mp_result mp_int_copy(klisp_State *K, mp_int a, mp_int c); /* c = a */
/* NOTE: this doesn't use the allocator */
-void mp_int_swap(mp_int a, mp_int c); /* swap a, c */
+ void mp_int_swap(mp_int a, mp_int c); /* swap a, c */
/* NOTE: this doesn't use the allocator */
-void mp_int_zero(mp_int z); /* z = 0 */
-mp_result mp_int_abs(klisp_State *K, mp_int a, mp_int c); /* c = |a| */
-mp_result mp_int_neg(klisp_State *K, mp_int a, mp_int c); /* c = -a */
+ void mp_int_zero(mp_int z); /* z = 0 */
+ mp_result mp_int_abs(klisp_State *K, mp_int a, mp_int c); /* c = |a| */
+ mp_result mp_int_neg(klisp_State *K, mp_int a, mp_int c); /* c = -a */
/* c = a + b */
-mp_result mp_int_add(klisp_State *K, mp_int a, mp_int b, mp_int c);
-mp_result mp_int_add_value(klisp_State *K, mp_int a, mp_small value,
- mp_int c);
+ mp_result mp_int_add(klisp_State *K, mp_int a, mp_int b, mp_int c);
+ mp_result mp_int_add_value(klisp_State *K, mp_int a, mp_small value,
+ mp_int c);
/* c = a - b */
-mp_result mp_int_sub(klisp_State *K, mp_int a, mp_int b, mp_int c);
-mp_result mp_int_sub_value(klisp_State *K, mp_int a, mp_small value,
- mp_int c);
+ mp_result mp_int_sub(klisp_State *K, mp_int a, mp_int b, mp_int c);
+ mp_result mp_int_sub_value(klisp_State *K, mp_int a, mp_small value,
+ mp_int c);
/* c = a * b */
-mp_result mp_int_mul(klisp_State *K, mp_int a, mp_int b, mp_int c);
-mp_result mp_int_mul_value(klisp_State *K, mp_int a, mp_small value,
- mp_int c);
-mp_result mp_int_mul_pow2(klisp_State *K, mp_int a, mp_small p2, mp_int c);
-mp_result mp_int_sqr(klisp_State *K, mp_int a, mp_int c); /* c = a * a */
+ mp_result mp_int_mul(klisp_State *K, mp_int a, mp_int b, mp_int c);
+ mp_result mp_int_mul_value(klisp_State *K, mp_int a, mp_small value,
+ mp_int c);
+ mp_result mp_int_mul_pow2(klisp_State *K, mp_int a, mp_small p2, mp_int c);
+ mp_result mp_int_sqr(klisp_State *K, mp_int a, mp_int c); /* c = a * a */
/* q = a / b */
/* r = a % b */
-mp_result mp_int_div(klisp_State *K, mp_int a, mp_int b, mp_int q,
- mp_int r);
+ mp_result mp_int_div(klisp_State *K, mp_int a, mp_int b, mp_int q,
+ mp_int r);
/* q = a / value */
/* r = a % value */
-mp_result mp_int_div_value(klisp_State *K, mp_int a, mp_small value,
- mp_int q, mp_small *r);
+ mp_result mp_int_div_value(klisp_State *K, mp_int a, mp_small value,
+ mp_int q, mp_small *r);
/* q = a / 2^p2 */
/* r = q % 2^p2 */
-mp_result mp_int_div_pow2(klisp_State *K, mp_int a, mp_small p2,
- mp_int q, mp_int r);
+ mp_result mp_int_div_pow2(klisp_State *K, mp_int a, mp_small p2,
+ mp_int q, mp_int r);
/* c = a % m */
-mp_result mp_int_mod(klisp_State *K, mp_int a, mp_int m, mp_int c);
-#define mp_int_mod_value(K, A, V, R) \
+ mp_result mp_int_mod(klisp_State *K, mp_int a, mp_int m, mp_int c);
+#define mp_int_mod_value(K, A, V, R) \
mp_int_div_value((K), (A), (V), 0, (R))
/* c = a^b */
-mp_result mp_int_expt(klisp_State *K, mp_int a, mp_small b, mp_int c);
+ mp_result mp_int_expt(klisp_State *K, mp_int a, mp_small b, mp_int c);
/* c = a^b */
-mp_result mp_int_expt_value(klisp_State *K, mp_small a, mp_small b, mp_int c);
+ mp_result mp_int_expt_value(klisp_State *K, mp_small a, mp_small b, mp_int c);
/* c = a^b */
-mp_result mp_int_expt_full(klisp_State *K, mp_int a, mp_int b, mp_int c);
+ mp_result mp_int_expt_full(klisp_State *K, mp_int a, mp_int b, mp_int c);
/* NOTE: this doesn't use the allocator */
-int mp_int_compare(mp_int a, mp_int b); /* a <=> b */
+ int mp_int_compare(mp_int a, mp_int b); /* a <=> b */
/* NOTE: this doesn't use the allocator */
-int mp_int_compare_unsigned(mp_int a, mp_int b); /* |a| <=> |b| */
+ int mp_int_compare_unsigned(mp_int a, mp_int b); /* |a| <=> |b| */
/* NOTE: this doesn't use the allocator */
-int mp_int_compare_zero(mp_int z); /* a <=> 0 */
+ int mp_int_compare_zero(mp_int z); /* a <=> 0 */
/* NOTE: this doesn't use the allocator */
-int mp_int_compare_value(mp_int z, mp_small value); /* a <=> v */
+ int mp_int_compare_value(mp_int z, mp_small value); /* a <=> v */
/* Returns true if v|a, false otherwise (including errors) */
-int mp_int_divisible_value(klisp_State *K, mp_int a, mp_small v);
+ int mp_int_divisible_value(klisp_State *K, mp_int a, mp_small v);
/* NOTE: this doesn't use the allocator */
/* Returns k >= 0 such that z = 2^k, if one exists; otherwise < 0 */
-int mp_int_is_pow2(mp_int z);
-
-mp_result mp_int_exptmod(klisp_State *K, mp_int a, mp_int b, mp_int m,
- mp_int c); /* c = a^b (mod m) */
-mp_result mp_int_exptmod_evalue(klisp_State *K, mp_int a, mp_small value,
- mp_int m, mp_int c); /* c = a^v (mod m) */
-mp_result mp_int_exptmod_bvalue(klisp_State *K, mp_small value, mp_int b,
- mp_int m, mp_int c); /* c = v^b (mod m) */
-mp_result mp_int_exptmod_known(klisp_State *K, mp_int a, mp_int b,
- mp_int m, mp_int mu,
- mp_int c); /* c = a^b (mod m) */
-mp_result mp_int_redux_const(klisp_State *K, mp_int m, mp_int c);
+ int mp_int_is_pow2(mp_int z);
+
+ mp_result mp_int_exptmod(klisp_State *K, mp_int a, mp_int b, mp_int m,
+ mp_int c); /* c = a^b (mod m) */
+ mp_result mp_int_exptmod_evalue(klisp_State *K, mp_int a, mp_small value,
+ mp_int m, mp_int c); /* c = a^v (mod m) */
+ mp_result mp_int_exptmod_bvalue(klisp_State *K, mp_small value, mp_int b,
+ mp_int m, mp_int c); /* c = v^b (mod m) */
+ mp_result mp_int_exptmod_known(klisp_State *K, mp_int a, mp_int b,
+ mp_int m, mp_int mu,
+ mp_int c); /* c = a^b (mod m) */
+ mp_result mp_int_redux_const(klisp_State *K, mp_int m, mp_int c);
/* c = 1/a (mod m) */
-mp_result mp_int_invmod(klisp_State *K, mp_int a, mp_int m, mp_int c);
+ mp_result mp_int_invmod(klisp_State *K, mp_int a, mp_int m, mp_int c);
/* c = gcd(a, b) */
-mp_result mp_int_gcd(klisp_State *K, mp_int a, mp_int b, mp_int c);
+ mp_result mp_int_gcd(klisp_State *K, mp_int a, mp_int b, mp_int c);
/* c = gcd(a, b) */
-/* c = ax + by */
-mp_result mp_int_egcd(klisp_State *K, mp_int a, mp_int b, mp_int c,
- mp_int x, mp_int y);
+/* c = ax + by */
+ mp_result mp_int_egcd(klisp_State *K, mp_int a, mp_int b, mp_int c,
+ mp_int x, mp_int y);
/* c = lcm(a, b) */
-mp_result mp_int_lcm(klisp_State *K, mp_int a, mp_int b, mp_int c);
+ mp_result mp_int_lcm(klisp_State *K, mp_int a, mp_int b, mp_int c);
/* c = floor(a^{1/b}) */
-mp_result mp_int_root(klisp_State *K, mp_int a, mp_small b, mp_int c);
+ mp_result mp_int_root(klisp_State *K, mp_int a, mp_small b, mp_int c);
/* c = floor(sqrt(a)) */
-#define mp_int_sqrt(K, a, c) mp_int_root((K), a, 2, c)
+#define mp_int_sqrt(K, a, c) mp_int_root((K), a, 2, c)
/* Convert to a small int, if representable; else MP_RANGE */
/* NOTE: this doesn't use the allocator */
-mp_result mp_int_to_int(mp_int z, mp_small *out);
+ mp_result mp_int_to_int(mp_int z, mp_small *out);
/* NOTE: this doesn't use the allocator */
-mp_result mp_int_to_uint(mp_int z, mp_usmall *out);
+ mp_result mp_int_to_uint(mp_int z, mp_usmall *out);
/* Convert to nul-terminated string with the specified radix, writing at
most limit characters including the nul terminator */
-mp_result mp_int_to_string(klisp_State *K, mp_int z, mp_size radix,
- char *str, int limit);
+ mp_result mp_int_to_string(klisp_State *K, mp_int z, mp_size radix,
+ char *str, int limit);
/* Return the number of characters required to represent
z in the given radix. May over-estimate. */
/* NOTE: this doesn't use the allocator */
-mp_result mp_int_string_len(mp_int z, mp_size radix);
+ mp_result mp_int_string_len(mp_int z, mp_size radix);
/* Read zero-terminated string into z */
-mp_result mp_int_read_string(klisp_State *K, mp_int z, mp_size radix,
- const char *str);
-mp_result mp_int_read_cstring(klisp_State *K, mp_int z, mp_size radix,
- const char *str, char **end);
+ mp_result mp_int_read_string(klisp_State *K, mp_int z, mp_size radix,
+ const char *str);
+ mp_result mp_int_read_cstring(klisp_State *K, mp_int z, mp_size radix,
+ const char *str, char **end);
/* Return the number of significant bits in z */
/* NOTE: this doesn't use the allocator */
-mp_result mp_int_count_bits(mp_int z);
+ mp_result mp_int_count_bits(mp_int z);
/* Convert z to two's complement binary, writing at most limit bytes */
-mp_result mp_int_to_binary(klisp_State *K, mp_int z, unsigned char *buf,
- int limit);
+ mp_result mp_int_to_binary(klisp_State *K, mp_int z, unsigned char *buf,
+ int limit);
/* Read a two's complement binary value into z from the given buffer */
-mp_result mp_int_read_binary(klisp_State *K, mp_int z, unsigned char *buf,
- int len);
+ mp_result mp_int_read_binary(klisp_State *K, mp_int z, unsigned char *buf,
+ int len);
/* Return the number of bytes required to represent z in binary. */
/* NOTE: this doesn't use the allocator */
-mp_result mp_int_binary_len(mp_int z);
+ mp_result mp_int_binary_len(mp_int z);
/* Convert z to unsigned binary, writing at most limit bytes */
-mp_result mp_int_to_unsigned(klisp_State *K, mp_int z, unsigned char *buf,
- int limit);
+ mp_result mp_int_to_unsigned(klisp_State *K, mp_int z, unsigned char *buf,
+ int limit);
/* Read an unsigned binary value into z from the given buffer */
-mp_result mp_int_read_unsigned(klisp_State *K, mp_int z, unsigned char *buf,
- int len);
+ mp_result mp_int_read_unsigned(klisp_State *K, mp_int z, unsigned char *buf,
+ int len);
/* Return the number of bytes required to represent z as unsigned output */
/* NOTE: this doesn't use the allocator */
-mp_result mp_int_unsigned_len(mp_int z);
+ mp_result mp_int_unsigned_len(mp_int z);
/* Return a statically allocated string describing error code res */
/* NOTE: this doesn't use the allocator */
-const char *mp_error_string(mp_result res);
+ const char *mp_error_string(mp_result res);
#if DEBUG
-void s_print(char *tag, mp_int z);
-void s_print_buf(char *tag, mp_digit *buf, mp_size num);
+ void s_print(char *tag, mp_int z);
+ void s_print_buf(char *tag, mp_digit *buf, mp_size num);
#endif
#ifdef __cplusplus
diff --git a/src/imrat.c b/src/imrat.c
@@ -26,7 +26,7 @@
/* {{{ Useful macros */
#define TEMP(K) (temp + (K))
-#define SETUP(E, C) \
+#define SETUP(E, C) \
do{if((res = (E)) != MP_OK) goto CLEANUP; ++(C);}while(0)
/* Argument checking:
@@ -43,8 +43,8 @@ static mp_result s_rat_reduce(klisp_State *K, mp_rat r);
/* Common code for addition and subtraction operations on rationals. */
static mp_result s_rat_combine(klisp_State *K, mp_rat a, mp_rat b, mp_rat c,
- mp_result (*comb_f)
- (klisp_State *,mp_int, mp_int, mp_int));
+ mp_result (*comb_f)
+ (klisp_State *,mp_int, mp_int, mp_int));
/* {{{ mp_rat_init(r) */
@@ -62,10 +62,10 @@ mp_rat mp_rat_alloc(klisp_State *K)
mp_rat out = klispM_new(K, mpq_t);
if(out != NULL) {
- if(mp_rat_init(K, out) != MP_OK) {
- klispM_free(K, out);
- return NULL;
- }
+ if(mp_rat_init(K, out) != MP_OK) {
+ klispM_free(K, out);
+ return NULL;
+ }
}
return out;
@@ -76,15 +76,15 @@ mp_rat mp_rat_alloc(klisp_State *K)
/* {{{ mp_rat_init_size(r, n_prec, d_prec) */
mp_result mp_rat_init_size(klisp_State *K, mp_rat r, mp_size n_prec,
- mp_size d_prec)
+ mp_size d_prec)
{
mp_result res;
if((res = mp_int_init_size(K, MP_NUMER_P(r), n_prec)) != MP_OK)
- return res;
+ return res;
if((res = mp_int_init_size(K, MP_DENOM_P(r), d_prec)) != MP_OK) {
- mp_int_clear(K, MP_NUMER_P(r));
- return res;
+ mp_int_clear(K, MP_NUMER_P(r));
+ return res;
}
return mp_int_set_value(K, MP_DENOM_P(r), 1);
@@ -99,9 +99,9 @@ mp_result mp_rat_init_copy(klisp_State *K, mp_rat r, mp_rat old)
mp_result res;
if((res = mp_int_init_copy(K, MP_NUMER_P(r), MP_NUMER_P(old))) != MP_OK)
- return res;
+ return res;
if((res = mp_int_init_copy(K, MP_DENOM_P(r), MP_DENOM_P(old))) != MP_OK)
- mp_int_clear(K, MP_NUMER_P(r));
+ mp_int_clear(K, MP_NUMER_P(r));
return res;
}
@@ -115,12 +115,12 @@ mp_result mp_rat_set_value(klisp_State *K, mp_rat r, int numer, int denom)
mp_result res;
if(denom == 0)
- return MP_UNDEF;
+ return MP_UNDEF;
if((res = mp_int_set_value(K, MP_NUMER_P(r), numer)) != MP_OK)
- return res;
+ return res;
if((res = mp_int_set_value(K, MP_DENOM_P(r), denom)) != MP_OK)
- return res;
+ return res;
return s_rat_reduce(K, r);
}
@@ -129,7 +129,7 @@ mp_result mp_rat_set_value(klisp_State *K, mp_rat r, int numer, int denom)
/* {{{ mp_rat_clear(r) */
-void mp_rat_clear(klisp_State *K, mp_rat r)
+void mp_rat_clear(klisp_State *K, mp_rat r)
{
mp_int_clear(K, MP_NUMER_P(r));
mp_int_clear(K, MP_DENOM_P(r));
@@ -139,14 +139,14 @@ void mp_rat_clear(klisp_State *K, mp_rat r)
/* {{{ mp_rat_free(r) */
-void mp_rat_free(klisp_State *K, mp_rat r)
+void mp_rat_free(klisp_State *K, mp_rat r)
{
NRCHECK(r != NULL);
if(r->num.digits != NULL)
- mp_rat_clear(K, r);
+ mp_rat_clear(K, r);
- klispM_free(K, r);
+ klispM_free(K, r);
}
/* }}} */
@@ -185,7 +185,7 @@ mp_result mp_rat_copy(klisp_State *K, mp_rat a, mp_rat c)
mp_result res;
if((res = mp_int_copy(K, MP_NUMER_P(a), MP_NUMER_P(c))) != MP_OK)
- return res;
+ return res;
res = mp_int_copy(K, MP_DENOM_P(a), MP_DENOM_P(c));
return res;
@@ -195,7 +195,7 @@ mp_result mp_rat_copy(klisp_State *K, mp_rat a, mp_rat c)
/* {{{ mp_rat_zero(r) */
-void mp_rat_zero(klisp_State *K, mp_rat r)
+void mp_rat_zero(klisp_State *K, mp_rat r)
{
mp_int_zero(MP_NUMER_P(r));
mp_int_set_value(K, MP_DENOM_P(r), 1);
@@ -210,7 +210,7 @@ mp_result mp_rat_abs(klisp_State *K, mp_rat a, mp_rat c)
mp_result res;
if((res = mp_int_abs(K, MP_NUMER_P(a), MP_NUMER_P(c))) != MP_OK)
- return res;
+ return res;
res = mp_int_abs(K, MP_DENOM_P(a), MP_DENOM_P(c));
return res;
@@ -225,8 +225,8 @@ mp_result mp_rat_neg(klisp_State *K, mp_rat a, mp_rat c)
mp_result res;
if((res = mp_int_neg(K, MP_NUMER_P(a),
- MP_NUMER_P(c))) != MP_OK)
- return res;
+ MP_NUMER_P(c))) != MP_OK)
+ return res;
res = mp_int_copy(K, MP_DENOM_P(a), MP_DENOM_P(c));
return res;
@@ -241,19 +241,19 @@ mp_result mp_rat_recip(klisp_State *K, mp_rat a, mp_rat c)
mp_result res;
if(mp_rat_compare_zero(a) == 0)
- return MP_UNDEF;
+ return MP_UNDEF;
if((res = mp_rat_copy(K, a, c)) != MP_OK)
- return res;
+ return res;
mp_int_swap(MP_NUMER_P(c), MP_DENOM_P(c));
/* Restore the signs of the swapped elements */
{
- mp_sign tmp = MP_SIGN(MP_NUMER_P(c));
+ mp_sign tmp = MP_SIGN(MP_NUMER_P(c));
- MP_SIGN(MP_NUMER_P(c)) = MP_SIGN(MP_DENOM_P(c));
- MP_SIGN(MP_DENOM_P(c)) = tmp;
+ MP_SIGN(MP_NUMER_P(c)) = MP_SIGN(MP_DENOM_P(c));
+ MP_SIGN(MP_DENOM_P(c)) = tmp;
}
return MP_OK;
@@ -288,13 +288,13 @@ mp_result mp_rat_mul(klisp_State *K, mp_rat a, mp_rat b, mp_rat c)
mp_result res;
if((res = mp_int_mul(K, MP_NUMER_P(a), MP_NUMER_P(b),
- MP_NUMER_P(c))) != MP_OK)
- return res;
+ MP_NUMER_P(c))) != MP_OK)
+ return res;
if(mp_int_compare_zero(MP_NUMER_P(c)) != 0) {
- if((res = mp_int_mul(K, MP_DENOM_P(a), MP_DENOM_P(b),
- MP_DENOM_P(c))) != MP_OK)
- return res;
+ if((res = mp_int_mul(K, MP_DENOM_P(a), MP_DENOM_P(b),
+ MP_DENOM_P(c))) != MP_OK)
+ return res;
}
return s_rat_reduce(K, c);
@@ -309,35 +309,35 @@ mp_result mp_rat_div(klisp_State *K, mp_rat a, mp_rat b, mp_rat c)
mp_result res = MP_OK;
if(mp_rat_compare_zero(b) == 0)
- return MP_UNDEF;
+ return MP_UNDEF;
if(c == a || c == b) {
- mpz_t tmp;
+ mpz_t tmp;
- if((res = mp_int_init(&tmp)) != MP_OK) return res;
- if((res = mp_int_mul(K, MP_NUMER_P(a), MP_DENOM_P(b), &tmp)) != MP_OK)
- goto CLEANUP;
- if((res = mp_int_mul(K, MP_DENOM_P(a), MP_NUMER_P(b),
- MP_DENOM_P(c))) != MP_OK)
- goto CLEANUP;
- res = mp_int_copy(K, &tmp, MP_NUMER_P(c));
+ if((res = mp_int_init(&tmp)) != MP_OK) return res;
+ if((res = mp_int_mul(K, MP_NUMER_P(a), MP_DENOM_P(b), &tmp)) != MP_OK)
+ goto CLEANUP;
+ if((res = mp_int_mul(K, MP_DENOM_P(a), MP_NUMER_P(b),
+ MP_DENOM_P(c))) != MP_OK)
+ goto CLEANUP;
+ res = mp_int_copy(K, &tmp, MP_NUMER_P(c));
CLEANUP:
- mp_int_clear(K, &tmp);
+ mp_int_clear(K, &tmp);
}
else {
- if((res = mp_int_mul(K, MP_NUMER_P(a), MP_DENOM_P(b),
- MP_NUMER_P(c))) != MP_OK)
- return res;
- if((res = mp_int_mul(K, MP_DENOM_P(a), MP_NUMER_P(b),
- MP_DENOM_P(c))) != MP_OK)
- return res;
+ if((res = mp_int_mul(K, MP_NUMER_P(a), MP_DENOM_P(b),
+ MP_NUMER_P(c))) != MP_OK)
+ return res;
+ if((res = mp_int_mul(K, MP_DENOM_P(a), MP_NUMER_P(b),
+ MP_DENOM_P(c))) != MP_OK)
+ return res;
}
if(res != MP_OK)
- return res;
+ return res;
else
- return s_rat_reduce(K, c);
+ return s_rat_reduce(K, c);
}
/* }}} */
@@ -350,16 +350,16 @@ mp_result mp_rat_add_int(klisp_State *K, mp_rat a, mp_int b, mp_rat c)
mp_result res;
if((res = mp_int_init_copy(K, &tmp, b)) != MP_OK)
- return res;
+ return res;
if((res = mp_int_mul(K, &tmp, MP_DENOM_P(a), &tmp)) != MP_OK)
- goto CLEANUP;
+ goto CLEANUP;
if((res = mp_rat_copy(K, a, c)) != MP_OK)
- goto CLEANUP;
+ goto CLEANUP;
if((res = mp_int_add(K, MP_NUMER_P(c), &tmp, MP_NUMER_P(c))) != MP_OK)
- goto CLEANUP;
+ goto CLEANUP;
res = s_rat_reduce(K, c);
@@ -378,16 +378,16 @@ mp_result mp_rat_sub_int(klisp_State *K, mp_rat a, mp_int b, mp_rat c)
mp_result res;
if((res = mp_int_init_copy(K, &tmp, b)) != MP_OK)
- return res;
+ return res;
if((res = mp_int_mul(K, &tmp, MP_DENOM_P(a), &tmp)) != MP_OK)
- goto CLEANUP;
+ goto CLEANUP;
if((res = mp_rat_copy(K, a, c)) != MP_OK)
- goto CLEANUP;
+ goto CLEANUP;
if((res = mp_int_sub(K, MP_NUMER_P(c), &tmp, MP_NUMER_P(c))) != MP_OK)
- goto CLEANUP;
+ goto CLEANUP;
res = s_rat_reduce(K, c);
@@ -405,10 +405,10 @@ mp_result mp_rat_mul_int(klisp_State *K, mp_rat a, mp_int b, mp_rat c)
mp_result res;
if((res = mp_rat_copy(K, a, c)) != MP_OK)
- return res;
+ return res;
if((res = mp_int_mul(K, MP_NUMER_P(c), b, MP_NUMER_P(c))) != MP_OK)
- return res;
+ return res;
return s_rat_reduce(K, c);
}
@@ -422,13 +422,13 @@ mp_result mp_rat_div_int(klisp_State *K, mp_rat a, mp_int b, mp_rat c)
mp_result res;
if(mp_int_compare_zero(b) == 0)
- return MP_UNDEF;
+ return MP_UNDEF;
if((res = mp_rat_copy(K, a, c)) != MP_OK)
- return res;
+ return res;
if((res = mp_int_mul(K, MP_DENOM_P(c), b, MP_DENOM_P(c))) != MP_OK)
- return res;
+ return res;
return s_rat_reduce(K, c);
}
@@ -443,14 +443,14 @@ mp_result mp_rat_expt(klisp_State *K, mp_rat a, mp_small b, mp_rat c)
/* Special cases for easy powers. */
if(b == 0)
- return mp_rat_set_value(K, c, 1, 1);
+ return mp_rat_set_value(K, c, 1, 1);
else if(b == 1)
- return mp_rat_copy(K, a, c);
+ return mp_rat_copy(K, a, c);
/* Since rationals are always stored in lowest terms, it is not
necessary to reduce again when raising to an integer power. */
if((res = mp_int_expt(K, MP_NUMER_P(a), b, MP_NUMER_P(c))) != MP_OK)
- return res;
+ return res;
return mp_int_expt(K, MP_DENOM_P(a), b, MP_DENOM_P(c));
}
@@ -459,25 +459,25 @@ mp_result mp_rat_expt(klisp_State *K, mp_rat a, mp_small b, mp_rat c)
/* {{{ mp_rat_compare(a, b) */
-int mp_rat_compare(klisp_State *K, mp_rat a, mp_rat b)
+int mp_rat_compare(klisp_State *K, mp_rat a, mp_rat b)
{
/* Quick check for opposite signs. Works because the sign of the
numerator is always definitive. */
if(MP_SIGN(MP_NUMER_P(a)) != MP_SIGN(MP_NUMER_P(b))) {
- if(MP_SIGN(MP_NUMER_P(a)) == MP_ZPOS)
- return 1;
- else
- return -1;
+ if(MP_SIGN(MP_NUMER_P(a)) == MP_ZPOS)
+ return 1;
+ else
+ return -1;
}
else {
- /* Compare absolute magnitudes; if both are positive, the answer
- stands, otherwise it needs to be reflected about zero. */
- int cmp = mp_rat_compare_unsigned(K, a, b);
-
- if(MP_SIGN(MP_NUMER_P(a)) == MP_ZPOS)
- return cmp;
- else
- return -cmp;
+ /* Compare absolute magnitudes; if both are positive, the answer
+ stands, otherwise it needs to be reflected about zero. */
+ int cmp = mp_rat_compare_unsigned(K, a, b);
+
+ if(MP_SIGN(MP_NUMER_P(a)) == MP_ZPOS)
+ return cmp;
+ else
+ return -cmp;
}
}
@@ -485,33 +485,33 @@ int mp_rat_compare(klisp_State *K, mp_rat a, mp_rat b)
/* {{{ mp_rat_compare_unsigned(a, b) */
-int mp_rat_compare_unsigned(klisp_State *K, mp_rat a, mp_rat b)
+int mp_rat_compare_unsigned(klisp_State *K, mp_rat a, mp_rat b)
{
/* If the denominators are equal, we can quickly compare numerators
without multiplying. Otherwise, we actually have to do some work. */
if(mp_int_compare_unsigned(MP_DENOM_P(a), MP_DENOM_P(b)) == 0)
- return mp_int_compare_unsigned(MP_NUMER_P(a), MP_NUMER_P(b));
+ return mp_int_compare_unsigned(MP_NUMER_P(a), MP_NUMER_P(b));
else {
- mpz_t temp[2];
- mp_result res;
- int cmp = INT_MAX, last = 0;
+ mpz_t temp[2];
+ mp_result res;
+ int cmp = INT_MAX, last = 0;
- /* t0 = num(a) * den(b), t1 = num(b) * den(a) */
- SETUP(mp_int_init_copy(K, TEMP(last), MP_NUMER_P(a)), last);
- SETUP(mp_int_init_copy(K, TEMP(last), MP_NUMER_P(b)), last);
+ /* t0 = num(a) * den(b), t1 = num(b) * den(a) */
+ SETUP(mp_int_init_copy(K, TEMP(last), MP_NUMER_P(a)), last);
+ SETUP(mp_int_init_copy(K, TEMP(last), MP_NUMER_P(b)), last);
- if((res = mp_int_mul(K, TEMP(0), MP_DENOM_P(b), TEMP(0))) != MP_OK ||
- (res = mp_int_mul(K, TEMP(1), MP_DENOM_P(a), TEMP(1))) != MP_OK)
- goto CLEANUP;
+ if((res = mp_int_mul(K, TEMP(0), MP_DENOM_P(b), TEMP(0))) != MP_OK ||
+ (res = mp_int_mul(K, TEMP(1), MP_DENOM_P(a), TEMP(1))) != MP_OK)
+ goto CLEANUP;
- cmp = mp_int_compare_unsigned(TEMP(0), TEMP(1));
+ cmp = mp_int_compare_unsigned(TEMP(0), TEMP(1));
CLEANUP:
- while(--last >= 0)
- mp_int_clear(K, TEMP(last));
+ while(--last >= 0)
+ mp_int_clear(K, TEMP(last));
- return cmp;
+ return cmp;
}
}
@@ -519,7 +519,7 @@ int mp_rat_compare_unsigned(klisp_State *K, mp_rat a, mp_rat b)
/* {{{ mp_rat_compare_zero(r) */
-int mp_rat_compare_zero(mp_rat r)
+int mp_rat_compare_zero(mp_rat r)
{
return mp_int_compare_zero(MP_NUMER_P(r));
@@ -536,9 +536,9 @@ int mp_rat_compare_value(klisp_State *K, mp_rat r, mp_small n, mp_small d)
int out = INT_MAX;
if((res = mp_rat_init(K, &tmp)) != MP_OK)
- return out;
+ return out;
if((res = mp_rat_set_value(K, &tmp, n, d)) != MP_OK)
- goto CLEANUP;
+ goto CLEANUP;
out = mp_rat_compare(K, r, &tmp);
@@ -551,7 +551,7 @@ CLEANUP:
/* {{{ mp_rat_is_integer(r) */
-int mp_rat_is_integer(mp_rat r)
+int mp_rat_is_integer(mp_rat r)
{
return (mp_int_compare_value(MP_DENOM_P(r), 1) == 0);
}
@@ -565,7 +565,7 @@ mp_result mp_rat_to_ints(mp_rat r, mp_small *num, mp_small *den)
mp_result res;
if((res = mp_int_to_int(MP_NUMER_P(r), num)) != MP_OK)
- return res;
+ return res;
res = mp_int_to_int(MP_DENOM_P(r), den);
return res;
@@ -576,7 +576,7 @@ mp_result mp_rat_to_ints(mp_rat r, mp_small *num, mp_small *den)
/* {{{ mp_rat_to_string(r, radix, *str, limit) */
mp_result mp_rat_to_string(klisp_State *K, mp_rat r, mp_size radix, char *str,
- int limit)
+ int limit)
{
char *start;
int len;
@@ -585,11 +585,11 @@ mp_result mp_rat_to_string(klisp_State *K, mp_rat r, mp_size radix, char *str,
/* Write the numerator. The sign of the rational number is written
by the underlying integer implementation. */
if((res = mp_int_to_string(K, MP_NUMER_P(r), radix, str, limit)) != MP_OK)
- return res;
+ return res;
/* If the value is zero, don't bother writing any denominator */
if(mp_int_compare_zero(MP_NUMER_P(r)) == 0)
- return MP_OK;
+ return MP_OK;
/* Locate the end of the numerator, and make sure we are not going to
exceed the limit by writing a slash. */
@@ -597,7 +597,7 @@ mp_result mp_rat_to_string(klisp_State *K, mp_rat r, mp_size radix, char *str,
start = str + len;
limit -= len;
if(limit == 0)
- return MP_TRUNC;
+ return MP_TRUNC;
*start++ = '/';
limit -= 1;
@@ -610,8 +610,8 @@ mp_result mp_rat_to_string(klisp_State *K, mp_rat r, mp_size radix, char *str,
/* {{{ mp_rat_to_decimal(r, radix, prec, *str, limit) */
mp_result mp_rat_to_decimal(klisp_State *K, mp_rat r, mp_size radix,
- mp_size prec, mp_round_mode round, char *str,
- int limit)
+ mp_size prec, mp_round_mode round, char *str,
+ int limit)
{
mpz_t temp[3];
mp_result res;
@@ -626,31 +626,31 @@ mp_result mp_rat_to_decimal(klisp_State *K, mp_rat r, mp_size radix,
absolute value of the numerator. */
mp_int_abs(K, TEMP(0), TEMP(0));
if((res = mp_int_div(K, TEMP(0), MP_DENOM_P(r), TEMP(0),
- TEMP(1))) != MP_OK)
- goto CLEANUP;
+ TEMP(1))) != MP_OK)
+ goto CLEANUP;
/* Now: T0 = integer portion, unsigned;
T1 = remainder, from which fractional part is computed. */
/* Count up leading zeroes after the radix point. */
for(lead_0 = 0; lead_0 < prec && mp_int_compare(TEMP(1), MP_DENOM_P(r)) < 0;
- ++lead_0) {
- if((res = mp_int_mul_value(K, TEMP(1), radix, TEMP(1))) != MP_OK)
- goto CLEANUP;
+ ++lead_0) {
+ if((res = mp_int_mul_value(K, TEMP(1), radix, TEMP(1))) != MP_OK)
+ goto CLEANUP;
}
/* Multiply remainder by a power of the radix sufficient to get the
right number of significant figures. */
if(prec > lead_0) {
- if((res = mp_int_expt_value(K, radix, prec - lead_0,
- TEMP(2))) != MP_OK)
- goto CLEANUP;
- if((res = mp_int_mul(K, TEMP(1), TEMP(2), TEMP(1))) != MP_OK)
- goto CLEANUP;
+ if((res = mp_int_expt_value(K, radix, prec - lead_0,
+ TEMP(2))) != MP_OK)
+ goto CLEANUP;
+ if((res = mp_int_mul(K, TEMP(1), TEMP(2), TEMP(1))) != MP_OK)
+ goto CLEANUP;
}
if((res = mp_int_div(K, TEMP(1), MP_DENOM_P(r), TEMP(1),
- TEMP(2))) != MP_OK)
- goto CLEANUP;
+ TEMP(2))) != MP_OK)
+ goto CLEANUP;
/* Now: T1 = significant digits of fractional part;
T2 = leftovers, to use for rounding.
@@ -660,40 +660,40 @@ mp_result mp_rat_to_decimal(klisp_State *K, mp_rat r, mp_size radix,
already.
*/
switch(round) {
- int cmp;
+ int cmp;
case MP_ROUND_UP:
- if(mp_int_compare_zero(TEMP(2)) != 0) {
- if(prec == 0)
- res = mp_int_add_value(K, TEMP(0), 1, TEMP(0));
- else
- res = mp_int_add_value(K, TEMP(1), 1, TEMP(1));
- }
- break;
+ if(mp_int_compare_zero(TEMP(2)) != 0) {
+ if(prec == 0)
+ res = mp_int_add_value(K, TEMP(0), 1, TEMP(0));
+ else
+ res = mp_int_add_value(K, TEMP(1), 1, TEMP(1));
+ }
+ break;
case MP_ROUND_HALF_UP:
case MP_ROUND_HALF_DOWN:
- if((res = mp_int_mul_pow2(K, TEMP(2), 1, TEMP(2))) != MP_OK)
- goto CLEANUP;
+ if((res = mp_int_mul_pow2(K, TEMP(2), 1, TEMP(2))) != MP_OK)
+ goto CLEANUP;
- cmp = mp_int_compare(TEMP(2), MP_DENOM_P(r));
+ cmp = mp_int_compare(TEMP(2), MP_DENOM_P(r));
- if(round == MP_ROUND_HALF_UP)
- cmp += 1;
+ if(round == MP_ROUND_HALF_UP)
+ cmp += 1;
- if(cmp > 0) {
- if(prec == 0)
- res = mp_int_add_value(K, TEMP(0), 1, TEMP(0));
- else
- res = mp_int_add_value(K, TEMP(1), 1, TEMP(1));
- }
- break;
+ if(cmp > 0) {
+ if(prec == 0)
+ res = mp_int_add_value(K, TEMP(0), 1, TEMP(0));
+ else
+ res = mp_int_add_value(K, TEMP(1), 1, TEMP(1));
+ }
+ break;
case MP_ROUND_DOWN:
- break; /* No action required */
+ break; /* No action required */
default:
- return MP_BADARG; /* Invalid rounding specifier */
+ return MP_BADARG; /* Invalid rounding specifier */
}
/* The sign of the output should be the sign of the numerator, but
@@ -701,27 +701,27 @@ mp_result mp_rat_to_decimal(klisp_State *K, mp_rat r, mp_size radix,
negative shouldn't be shown. */
if(MP_SIGN(MP_NUMER_P(r)) == MP_NEG &&
(mp_int_compare_zero(TEMP(0)) != 0 ||
- mp_int_compare_zero(TEMP(1)) != 0)) {
- *start++ = '-';
- left -= 1;
+ mp_int_compare_zero(TEMP(1)) != 0)) {
+ *start++ = '-';
+ left -= 1;
}
if((res = mp_int_to_string(K, TEMP(0), radix, start, left)) != MP_OK)
- goto CLEANUP;
+ goto CLEANUP;
len = strlen(start);
start += len;
left -= len;
if(prec == 0)
- goto CLEANUP;
+ goto CLEANUP;
*start++ = '.';
left -= 1;
if(left < prec + 1) {
- res = MP_TRUNC;
- goto CLEANUP;
+ res = MP_TRUNC;
+ goto CLEANUP;
}
memset(start, '0', lead_0 - 1);
@@ -732,7 +732,7 @@ mp_result mp_rat_to_decimal(klisp_State *K, mp_rat r, mp_size radix,
CLEANUP:
while(--last >= 0)
- mp_int_clear(K, TEMP(last));
+ mp_int_clear(K, TEMP(last));
return res;
}
@@ -748,7 +748,7 @@ mp_result mp_rat_string_len(mp_rat r, mp_size radix)
n_len = mp_int_string_len(MP_NUMER_P(r), radix);
if(mp_int_compare_zero(MP_NUMER_P(r)) != 0)
- d_len = mp_int_string_len(MP_DENOM_P(r), radix);
+ d_len = mp_int_string_len(MP_DENOM_P(r), radix);
/* Though simplistic, this formula is correct. Space for the sign
flag is included in n_len, and the space for the NUL that is
@@ -770,9 +770,9 @@ mp_result mp_rat_decimal_len(mp_rat r, mp_size radix, mp_size prec)
z_len = mp_int_string_len(MP_NUMER_P(r), radix);
if(prec == 0)
- f_len = 1; /* terminator only */
+ f_len = 1; /* terminator only */
else
- f_len = 1 + prec + 1; /* decimal point, digits, terminator */
+ f_len = 1 + prec + 1; /* decimal point, digits, terminator */
return z_len + f_len;
}
@@ -782,7 +782,7 @@ mp_result mp_rat_decimal_len(mp_rat r, mp_size radix, mp_size prec)
/* {{{ mp_rat_read_string(r, radix, *str) */
mp_result mp_rat_read_string(klisp_State *K, mp_rat r, mp_size radix,
- const char *str)
+ const char *str)
{
return mp_rat_read_cstring(K, r, radix, str, NULL);
}
@@ -792,34 +792,34 @@ mp_result mp_rat_read_string(klisp_State *K, mp_rat r, mp_size radix,
/* {{{ mp_rat_read_cstring(r, radix, *str, **end) */
mp_result mp_rat_read_cstring(klisp_State *K, mp_rat r, mp_size radix,
- const char *str, char **end)
+ const char *str, char **end)
{
mp_result res;
char *endp;
if((res = mp_int_read_cstring(K, MP_NUMER_P(r), radix, str,
- &endp)) != MP_OK && (res != MP_TRUNC))
- return res;
+ &endp)) != MP_OK && (res != MP_TRUNC))
+ return res;
/* Skip whitespace between numerator and (possible) separator */
while(isspace((unsigned char) *endp))
- ++endp;
+ ++endp;
/* If there is no separator, we will stop reading at this point. */
if(*endp != '/') {
- mp_int_set_value(K, MP_DENOM_P(r), 1);
- if(end != NULL)
- *end = endp;
- return res;
+ mp_int_set_value(K, MP_DENOM_P(r), 1);
+ if(end != NULL)
+ *end = endp;
+ return res;
}
++endp; /* skip separator */
if((res = mp_int_read_cstring(K, MP_DENOM_P(r), radix, endp, end)) != MP_OK)
- return res;
+ return res;
/* Make sure the value is well-defined */
if(mp_int_compare_zero(MP_DENOM_P(r)) == 0)
- return MP_UNDEF;
+ return MP_UNDEF;
/* Reduce to lowest terms */
return s_rat_reduce(K, r);
@@ -835,25 +835,25 @@ mp_result mp_rat_read_cstring(klisp_State *K, mp_rat r, mp_size radix,
This function will accept either a/b notation or decimal notation.
*/
mp_result mp_rat_read_ustring(klisp_State *K, mp_rat r, mp_size radix,
- const char *str, char **end)
+ const char *str, char **end)
{
- char *endp;
+ char *endp;
mp_result res;
if(radix == 0)
- radix = 10; /* default to decimal input */
+ radix = 10; /* default to decimal input */
if((res = mp_rat_read_cstring(K, r, radix, str, &endp)) != MP_OK) {
- if(res == MP_TRUNC) {
- if(*endp == '.')
- res = mp_rat_read_cdecimal(K, r, radix, str, &endp);
- }
- else
- return res;
+ if(res == MP_TRUNC) {
+ if(*endp == '.')
+ res = mp_rat_read_cdecimal(K, r, radix, str, &endp);
+ }
+ else
+ return res;
}
if(end != NULL)
- *end = endp;
+ *end = endp;
return res;
}
@@ -863,7 +863,7 @@ mp_result mp_rat_read_ustring(klisp_State *K, mp_rat r, mp_size radix,
/* {{{ mp_rat_read_decimal(r, radix, *str) */
mp_result mp_rat_read_decimal(klisp_State *K, mp_rat r, mp_size radix,
- const char *str)
+ const char *str)
{
return mp_rat_read_cdecimal(K, r, radix, str, NULL);
}
@@ -873,34 +873,34 @@ mp_result mp_rat_read_decimal(klisp_State *K, mp_rat r, mp_size radix,
/* {{{ mp_rat_read_cdecimal(r, radix, *str, **end) */
mp_result mp_rat_read_cdecimal(klisp_State *K, mp_rat r, mp_size radix,
- const char *str, char **end)
+ const char *str, char **end)
{
mp_result res;
mp_sign osign;
char *endp;
while(isspace((unsigned char) *str))
- ++str;
+ ++str;
switch(*str) {
case '-':
- osign = MP_NEG;
- break;
+ osign = MP_NEG;
+ break;
default:
- osign = MP_ZPOS;
+ osign = MP_ZPOS;
}
if((res = mp_int_read_cstring(K, MP_NUMER_P(r), radix, str,
- &endp)) != MP_OK && (res != MP_TRUNC))
- return res;
+ &endp)) != MP_OK && (res != MP_TRUNC))
+ return res;
/* This needs to be here. */
(void) mp_int_set_value(K, MP_DENOM_P(r), 1);
if(*endp != '.') {
- if(end != NULL)
- *end = endp;
- return res;
+ if(end != NULL)
+ *end = endp;
+ return res;
}
/* If the character following the decimal point is whitespace or a
@@ -914,92 +914,92 @@ mp_result mp_rat_read_cdecimal(klisp_State *K, mp_rat r, mp_size radix,
*/
++endp;
if(*endp == '\0') {
- if(end != NULL)
- *end = endp;
- return MP_OK;
+ if(end != NULL)
+ *end = endp;
+ return MP_OK;
}
else if(isspace((unsigned char) *endp) || *endp == '-' || *endp == '+') {
- return MP_TRUNC;
+ return MP_TRUNC;
}
else {
- mpz_t frac;
- mp_result save_res;
- char *save = endp;
- int num_lz = 0;
-
- /* Make a temporary to hold the part after the decimal point. */
- if((res = mp_int_init(&frac)) != MP_OK)
- return res;
+ mpz_t frac;
+ mp_result save_res;
+ char *save = endp;
+ int num_lz = 0;
+
+ /* Make a temporary to hold the part after the decimal point. */
+ if((res = mp_int_init(&frac)) != MP_OK)
+ return res;
- if((res = mp_int_read_cstring(K, &frac, radix, endp, &endp)) != MP_OK &&
- (res != MP_TRUNC))
- goto CLEANUP;
+ if((res = mp_int_read_cstring(K, &frac, radix, endp, &endp)) != MP_OK &&
+ (res != MP_TRUNC))
+ goto CLEANUP;
- /* Save this response for later. */
- save_res = res;
+ /* Save this response for later. */
+ save_res = res;
- if(mp_int_compare_zero(&frac) == 0)
- goto FINISHED;
+ if(mp_int_compare_zero(&frac) == 0)
+ goto FINISHED;
- /* Discard trailing zeroes (somewhat inefficiently) */
- while(mp_int_divisible_value(K, &frac, radix))
- if((res = mp_int_div_value(K, &frac, radix, &frac, NULL)) != MP_OK)
- goto CLEANUP;
+ /* Discard trailing zeroes (somewhat inefficiently) */
+ while(mp_int_divisible_value(K, &frac, radix))
+ if((res = mp_int_div_value(K, &frac, radix, &frac, NULL)) != MP_OK)
+ goto CLEANUP;
- /* Count leading zeros after the decimal point */
- while(save[num_lz] == '0')
- ++num_lz;
-
- /* Find the least power of the radix that is at least as large as
- the significant value of the fractional part, ignoring leading
- zeroes. */
- (void) mp_int_set_value(K, MP_DENOM_P(r), radix);
+ /* Count leading zeros after the decimal point */
+ while(save[num_lz] == '0')
+ ++num_lz;
+
+ /* Find the least power of the radix that is at least as large as
+ the significant value of the fractional part, ignoring leading
+ zeroes. */
+ (void) mp_int_set_value(K, MP_DENOM_P(r), radix);
- while(mp_int_compare(MP_DENOM_P(r), &frac) < 0) {
- if((res = mp_int_mul_value(K, MP_DENOM_P(r), radix,
- MP_DENOM_P(r))) != MP_OK)
- goto CLEANUP;
- }
+ while(mp_int_compare(MP_DENOM_P(r), &frac) < 0) {
+ if((res = mp_int_mul_value(K, MP_DENOM_P(r), radix,
+ MP_DENOM_P(r))) != MP_OK)
+ goto CLEANUP;
+ }
- /* Also shift by enough to account for leading zeroes */
- while(num_lz > 0) {
- if((res = mp_int_mul_value(K, MP_DENOM_P(r), radix,
- MP_DENOM_P(r))) != MP_OK)
- goto CLEANUP;
-
- --num_lz;
- }
-
- /* Having found this power, shift the numerator leftward that
- many, digits, and add the nonzero significant digits of the
- fractional part to get the result. */
- if((res = mp_int_mul(K, MP_NUMER_P(r), MP_DENOM_P(r),
- MP_NUMER_P(r))) != MP_OK)
- goto CLEANUP;
+ /* Also shift by enough to account for leading zeroes */
+ while(num_lz > 0) {
+ if((res = mp_int_mul_value(K, MP_DENOM_P(r), radix,
+ MP_DENOM_P(r))) != MP_OK)
+ goto CLEANUP;
+
+ --num_lz;
+ }
+
+ /* Having found this power, shift the numerator leftward that
+ many, digits, and add the nonzero significant digits of the
+ fractional part to get the result. */
+ if((res = mp_int_mul(K, MP_NUMER_P(r), MP_DENOM_P(r),
+ MP_NUMER_P(r))) != MP_OK)
+ goto CLEANUP;
- { /* This addition needs to be unsigned. */
- MP_SIGN(MP_NUMER_P(r)) = MP_ZPOS;
- if((res = mp_int_add(K, MP_NUMER_P(r), &frac,
- MP_NUMER_P(r))) != MP_OK)
- goto CLEANUP;
-
- MP_SIGN(MP_NUMER_P(r)) = osign;
- }
- if((res = s_rat_reduce(K, r)) != MP_OK)
- goto CLEANUP;
-
- /* At this point, what we return depends on whether reading the
- fractional part was truncated or not. That information is
- saved from when we called mp_int_read_string() above. */
+ { /* This addition needs to be unsigned. */
+ MP_SIGN(MP_NUMER_P(r)) = MP_ZPOS;
+ if((res = mp_int_add(K, MP_NUMER_P(r), &frac,
+ MP_NUMER_P(r))) != MP_OK)
+ goto CLEANUP;
+
+ MP_SIGN(MP_NUMER_P(r)) = osign;
+ }
+ if((res = s_rat_reduce(K, r)) != MP_OK)
+ goto CLEANUP;
+
+ /* At this point, what we return depends on whether reading the
+ fractional part was truncated or not. That information is
+ saved from when we called mp_int_read_string() above. */
FINISHED:
- res = save_res;
- if(end != NULL)
- *end = endp;
+ res = save_res;
+ if(end != NULL)
+ *end = endp;
CLEANUP:
- mp_int_clear(K, &frac);
+ mp_int_clear(K, &frac);
- return res;
+ return res;
}
}
@@ -1016,33 +1016,33 @@ static mp_result s_rat_reduce(klisp_State *K, mp_rat r)
mp_result res = MP_OK;
if(mp_int_compare_zero(MP_NUMER_P(r)) == 0) {
- mp_int_set_value(K, MP_DENOM_P(r), 1);
- return MP_OK;
+ mp_int_set_value(K, MP_DENOM_P(r), 1);
+ return MP_OK;
}
/* If the greatest common divisor of the numerator and denominator
is greater than 1, divide it out. */
if((res = mp_int_init(&gcd)) != MP_OK)
- return res;
+ return res;
if((res = mp_int_gcd(K, MP_NUMER_P(r), MP_DENOM_P(r), &gcd)) != MP_OK)
- goto CLEANUP;
+ goto CLEANUP;
if(mp_int_compare_value(&gcd, 1) != 0) {
- if((res = mp_int_div(K, MP_NUMER_P(r), &gcd, MP_NUMER_P(r),
- NULL)) != MP_OK)
- goto CLEANUP;
- if((res = mp_int_div(K, MP_DENOM_P(r), &gcd, MP_DENOM_P(r),
- NULL)) != MP_OK)
- goto CLEANUP;
+ if((res = mp_int_div(K, MP_NUMER_P(r), &gcd, MP_NUMER_P(r),
+ NULL)) != MP_OK)
+ goto CLEANUP;
+ if((res = mp_int_div(K, MP_DENOM_P(r), &gcd, MP_DENOM_P(r),
+ NULL)) != MP_OK)
+ goto CLEANUP;
}
/* Fix up the signs of numerator and denominator */
if(MP_SIGN(MP_NUMER_P(r)) == MP_SIGN(MP_DENOM_P(r)))
- MP_SIGN(MP_NUMER_P(r)) = MP_SIGN(MP_DENOM_P(r)) = MP_ZPOS;
+ MP_SIGN(MP_NUMER_P(r)) = MP_SIGN(MP_DENOM_P(r)) = MP_ZPOS;
else {
- MP_SIGN(MP_NUMER_P(r)) = MP_NEG;
- MP_SIGN(MP_DENOM_P(r)) = MP_ZPOS;
+ MP_SIGN(MP_NUMER_P(r)) = MP_NEG;
+ MP_SIGN(MP_DENOM_P(r)) = MP_ZPOS;
}
CLEANUP:
@@ -1056,45 +1056,45 @@ CLEANUP:
/* {{{ s_rat_combine(a, b, c, comb_f) */
static mp_result s_rat_combine(klisp_State *K, mp_rat a, mp_rat b, mp_rat c,
- mp_result (*comb_f)(klisp_State *K, mp_int,
- mp_int, mp_int))
+ mp_result (*comb_f)(klisp_State *K, mp_int,
+ mp_int, mp_int))
{
mp_result res;
/* Shortcut when denominators are already common */
if(mp_int_compare(MP_DENOM_P(a), MP_DENOM_P(b)) == 0) {
- if((res = (comb_f)(K, MP_NUMER_P(a), MP_NUMER_P(b),
- MP_NUMER_P(c))) != MP_OK)
- return res;
- if((res = mp_int_copy(K, MP_DENOM_P(a), MP_DENOM_P(c))) != MP_OK)
- return res;
+ if((res = (comb_f)(K, MP_NUMER_P(a), MP_NUMER_P(b),
+ MP_NUMER_P(c))) != MP_OK)
+ return res;
+ if((res = mp_int_copy(K, MP_DENOM_P(a), MP_DENOM_P(c))) != MP_OK)
+ return res;
- return s_rat_reduce(K, c);
+ return s_rat_reduce(K, c);
}
else {
- mpz_t temp[2];
- int last = 0;
+ mpz_t temp[2];
+ int last = 0;
- SETUP(mp_int_init_copy(K, TEMP(last), MP_NUMER_P(a)), last);
- SETUP(mp_int_init_copy(K, TEMP(last), MP_NUMER_P(b)), last);
+ SETUP(mp_int_init_copy(K, TEMP(last), MP_NUMER_P(a)), last);
+ SETUP(mp_int_init_copy(K, TEMP(last), MP_NUMER_P(b)), last);
- if((res = mp_int_mul(K, TEMP(0), MP_DENOM_P(b), TEMP(0))) != MP_OK)
- goto CLEANUP;
- if((res = mp_int_mul(K, TEMP(1), MP_DENOM_P(a), TEMP(1))) != MP_OK)
- goto CLEANUP;
- if((res = (comb_f)(K, TEMP(0), TEMP(1), MP_NUMER_P(c))) != MP_OK)
- goto CLEANUP;
+ if((res = mp_int_mul(K, TEMP(0), MP_DENOM_P(b), TEMP(0))) != MP_OK)
+ goto CLEANUP;
+ if((res = mp_int_mul(K, TEMP(1), MP_DENOM_P(a), TEMP(1))) != MP_OK)
+ goto CLEANUP;
+ if((res = (comb_f)(K, TEMP(0), TEMP(1), MP_NUMER_P(c))) != MP_OK)
+ goto CLEANUP;
- res = mp_int_mul(K, MP_DENOM_P(a), MP_DENOM_P(b), MP_DENOM_P(c));
+ res = mp_int_mul(K, MP_DENOM_P(a), MP_DENOM_P(b), MP_DENOM_P(c));
CLEANUP:
- while(--last >= 0)
- mp_int_clear(K, TEMP(last));
+ while(--last >= 0)
+ mp_int_clear(K, TEMP(last));
- if(res == MP_OK)
- return s_rat_reduce(K, c);
- else
- return res;
+ if(res == MP_OK)
+ return s_rat_reduce(K, c);
+ else
+ return res;
}
}
diff --git a/src/imrat.h b/src/imrat.h
@@ -29,13 +29,13 @@ extern "C" {
#endif
/* Andres Navarro: Use kobject type instead */
-typedef Bigrat mpq_t, *mp_rat;
+ typedef Bigrat mpq_t, *mp_rat;
#if 0
-typedef struct mpq {
- mpz_t num; /* Numerator */
- mpz_t den; /* Denominator, <> 0 */
-} mpq_t, *mp_rat;
+ typedef struct mpq {
+ mpz_t num; /* Numerator */
+ mpz_t den; /* Denominator, <> 0 */
+ } mpq_t, *mp_rat;
#endif
#define MP_NUMER_P(Q) (&((Q)->num)) /* Pointer to numerator */
@@ -43,99 +43,99 @@ typedef struct mpq {
/* Rounding constants */
/* TODO: klisp add MP_ROUND_HALF_EVEN for compatibility with floating point */
-typedef enum {
- MP_ROUND_DOWN,
- MP_ROUND_HALF_UP,
- MP_ROUND_UP,
- MP_ROUND_HALF_DOWN
-} mp_round_mode;
-
-mp_result mp_rat_init(klisp_State *K, mp_rat r);
-mp_rat mp_rat_alloc(klisp_State *K);
-mp_result mp_rat_init_size(klisp_State *K, mp_rat r, mp_size n_prec,
- mp_size d_prec);
-mp_result mp_rat_init_copy(klisp_State *K, mp_rat r, mp_rat old);
-mp_result mp_rat_set_value(klisp_State *K, mp_rat r, int numer, int denom);
-void mp_rat_clear(klisp_State *K, mp_rat r);
-void mp_rat_free(klisp_State *K, mp_rat r);
-mp_result mp_rat_numer(klisp_State *K, mp_rat r, mp_int z); /* z = num(r) */
-mp_result mp_rat_denom(klisp_State *K, mp_rat r, mp_int z); /* z = den(r) */
+ typedef enum {
+ MP_ROUND_DOWN,
+ MP_ROUND_HALF_UP,
+ MP_ROUND_UP,
+ MP_ROUND_HALF_DOWN
+ } mp_round_mode;
+
+ mp_result mp_rat_init(klisp_State *K, mp_rat r);
+ mp_rat mp_rat_alloc(klisp_State *K);
+ mp_result mp_rat_init_size(klisp_State *K, mp_rat r, mp_size n_prec,
+ mp_size d_prec);
+ mp_result mp_rat_init_copy(klisp_State *K, mp_rat r, mp_rat old);
+ mp_result mp_rat_set_value(klisp_State *K, mp_rat r, int numer, int denom);
+ void mp_rat_clear(klisp_State *K, mp_rat r);
+ void mp_rat_free(klisp_State *K, mp_rat r);
+ mp_result mp_rat_numer(klisp_State *K, mp_rat r, mp_int z); /* z = num(r) */
+ mp_result mp_rat_denom(klisp_State *K, mp_rat r, mp_int z); /* z = den(r) */
/* NOTE: this doesn't use the allocator */
-mp_sign mp_rat_sign(mp_rat r);
+ mp_sign mp_rat_sign(mp_rat r);
-mp_result mp_rat_copy(klisp_State *K, mp_rat a, mp_rat c); /* c = a */
-void mp_rat_zero(klisp_State *K, mp_rat r); /* r = 0 */
-mp_result mp_rat_abs(klisp_State *K, mp_rat a, mp_rat c); /* c = |a| */
-mp_result mp_rat_neg(klisp_State *K, mp_rat a, mp_rat c); /* c = -a */
-mp_result mp_rat_recip(klisp_State *K, mp_rat a, mp_rat c); /* c = 1 / a */
+ mp_result mp_rat_copy(klisp_State *K, mp_rat a, mp_rat c); /* c = a */
+ void mp_rat_zero(klisp_State *K, mp_rat r); /* r = 0 */
+ mp_result mp_rat_abs(klisp_State *K, mp_rat a, mp_rat c); /* c = |a| */
+ mp_result mp_rat_neg(klisp_State *K, mp_rat a, mp_rat c); /* c = -a */
+ mp_result mp_rat_recip(klisp_State *K, mp_rat a, mp_rat c); /* c = 1 / a */
/* c = a + b */
-mp_result mp_rat_add(klisp_State *K, mp_rat a, mp_rat b, mp_rat c);
+ mp_result mp_rat_add(klisp_State *K, mp_rat a, mp_rat b, mp_rat c);
/* c = a - b */
-mp_result mp_rat_sub(klisp_State *K, mp_rat a, mp_rat b, mp_rat c);
+ mp_result mp_rat_sub(klisp_State *K, mp_rat a, mp_rat b, mp_rat c);
/* c = a * b */
-mp_result mp_rat_mul(klisp_State *K, mp_rat a, mp_rat b, mp_rat c);
+ mp_result mp_rat_mul(klisp_State *K, mp_rat a, mp_rat b, mp_rat c);
/* c = a / b */
-mp_result mp_rat_div(klisp_State *K, mp_rat a, mp_rat b, mp_rat c);
+ mp_result mp_rat_div(klisp_State *K, mp_rat a, mp_rat b, mp_rat c);
/* c = a + b */
-mp_result mp_rat_add_int(klisp_State *K, mp_rat a, mp_int b, mp_rat c);
+ mp_result mp_rat_add_int(klisp_State *K, mp_rat a, mp_int b, mp_rat c);
/* c = a - b */
-mp_result mp_rat_sub_int(klisp_State *K, mp_rat a, mp_int b, mp_rat c);
+ mp_result mp_rat_sub_int(klisp_State *K, mp_rat a, mp_int b, mp_rat c);
/* c = a * b */
-mp_result mp_rat_mul_int(klisp_State *K, mp_rat a, mp_int b, mp_rat c);
+ mp_result mp_rat_mul_int(klisp_State *K, mp_rat a, mp_int b, mp_rat c);
/* c = a / b */
-mp_result mp_rat_div_int(klisp_State *K, mp_rat a, mp_int b, mp_rat c);
+ mp_result mp_rat_div_int(klisp_State *K, mp_rat a, mp_int b, mp_rat c);
/* c = a ^ b */
-mp_result mp_rat_expt(klisp_State *K, mp_rat a, mp_small b, mp_rat c);
+ mp_result mp_rat_expt(klisp_State *K, mp_rat a, mp_small b, mp_rat c);
/* NOTE: because we may need to do multiplications, some of
these take a klisp_State */
-int mp_rat_compare(klisp_State *K, mp_rat a, mp_rat b); /* a <=> b */
+ int mp_rat_compare(klisp_State *K, mp_rat a, mp_rat b); /* a <=> b */
/* |a| <=> |b| */
-int mp_rat_compare_unsigned(klisp_State *K, mp_rat a, mp_rat b);
+ int mp_rat_compare_unsigned(klisp_State *K, mp_rat a, mp_rat b);
/* NOTE: this doesn't use the allocator */
-int mp_rat_compare_zero(mp_rat r); /* r <=> 0 */
-int mp_rat_compare_value(klisp_State *K, mp_rat r, mp_small n,
- mp_small d); /* r <=> n/d */
+ int mp_rat_compare_zero(mp_rat r); /* r <=> 0 */
+ int mp_rat_compare_value(klisp_State *K, mp_rat r, mp_small n,
+ mp_small d); /* r <=> n/d */
/* NOTE: this doesn't use the allocator */
-int mp_rat_is_integer(mp_rat r);
+ int mp_rat_is_integer(mp_rat r);
/* Convert to integers, if representable (returns MP_RANGE if not). */
/* NOTE: this doesn't use the allocator */
-mp_result mp_rat_to_ints(mp_rat r, mp_small *num, mp_small *den);
+ mp_result mp_rat_to_ints(mp_rat r, mp_small *num, mp_small *den);
/* Convert to nul-terminated string with the specified radix, writing
at most limit characters including the nul terminator. */
-mp_result mp_rat_to_string(klisp_State *K, mp_rat r, mp_size radix, char *str,
- int limit);
+ mp_result mp_rat_to_string(klisp_State *K, mp_rat r, mp_size radix, char *str,
+ int limit);
/* Convert to decimal format in the specified radix and precision,
writing at most limit characters including a nul terminator. */
-mp_result mp_rat_to_decimal(klisp_State *K, mp_rat r, mp_size radix,
- mp_size prec, mp_round_mode round,
- char *str, int limit);
+ mp_result mp_rat_to_decimal(klisp_State *K, mp_rat r, mp_size radix,
+ mp_size prec, mp_round_mode round,
+ char *str, int limit);
/* Return the number of characters required to represent r in the given
radix. May over-estimate. */
-mp_result mp_rat_string_len(mp_rat r, mp_size radix);
+ mp_result mp_rat_string_len(mp_rat r, mp_size radix);
/* Return the number of characters required to represent r in decimal
format with the given radix and precision. May over-estimate. */
-mp_result mp_rat_decimal_len(mp_rat r, mp_size radix, mp_size prec);
+ mp_result mp_rat_decimal_len(mp_rat r, mp_size radix, mp_size prec);
/* Read zero-terminated string into r */
-mp_result mp_rat_read_string(klisp_State *K, mp_rat r, mp_size radix,
- const char *str);
-mp_result mp_rat_read_cstring(klisp_State *K, mp_rat r, mp_size radix,
- const char *str, char **end);
-mp_result mp_rat_read_ustring(klisp_State *K, mp_rat r, mp_size radix,
- const char *str, char **end);
+ mp_result mp_rat_read_string(klisp_State *K, mp_rat r, mp_size radix,
+ const char *str);
+ mp_result mp_rat_read_cstring(klisp_State *K, mp_rat r, mp_size radix,
+ const char *str, char **end);
+ mp_result mp_rat_read_ustring(klisp_State *K, mp_rat r, mp_size radix,
+ const char *str, char **end);
/* Read zero-terminated string in decimal format into r */
-mp_result mp_rat_read_decimal(klisp_State *K, mp_rat r, mp_size radix,
- const char *str);
-mp_result mp_rat_read_cdecimal(klisp_State *K, mp_rat r, mp_size radix,
- const char *str, char **end);
+ mp_result mp_rat_read_decimal(klisp_State *K, mp_rat r, mp_size radix,
+ const char *str);
+ mp_result mp_rat_read_cdecimal(klisp_State *K, mp_rat r, mp_size radix,
+ const char *str, char **end);
#ifdef __cplusplus
}
diff --git a/src/kapplicative.c b/src/kapplicative.c
@@ -17,7 +17,7 @@ TValue kwrap(klisp_State *K, TValue underlying)
/* header + gc_fields */
klispC_link(K, (GCObject *) new_app, K_TAPPLICATIVE,
- K_FLAG_CAN_HAVE_NAME);
+ K_FLAG_CAN_HAVE_NAME);
/* applicative specific fields */
new_app->underlying = underlying;
diff --git a/src/kapplicative.h b/src/kapplicative.h
@@ -15,13 +15,13 @@
TValue kwrap(klisp_State *K, TValue underlying);
/* GC: Assumes all argps are rooted */
-#define kmake_applicative(K_, ...) \
- ({ klisp_State *K__ = (K_); \
- TValue op = kmake_operative(K__, __VA_ARGS__); \
- krooted_tvs_push(K__, op); \
- TValue app = kwrap(K__, op); \
- krooted_tvs_pop(K__); \
- (app); })
+#define kmake_applicative(K_, ...) \
+ ({ klisp_State *K__ = (K_); \
+ TValue op = kmake_operative(K__, __VA_ARGS__); \
+ krooted_tvs_push(K__, op); \
+ TValue app = kwrap(K__, op); \
+ krooted_tvs_pop(K__); \
+ (app); })
inline TValue kunwrap(TValue app) { return (tv2app(app)->underlying); }
diff --git a/src/kauxlib.c b/src/kauxlib.c
@@ -16,15 +16,15 @@
/* generic alloc function */
static void *k_alloc (void *ud, void *ptr, size_t osize, size_t nsize) {
- (void)ud;
- (void)osize;
+ (void)ud;
+ (void)osize;
- if (nsize == 0) {
- free(ptr);
- return NULL;
- } else {
- return realloc(ptr, nsize);
- }
+ if (nsize == 0) {
+ free(ptr);
+ return NULL;
+ } else {
+ return realloc(ptr, nsize);
+ }
}
/*
@@ -32,8 +32,8 @@ static void *k_alloc (void *ud, void *ptr, size_t osize, size_t nsize) {
*/
klisp_State *klispL_newstate (void)
{
- klisp_State *K = klisp_newstate(k_alloc, NULL);
- /* TODO: set any panic functions or something like that... */
- return K;
+ klisp_State *K = klisp_newstate(k_alloc, NULL);
+ /* TODO: set any panic functions or something like that... */
+ return K;
}
diff --git a/src/kbytevector.c b/src/kbytevector.c
@@ -18,10 +18,10 @@
/* General constructor for bytevectors */
TValue kbytevector_new_bs_g(klisp_State *K, bool m, const uint8_t *buf,
- uint32_t size)
+ uint32_t size)
{
return m? kbytevector_new_bs(K, buf, size) :
- kbytevector_new_bs_imm(K, buf, size);
+ kbytevector_new_bs_imm(K, buf, size);
}
/*
@@ -34,24 +34,24 @@ TValue kbytevector_new_bs_imm(klisp_State *K, const uint8_t *buf, uint32_t size)
/* first check to see if it's in the stringtable */
uint32_t h = size; /* seed */
size_t step = (size>>5)+1; /* if bytevector is too long, don't hash all
- its bytes */
+ its bytes */
size_t size1;
for (size1 = size; size1 >= step; size1 -= step) /* compute hash */
- h = h ^ ((h<<5)+(h>>2)+ buf[size1-1]);
+ h = h ^ ((h<<5)+(h>>2)+ buf[size1-1]);
for (GCObject *o = K->strt.hash[lmod(h, K->strt.size)];
- o != NULL; o = o->gch.next) {
- klisp_assert(o->gch.tt == K_TKEYWORD || o->gch.tt == K_TSYMBOL ||
- o->gch.tt == K_TSTRING || o->gch.tt == K_TBYTEVECTOR);
-
- if (o->gch.tt != K_TBYTEVECTOR) continue;
-
- Bytevector *tb = (Bytevector *) o;
- if (tb->size == size && (memcmp(buf, tb->b, size) == 0)) {
- /* bytevector may be dead */
- if (isdead(K, o)) changewhite(o);
- return gc2bytevector(o);
- }
+ o != NULL; o = o->gch.next) {
+ klisp_assert(o->gch.tt == K_TKEYWORD || o->gch.tt == K_TSYMBOL ||
+ o->gch.tt == K_TSTRING || o->gch.tt == K_TBYTEVECTOR);
+
+ if (o->gch.tt != K_TBYTEVECTOR) continue;
+
+ Bytevector *tb = (Bytevector *) o;
+ if (tb->size == size && (memcmp(buf, tb->b, size) == 0)) {
+ /* bytevector may be dead */
+ if (isdead(K, o)) changewhite(o);
+ return gc2bytevector(o);
+ }
}
/* If it exits the loop, it means it wasn't found, hash is still in h */
@@ -59,7 +59,7 @@ TValue kbytevector_new_bs_imm(klisp_State *K, const uint8_t *buf, uint32_t size)
Bytevector *new_bb;
if (size > (SIZE_MAX - sizeof(Bytevector)))
- klispM_toobig(K);
+ klispM_toobig(K);
new_bb = (Bytevector *) klispM_malloc(K, sizeof(Bytevector) + size);
@@ -77,7 +77,7 @@ TValue kbytevector_new_bs_imm(klisp_State *K, const uint8_t *buf, uint32_t size)
new_bb->size = size;
if (size != 0) {
- memcpy(new_bb->b, buf, size);
+ memcpy(new_bb->b, buf, size);
}
/* add to the string/symbol table (and link it) */
@@ -89,9 +89,9 @@ TValue kbytevector_new_bs_imm(klisp_State *K, const uint8_t *buf, uint32_t size)
tb->nuse++;
TValue ret_tv = gc2bytevector(new_bb);
if (tb->nuse > ((uint32_t) tb->size) && tb->size <= INT32_MAX / 2) {
- krooted_tvs_push(K, ret_tv); /* save in case of gc */
- klispS_resize(K, tb->size*2); /* too crowded */
- krooted_tvs_pop(K);
+ krooted_tvs_push(K, ret_tv); /* save in case of gc */
+ klispS_resize(K, tb->size*2); /* too crowded */
+ krooted_tvs_pop(K);
}
return ret_tv;
@@ -108,8 +108,8 @@ TValue kbytevector_new_s(klisp_State *K, uint32_t size)
Bytevector *new_bb;
if (size == 0) {
- klisp_assert(ttisbytevector(K->empty_bytevector));
- return K->empty_bytevector;
+ klisp_assert(ttisbytevector(K->empty_bytevector));
+ return K->empty_bytevector;
}
new_bb = klispM_malloc(K, sizeof(Bytevector) + size);
@@ -130,8 +130,8 @@ TValue kbytevector_new_s(klisp_State *K, uint32_t size)
TValue kbytevector_new_bs(klisp_State *K, const uint8_t *buf, uint32_t size)
{
if (size == 0) {
- klisp_assert(ttisbytevector(K->empty_bytevector));
- return K->empty_bytevector;
+ klisp_assert(ttisbytevector(K->empty_bytevector));
+ return K->empty_bytevector;
}
TValue new_bb = kbytevector_new_s(K, size);
@@ -143,8 +143,8 @@ TValue kbytevector_new_bs(klisp_State *K, const uint8_t *buf, uint32_t size)
TValue kbytevector_new_sf(klisp_State *K, uint32_t size, uint8_t fill)
{
if (size == 0) {
- klisp_assert(ttisbytevector(K->empty_bytevector));
- return K->empty_bytevector;
+ klisp_assert(ttisbytevector(K->empty_bytevector));
+ return K->empty_bytevector;
}
TValue new_bb = kbytevector_new_s(K, size);
@@ -161,10 +161,10 @@ bool kbytevector_equalp(TValue obj1, TValue obj2)
Bytevector *bytevector2 = tv2bytevector(obj2);
if (bytevector1->size == bytevector2->size) {
- return (bytevector1->size == 0) ||
- (memcmp(bytevector1->b, bytevector2->b, bytevector1->size) == 0);
+ return (bytevector1->size == 0) ||
+ (memcmp(bytevector1->b, bytevector2->b, bytevector1->size) == 0);
} else {
- return false;
+ return false;
}
}
diff --git a/src/kbytevector.h b/src/kbytevector.h
@@ -14,7 +14,7 @@
/* General constructor for bytevectors */
TValue kbytevector_new_bs_g(klisp_State *K, bool m, const uint8_t *buf,
- uint32_t size);
+ uint32_t size);
/*
** Constructors for immutable bytevectors
@@ -37,7 +37,7 @@ TValue kbytevector_new_bs(klisp_State *K, const uint8_t *buf, uint32_t size);
TValue kbytevector_new_sf(klisp_State *K, uint32_t size, uint8_t fill);
/* both obj1 and obj2 should be bytevectors, this compares byte by byte
- and doesn't differentiate immutable from mutable bytevectors */
+ and doesn't differentiate immutable from mutable bytevectors */
bool kbytevector_equalp(TValue obj1, TValue obj2);
bool kbytevectorp(TValue obj);
bool kimmutable_bytevectorp(TValue obj);
diff --git a/src/kcontinuation.c b/src/kcontinuation.c
@@ -13,16 +13,16 @@
#include "kgc.h"
TValue kmake_continuation(klisp_State *K, TValue parent, klisp_CFunction fn,
- int32_t xcount, ...)
+ int32_t xcount, ...)
{
va_list argp;
Continuation *new_cont = (Continuation *)
- klispM_malloc(K, sizeof(Continuation) + sizeof(TValue) * xcount);
+ klispM_malloc(K, sizeof(Continuation) + sizeof(TValue) * xcount);
/* header + gc_fields */
klispC_link(K, (GCObject *) new_cont, K_TCONTINUATION,
- K_FLAG_CAN_HAVE_NAME);
+ K_FLAG_CAN_HAVE_NAME);
/* continuation specific fields */
@@ -31,7 +31,7 @@ TValue kmake_continuation(klisp_State *K, TValue parent, klisp_CFunction fn,
TValue comb = K->next_obj;
if (ttiscontinuation(comb))
- comb = tv2cont(comb)->comb;
+ comb = tv2cont(comb)->comb;
new_cont->comb = comb;
new_cont->fn = fn;
@@ -39,7 +39,7 @@ TValue kmake_continuation(klisp_State *K, TValue parent, klisp_CFunction fn,
va_start(argp, xcount);
for (int i = 0; i < xcount; i++) {
- new_cont->extra[i] = va_arg(argp, TValue);
+ new_cont->extra[i] = va_arg(argp, TValue);
}
va_end(argp);
diff --git a/src/kcontinuation.h b/src/kcontinuation.h
@@ -12,6 +12,6 @@
/* TODO: make some specialized constructors for 0, 1 and 2 parameters */
TValue kmake_continuation(klisp_State *K, TValue parent, klisp_CFunction fn,
- int xcount, ...);
+ int xcount, ...);
#endif
diff --git a/src/kenvironment.c b/src/kenvironment.c
@@ -33,7 +33,7 @@ TValue kmake_environment(klisp_State *K, TValue parents)
/* header + gc_fields */
klispC_link(K, (GCObject *) new_env, K_TENVIRONMENT,
- K_FLAG_CAN_HAVE_NAME);
+ K_FLAG_CAN_HAVE_NAME);
/* environment specific fields */
new_env->mark = KFALSE;
@@ -49,40 +49,40 @@ TValue kmake_environment(klisp_State *K, TValue parents)
/* MAYBE: this could be optimized to avoid repetition of parents */
TValue kparents;
if (ttisnil(parents)) {
- kparents = KNIL;
+ kparents = KNIL;
} else if (ttisenvironment(parents)) {
- kparents = env_is_keyed(parents)? parents : env_keyed_parents(parents);
+ kparents = env_is_keyed(parents)? parents : env_keyed_parents(parents);
} else {
- /* list of parents, for now, just append them */
- krooted_tvs_push(K, gc2env(new_env)); /* keep the new env rooted */
- TValue plist = kcons(K, KNIL, KNIL); /* keep the list rooted */
- krooted_vars_push(K, &plist);
- TValue tail = plist;
- while(!ttisnil(parents)) {
- TValue parent = kcar(parents);
- TValue pkparents = env_keyed_parents(parent);
- while(!ttisnil(pkparents)) {
- TValue next;
- if (ttisenvironment(pkparents)) {
- next = pkparents;
- pkparents = KNIL;
- } else {
- next = kcar(pkparents);
- pkparents = kcdr(pkparents);
- }
- TValue new_pair = kcons(K, next, KNIL);
- kset_cdr(tail, new_pair);
- tail = new_pair;
- }
- parents = kcdr(parents);
- }
- /* all alocation done */
- kparents = kcdr(plist);
- krooted_vars_pop(K);
- krooted_tvs_pop(K);
- /* if it's just one env switch from (env) to env. */
- if (ttispair(kparents) && ttisnil(kcdr(kparents)))
- kparents = kcar(kparents);
+ /* list of parents, for now, just append them */
+ krooted_tvs_push(K, gc2env(new_env)); /* keep the new env rooted */
+ TValue plist = kcons(K, KNIL, KNIL); /* keep the list rooted */
+ krooted_vars_push(K, &plist);
+ TValue tail = plist;
+ while(!ttisnil(parents)) {
+ TValue parent = kcar(parents);
+ TValue pkparents = env_keyed_parents(parent);
+ while(!ttisnil(pkparents)) {
+ TValue next;
+ if (ttisenvironment(pkparents)) {
+ next = pkparents;
+ pkparents = KNIL;
+ } else {
+ next = kcar(pkparents);
+ pkparents = kcdr(pkparents);
+ }
+ TValue new_pair = kcons(K, next, KNIL);
+ kset_cdr(tail, new_pair);
+ tail = new_pair;
+ }
+ parents = kcdr(parents);
+ }
+ /* all alocation done */
+ kparents = kcdr(plist);
+ krooted_vars_pop(K);
+ krooted_tvs_pop(K);
+ /* if it's just one env switch from (env) to env. */
+ if (ttispair(kparents) && ttisnil(kcdr(kparents)))
+ kparents = kcar(kparents);
}
new_env->keyed_parents = kparents; /* overwrite with the proper value */
return gc2env(new_env);
@@ -98,12 +98,12 @@ TValue kfind_local_binding(klisp_State *K, TValue bindings, TValue sym)
UNUSED(K);
while(!ttisnil(bindings)) {
- TValue first = kcar(bindings);
- TValue first_sym = kcar(first);
- /* symbols can't be compared with tv_equal! */
- if (tv_sym_equal(sym, first_sym))
- return first;
- bindings = kcdr(bindings);
+ TValue first = kcar(bindings);
+ TValue first_sym = kcar(first);
+ /* symbols can't be compared with tv_equal! */
+ if (tv_sym_equal(sym, first_sym))
+ return first;
+ bindings = kcdr(bindings);
}
return KNIL;
}
@@ -119,29 +119,29 @@ TValue kfind_local_binding(klisp_State *K, TValue bindings, TValue sym)
void ktry_set_name(klisp_State *K, TValue obj, TValue sym)
{
if (kcan_have_name(obj) && !khas_name(obj)) {
- /* TODO: maybe we could have some kind of inheritance so
- that if this object receives a name it can pass on that
- name to other objs, like applicatives to operatives &
- some applicatives to objects */
- gcvalue(obj)->gch.kflags |= K_FLAG_HAS_NAME;
- TValue *node = klispH_set(K, tv2table(K->name_table), obj);
- *node = sym;
+ /* TODO: maybe we could have some kind of inheritance so
+ that if this object receives a name it can pass on that
+ name to other objs, like applicatives to operatives &
+ some applicatives to objects */
+ gcvalue(obj)->gch.kflags |= K_FLAG_HAS_NAME;
+ TValue *node = klispH_set(K, tv2table(K->name_table), obj);
+ *node = sym;
- /* TEMP: use this until we have a general mechanism to add
- objects to be named after some other obj */
- if (ttisapplicative(obj)) {
- /* underlying is rooted by means of obj */
- TValue underlying = kunwrap(obj);
- while (kcan_have_name(underlying) && !khas_name(underlying)) {
- gcvalue(underlying)->gch.kflags |= K_FLAG_HAS_NAME;
- node = klispH_set(K, tv2table(K->name_table), underlying);
- *node = sym;
- if (ttisapplicative(underlying))
- underlying = kunwrap(underlying);
- else
- break;
- }
- }
+ /* TEMP: use this until we have a general mechanism to add
+ objects to be named after some other obj */
+ if (ttisapplicative(obj)) {
+ /* underlying is rooted by means of obj */
+ TValue underlying = kunwrap(obj);
+ while (kcan_have_name(underlying) && !khas_name(underlying)) {
+ gcvalue(underlying)->gch.kflags |= K_FLAG_HAS_NAME;
+ node = klispH_set(K, tv2table(K->name_table), underlying);
+ *node = sym;
+ if (ttisapplicative(underlying))
+ underlying = kunwrap(underlying);
+ else
+ break;
+ }
+ }
}
}
@@ -149,7 +149,7 @@ void ktry_set_name(klisp_State *K, TValue obj, TValue sym)
TValue kget_name(klisp_State *K, TValue obj)
{
const TValue *node = klispH_get(tv2table(K->name_table),
- obj);
+ obj);
klisp_assert(node != &kfree);
return *node;
}
@@ -167,64 +167,64 @@ void kadd_binding(klisp_State *K, TValue env, TValue sym, TValue val)
TValue bindings = kenv_bindings(K, env);
if (ttistable(bindings)) {
- TValue *cell = klispH_setsym(K, tv2table(bindings), tv2sym(sym));
- *cell = val;
+ TValue *cell = klispH_setsym(K, tv2table(bindings), tv2sym(sym));
+ *cell = val;
} else {
- TValue oldb = kfind_local_binding(K, bindings, sym);
+ TValue oldb = kfind_local_binding(K, bindings, sym);
- if (ttisnil(oldb)) {
- TValue new_pair = kcons(K, sym, val);
- krooted_tvs_push(K, new_pair);
- kenv_bindings(K, env) = kcons(K, new_pair, bindings);
- krooted_tvs_pop(K);
- } else {
- kset_cdr(oldb, val);
- }
+ if (ttisnil(oldb)) {
+ TValue new_pair = kcons(K, sym, val);
+ krooted_tvs_push(K, new_pair);
+ kenv_bindings(K, env) = kcons(K, new_pair, bindings);
+ krooted_tvs_pop(K);
+ } else {
+ kset_cdr(oldb, val);
+ }
}
}
/* This works no matter if parents is a list or a single environment */
/* GC: assumes env & sym are rooted */
inline bool try_get_binding(klisp_State *K, TValue env, TValue sym,
- TValue *value)
+ TValue *value)
{
/* assume the stack may be in use, keep track of pushed objs */
int pushed = 1;
ks_spush(K, env);
while(pushed) {
- TValue obj = ks_spop(K);
- --pushed;
- if (ttisnil(obj)) {
- continue;
- } else if (ttisenvironment(obj)) {
- TValue bindings = kenv_bindings(K, obj);
- if (ttistable(bindings)) {
- const TValue *cell = klispH_getsym(tv2table(bindings),
- tv2sym(sym));
- if (cell != &kfree) {
- /* remember to leave the stack as it was */
- ks_sdiscardn(K, pushed);
- *value = *cell;
- return true;
- }
- } else {
- TValue oldb = kfind_local_binding(K, bindings, sym);
- if (!ttisnil(oldb)) {
- /* remember to leave the stack as it was */
- ks_sdiscardn(K, pushed);
- *value = kcdr(oldb);
- return true;
- }
- }
- TValue parents = kenv_parents(K, obj);
- ks_spush(K, parents);
- ++pushed;
- } else { /* parent list */
- ks_spush(K, kcdr(obj));
- ks_spush(K, kcar(obj));
- pushed += 2;
- }
+ TValue obj = ks_spop(K);
+ --pushed;
+ if (ttisnil(obj)) {
+ continue;
+ } else if (ttisenvironment(obj)) {
+ TValue bindings = kenv_bindings(K, obj);
+ if (ttistable(bindings)) {
+ const TValue *cell = klispH_getsym(tv2table(bindings),
+ tv2sym(sym));
+ if (cell != &kfree) {
+ /* remember to leave the stack as it was */
+ ks_sdiscardn(K, pushed);
+ *value = *cell;
+ return true;
+ }
+ } else {
+ TValue oldb = kfind_local_binding(K, bindings, sym);
+ if (!ttisnil(oldb)) {
+ /* remember to leave the stack as it was */
+ ks_sdiscardn(K, pushed);
+ *value = kcdr(oldb);
+ return true;
+ }
+ }
+ TValue parents = kenv_parents(K, obj);
+ ks_spush(K, parents);
+ ++pushed;
+ } else { /* parent list */
+ ks_spush(K, kcdr(obj));
+ ks_spush(K, kcar(obj));
+ pushed += 2;
+ }
}
*value = KINERT;
@@ -237,11 +237,11 @@ TValue kget_binding(klisp_State *K, TValue env, TValue sym)
klisp_assert(ttissymbol(sym));
TValue value;
if (try_get_binding(K, env, sym, &value)) {
- return value;
+ return value;
} else {
- klispE_throw_simple_with_irritants(K, "Unbound symbol", 1, sym);
- /* avoid warning */
- return KINERT;
+ klispE_throw_simple_with_irritants(K, "Unbound symbol", 1, sym);
+ /* avoid warning */
+ return KINERT;
}
}
@@ -256,7 +256,7 @@ bool kbinds(klisp_State *K, TValue env, TValue sym)
/* MAYBE: This could be combined with the default constructor */
/* GC: assumes parent, key & val are rooted */
TValue kmake_keyed_static_env(klisp_State *K, TValue parent, TValue key,
- TValue val)
+ TValue val)
{
TValue new_env = kmake_environment(K, parent);
krooted_tvs_push(K, new_env); /* keep the env rooted */
@@ -267,38 +267,38 @@ TValue kmake_keyed_static_env(klisp_State *K, TValue parent, TValue key,
/* GC: assumes parent, key & env are rooted */
inline bool try_get_keyed(klisp_State *K, TValue env, TValue key,
- TValue *value)
+ TValue *value)
{
/* MAYBE: this could be optimized to mark environments to avoid
- repetition */
+ repetition */
/* assume the stack may be in use, keep track of pushed objs */
int pushed = 1;
if (!env_is_keyed(env))
- env = env_keyed_parents(env);
+ env = env_keyed_parents(env);
ks_spush(K, env);
while(pushed) {
- TValue obj = ks_spop(K);
- --pushed;
- if (ttisnil(obj)) {
- continue;
- } else if (ttisenvironment(obj)) {
- /* obj is guaranteed to be a keyed env */
- if (env_has_key(obj, key)) {
- /* remember to leave the stack as it was */
- ks_sdiscardn(K, pushed);
- *value = env_keyed_val(obj);
- return true;
- } else {
- TValue parents = env_keyed_parents(obj);
- ks_spush(K, parents);
- ++pushed;
- }
- } else { /* parent list */
- ks_spush(K, kcdr(obj));
- ks_spush(K, kcar(obj));
- pushed += 2;
- }
+ TValue obj = ks_spop(K);
+ --pushed;
+ if (ttisnil(obj)) {
+ continue;
+ } else if (ttisenvironment(obj)) {
+ /* obj is guaranteed to be a keyed env */
+ if (env_has_key(obj, key)) {
+ /* remember to leave the stack as it was */
+ ks_sdiscardn(K, pushed);
+ *value = env_keyed_val(obj);
+ return true;
+ } else {
+ TValue parents = env_keyed_parents(obj);
+ ks_spush(K, parents);
+ ++pushed;
+ }
+ } else { /* parent list */
+ ks_spush(K, kcdr(obj));
+ ks_spush(K, kcar(obj));
+ pushed += 2;
+ }
}
*value = KINERT;
return false;
@@ -308,11 +308,11 @@ TValue kget_keyed_static_var(klisp_State *K, TValue env, TValue key)
{
TValue value;
if (try_get_keyed(K, env, key, &value)) {
- return value;
+ return value;
} else {
- klispE_throw_simple(K, "Unbound keyed static variable");
- /* avoid warning */
- return KINERT;
+ klispE_throw_simple(K, "Unbound keyed static variable");
+ /* avoid warning */
+ return KINERT;
}
}
diff --git a/src/klisp.c b/src/klisp.c
@@ -457,9 +457,10 @@ static int dorfile(klisp_State *K, const char *name)
and return #inert instead, it will also signal via rootp = false
that the evaluation didn't explicitly invoke the root continuation
*/
+ /* XXX for now, GC protect the environment in this discard continuation */
+ /* TODO use a more elegant way! */
TValue discard_cont = kmake_continuation(K, inner_cont, do_int_mark_root,
- 1, p2tv(&rootp));
-
+ 2, p2tv(&rootp), K->next_env);
krooted_tvs_pop(K); /* pop inner cont */
/* set the cont & call require */
