Commits

Jerry James  committed 3192994

Convert C (un)signed long long values to bignums properly.

This patch also does the following:
- Uses make_fixnum instead of make_integer when the argument is guaranteed to
be in the fixnum range.
- Introduces make_unsigned_integer so that we handle unsigned values with the
high bit set correctly.
- Introduces conversions between bignums and (un)signed long long values.
- Uses mp_set_memory_functions with the BSD MP code, if it exists.
- Eliminates some unnecessary consing in the Lisp + and * implementations.
- Fixes a problem with check_valid_xbm_inline(). This function is called
during intialization. It calls Ftimes. When using pdump, this is a
problem, because (a) the bignum code is not initialized until *after*
dumping, so we don't try to dump any bignums, and (b) multiplication of
integers is done inside bignums so we handle fixnum overflow correctly. I
decided that an XBM file with dimensions that don't fit into fixnums is
probably not something we want to try to handle anyway, and did the
arithmetic with C values instead of Lisp values. Doing that broke one test,
which started getting a different error message from the one it expected, so
I adjusted the test to match the new reality.
- Fixes a few miscellaneous bugs in the BSD MP code.
See <CAHCOHQk0u0=eD1fUMHTNWi2Yh=1WgiYyCXdMbsGzHBNhdqYz4w@mail.gmail.com> in
xemacs-patches, as well as followup messages.

  • Participants
  • Parent commits ff13c44

Comments (0)

Files changed (27)

+2013-06-17  Jerry James  <james@xemacs.org>
+
+	* configure.ac: Add check for mp_set_memory_functions.
+
 2013-03-12  Jerry James  <james@xemacs.org>
 
 	* config.guess: Update to latest upstream version.
   else
     { echo "Error:" "Required MP numeric support cannot be provided." >&2; exit 1; }
   fi
+  ac_fn_c_check_func "$LINENO" "mp_set_memory_functions" "ac_cv_func_mp_set_memory_functions"
+if test "x$ac_cv_func_mp_set_memory_functions" = xyes; then :
+  $as_echo "#define HAVE_MP_SET_MEMORY_FUNCTIONS 1" >>confdefs.h
+
+else
+  ac_fn_c_check_func "$LINENO" "__gmp_set_memory_functions" "ac_cv_func___gmp_set_memory_functions"
+if test "x$ac_cv_func___gmp_set_memory_functions" = xyes; then :
+  $as_echo "#define HAVE_MP_SET_MEMORY_FUNCTIONS 1" >>confdefs.h
+
+fi
+
+fi
+
   $as_echo "#define WITH_NUMBER_TYPES 1" >>confdefs.h
 
   $as_echo "#define WITH_MP 1" >>confdefs.h

File configure.ac

   else
     XE_DIE("Required MP numeric support cannot be provided.")
   fi
+  AC_CHECK_FUNC(mp_set_memory_functions,
+    [AC_DEFINE(HAVE_MP_SET_MEMORY_FUNCTIONS)],
+    [AC_CHECK_FUNC(__gmp_set_memory_functions,
+      [AC_DEFINE(HAVE_MP_SET_MEMORY_FUNCTIONS)])])
   AC_DEFINE(WITH_NUMBER_TYPES)
   AC_DEFINE(WITH_MP)
 fi

File src/ChangeLog

