summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog15
-rw-r--r--arith.c123
-rw-r--r--eval.c3
-rw-r--r--lib.h3
-rw-r--r--mpi-patches/add-bitops273
-rw-r--r--mpi-patches/series1
6 files changed, 418 insertions, 0 deletions
diff --git a/ChangeLog b/ChangeLog
index 9fee44f5..e74d082c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,20 @@
2012-09-16 Kaz Kylheku <kaz@kylheku.com>
+ Starting work on adding bit operations. The semantics is that
+ negative integers behave as an "infinite bit two's complement".
+
+ * arith.c (logand, logor, logxor): New functions.
+
+ * eval.c (eval_init): New intrinsic functions logand, logior, logxor.
+
+ * lib.h (logand, logor, logxor): Declared.
+
+ * mpi-patches/series: New patch, add-bitops.
+
+ * mpi-patches/add-bitops: New file.
+
+2012-09-16 Kaz Kylheku <kaz@kylheku.com>
+
* stream.c (vformat): Fix bug in ~x format directive for printing
integers in hex. When we use the printf's %x conversion specifiers for
fixnums, we get incorrect results when the values are negative, because
diff --git a/arith.c b/arith.c
index 5b57faa1..82189866 100644
--- a/arith.c
+++ b/arith.c
@@ -1488,6 +1488,129 @@ val flo_int(val i)
}
}
+val logand(val a, val b)
+{
+ val c;
+
+ if (zerop(a) || zerop(b))
+ return zero;
+
+ switch (TYPE_PAIR(type(a), type(b))) {
+ case TYPE_PAIR(NUM, NUM):
+ if (a == b) {
+ return a;
+ } else {
+ cnum ac = c_num(a);
+ cnum bc = c_num(b);
+ return num_fast(ac & bc);
+ }
+ case TYPE_PAIR(BGNUM, NUM):
+ {
+ val tmp = a;
+ a = b;
+ b = tmp;
+ }
+ /* fallthrough */
+ case TYPE_PAIR(NUM, BGNUM):
+ a = bignum(c_num(a));
+ /* fallthrough */
+ case TYPE_PAIR(BGNUM, BGNUM):
+ if (a == b)
+ return a;
+ c = make_bignum();
+ if (mp_and(mp(a), mp(b), mp(c)) != MP_OKAY)
+ goto bad;
+ return c;
+ default:
+ uw_throwf(error_s, lit("logand: non-integral operands ~s ~s"), a, b, nao);
+ }
+
+bad:
+ uw_throwf(error_s, lit("logand: operation failed on ~s ~s"), a, b, nao);
+}
+
+val logior(val a, val b)
+{
+ val c;
+
+ if (zerop(a) && zerop(b))
+ return zero;
+
+ switch (TYPE_PAIR(type(a), type(b))) {
+ case TYPE_PAIR(NUM, NUM):
+ if (a == b) {
+ return a;
+ } else {
+ cnum ac = c_num(a);
+ cnum bc = c_num(b);
+ return num_fast(ac | bc);
+ }
+ case TYPE_PAIR(BGNUM, NUM):
+ {
+ val tmp = a;
+ a = b;
+ b = tmp;
+ }
+ /* fallthrough */
+ case TYPE_PAIR(NUM, BGNUM):
+ a = bignum(c_num(a));
+ /* fallthrough */
+ case TYPE_PAIR(BGNUM, BGNUM):
+ if (a == b)
+ return a;
+ c = make_bignum();
+ if (mp_or(mp(a), mp(b), mp(c)) != MP_OKAY)
+ goto bad;
+ return c;
+ default:
+ uw_throwf(error_s, lit("logior: non-integral operands ~s ~s"), a, b, nao);
+ }
+
+bad:
+ uw_throwf(error_s, lit("logior: operation failed on ~s ~s"), a, b, nao);
+}
+
+val logxor(val a, val b)
+{
+ val c;
+
+ if (zerop(a) && zerop(b))
+ return zero;
+
+ switch (TYPE_PAIR(type(a), type(b))) {
+ case TYPE_PAIR(NUM, NUM):
+ if (a == b) {
+ return a;
+ } else {
+ cnum ac = c_num(a);
+ cnum bc = c_num(b);
+ return num_fast(ac ^ bc);
+ }
+ case TYPE_PAIR(BGNUM, NUM):
+ {
+ val tmp = a;
+ a = b;
+ b = tmp;
+ }
+ /* fallthrough */
+ case TYPE_PAIR(NUM, BGNUM):
+ a = bignum(c_num(a));
+ /* fallthrough */
+ case TYPE_PAIR(BGNUM, BGNUM):
+ if (a == b)
+ return a;
+ c = make_bignum();
+ if (mp_xor(mp(a), mp(b), mp(c)) != MP_OKAY)
+ goto bad;
+ return c;
+ default:
+ uw_throwf(error_s, lit("logxor: non-integral operands ~s ~s"), a, b, nao);
+ }
+
+bad:
+ uw_throwf(error_s, lit("logxor: operation failed on ~s ~s"), a, b, nao);
+}
+
void arith_init(void)
{
mp_init(&NUM_MAX_MP);
diff --git a/eval.c b/eval.c
index ecf44424..786fc0d4 100644
--- a/eval.c
+++ b/eval.c
@@ -2231,6 +2231,9 @@ void eval_init(void)
reg_fun(intern(lit("/="), user_package), func_n0v(numneqv));
reg_fun(intern(lit("max"), user_package), func_n1v(maxv));
reg_fun(intern(lit("min"), user_package), func_n1v(minv));
+ reg_fun(intern(lit("logand"), user_package), func_n2(logand));
+ reg_fun(intern(lit("logior"), user_package), func_n2(logior));
+ reg_fun(intern(lit("logxor"), user_package), func_n2(logxor));
reg_fun(intern(lit("regex-compile"), user_package), func_n1(regex_compile));
reg_fun(intern(lit("regexp"), user_package), func_n1(regexp));
diff --git a/lib.h b/lib.h
index d454fd29..90975644 100644
--- a/lib.h
+++ b/lib.h
@@ -471,6 +471,9 @@ val acosi(val);
val atang(val);
val loga(val);
val expo(val);
+val logand(val, val);
+val logior(val, val);
+val logxor(val, val);
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
new file mode 100644
index 00000000..db4611de
--- /dev/null
+++ b/mpi-patches/add-bitops
@@ -0,0 +1,273 @@
+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 13:31:03.146453506 -0700
+@@ -16,6 +16,9 @@
+ #include <ctype.h>
+ #include <math.h>
+
++#define MAX(A, B) ((A) > (B) ? (A) : (B))
++#define MIN(A, B) ((A) < (B) ? (A) : (B))
++
+ 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,232 @@
+
+ /* }}} */
+
++/*
++ * Convert a's bit vector to its two's complement, up to the
++ * number of words that it contains, storing result in b. The numeric value of
++ * this result depends on the size of mpi_digit. This is a building block for
++ * handling negative operands in the bit operations.
++ */
++mp_err mp_2comp(mp_int *a, mp_int *b, mp_size dig)
++{
++ mp_err res;
++ mp_size ix;
++ mp_digit *pa, *pb;
++ mp_word w;
++
++ ARGCHK(a != NULL && b != NULL, MP_BADARG);
++
++ if (a != b) {
++ if ((res = mp_init_size(b, dig)) != MP_OKAY)
++ return res;
++ SIGN(b) = SIGN(a);
++ } else {
++ if((res = s_mp_pad(b, dig)) != MP_OKAY)
++ return res;
++ }
++
++ for (pa = DIGITS(a), pb = DIGITS(b), w = 0, ix = 0; ix < dig; ix++) {
++ w += ~pa[ix] + (mp_word) (ix == 0);
++ pb[ix] = ACCUM(w);
++ w = CARRYOUT(w);
++ }
++
++ USED(b) = dig;
++
++ return MP_OKAY;
++}
++
++mp_err mp_and(mp_int *a, mp_int *b, mp_int *c)
++{
++ mp_err res;
++ mp_size ix, extent = 0;
++ mp_digit *pa, *pb, *pc;
++ mp_int tmp_a, tmp_b;
++
++ ARGCHK(a != NULL && b != NULL && c != NULL, MP_BADARG);
++
++ if (a == b)
++ return mp_copy(a, c);
++
++ if (ISNEG(a)) {
++ mp_init(&tmp_a);
++ extent = USED(b);
++ if ((res = mp_2comp(a, &tmp_a, extent)) != MP_OKAY)
++ return res;
++ a = &tmp_a;
++ }
++
++ if (ISNEG(b)) {
++ mp_init(&tmp_b);
++ extent = USED(a);
++ if ((res = mp_2comp(b, &tmp_b, extent)) != MP_OKAY) {
++ if (ISNEG(a))
++ mp_clear(&tmp_a);
++ return res;
++ }
++ b = &tmp_b;
++ }
++
++ if (!extent)
++ extent = MIN(USED(a), USED(b));
++
++ if (c != a && c != b) {
++ if ((res = mp_init_size(c, extent)) != MP_OKAY)
++ return res;
++ }
++
++ for (pa = DIGITS(a), pb = DIGITS(b), pc = DIGITS(c), ix = 0;
++ ix < extent; ix++)
++ {
++ pc[ix] = pa[ix] & pb[ix];
++ }
++
++ USED(c) = extent;
++
++ if (ISNEG(a) && ISNEG(b)) {
++ mp_2comp(c, c, extent);
++ SIGN(c) = MP_NEG;
++ }
++
++ s_mp_clamp(c);
++
++ if (ISNEG(a))
++ mp_clear(&tmp_a);
++
++ if (ISNEG(b))
++ mp_clear(&tmp_b);
++
++ return MP_OKAY;
++}
++
++mp_err mp_or(mp_int *a, mp_int *b, mp_int *c)
++{
++ mp_err res;
++ mp_size ix, extent = 0;
++ mp_digit *pa, *pb, *pc;
++ mp_int tmp_a, tmp_b;
++
++ ARGCHK(a != NULL && b != NULL && c != NULL, MP_BADARG);
++
++ extent = MAX(USED(a), USED(b));
++
++ if (a == b)
++ return mp_copy(a, c);
++
++ if (ISNEG(a)) {
++ mp_init(&tmp_a);
++ if ((res = mp_2comp(a, &tmp_a, extent)) != MP_OKAY)
++ return res;
++ a = &tmp_a;
++ }
++
++ if (ISNEG(b)) {
++ mp_init(&tmp_b);
++ if ((res = mp_2comp(b, &tmp_b, extent)) != MP_OKAY) {
++ if (ISNEG(a))
++ mp_clear(&tmp_a);
++ return res;
++ }
++ b = &tmp_b;
++ }
++
++
++ if (c != a && c != b)
++ res = mp_init_size(c, extent);
++ else
++ res = s_mp_pad(c, extent);
++
++ if (res != MP_OKAY)
++ return res;
++
++ for (pa = DIGITS(a), pb = DIGITS(b), pc = DIGITS(c), ix = 0;
++ ix < extent; ix++)
++ {
++ pc[ix] = pa[ix] | pb[ix];
++ }
++
++ USED(c) = extent;
++
++ if (ISNEG(a) || ISNEG(b)) {
++ mp_2comp(c, c, extent);
++ SIGN(c) = MP_NEG;
++ }
++
++ s_mp_clamp(c);
++
++ if (ISNEG(a))
++ mp_clear(&tmp_a);
++
++ if (ISNEG(b))
++ mp_clear(&tmp_b);
++
++ return MP_OKAY;
++}
++
++mp_err mp_xor(mp_int *a, mp_int *b, mp_int *c)
++{
++ mp_err res;
++ mp_size ix, extent = 0;
++ mp_digit *pa, *pb, *pc;
++ mp_int tmp_a, tmp_b;
++
++ ARGCHK(a != NULL && b != NULL && c != NULL, MP_BADARG);
++
++ extent = MAX(USED(a), USED(b)) + 1;
++
++ if (a == b)
++ return mp_copy(a, c);
++
++ if (ISNEG(a)) {
++ mp_init(&tmp_a);
++ if ((res = mp_2comp(a, &tmp_a, extent)) != MP_OKAY)
++ return res;
++ a = &tmp_a;
++ }
++
++ if (ISNEG(b)) {
++ mp_init(&tmp_b);
++ if ((res = mp_2comp(b, &tmp_b, extent)) != MP_OKAY) {
++ if (ISNEG(a))
++ mp_clear(&tmp_a);
++ return res;
++ }
++ b = &tmp_b;
++ }
++
++
++ if (c != a && c != b)
++ res = mp_init_size(c, extent);
++ else
++ res = s_mp_pad(c, extent);
++
++ if (res != MP_OKAY)
++ return res;
++
++ for (pa = DIGITS(a), pb = DIGITS(b), pc = DIGITS(c), ix = 0;
++ ix < extent; ix++)
++ {
++ pc[ix] = pa[ix] ^ pb[ix];
++ }
++
++ USED(c) = extent;
++
++ if (ISNEG(a) ^ ISNEG(b)) {
++ mp_2comp(c, c, extent);
++ SIGN(c) = MP_NEG;
++ }
++
++ s_mp_clamp(c);
++
++ if (ISNEG(a))
++ mp_clear(&tmp_a);
++
++ if (ISNEG(b))
++ mp_clear(&tmp_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 13:23:09.824359506 -0700
+@@ -54,6 +54,7 @@
+
+ /* Macros for accessing the mp_int internals */
+ #define SIGN(MP) ((MP)->sign)
++#define ISNEG(MP) ((MP)->sign == MP_NEG)
+ #define USED(MP) ((MP)->used)
+ #define ALLOC(MP) ((MP)->alloc)
+ #define DIGITS(MP) ((MP)->dp)
+@@ -187,6 +188,13 @@
+ #endif /* end MP_NUMTH */
+
+ /*------------------------------------------------------------------------*/
++/* Bit ops */
++mp_err mp_2comp(mp_int *a, mp_int *b, mp_size dig); /* peculiar semantics */
++mp_err mp_and(mp_int *a, mp_int *b, mp_int *c);
++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);
++
++/*------------------------------------------------------------------------*/
+ /* Conversions */
+
+ mp_err mp_to_double(mp_int *mp, double *d);
diff --git a/mpi-patches/series b/mpi-patches/series
index 08e0f6ee..4d56c94a 100644
--- a/mpi-patches/series
+++ b/mpi-patches/series
@@ -15,3 +15,4 @@ shrink-mpi-int
faster-square-root
mpi-to-double
fix-ctype-warnings
+add-bitops
generated by cgit v1.2.3 (git 2.25.1) at 2025-03-10 16:16:10 +0000