From 4a380aa6ac331500faf52a2c599abac06dd7855b Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Sun, 19 Dec 2021 10:03:31 +0100
Subject: [PATCH] Implement scm_logand with new integer library

* libguile/integers.c (scm_integer_logand_ii, scm_integer_logand_zi)
(scm_integer_logand_zz): New internal functions.
* libguile/integers.h: Declare the new internal functions.
* libguile/numbers.c (scm_logand): Use new internal functions.
---
 libguile/integers.c | 70 +++++++++++++++++++++++++++++++++++++++++++++
 libguile/integers.h |  4 +++
 libguile/numbers.c  | 38 ++++--------------------
 3 files changed, 79 insertions(+), 33 deletions(-)

diff --git a/libguile/integers.c b/libguile/integers.c
index 3c7a86709..eb65ed221 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -1854,3 +1854,73 @@ scm_integer_lcm_zz (SCM x, SCM y)
   /* shouldn't need to normalize b/c lcm of 2 bigs should be big */
   return take_mpz (result);
 }
+
+/* Emulating 2's complement bignums with sign magnitude arithmetic:
+
+   Logand:
+   X	Y	Result	Method:
+		 (len)
+   +	+	+ x	(map digit:logand X Y)
+   +	-	+ x	(map digit:logand X (lognot (+ -1 Y)))
+   -	+	+ y	(map digit:logand (lognot (+ -1 X)) Y)
+   -	-	-	(+ 1 (map digit:logior (+ -1 X) (+ -1 Y)))
+
+   Logior:
+   X	Y	Result	Method:
+
+   +	+	+	(map digit:logior X Y)
+   +	-	- y	(+ 1 (map digit:logand (lognot X) (+ -1 Y)))
+   -	+	- x	(+ 1 (map digit:logand (+ -1 X) (lognot Y)))
+   -	-	- x	(+ 1 (map digit:logand (+ -1 X) (+ -1 Y)))
+
+   Logxor:
+   X	Y	Result	Method:
+
+   +	+	+	(map digit:logxor X Y)
+   +	-	-	(+ 1 (map digit:logxor X (+ -1 Y)))
+   -	+	-	(+ 1 (map digit:logxor (+ -1 X) Y))
+   -	-	+	(map digit:logxor (+ -1 X) (+ -1 Y))
+
+   Logtest:
+   X	Y	Result
+
+   +	+	(any digit:logand X Y)
+   +	-	(any digit:logand X (lognot (+ -1 Y)))
+   -	+	(any digit:logand (lognot (+ -1 X)) Y)
+   -	-	#t
+
+*/
+
+SCM
+scm_integer_logand_ii (scm_t_inum x, scm_t_inum y)
+{
+  return SCM_I_MAKINUM (x & y);
+}
+
+SCM
+scm_integer_logand_zi (SCM x, scm_t_inum y)
+{
+  if (y == 0)
+    return SCM_INUM0;
+
+  mpz_t result, zx, zy;
+  mpz_init (result);
+  alias_bignum_to_mpz (scm_bignum (x), zx);
+  mpz_init_set_si (zy, y);
+  mpz_and (result, zy, zx);
+  scm_remember_upto_here_1 (x);
+  mpz_clear (zy);
+  return take_mpz (result);
+}
+
+SCM
+scm_integer_logand_zz (SCM x, SCM y)
+{
+  mpz_t result, zx, zy;
+  mpz_init (result);
+  alias_bignum_to_mpz (scm_bignum (x), zx);
+  alias_bignum_to_mpz (scm_bignum (y), zy);
+  mpz_and (result, zx, zy);
+  scm_remember_upto_here_2 (x, y);
+  return take_mpz (result);
+}
diff --git a/libguile/integers.h b/libguile/integers.h
index 31407b79e..d2ab465d7 100644
--- a/libguile/integers.h
+++ b/libguile/integers.h
@@ -132,6 +132,10 @@ SCM_INTERNAL SCM scm_integer_lcm_ii (scm_t_inum x, scm_t_inum y);
 SCM_INTERNAL SCM scm_integer_lcm_zi (SCM x, scm_t_inum y);
 SCM_INTERNAL SCM scm_integer_lcm_zz (SCM x, SCM y);
 
+SCM_INTERNAL SCM scm_integer_logand_ii (scm_t_inum x, scm_t_inum y);
+SCM_INTERNAL SCM scm_integer_logand_zi (SCM x, scm_t_inum y);
+SCM_INTERNAL SCM scm_integer_logand_zz (SCM x, SCM y);
+
 
 
 #endif  /* SCM_INTEGERS_H */
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 7aea6661a..c4955b641 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -2961,47 +2961,19 @@ SCM scm_logand (SCM n1, SCM n2)
 
   if (SCM_I_INUMP (n1))
     {
-      nn1 = SCM_I_INUM (n1);
       if (SCM_I_INUMP (n2))
-	{
-	  scm_t_inum nn2 = SCM_I_INUM (n2);
-	  return SCM_I_MAKINUM (nn1 & nn2);
-	}
-      else if SCM_BIGP (n2)
-	{
-	intbig: 
-	  if (nn1 == 0)
-	    return SCM_INUM0;
-	  {
-	    SCM result_z = scm_i_mkbig ();
-	    mpz_t nn1_z;
-	    mpz_init_set_si (nn1_z, nn1);
-	    mpz_and (SCM_I_BIG_MPZ (result_z), nn1_z, SCM_I_BIG_MPZ (n2));
-	    scm_remember_upto_here_1 (n2);
-	    mpz_clear (nn1_z);
-	    return scm_i_normbig (result_z);
-	  }
-	}
+        return scm_integer_logand_ii (SCM_I_INUM (n1), SCM_I_INUM (n2));
+      else if (SCM_BIGP (n2))
+        return scm_integer_logand_zi (n2, SCM_I_INUM (n1));
       else
 	SCM_WRONG_TYPE_ARG (SCM_ARG2, n2);
     }
   else if (SCM_BIGP (n1))
     {
       if (SCM_I_INUMP (n2))
-	{
-	  SCM_SWAP (n1, n2);
-	  nn1 = SCM_I_INUM (n1);
-	  goto intbig;
-	}
+        return scm_integer_logand_zi (n1, SCM_I_INUM (n2));
       else if (SCM_BIGP (n2))
-	{
-	  SCM result_z = scm_i_mkbig ();
-	  mpz_and (SCM_I_BIG_MPZ (result_z),
-		   SCM_I_BIG_MPZ (n1),
-		   SCM_I_BIG_MPZ (n2));
-	  scm_remember_upto_here_2 (n1, n2);
-	  return scm_i_normbig (result_z);
-	}
+        return scm_integer_logand_zz (n1, n2);
       else
 	SCM_WRONG_TYPE_ARG (SCM_ARG2, n2);
     }