+2013-06-17  Jerry James  <james@xemacs.org>
+
+	* alloc.c (make_bignum_un): New function.
+	(make_bignum_ll): New function.
+	(make_bignum_ull): New function.
+	* config.h.in (HAVE_MP_SET_MEMORY_FUNCTIONS): Add.
+	* data.c (Fplus): avoid unnecessary consing.
+	(Ftimes): ditto.
+	* glyphs.c (check_valid_xbm_inline): Since this function is called
+	prior to dumping, when bignums are forbidden, do all arithmetic
+	with C integers.
+	* lisp.h (MOST_POSITIVE_FIXNUM_UNSIGNED): New constant.
+	(MOST_POSITIVE_FIXNUM): Redefine in terms of the above.
+	(UNSIGNED_NUMBER_FITS_IN_A_FIXNUM): New macro.
+	* number-gmp.c (bignum_to_llong): New function.
+	(bignum_to_ullong): New function.
+	(bignum_set_llong): New function.
+	(bigfloat_to_string): Adjust whitespace.
+	(gmp_realloc): Ditto.
+	(gmp_free): Ditto.
+	* number-gmp.h (bignum_fits_llong): New macro.
+	(bignum_fits_ullong): New macro.
+	(bignum_set_ullong): New macro.
+	* number-mp.c (bignum_long_sign_bit): Remove, didn't work.
+	(bignum_min_llong): New variable.
+	(bignum_max_llong): New variable.
+	(bignum_max_ullong): New variable.
+	(bignum_to_llong): New function.
+	(bignum_to_ullong): New function.
+	(bignum_set_long): Reimplement using MP_XTOM.
+	(bignum_set_ulong): Ditto.
+	(bignum_set_llong): New function.
+	(bignum_set_ullong): New function.
+	(bignum_clrbit): Fix a comment.
+	(bignum_random_seed): Move to number-mp.h, since it is a no-op.
+	(bignum_random): Implement.
+	(mp_realloc): New function.
+	(mp_free): New function.
+	(init_number_mp): Use them.  Fix a comment.  Eliminate
+	initialization of bignum_long_sign_bit.  Initialize
+	bignum_min_llong, bignum_max_llong, and bignum_set_ullong.
+	* number-mp.h (MP_XTOM): New macro.
+	(bignum_fits_llong_p): New macro.
+	(bignum_fits_ullong_p): New macro.
+	(bignum_random_seed): New macro.
+	* number.h: Implement bignums as long long integers.
+	(make_bignum_ll): New macro.
+	(make_integer): Accept a long long value.
+	(make_unsigned_integer): New macro.
+	(NATNUMP): Adjust whitespace.
+	(non_fixnum_number_p): Ditto.
+
+	* alloc.c (Fmake_list): Use make_unsigned_integer or make_fixnum
+	instead of make_integer where it is appropriate to do so.
+	* chartab.c (char_table_default_for_type): Ditto.
+	* dired.c (Ffile_attributes): Ditto.
+	* elhash.c (hash_table_size_validate): Ditto.
+	* eval.c (Fmacroexpand): Ditto.
+	* event-stream.c (Faccept_process_output): Ditto.
+	(Frecent_keys): Ditto.
+	* events.c (Fmake_event): Ditto.
+	(Fevent_timestamp_lessp): Ditto.
+	* font-mgr.c (Ffc_pattern_get): Ditto.
+	* indent.c (Fmove_to_column): Ditto.
+	* process.c (Fset_process_window_size): Ditto.
+	* profile.c (Fstart_profiling): Ditto.
+	* unicode.c (Fset_unicode_conversion): Ditto.
+	(Funicode_to_char): Ditto.
+
 2013-04-23  Vin Shelton  <acs@xemacs.org>
 
 	* sysdep.c (qxe_getgrgid): Hack in WIN32_NATIVE group support.
   Lisp_Object val = Qnil;
   Elemcount size;
 
-  check_integer_range (length, Qzero, make_integer (MOST_POSITIVE_FIXNUM));
+  check_integer_range (length, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM));
 
   size = XFIXNUM (length);
 
 /* WARNING: This function returns a bignum even if its argument fits into a
    fixnum.  See Fcanonicalize_number(). */
 Lisp_Object
+make_bignum_un (unsigned long bignum_value)
+{
+  Lisp_Bignum *b;
+
+  ALLOC_FROB_BLOCK_LISP_OBJECT (bignum, Lisp_Bignum, b, &lrecord_bignum);
+  bignum_init (bignum_data (b));
+  bignum_set_ulong (bignum_data (b), bignum_value);
+  return wrap_bignum (b);
+}
+
+/* WARNING: This function returns a bignum even if its argument fits into a
+   fixnum.  See Fcanonicalize_number(). */
+Lisp_Object
+make_bignum_ll (long long bignum_value)
+{
+  Lisp_Bignum *b;
+
+  ALLOC_FROB_BLOCK_LISP_OBJECT (bignum, Lisp_Bignum, b, &lrecord_bignum);
+  bignum_init (bignum_data (b));
+  bignum_set_llong (bignum_data (b), bignum_value);
+  return wrap_bignum (b);
+}
+
+/* WARNING: This function returns a bignum even if its argument fits into a
+   fixnum.  See Fcanonicalize_number(). */
+Lisp_Object
+make_bignum_ull (unsigned long long bignum_value)
+{
+  Lisp_Bignum *b;
+
+  ALLOC_FROB_BLOCK_LISP_OBJECT (bignum, Lisp_Bignum, b, &lrecord_bignum);
+  bignum_init (bignum_data (b));
+  bignum_set_ullong (bignum_data (b), bignum_value);
+  return wrap_bignum (b);
+}
+
+/* WARNING: This function returns a bignum even if its argument fits into a
+   fixnum.  See Fcanonicalize_number(). */
+Lisp_Object
 make_bignum_bg (bignum bg)
 {
   Lisp_Bignum *b;

File src/chartab.c

       break;
 
     case CHAR_TABLE_TYPE_SYNTAX:
-      return make_integer (Sinherit);
+      return make_fixnum (Sinherit);
       break;
     }
   ABORT();

File src/config.h.in

 #undef WITH_MP
 #undef MP_PREFIX
 #undef HAVE_MP_MOVE
+#undef HAVE_MP_SET_MEMORY_FUNCTIONS
 
 #undef SIZEOF_SHORT
 #undef SIZEOF_INT
 	  break;
 #ifdef HAVE_BIGNUM
 	case BIGNUM_T:
