diff options
| -rw-r--r-- | ChangeLog | 32 | ||||
| -rw-r--r-- | arith.c | 120 | ||||
| -rw-r--r-- | eval.c | 2 | ||||
| -rw-r--r-- | lib.h | 2 | ||||
| -rw-r--r-- | mpi-patches/add-bitops | 117 |
5 files changed, 262 insertions, 11 deletions
@@ -1,3 +1,35 @@ +2012-09-17 Kaz Kylheku <kaz@kylheku.com> + + * arith.c (highest_significant_bit): New static function. + (comp_clamp): Bugfix: avoid shifting left into sign bit. Function + renamed to comp_trunc. + (logtrunc, ash): New functions. + + * eval.c (eval_init): Registered logtrunc and ash intrinsics. + + * lib.h (logtrunc, ash): Declared. + + * mpi-patches/add-bitops (s_highest_bit_mp): Forward declaration for + added. + (mp_clamp_comp): Bugfix in handling remainder bits. Function + renamed to mp_trunc_comp. + (mp_trunc, mp_shift): New functions. + +2012-09-17 Kaz Kylheku <kaz@kylheku.com> + + * arith.c (highest_significant_bit): New static function. + (comp_clamp): Bugfix: avoid shifting left into sign bit. + (logclamp, ash): New functions. + + * eval.c (eval_init): Registered logclamp and ash intrinsics. + + * lib.h (logclamp, ash): Declared. + + * mpi-patches/add-bitops (s_highest_bit_mp): Forward declaration for + added. + (mp_comp_clamp): Bugfix in handling remainder bits. + (mp_clamp, mp_shift): New functions. + 2012-09-16 Kaz Kylheku <kaz@kylheku.com> * mpi-patches/add-bitops: Bugfixes: mp_2comp is extended to properly @@ -268,6 +268,13 @@ int highest_bit(int_ptr_t n) abort(); } +static int highest_significant_bit(int_ptr_t n) +{ + if (n >= 0) + return highest_bit(n); + return highest_bit(n ^ INT_PTR_MAX); +} + val plus(val anum, val bnum) { tail: @@ -1611,7 +1618,7 @@ bad: uw_throwf(error_s, lit("logxor: operation failed on ~s ~s"), a, b, nao); } -static val comp_clamp(val a, val bits) +static val comp_trunc(val a, val bits) { cnum an, bn; val b; @@ -1626,7 +1633,7 @@ static val comp_clamp(val a, val bits) switch (type(a)) { case NUM: an = c_num(a); - if (bn <= num_bits) { + if (bn < num_bits) { cnum mask = num_mask >> (num_bits - bn); return num_fast((an & mask) ^ mask); } @@ -1634,7 +1641,7 @@ static val comp_clamp(val a, val bits) /* fallthrough */ case BGNUM: b = make_bignum(); - if (mp_clamp_comp(mp(a), mp(b), bn) != MP_OKAY) + if (mp_trunc_comp(mp(a), mp(b), bn) != MP_OKAY) goto bad; return normalize(b); default: @@ -1656,7 +1663,7 @@ val logcomp(val a, val bits) val b; if (bits) - return comp_clamp(a, bits); + return comp_trunc(a, bits); switch (type(a)) { case NUM: @@ -1674,6 +1681,111 @@ bad: uw_throwf(error_s, lit("logcomp: operation failed on ~s"), a, nao); } +val logtrunc(val a, val bits) +{ + cnum an, bn; + val b; + const cnum num_mask = (NUM_MAX << 1) | 1; + const int num_bits = CHAR_BIT * sizeof (cnum) - 2; + + if (!fixnump(bits)) + goto bad2; + + bn = c_num(bits); + + switch (type(a)) { + case NUM: + an = c_num(a); + if (bn <= num_bits) { + cnum mask = num_mask >> (num_bits - bn); + return num_fast(an & mask); + } + a = bignum(an); + /* fallthrough */ + case BGNUM: + b = make_bignum(); + if (mp_trunc(mp(a), mp(b), bn) != MP_OKAY) + goto bad; + return normalize(b); + default: + goto bad3; + } + +bad: + uw_throwf(error_s, lit("logtrunc: operation failed on ~s"), a, nao); + +bad2: + uw_throwf(error_s, lit("logtrunc: bits value ~s is not a fixnum"), bits, nao); + +bad3: + uw_throwf(error_s, lit("logtrunc: non-integral operand ~s"), a, nao); +} + +val ash(val a, val bits) +{ + cnum an, bn; + val b; + int hb; + const int num_bits = CHAR_BIT * sizeof (cnum) - 2; + + if (!fixnump(bits)) + goto bad2; + + bn = c_num(bits); + + if (bn == 0) { + switch (type(a)) { + case NUM: + case BGNUM: + return a; + default: + goto bad3; + } + } else if (bn > 0) { + switch (type(a)) { + case NUM: + an = c_num(a); + hb = highest_significant_bit(an); + if (bn + hb < num_bits) + return num_fast(an << bn); + a = bignum(an); + /* fallthrough */ + case BGNUM: + b = make_bignum(); + if (mp_shift(mp(a), mp(b), bn) != MP_OKAY) + goto bad; + return normalize(b); + default: + goto bad3; + } + } else { + switch (type(a)) { + case NUM: + an = c_num(a); + if (bn <= num_bits) + return num_fast(an >> -bn); + return num_fast(an >> num_bits); + case BGNUM: + b = make_bignum(); + if (mp_shift(mp(a), mp(b), bn) != MP_OKAY) + goto bad; + return normalize(b); + default: + goto bad3; + } + + } + +bad: + uw_throwf(error_s, lit("ashift: operation failed on ~s"), a, nao); + +bad2: + uw_throwf(error_s, lit("ashift: bits value ~s is not a fixnum"), bits, nao); + +bad3: + uw_throwf(error_s, lit("ashift: non-integral operand ~s"), a, nao); +} + void arith_init(void) { mp_init(&NUM_MAX_MP); @@ -2235,6 +2235,8 @@ void eval_init(void) reg_fun(intern(lit("logior"), user_package), func_n2(logior)); reg_fun(intern(lit("logxor"), user_package), func_n2(logxor)); reg_fun(intern(lit("logcomp"), user_package), func_n2o(logcomp, 1)); + reg_fun(intern(lit("logtrunc"), user_package), func_n2(logtrunc)); + reg_fun(intern(lit("ash"), user_package), func_n2(ash)); reg_fun(intern(lit("regex-compile"), user_package), func_n1(regex_compile)); reg_fun(intern(lit("regexp"), user_package), func_n1(regexp)); @@ -475,6 +475,8 @@ val logand(val, val); val logior(val, val); val logxor(val, val); val logcomp(val, val); +val logtrunc(val a, val bits); +val ash(val a, val bits); val string_own(wchar_t *str); val string(const wchar_t *str); val string_utf8(const char *str); diff --git a/mpi-patches/add-bitops b/mpi-patches/add-bitops index 7e8dc696..7eae01cb 100644 --- a/mpi-patches/add-bitops +++ b/mpi-patches/add-bitops @@ -1,7 +1,7 @@ Index: mpi-1.8.6/mpi.c =================================================================== --- mpi-1.8.6.orig/mpi.c 2012-09-16 10:50:08.270639006 -0700 -+++ mpi-1.8.6/mpi.c 2012-09-16 23:09:57.601600506 -0700 ++++ mpi-1.8.6/mpi.c 2012-09-17 07:33:38.563334756 -0700 @@ -16,6 +16,9 @@ #include <ctype.h> #include <math.h> @@ -12,7 +12,15 @@ Index: mpi-1.8.6/mpi.c typedef unsigned char mem_t; extern mem_t *chk_malloc(size_t size); extern mem_t *chk_calloc(size_t n, size_t size); -@@ -2330,6 +2333,321 @@ +@@ -159,6 +162,7 @@ + mp_err s_mp_grow(mp_int *mp, mp_size min); /* increase allocated size */ + mp_err s_mp_pad(mp_int *mp, mp_size min); /* left pad with zeroes */ + ++static int s_highest_bit(mp_digit n); + int s_highest_bit_mp(mp_int *a); + mp_err s_mp_set_bit(mp_int *a, int bit); + +@@ -2330,6 +2334,414 @@ /* }}} */ @@ -287,7 +295,7 @@ Index: mpi-1.8.6/mpi.c + return MP_OKAY; +} + -+mp_err mp_clamp_comp(mp_int *a, mp_int *b, mp_digit bits) ++mp_err mp_trunc_comp(mp_int *a, mp_int *b, mp_digit bits) +{ + mp_err res; + mp_size ix, dig = bits / DIGIT_BIT, rembits = bits % DIGIT_BIT; @@ -319,7 +327,51 @@ Index: mpi-1.8.6/mpi.c + + if (rembits) { + mp_digit mask = (MP_DIGIT_MAX >> (DIGIT_BIT - rembits)); -+ pb[ix] = (pa[ix] & mask) ^ mask; ++ pb[ix] = (((ix < adig) ? pa[ix] : padding) & mask) ^ mask; ++ } ++ ++ USED(b) = dig + extra; ++ ++ if (ISNEG(a)) ++ mp_clear(&tmp); ++ ++ s_mp_clamp(b); ++ return MP_OKAY; ++} ++ ++mp_err mp_trunc(mp_int *a, mp_int *b, mp_digit bits) ++{ ++ mp_err res; ++ mp_size ix, dig = bits / DIGIT_BIT, rembits = bits % DIGIT_BIT; ++ mp_size adig = USED(a); ++ mp_digit padding = ISNEG(a) ? MP_DIGIT_MAX : 0; ++ int extra = (rembits != 0); ++ mp_digit *pa, *pb; ++ mp_int tmp; ++ ++ ARGCHK(a != NULL && b != NULL, MP_BADARG); ++ ++ if (a != b) ++ res = mp_init_size(b, dig + extra); ++ else ++ res = s_mp_pad(b, dig + extra); ++ ++ if (res != MP_OKAY) ++ return res; ++ ++ if (ISNEG(a)) { ++ mp_init_size(&tmp, dig + extra); ++ if ((res = mp_2comp(a, &tmp, dig + extra)) != MP_OKAY) ++ return res; ++ a = &tmp; ++ } ++ ++ for (pa = DIGITS(a), pb = DIGITS(b), ix = 0; ix < dig; ix++) ++ pb[ix] = (ix < adig) ? pa[ix] : padding; ++ ++ if (rembits) { ++ mp_digit mask = (MP_DIGIT_MAX >> (DIGIT_BIT - rembits)); ++ pb[ix] = ((ix < adig) ? pa[ix] : padding) & mask; + } + + USED(b) = dig + extra; @@ -331,13 +383,62 @@ Index: mpi-1.8.6/mpi.c + return MP_OKAY; +} + ++mp_err mp_shift(mp_int *a, mp_int *b, int bits) ++{ ++ mp_int tmp; ++ mp_err res; ++ int a_neg = ISNEG(a); ++ ++ if (bits == 0) ++ return mp_copy(a, b); ++ ++ if (a_neg) { ++ mp_size ua = USED(a); ++ mp_init_size(&tmp, ua); ++ if ((res = mp_2comp(a, &tmp, ua)) != MP_OKAY) ++ return res; ++ SIGN(&tmp) = MP_ZPOS; ++ a = &tmp; ++ } ++ ++ if (bits > 0) ++ res = mp_mul_2d(a, bits, b); ++ else ++ res = mp_div_2d(a, -bits, b, NULL); ++ ++ if (res != MP_OKAY) ++ return res; ++ ++ if (a_neg) { ++ int hb, msd; ++ mp_digit *db; ++ ++ mp_clear(&tmp); ++ ++ msd = USED(b)-1; ++ db = DIGITS(b); ++ hb = s_highest_bit(db[msd]); ++ ++ if (hb < DIGIT_BIT) ++ db[msd] |= MP_DIGIT_MAX << hb; ++ ++ if ((res = mp_2comp(b, b, USED(b))) != MP_OKAY) ++ return res; ++ ++ SIGN(b) = MP_NEG; ++ s_mp_clamp(b); ++ } ++ ++ return MP_OKAY; ++} ++ mp_err mp_to_double(mp_int *mp, double *d) { int ix; Index: mpi-1.8.6/mpi.h =================================================================== --- mpi-1.8.6.orig/mpi.h 2012-09-16 10:50:08.046513006 -0700 -+++ mpi-1.8.6/mpi.h 2012-09-16 21:45:17.713770006 -0700 ++++ mpi-1.8.6/mpi.h 2012-09-17 07:32:54.738697256 -0700 @@ -54,6 +54,7 @@ /* Macros for accessing the mp_int internals */ @@ -346,7 +447,7 @@ Index: mpi-1.8.6/mpi.h #define USED(MP) ((MP)->used) #define ALLOC(MP) ((MP)->alloc) #define DIGITS(MP) ((MP)->dp) -@@ -187,6 +188,15 @@ +@@ -187,6 +188,17 @@ #endif /* end MP_NUMTH */ /*------------------------------------------------------------------------*/ @@ -356,7 +457,9 @@ Index: mpi-1.8.6/mpi.h +mp_err mp_or(mp_int *a, mp_int *b, mp_int *c); +mp_err mp_xor(mp_int *a, mp_int *b, mp_int *c); +mp_err mp_comp(mp_int *a, mp_int *b); -+mp_err mp_clamp_comp(mp_int *a, mp_int *b, mp_digit bits); ++mp_err mp_trunc_comp(mp_int *a, mp_int *b, mp_digit bits); ++mp_err mp_trunc(mp_int *a, mp_int *b, mp_digit bits); ++mp_err mp_shift(mp_int *a, mp_int *b, int bits); /* + left, - right */ + +/*------------------------------------------------------------------------*/ /* Conversions */ |