summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog12
-rw-r--r--arith.c50
-rw-r--r--eval.c1
-rw-r--r--lib.h1
-rw-r--r--mpi-patches/add-bitops28
-rw-r--r--txr.122
6 files changed, 110 insertions, 4 deletions
diff --git a/ChangeLog b/ChangeLog
index 6a7ceddc..a41dccd0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,17 @@
2014-06-28 Kaz Kylheku <kaz@kylheku.com>
+ * arith.c (bit): New function.
+
+ * eval.c (eval_init): Register bit as intrinsic.
+
+ * lib.h (bit): Declared.
+
+ * mpi-patches/add-bitops (mp_bit): New function.
+
+ * txr.1: Documented bit
+
+2014-06-28 Kaz Kylheku <kaz@kylheku.com>
+
* mpi-patches/add-bitops (mp_and, mp_or, mp_xor, mp_shift): Plug memory
leaks caused by wrongly initializing the temporary destination operand
for mp2_comp with a size, which mp2_comp then clobbers by doing the same
diff --git a/arith.c b/arith.c
index c52cdb6c..76d00d1d 100644
--- a/arith.c
+++ b/arith.c
@@ -1826,6 +1826,56 @@ bad3:
uw_throwf(error_s, lit("ashift: non-integral operand ~s"), a, nao);
}
+val bit(val a, val bit)
+{
+ cnum bn;
+
+ if (!fixnump(bit))
+ goto bad;
+
+ bn = c_num(bit);
+
+ if (bn < 0)
+ goto bad2;
+
+ switch (type(a)) {
+ case NUM:
+ {
+ cnum an = c_num(a);
+ if (bn < (SIZEOF_PTR * CHAR_BIT))
+ return (an & ((cnum) 1 << bn)) ? t : nil;
+ return an < 0 ? t : nil;
+ }
+ case BGNUM:
+ {
+ mp_err res = mp_bit(mp(a), bn);
+
+ switch (res) {
+ case MP_YES:
+ return t;
+ case MP_NO:
+ return nil;
+ default:
+ goto bad4;
+ }
+ }
+ default:
+ goto bad3;
+ }
+
+bad:
+ uw_throwf(error_s, lit("bit: bit position ~s is not a fixnum"), bit, nao);
+
+bad2:
+ uw_throwf(error_s, lit("bit: bit position ~s is negative"), bit, nao);
+
+bad3:
+ uw_throwf(error_s, lit("bit: non-integral operand ~s"), a, nao);
+
+bad4:
+ uw_throwf(error_s, lit("bit: operation failed on ~s, bit ~s"), a, bit, nao);
+}
+
val maskv(val bits)
{
val accum = zero;
diff --git a/eval.c b/eval.c
index 6b6fbc16..2d4243df 100644
--- a/eval.c
+++ b/eval.c
@@ -3470,6 +3470,7 @@ void eval_init(void)
reg_fun(intern(lit("lognot"), user_package), func_n2o(lognot, 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("bit"), user_package), func_n2(bit));
reg_fun(intern(lit("mask"), user_package), func_n0v(maskv));
reg_fun(intern(lit("regex-compile"), user_package), func_n2o(regex_compile, 1));
diff --git a/lib.h b/lib.h
index 2a07d982..a20382da 100644
--- a/lib.h
+++ b/lib.h
@@ -553,6 +553,7 @@ val logtest(val, val);
val lognot(val, val);
val logtrunc(val a, val bits);
val ash(val a, val bits);
+val bit(val a, val bit);
val maskv(val bits);
val string_own(wchar_t *str);
val string(const wchar_t *str);
diff --git a/mpi-patches/add-bitops b/mpi-patches/add-bitops
index da2cfa3d..81d7de2b 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 2014-06-16 11:22:15.632802821 -0700
-+++ mpi-1.8.6/mpi.c 2014-06-28 07:20:04.364811464 -0700
++++ mpi-1.8.6/mpi.c 2014-06-28 07:42:26.140352649 -0700
@@ -16,6 +16,9 @@
#include <ctype.h>
#include <math.h>
@@ -20,7 +20,7 @@ Index: mpi-1.8.6/mpi.c
int s_highest_bit_mp(mp_int *a);
mp_err s_mp_set_bit(mp_int *a, int bit);
-@@ -2336,6 +2340,411 @@
+@@ -2336,6 +2340,430 @@
/* }}} */
@@ -429,13 +429,32 @@ Index: mpi-1.8.6/mpi.c
+ return MP_OKAY;
+}
+
++mp_err mp_bit(mp_int *a, mp_digit bit)
++{
++ mp_int tmp;
++ mp_err res;
++ int a_neg = ISNEG(a);
++ int digit = bit / MP_DIGIT_BIT;
++ mp_digit mask = ((mp_digit) 1 << (bit % MP_DIGIT_BIT));
++
++ if (a_neg) {
++ mp_init(&tmp);
++ if ((res = mp_2comp(a, &tmp, bit + 1)) != MP_OKAY)
++ return res;
++ SIGN(&tmp) = MP_ZPOS;
++ a = &tmp;
++ }
++
++ return (DIGITS(a)[digit] & mask) != 0 ? MP_YES : MP_NO;
++}
++
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 2014-06-16 11:22:15.620803044 -0700
-+++ mpi-1.8.6/mpi.h 2014-06-16 11:22:15.648802523 -0700
++++ mpi-1.8.6/mpi.h 2014-06-28 08:46:48.354193482 -0700
@@ -54,6 +54,7 @@
/* Macros for accessing the mp_int internals */
@@ -444,7 +463,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,17 @@
+@@ -187,6 +188,18 @@
#endif /* end MP_NUMTH */
/*------------------------------------------------------------------------*/
@@ -457,6 +476,7 @@ Index: mpi-1.8.6/mpi.h
+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 */
++mp_err mp_bit(mp_int *a, mp_digit bit);
+
+/*------------------------------------------------------------------------*/
/* Conversions */
diff --git a/txr.1 b/txr.1
index f2f26476..499eb25a 100644
--- a/txr.1
+++ b/txr.1
@@ -11207,6 +11207,28 @@ a right shift does not exhaust the infinite sequence of 1 digits which
extends to the left. Thus if -4 is shifted right it becomes -2 because
the bitwise representations are ...111100 and ...11110.
+.SS Function bit
+
+.TP
+Syntax:
+
+ (bit <value> <bit>)
+
+.TP
+Description:
+
+The bit function tests whether the integer <value> has a 1 in bit position <bit>.
+The <bit> argument must be a non-negative integer. A value of zero of <bit>
+indicates the least significant bit position of <value>.
+
+The bit function has a boolean result, returning the symbol t if bit <bit>
+of <value> is set, otherwise nil.
+
+If <value> is negative, it is treated as if it had an infinite-bit two's
+complement representation. For instance, if value is -2, then the bit
+function returns nil for a <bit> value of zero, and t for all other values,
+since the infinite bit two's complement representation of -2 is ...11110.
+
.SS Function mask
.TP