-	  bignum_add (scratch_bignum, XBIGNUM_DATA (accum),
+	  bignum_add (XBIGNUM_DATA (accum), XBIGNUM_DATA (accum),
 		      XBIGNUM_DATA (addend));
-	  accum = make_bignum_bg (scratch_bignum);
 	  break;
 #endif
 #ifdef HAVE_RATIO
 	case RATIO_T:
-	  ratio_add (scratch_ratio, XRATIO_DATA (accum),
+	  ratio_add (XRATIO_DATA (accum), XRATIO_DATA (accum),
 		     XRATIO_DATA (addend));
-	  accum = make_ratio_rt (scratch_ratio);
 	  break;
 #endif
 	case FLOAT_T:
 	  break;
 #ifdef HAVE_BIGFLOAT
 	case BIGFLOAT_T:
-	  bigfloat_set_prec (scratch_bigfloat,
+	  bigfloat_set_prec (XBIGFLOAT_DATA (accum),
 			     max (XBIGFLOAT_GET_PREC (addend),
 				  XBIGFLOAT_GET_PREC (accum)));
-	  bigfloat_add (scratch_bigfloat, XBIGFLOAT_DATA (accum),
+	  bigfloat_add (XBIGFLOAT_DATA (accum), XBIGFLOAT_DATA (accum),
 			XBIGFLOAT_DATA (addend));
-	  accum = make_bigfloat_bf (scratch_bigfloat);
 	  break;
 #endif
 	}
 	{
 #ifdef HAVE_BIGNUM
 	case BIGNUM_T:
-	  bignum_mul (scratch_bignum, XBIGNUM_DATA (accum),
+	  bignum_mul (XBIGNUM_DATA (accum), XBIGNUM_DATA (accum),
 		      XBIGNUM_DATA (multiplier));
-	  accum = make_bignum_bg (scratch_bignum);
 	  break;
 #endif
 #ifdef HAVE_RATIO
 	case RATIO_T:
-	  ratio_mul (scratch_ratio, XRATIO_DATA (accum),
+	  ratio_mul (XRATIO_DATA (accum), XRATIO_DATA (accum),
 		     XRATIO_DATA (multiplier));
-	  accum = make_ratio_rt (scratch_ratio);
 	  break;
 #endif
 	case FLOAT_T:
 	  break;
 #ifdef HAVE_BIGFLOAT
 	case BIGFLOAT_T:
-	  bigfloat_set_prec (scratch_bigfloat,
+	  bigfloat_set_prec (XBIGFLOAT_DATA (accum),
 			     max (XBIGFLOAT_GET_PREC (multiplier),
 				  XBIGFLOAT_GET_PREC (accum)));
-	  bigfloat_mul (scratch_bigfloat, XBIGFLOAT_DATA (accum),
+	  bigfloat_mul (XBIGFLOAT_DATA (accum), XBIGFLOAT_DATA (accum),
 			XBIGFLOAT_DATA (multiplier));
-	  accum = make_bigfloat_bf (scratch_bigfloat);
 	  break;
 #endif
 	}
     }
 
 #ifndef HAVE_BIGNUM
-  size = make_integer (NUMBER_FITS_IN_A_FIXNUM (s.st_size) ?
-		       (EMACS_INT)s.st_size : -1);
+  size = make_fixnum (NUMBER_FITS_IN_A_FIXNUM (s.st_size) ?
+		      (EMACS_INT)s.st_size : -1);
 #else
   size = make_integer (s.st_size);
 #endif
 
   if (NILP(id_format) || EQ (id_format, Qinteger))
     {
-      uidInfo = make_integer (s.st_uid);
-      gidInfo = make_integer (s.st_gid);
+      uidInfo = make_unsigned_integer (s.st_uid);
+      gidInfo = make_unsigned_integer (s.st_gid);
     }
   else
     {
   
   RETURN_UNGCPRO (listn (12,
 			 mode,
-			 make_integer (s.st_nlink),
+			 make_unsigned_integer (s.st_nlink),
 			 uidInfo,
 			 gidInfo,
 			 make_time (s.st_atime),
 			 size,
 			 modestring,
 			 gid,
-			 make_integer (s.st_ino),
-			 make_integer (s.st_dev)));
+			 make_unsigned_integer (s.st_ino),
+			 make_unsigned_integer (s.st_dev)));
 }
 
 

File src/elhash.c

           /* hash_table_size() can't handle excessively large sizes. */
           maybe_signal_error_1 (Qargs_out_of_range,
                                 list3 (value, Qzero,
-                                       make_integer (MOST_POSITIVE_FIXNUM)),
+                                       make_fixnum (MOST_POSITIVE_FIXNUM)),
                                 Qhash_table, errb);
           return 0;
         }
 	 in case it expands into another macro call.  */
       if (SYMBOLP (form))
         {
-          Lisp_Object hashed = make_integer ((EMACS_INT) (LISP_HASH (form)));
+          Lisp_Object hashed = make_unsigned_integer (LISP_HASH (form));
           Lisp_Object assocked;
 
           if (BIGNUMP (hashed))
   REGISTER int i;
   Lisp_Object tem;
 
-  check_integer_range (nframes, Qzero, make_integer (MOST_POSITIVE_FIXNUM));
+  check_integer_range (nframes, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM));
 
   /* Find the frame requested.  */
   for (i = XFIXNUM (nframes); backlist && (i-- > 0);)

File src/event-stream.c

       if (!NILP (timeout_msecs))
 	{
           check_integer_range (timeout_msecs, Qzero,
-                               make_integer (MOST_POSITIVE_FIXNUM));
+                               make_fixnum (MOST_POSITIVE_FIXNUM));
 	  msecs += XFIXNUM (timeout_msecs);
 	}
       if (msecs)
   else
     {
       check_integer_range (number, Qzero,
-                           make_integer (ARRAY_DIMENSION_LIMIT));
+                           make_fixnum (ARRAY_DIMENSION_LIMIT));
       nwanted = XFIXNUM (number);
     }
 

