From f69bc0426a3f94318ef89dba18cdad3cbed180e7 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sat, 28 Jun 2014 08:53:45 -0700 Subject: * 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 --- ChangeLog | 12 ++++++++++++ arith.c | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++ eval.c | 1 + lib.h | 1 + mpi-patches/add-bitops | 28 ++++++++++++++++++++++++---- txr.1 | 22 ++++++++++++++++++++++ 6 files changed, 110 insertions(+), 4 deletions(-) diff --git a/ChangeLog b/ChangeLog index 6a7ceddc..a41dccd0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2014-06-28 Kaz Kylheku + + * 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 * mpi-patches/add-bitops (mp_and, mp_or, mp_xor, mp_shift): Plug memory 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 #include @@ -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 @@ /* }}} */ @@ -428,6 +428,25 @@ 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) { @@ -435,7 +454,7 @@ Index: mpi-1.8.6/mpi.c 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 ) + +.TP +Description: + +The bit function tests whether the integer has a 1 in bit position . +The argument must be a non-negative integer. A value of zero of +indicates the least significant bit position of . + +The bit function has a boolean result, returning the symbol t if bit +of is set, otherwise nil. + +If 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 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 -- cgit v1.2.3