Re: bignum branch

[Andy Moreton <andrewjmoreton@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1891 bytes --]

On Sun 22 Jul 2018, Andy Moreton wrote:

> On Sun 22 Jul 2018, Tom Tromey wrote:
>
>>>>>>> "Andy" == Andy Moreton <andrewjmoreton@gmail.com> writes:
>>
>> Andy> I think the following patch fixes the issues in CCL (compiler,
>> Andy> interpreter and disassembler). It truncates the compiled CCL code words
>> Andy> to 28 bits and then sign extends to ensure that the interpreter sees
>> Andy> signed values of constants (stored at the upper end of the code word).
>>
>> Would you mind pushing this to the bignum branch?
>> If it's inconvenient, let me know and I will do it.
>
> I've done some more testing with the CCl program in the midi-kbd ELPA
> package, and that shows that the patch is not correct.
>
> I'll report back when I get it working on master and on the bignum
> branch. The problems I reported with markers make debugging awkward on
> the bignum branch.

After a lot more testing, I have a somewhat scruffy patch that works in
the following emacs builds on unpatched master, and on patched bignum branch:
 - cygwin 64bit (LP64 model)
 - mingw64 msys2 32bit
 - mingw64 msys2 64bit (LLP64 model)

The patch contains changes for:
 - fix CCL to ensure it uses 28biut codewords properly in bignum build
 - ensure make_number creates fixnums in LLP64 builds
 - fix bugnumcompare for LLP64 builds
 - fix arith_driver to handle markers correctly
 - fix arith_driver operations for LLP64 builds (more testing needed)
 - fix float_arith_driver to allow bignums
 - fix ash_lsh_impl to produce correct results in bignum build
 - fix NUMBERP to remove redundant BIGNUMP test (ensured by INTEGERP)

The patch has been tested with the attached ccl-tests.el ERT tests to
check that ash/lsh shifts behave properly, and that the CCL machinery
uses its 28bit codewords correctly in a bignum build.

Please check this works for you, and feel free to commit it to the
bignum branch.

    AndyM



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Bignum support fixes --]
[-- Type: text/x-patch, Size: 9886 bytes --]

diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el
index d2f490d59c..3529dd9c30 100644
--- a/lisp/international/ccl.el
+++ b/lisp/international/ccl.el
@@ -184,11 +184,15 @@ ccl-program-vector
 (defvar ccl-current-ic 0
   "The current index for `ccl-program-vector'.")
 