File src/events.c

 	else if (EQ (keyword, Qtimestamp))
 	  {
 #ifdef HAVE_BIGNUM
-            check_integer_range (value, Qzero, make_integer (UINT_MAX));
+            check_integer_range (value, Qzero, make_unsigned_integer (UINT_MAX));
             if (BIGNUMP (value))
               {
                 SET_EVENT_TIMESTAMP (e, bignum_to_uint (XBIGNUM_DATA (value)));
               }
 #else
-            check_integer_range (value, Qzero, make_integer (MOST_POSITIVE_FIXNUM));
+            check_integer_range (value, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM));
 #endif
             if (FIXNUMP (value))
               {
 {
   EMACS_INT t1, t2;
 
-  check_integer_range (time1, Qzero, make_integer (MOST_POSITIVE_FIXNUM));
-  check_integer_range (time2, Qzero, make_integer (MOST_POSITIVE_FIXNUM));
+  check_integer_range (time1, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM));
+  check_integer_range (time2, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM));
 
   t1 = XFIXNUM (time1);
   t2 = XFIXNUM (time2);

File src/font-mgr.c

       check_integer_range (id, Qzero, make_integer (INT_MAX));
       int_id = BIGNUMP (id) ? bignum_to_int (XBIGNUM_DATA (id)) : XFIXNUM (id);
 #else
-      check_integer_range (id, Qzero, make_integer (MOST_POSITIVE_FIXNUM));
+      check_integer_range (id, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM));
       int_id = XFIXNUM (id);      
 #endif
     }

File src/glyphs.c

 check_valid_xbm_inline (Lisp_Object data)
 {
   Lisp_Object width, height, bits, args[2];
+  unsigned long i_width, i_height;
 
   if (!CONSP (data) ||
       !CONSP (XCDR (data)) ||
 
   CHECK_STRING (bits);
 
-  if (!NATNUMP (width))
+  if (!FIXNUMP (width) || XREALFIXNUM (width) < 0)
     invalid_argument ("Width must be a natural number", width);
 
-  if (!NATNUMP (height))
+  if (!FIXNUMP (height) || XREALFIXNUM (height) < 0)
     invalid_argument ("Height must be a natural number", height);
 
-  args[0] = width;
-  args[1] = height;
-
-  args[0] = Ftimes (countof (args), args);
-  args[1] = make_integer (8);
-
-  args[0] = Fquo (countof (args), args);
-  args[1] = make_integer (string_char_length (bits));
-
-  if (!NILP (Fgtr (countof (args), args)))
+  i_width = (unsigned long) XREALFIXNUM (width);
+  i_height = (unsigned long) XREALFIXNUM (height);
+  if (i_width * i_height / 8UL > string_char_length (bits))
     invalid_argument ("data is too short for width and height",
 			 vector3 (width, height, bits));
 }

File src/indent.c

   buffer = wrap_buffer (buf);
   if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
 
-  check_integer_range (column, Qzero, make_integer (MOST_POSITIVE_FIXNUM));
+  check_integer_range (column, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM));
   goal = XFIXNUM (column);
 
  retry:
 
 #define FIXNUM_VALBITS (BITS_PER_EMACS_INT - FIXNUM_GCBITS)
 #define VALBITS (BITS_PER_EMACS_INT - GCBITS)
-#define MOST_POSITIVE_FIXNUM ((EMACS_INT) ((1UL << (FIXNUM_VALBITS - 1)) -1UL))
+#define MOST_POSITIVE_FIXNUM_UNSIGNED ((1UL << (FIXNUM_VALBITS - 1)) -1UL)
+#define MOST_POSITIVE_FIXNUM ((EMACS_INT) MOST_POSITIVE_FIXNUM_UNSIGNED)
 #define MOST_NEGATIVE_FIXNUM (-(MOST_POSITIVE_FIXNUM) - 1)
 /* WARNING: evaluates its arg twice. */
 #define NUMBER_FITS_IN_A_FIXNUM(num) \
   ((num) <= MOST_POSITIVE_FIXNUM && (num) >= MOST_NEGATIVE_FIXNUM)
+#define UNSIGNED_NUMBER_FITS_IN_A_FIXNUM(num) \
+  ((num) <= MOST_POSITIVE_FIXNUM_UNSIGNED)
 
 #ifdef USE_UNION_TYPE
 # include "lisp-union.h"

File src/number-gmp.c

 static mp_exp_t float_print_min, float_print_max;
 gmp_randstate_t random_state;
 
+long long
+bignum_to_llong (const bignum b)
+{
+  long long l;
+
+  mpz_export (&l, NULL, 1, sizeof (l), 0, 0U, b);
+  return (mpz_sgn (b) < 0) ? -l : l;
+}
+
+unsigned long long
+bignum_to_ullong (const bignum b)
+{
+  unsigned long long l;
+
+  mpz_export (&l, NULL, 1, sizeof (l), 0, 0U, b);
+  return l;
+}
+
+void
+bignum_set_llong (bignum b, long long l)
+{
+  if (l < 0LL)
+    {
+      /* This even works for LLONG_MIN.  Try it! */
+      l = -l;
+      mpz_import (b, 1U, 1, sizeof (l), 0, 0U, &l);
+      mpz_neg (b, b);
+    }
+  else
+    {
+      mpz_import (b, 1U, 1, sizeof (l), 0, 0U, &l);
+    }
+}
+
 CIbyte *
-bigfloat_to_string(mpf_t f, int base)
+bigfloat_to_string (mpf_t f, int base)
 {
   mp_exp_t expt;
   CIbyte *str = mpf_get_str (NULL, &expt, base, 0, f);
 
 /* We need the next two functions since GNU MP insists on giving us an extra
    parameter. */
-static void *gmp_realloc (void *ptr, size_t UNUSED (old_size), size_t new_size)
+static void *
+gmp_realloc (void *ptr, size_t UNUSED (old_size), size_t new_size)
 {
   return xrealloc (ptr, new_size);
 }
 
-static void gmp_free (void *ptr, size_t UNUSED (size))
+static void
+gmp_free (void *ptr, size_t UNUSED (size))
 {
   xfree (ptr);
 }

File src/number-gmp.h

 #define bignum_fits_uint_p(b)           mpz_fits_uint_p (b)
 #define bignum_fits_long_p(b)           mpz_fits_slong_p (b)
 #define bignum_fits_ulong_p(b)          mpz_fits_ulong_p (b)
+#define bignum_fits_llong_p(b)					\
+  (mpz_sizeinbase (b, 2) <= (sizeof(long long) << 3) - 1U)
+#define bignum_fits_ullong_p(b)						\
+  (mpz_sgn (b) >= 0 &&							\
+   mpz_sizeinbase (b, 2) <= (sizeof(unsigned long long) << 3))
 
 /***** Bignum: conversions *****/
 #define bignum_to_string(b,base)        mpz_get_str (NULL, base, b)
 #define bignum_to_uint(b)               ((unsigned int) mpz_get_ui (b))
 #define bignum_to_long(b)               mpz_get_si (b)
 #define bignum_to_ulong(b)              mpz_get_ui (b)
+extern long long bignum_to_llong(const bignum b);
+extern unsigned long long bignum_to_ullong(const bignum b);
 #define bignum_to_double(b)             mpz_get_d (b)
 
 /***** Bignum: converting assignments *****/
 #define bignum_set_string(b,s,base)     mpz_set_str (b, s, base)
 #define bignum_set_long(b,l)            mpz_set_si (b, l)
 #define bignum_set_ulong(b,l)           mpz_set_ui (b, l)
+extern void bignum_set_llong(bignum b, long long l);
+#define bignum_set_ullong(b,l)          mpz_import (b,1U,1,sizeof (l),0,0U,&l)
 #define bignum_set_double(b,f)          mpz_set_d (b, f)
 #define bignum_set_ratio(b,r)           mpz_set_q (b, r)
 #define bignum_set_bigfloat(b,f)        mpz_set_f (b, f)

File src/number-mp.c

 #include <config.h>
 #include <limits.h>
 #include <math.h>
+#include <stdlib.h>
 #include "lisp.h"
 
-static MINT *bignum_bytesize, *bignum_long_sign_bit, *bignum_one, *bignum_two;
+static MINT *bignum_bytesize, *bignum_one, *bignum_two;
 MINT *bignum_zero, *intern_bignum;
 MINT *bignum_min_int, *bignum_max_int, *bignum_max_uint;
 MINT *bignum_min_long, *bignum_max_long, *bignum_max_ulong;
+MINT *bignum_min_llong, *bignum_max_llong, *bignum_max_ullong;
 short div_rem;
 
 char *
   return retval;
 }
 
+long long
+bignum_to_llong (bignum b)
+{
+  short rem, sign;
+  unsigned long long retval = 0LL;
+  REGISTER unsigned int i;
+  MINT *quo;
+
+  sign = bignum_sign (b);
+  BIGNUM_TO_TYPE (long long, unsigned long long);
+  return ((long long) retval) * sign;
+}
+
+unsigned long long
+bignum_to_ullong (bignum b)
+{
+  short rem, sign;
+  unsigned long long retval = 0UL;
+  REGISTER unsigned int i;
+  MINT *quo;
+
+  sign = bignum_sign (b);
+  BIGNUM_TO_TYPE (unsigned long long, unsigned long long);
+  return retval;
+}
+
 double
 bignum_to_double (bignum b)
 {
       MP_MADD (b, temp, b);
       MP_MFREE (temp);
     }
+  MP_MFREE (mbase);
 
   if (neg)
     MP_MSUB (bignum_zero, b, b);
 }
 
 void