+(defun ccl-fixnum (code)
+  "Convert a CCL code word to a fixnum value."
+  (- (logxor (logand code #x0fffffff) #x08000000) #x08000000))
+
 (defun ccl-embed-data (data &optional ic)
   "Embed integer DATA in `ccl-program-vector' at `ccl-current-ic' and
 increment it.  If IC is specified, embed DATA at IC."
   (if ic
-      (aset ccl-program-vector ic data)
+      (aset ccl-program-vector ic (ccl-fixnum data))
     (let ((len (length ccl-program-vector)))
       (if (>= ccl-current-ic len)
 	  (let ((new (make-vector (* len 2) nil)))
@@ -196,7 +200,7 @@ ccl-embed-data
 	      (setq len (1- len))
 	      (aset new len (aref ccl-program-vector len)))
 	    (setq ccl-program-vector new))))
-    (aset ccl-program-vector ccl-current-ic data)
+    (aset ccl-program-vector ccl-current-ic (ccl-fixnum data))
     (setq ccl-current-ic (1+ ccl-current-ic))))
 
 (defun ccl-embed-symbol (symbol prop)
@@ -230,7 +234,8 @@ ccl-embed-current-address
 `ccl-program-vector' at IC without altering the other bit field."
   (let ((relative (- ccl-current-ic (1+ ic))))
     (aset ccl-program-vector ic
-	  (logior (aref ccl-program-vector ic) (ash relative 8)))))
+	  (logior (aref ccl-program-vector ic)
+                  (ccl-fixnum (ash relative 8))))))
 
 (defun ccl-embed-code (op reg data &optional reg2)
   "Embed CCL code for the operation OP and arguments REG and DATA in
@@ -986,7 +991,8 @@ ccl-dump
 (defun ccl-get-next-code ()
   "Return a CCL code in `ccl-code' at `ccl-current-ic'."
   (prog1
-      (aref ccl-code ccl-current-ic)
+      (let ((code (aref ccl-code ccl-current-ic)))
+        (if (numberp code) (ccl-fixnum code) code))
     (setq ccl-current-ic (1+ ccl-current-ic))))
 
 (defun ccl-dump-1 ()
diff --git a/src/alloc.c b/src/alloc.c
index 1dc1bbb031..4c794048be 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3815,6 +3815,34 @@ make_number (mpz_t value)
 	}
     }
 
+  /* Check if fixnum can be larger than long.  */
+  if (sizeof (EMACS_INT) > sizeof (long))
+    {
+      size_t bits = mpz_sizeinbase (value, 2);
+      int sign = mpz_sgn (value);
+
+      if (bits < FIXNUM_BITS + (sign < 0))
+        {
+          EMACS_INT v = 0;
+          size_t limbs = mpz_size(value);
+          mp_size_t i;
+
+          for (i = 0; i < limbs; i++)
+            {
+              mp_limb_t limb = mpz_getlimbn (value, i);
+              v |= (EMACS_INT) ((EMACS_UINT) limb << (i * GMP_NUMB_BITS));
+            }
+          if (sign < 0)
+            v = -v;
+
+          if (!FIXNUM_OVERFLOW_P (v))
+            {
+              XSETINT (obj, v);
+              return obj;
+            }
+        }
+    }
+
   obj = allocate_misc (Lisp_Misc_Bignum);
   b = XBIGNUM (obj);
   /* We could mpz_init + mpz_swap here, to avoid a copy, but the
diff --git a/src/data.c b/src/data.c
index 0deebdca1a..6ca868a938 100644
--- a/src/data.c
+++ b/src/data.c
@@ -2409,7 +2409,18 @@ bignumcompare (Lisp_Object num1, Lisp_Object num2,
       if (FLOATP (num2))
 	cmp = mpz_cmp_d (XBIGNUM (num1)->value, XFLOAT_DATA (num2));
       else if (FIXNUMP (num2))
-	cmp = mpz_cmp_si (XBIGNUM (num1)->value, XINT (num2));
+        {
+          if (sizeof (EMACS_INT) > sizeof(long) && XINT (num2) > LONG_MAX)
+            {
+              mpz_t tem;
+              mpz_init (tem);
+              mpz_set_intmax (tem, XINT (num2));
+              cmp = mpz_cmp (XBIGNUM (num1)->value, tem);
+              mpz_clear(tem);
+            }
+          else
+            cmp = mpz_cmp_si (XBIGNUM (num1)->value, XINT (num2));
+        }
       else
 	{
 	  eassume (BIGNUMP (num2));
@@ -2422,10 +2433,18 @@ bignumcompare (Lisp_Object num1, Lisp_Object num2,
       if (FLOATP (num1))
 	cmp = - mpz_cmp_d (XBIGNUM (num2)->value, XFLOAT_DATA (num1));
       else
-	{
-	  eassume (FIXNUMP (num1));
-	  cmp = - mpz_cmp_si (XBIGNUM (num2)->value, XINT (num1));
-	}
+        {
+          if (sizeof (EMACS_INT) > sizeof(long) && XINT (num1) > LONG_MAX)
+            {
+              mpz_t tem;
+              mpz_init (tem);
+              mpz_set_intmax (tem, XINT (num1));
+              cmp = - mpz_cmp (XBIGNUM (num2)->value, tem);
+              mpz_clear(tem);
+            }
+          else
+            cmp = - mpz_cmp_si (XBIGNUM (num2)->value, XINT (num1));
+        }
     }
 
   switch (comparison)
@@ -2860,7 +2879,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
     {
       /* Using args[argnum] as argument to CHECK_NUMBER... */
       val = args[argnum];
-      CHECK_NUMBER (val);
+      CHECK_NUMBER_COERCE_MARKER (val);
 
       if (FLOATP (val))
 	return unbind_to (count,
@@ -2871,7 +2890,15 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
 	case Aadd:
 	  if (BIGNUMP (val))
 	    mpz_add (accum, accum, XBIGNUM (val)->value);
-	  else if (XINT (val) < 0)
+	  else if (sizeof (EMACS_INT) > sizeof (long))
+            {
+	      mpz_t tem;
+	      mpz_init (tem);
+	      mpz_set_intmax (tem, XINT (val));
+	      mpz_add (accum, accum, tem);
+	      mpz_clear (tem);
+            }
+          else if (XINT (val) < 0)
 	    mpz_sub_ui (accum, accum, - XINT (val));
 	  else
 	    mpz_add_ui (accum, accum, XINT (val));
@@ -2888,6 +2915,14 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
 	    }
 	  else if (BIGNUMP (val))
 	    mpz_sub (accum, accum, XBIGNUM (val)->value);
+	  else if (sizeof (EMACS_INT) > sizeof (long))
+            {
+	      mpz_t tem;
+	      mpz_init (tem);
+	      mpz_set_intmax (tem, XINT (val));
+	      mpz_sub (accum, accum, tem);
+	      mpz_clear (tem);
+            }
 	  else if (XINT (val) < 0)
 	    mpz_add_ui (accum, accum, - XINT (val));
 	  else
@@ -2896,6 +2931,14 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
 	case Amult:
 	  if (BIGNUMP (val))
 	    mpz_mul (accum, accum, XBIGNUM (val)->value);
+	  else if (sizeof (EMACS_INT) > sizeof (long))
+            {
+	      mpz_t tem;
+	      mpz_init (tem);
+	      mpz_set_intmax (tem, XINT (val));
+	      mpz_mul (accum, accum, tem);
+	      mpz_clear (tem);
+            }
 	  else
 	    mpz_mul_si (accum, accum, XINT (val));
 	  break;
@@ -2915,6 +2958,14 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
 		xsignal0 (Qarith_error);
 	      if (BIGNUMP (val))
 		mpz_tdiv_q (accum, accum, XBIGNUM (val)->value);
+              else if (sizeof (EMACS_INT) > sizeof (long))
+                {
+                  mpz_t tem;
+                  mpz_init (tem);
+                  mpz_set_intmax (tem, XINT (val));
+                  mpz_tdiv_q (accum, accum, tem);
+                  mpz_clear (tem);
+                }
 	      else
 		{
 		  EMACS_INT value = XINT (val);
@@ -2982,8 +3033,9 @@ float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code,
 
   for (; argnum < nargs; argnum++)
     {
-      val = args[argnum];    /* using args[argnum] as argument to CHECK_FIXNUM_... */
-      CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (val);
+      /* using args[argnum] as argument to CHECK_NUMBER_... */
+      val = args[argnum];
+      CHECK_NUMBER_COERCE_MARKER (val);
 
       if (FLOATP (val))
 	{
@@ -3277,7 +3329,7 @@ representation.  */)
 
   if (BIGNUMP (value))
     {
-      if (mpz_cmp_si (XBIGNUM (value)->value, 0) >= 0)
+      if (mpz_sgn (XBIGNUM (value)->value) >= 0)
 	return make_fixnum (mpz_popcount (XBIGNUM (value)->value));
       mpz_t tem;
       mpz_init (tem);
@@ -3314,8 +3366,10 @@ ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh)
       mpz_init (result);
       if (XINT (count) >= 0)
 	mpz_mul_2exp (result, XBIGNUM (value)->value, XINT (count));
-      else
+      else if (lsh)
 	mpz_tdiv_q_2exp (result, XBIGNUM (value)->value, - XINT (count));
+      else
+	mpz_fdiv_q_2exp (result, XBIGNUM (value)->value, - XINT (count));
       val = make_number (result);
       mpz_clear (result);
     }
@@ -3325,14 +3379,19 @@ ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh)
       mpz_t result;
       eassume (FIXNUMP (value));
       mpz_init (result);
-      if (lsh)
-	mpz_set_uintmax (result, XUINT (value));
-      else
-	mpz_set_intmax (result, XINT (value));
+
+      mpz_set_intmax (result, XINT (value));
+
       if (XINT (count) >= 0)
 	mpz_mul_2exp (result, result, XINT (count));
-      else
-	mpz_tdiv_q_2exp (result, result, - XINT (count));
+      else if (lsh)
+        if (mpz_sgn (result) > 0)
+          mpz_fdiv_q_2exp (result, result, - XINT (count));
+        else
+          mpz_fdiv_q_2exp (result, result, - XINT (count));
+      else /* ash */
+	mpz_fdiv_q_2exp (result, result, - XINT (count));
+
       val = make_number (result);
       mpz_clear (result);
     }
@@ -3414,7 +3473,7 @@ Markers are converted to integers.  */)
   else
     {
       eassume (FIXNUMP (number));
-      if (XINT (number) > MOST_POSITIVE_FIXNUM)
+      if (XINT (number) > MOST_NEGATIVE_FIXNUM)
 	XSETINT (number, XINT (number) - 1);
       else
 	{
diff --git a/src/lisp.h b/src/lisp.h
index 4208634fa9..b404f9d89a 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2778,7 +2778,7 @@ NATNUMP (Lisp_Object x)
 INLINE bool
 NUMBERP (Lisp_Object x)
 {
-  return INTEGERP (x) || FLOATP (x) || BIGNUMP (x);
+  return INTEGERP (x) || FLOATP (x);
 }
 
 INLINE bool
@@ -2947,7 +2947,7 @@ CHECK_INTEGER (Lisp_Object x)
     if (MARKERP (x))							\
       XSETFASTINT (x, marker_position (x));				\
     else								\
-      CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumber_or_marker_p, x);			\
+      CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumber_or_marker_p, x);		\
   } while (false)
 
 #define CHECK_NUMBER_COERCE_MARKER(x)					\

[-- Attachment #3: Tests for bignum support and CCL fixes --]
[-- Type: application/emacs-lisp, Size: 7683 bytes --]