-bignum_set_long (MINT *b, long l)
+bignum_set_long (bignum b, long l)
 {
-  /* Negative l is hard, not least because -LONG_MIN == LONG_MIN.  We pretend
-     that l is unsigned, then subtract off the amount equal to the sign bit. */
-  bignum_set_ulong (b, (unsigned long) l);
-  if (l < 0L)
-    MP_MSUB (b, bignum_long_sign_bit, b);
+  char hex[SIZEOF_LONG * 2U + 2U];
+  MINT *temp;
+  int neg = l < 0L;
+
+  snprintf (hex, SIZEOF_LONG * 2U + 2U, "%lx",
+	    neg ? (unsigned long) -l : (unsigned long) l);
+  temp = MP_XTOM (hex);
+  if (neg)
+    MP_MSUB (bignum_zero, temp, b);
+  else
+    MP_MOVE (temp, b);
+  MP_MFREE (temp);
 }
 
 void
 bignum_set_ulong (bignum b, unsigned long l)
 {
-  REGISTER unsigned int i;
-  MINT *multiplier = MP_ITOM (1);
+  char hex[SIZEOF_LONG * 2U + 2U];
+  MINT *temp;
 
-  MP_MOVE (bignum_zero, b);
-  for (i = 0UL; l > 0UL; l >>= 8, i++)
-    {
-      MINT *temp = MP_ITOM ((short) (l & 255));
-      MP_MULT (multiplier, temp, temp);
-      MP_MADD (b, temp, b);
-      MP_MULT (multiplier, bignum_bytesize, multiplier);
-      MP_MFREE (temp);
-    }
-  MP_MFREE (multiplier);
+  snprintf (hex, SIZEOF_LONG * 2U + 2U, "%lx", l);
+  temp = MP_XTOM (hex);
+  MP_MOVE (temp, b);
+  MP_MFREE (temp);
+}
+
+void
+bignum_set_llong (bignum b, long long l)
+{
+  char hex[SIZEOF_LONG_LONG * 2U + 2U];
+  MINT *temp;
+  int neg = l < 0LL;
+
+  snprintf (hex, SIZEOF_LONG_LONG * 2U + 2U, "%llx",
+	    neg ? (unsigned long long) -l : (unsigned long long) l);
+  temp = MP_XTOM (hex);
+  if (neg)
+    MP_MSUB (bignum_zero, temp, b);
+  else
+    MP_MOVE (temp, b);
+  MP_MFREE (temp);
+}
+
+void
+bignum_set_ullong (bignum b, unsigned long long l)
+{
+  char hex[SIZEOF_LONG_LONG * 2U + 2U];
+  MINT *temp;
+
+  snprintf (hex, SIZEOF_LONG_LONG * 2U + 2U, "%llx", l);
+  temp = MP_XTOM (hex);
+  MP_MOVE (temp, b);
+  MP_MFREE (temp);
 }
 
 void
 {
   MINT *num = MP_ITOM (0);
 
-  /* See if the bit is already set, and subtract it off if not */
+  /* See if the bit is set, and subtract it off if so */
   MP_MOVE (b, intern_bignum);
   bignum_pow (num, bignum_two, bit);
   bignum_ior (intern_bignum, intern_bignum, num);
   MP_MDIV (b, intern_bignum, result, intern_bignum);
 }
 
-void bignum_random_seed(unsigned long seed)
+void
+bignum_random (bignum result, bignum limit)
 {
-  /* FIXME: Implement me */
+  MINT *denominator = MP_ITOM (0), *divisor = MP_ITOM (0);
+  bignum_set_long (denominator, RAND_MAX);
+  MP_MADD (denominator, bignum_one, denominator);
+  MP_MADD (limit, bignum_one, divisor);
+  MP_MDIV (denominator, divisor, denominator, intern_bignum);
+  MP_MFREE (divisor);
+
+  do
+    {
+      MINT *limitcmp = MP_ITOM (1);
+
+      /* Accumulate at least as many random bits as in LIMIT */
+      MP_MOVE (bignum_zero, result);
+      do
+	{
+	  bignum_lshift (limitcmp, limitcmp, FIXNUM_VALBITS);
+	  bignum_lshift (result, result, FIXNUM_VALBITS);
+	  bignum_set_long (intern_bignum, get_random ());
+	  MP_MADD (intern_bignum, result, result);
+	}
+      while (MP_MCMP (limitcmp, limit) <= 0);
+      MP_MDIV (result, denominator, result, intern_bignum);
+      MP_MFREE (limitcmp);
+    }
+  while (MP_MCMP (limit, result) <= 0);
+
+  MP_MFREE (denominator);
 }
 
-void bignum_random(bignum result, bignum limit)
+#ifdef HAVE_MP_SET_MEMORY_FUNCTIONS
+/* We need the next two functions due to the extra parameter. */
+static void *
+mp_realloc (void *ptr, size_t UNUSED (old_size), size_t new_size)
 {
-  /* FIXME: Implement me */
-  MP_MOVE (bignum_zero, result);
+  return xrealloc (ptr, new_size);
 }
 
+static void
+mp_free (void *ptr, size_t UNUSED (size))
+{
+  xfree (ptr);
+}
+#endif
+
 void
 init_number_mp ()
 {
-  REGISTER unsigned int i;
+#ifdef HAVE_MP_SET_MEMORY_FUNCTIONS
+  mp_set_memory_functions ((void *(*) (size_t)) xmalloc, mp_realloc, mp_free);
+#endif
 
   bignum_zero = MP_ITOM (0);
   bignum_one = MP_ITOM (1);
      number-mp.h.  Its value is immaterial. */
   intern_bignum = MP_ITOM (0);
 
-  /* bignum_bytesize holds the number of bits in a byte. */
+  /* The multiplier used to shift a number left by one byte's worth of bits */
   bignum_bytesize = MP_ITOM (256);
 
-  /* bignum_long_sign_bit holds an adjustment for negative longs. */
-  bignum_long_sign_bit = MP_ITOM (256);
-  for (i = 1UL; i < sizeof (long); i++)
-    MP_MULT (bignum_bytesize, bignum_long_sign_bit, bignum_long_sign_bit);
-
   /* The MP interface only supports turning short ints into MINTs, so we have
      to set these the hard way. */
 
 
   bignum_max_ulong = MP_ITOM (0);
   bignum_set_ulong (bignum_max_ulong, ULONG_MAX);
+
+  bignum_min_llong = MP_ITOM (0);
+  bignum_set_llong (bignum_min_llong, LLONG_MIN);
+
+  bignum_max_llong = MP_ITOM (0);
+  bignum_set_llong (bignum_max_llong, LLONG_MAX);
+
+  bignum_max_ullong = MP_ITOM (0);
+  bignum_set_ullong (bignum_max_ullong, ULLONG_MAX);
 }

File src/number-mp.h

 #ifdef MP_PREFIX
 #define MP_GCD   mp_gcd
 #define MP_ITOM  mp_itom
+#define MP_XTOM  mp_xtom
 #define MP_MADD  mp_madd
 #define MP_MCMP  mp_mcmp
 #define MP_MDIV  mp_mdiv
 #else
 #define MP_GCD   gcd
 #define MP_ITOM  itom
+#define MP_XTOM  xtom
 #define MP_MADD  madd
 #define MP_MCMP  mcmp
 #define MP_MDIV  mdiv
 extern MINT *bignum_zero, *intern_bignum;
 extern MINT *bignum_min_int, *bignum_max_int, *bignum_max_uint;
 extern MINT *bignum_min_long, *bignum_max_long, *bignum_max_ulong;
+extern MINT *bignum_min_llong, *bignum_max_llong, *bignum_max_ullong;
 extern short div_rem;
 
 /***** Bignum: basic functions *****/
 				     MP_MCMP (b, bignum_max_long) <= 0)
 #define bignum_fits_ulong_p(b)      (MP_MCMP (b, bignum_zero) >= 0 &&	\
 				     MP_MCMP (b, bignum_max_ulong) <= 0)
+#define bignum_fits_llong_p(b)      (MP_MCMP (b, bignum_min_llong) >= 0 && \
+				     MP_MCMP (b, bignum_max_llong) <= 0)
+#define bignum_fits_ullong_p(b)     (MP_MCMP (b, bignum_zero) >= 0 &&	\
+				     MP_MCMP (b, bignum_max_ullong) <= 0)
 
 /***** Bignum: conversions *****/
 extern char *bignum_to_string(bignum, int);
 extern unsigned int bignum_to_uint(bignum);
 extern long bignum_to_long(bignum);
 extern unsigned long bignum_to_ulong(bignum);
+extern long long bignum_to_llong(bignum);
+extern unsigned long long bignum_to_ullong(bignum);
 extern double bignum_to_double(bignum);
 
 /***** Bignum: converting assignments *****/
 extern int bignum_set_string(bignum, const char *, int);
 extern void bignum_set_long(bignum, long);
 extern void bignum_set_ulong(bignum, unsigned long);
+extern void bignum_set_llong(bignum, long long);
+extern void bignum_set_ullong(bignum, unsigned long long);
 extern void bignum_set_double(bignum, double);
 
 /***** Bignum: comparisons *****/
 extern void bignum_rshift(bignum, bignum, unsigned long);
 
 /***** Bignum: random numbers *****/
-extern void bignum_random_seed(unsigned long);
+#define bignum_random_seed(s)
 extern void bignum_random(bignum, bignum);
 
 #endif /* INCLUDED_number_mp_h_ */

File src/number.h

 # define bignum_fits_emacs_int_p(b) bignum_fits_int_p(b)
 # define bignum_to_emacs_int(b) bignum_to_int(b)
 #else
-# error Bignums currently do not work with long long Emacs integers.
+# define bignum_fits_emacs_int_p(b) bignum_fits_llong_p(b)
+# define bignum_to_emacs_int(b) bignum_to_llong(b)
 #endif
 
 extern Lisp_Object make_bignum (long);
+extern Lisp_Object make_bignum_un (unsigned long);
+extern Lisp_Object make_bignum_ll (long long);
+extern Lisp_Object make_bignum_ull (unsigned long long);
 extern Lisp_Object make_bignum_bg (bignum);
 extern bignum scratch_bignum, scratch_bignum2;
 
 #define CONCHECK_BIGNUM(x) dead_wrong_type_argument (Qbignump, x)
 typedef void bignum;
 #define make_bignum(l)     This XEmacs does not support bignums
+#define make_bignum_ll(l)  This XEmacs does not support bignums
 #define make_bignum_bg(b)  This XEmacs does not support bignums
 
 #endif /* HAVE_BIGNUM */
 }  while (0)
 
 #ifdef HAVE_BIGNUM
-#define make_integer(x) \
-  (NUMBER_FITS_IN_A_FIXNUM (x) ? make_fixnum (x) : make_bignum (x))
+#define make_integer(x)							\
+  (NUMBER_FITS_IN_A_FIXNUM (x) ? make_fixnum (x)			\
+   : (sizeof (x) > SIZEOF_LONG ? make_bignum_ll (x) : make_bignum (x)))
+#define make_unsigned_integer(x)					\
+  (UNSIGNED_NUMBER_FITS_IN_A_FIXNUM (x) ? make_fixnum (x)		\
+   : (sizeof (x) > SIZEOF_LONG ? make_bignum_ull (x) : make_bignum_un (x)))
 #else
 #define make_integer(x) make_fixnum (x)
+#define make_unsigned_integer(x) make_fixnum ((EMACS_INT) x)
 #endif
 
 extern Fixnum Vmost_negative_fixnum, Vmost_positive_fixnum;
 
 #ifdef HAVE_BIGNUM
 #define NATNUMP(x) ((FIXNUMP (x) && XFIXNUM (x) >= 0) || \
-                    (BIGNUMP (x) && bignum_sign (XBIGNUM_DATA (x)) >= 0))
+		    (BIGNUMP (x) && bignum_sign (XBIGNUM_DATA (x)) >= 0))
 #else
 #define NATNUMP(x) (FIXNUMP (x) && XFIXNUM (x) >= 0)
 #endif
   if (LRECORDP (object))
     {
       switch (XRECORD_LHEADER (object)->type)
-        {
-        case lrecord_type_float:
+	{
+	case lrecord_type_float:
 #ifdef HAVE_BIGNUM
-        case lrecord_type_bignum:
+	case lrecord_type_bignum:
 #endif
 #ifdef HAVE_RATIO
-        case lrecord_type_ratio:
+	case lrecord_type_ratio:
 #endif
 #ifdef HAVE_BIGFLOAT
-        case lrecord_type_bigfloat:
+	case lrecord_type_bigfloat:
 #endif
-          return 1;
-        }
+	  return 1;
+	}
     }
   return 0;
 }

File src/process.c

        (process, height, width))
 {
   CHECK_PROCESS (process);
-  check_integer_range (height, Qzero, make_integer (MOST_POSITIVE_FIXNUM));
-  check_integer_range (width, Qzero, make_integer (MOST_POSITIVE_FIXNUM));
+  check_integer_range (height, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM));
+  check_integer_range (width, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM));
   return
     MAYBE_INT_PROCMETH (set_window_size,
 			(XPROCESS (process), XFIXNUM (height), XFIXNUM (width))) <= 0

File src/profile.c

                                              XFIXNUM (microsecs);
 #else
       check_integer_range (microsecs, make_fixnum (1000),
-                           make_integer (MOST_POSITIVE_FIXNUM));
+                           make_fixnum (MOST_POSITIVE_FIXNUM));
       msecs = XFIXNUM (microsecs);
 #endif
     }

File src/unicode.c

 
   CHECK_CHAR (character);
 
-  check_integer_range (code, Qzero, make_integer (MOST_POSITIVE_FIXNUM));
+  check_integer_range (code, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM));
 
   unicode = XFIXNUM (code);
   ichar = XCHAR (character);
   int lbs[NUM_LEADING_BYTES];
   int c;
 
-  check_integer_range (code, Qzero, make_integer (MOST_POSITIVE_FIXNUM));
+  check_integer_range (code, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM));
   c = XFIXNUM (code);
   {
     EXTERNAL_LIST_LOOP_2 (elt, charsets)
     return make_char (ret);
   }
 #else
-  check_integer_range (code, Qzero, make_integer (MOST_POSITIVE_FIXNUM));
+  check_integer_range (code, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM));
   return Fint_to_char (code);
 #endif /* MULE */
 }

File tests/ChangeLog

+2013-06-17  Jerry James  <james@xemacs.org>
+
+	* automated/lisp-tests.el: Adjust expected failure message due to
+	changes in check_valid_xbm_inline().
+
 2013-04-20  Mats Lidell  <matsl@xemacs.org>
 
 	* automated/dired-tests.el: New. Tests for file-attributes.

File tests/automated/lisp-tests.el

   (when (featurep 'xbm)
     (Check-Error-Message
      invalid-argument
-     "^data is too short for width and height"
+     "^Height must be a natural number"
      (set-face-background-pixmap
       'left-margin
       `[xbm :data (20 ,(* 2 most-positive-fixnum) "random-text")])))