changeset 5307:c096d8051f89

Have NATNUMP give t for positive bignums; check limits appropriately. src/ChangeLog addition: 2010-11-20 Aidan Kehoe <kehoea@parhasard.net> * abbrev.c (Fexpand_abbrev): * alloc.c: * alloc.c (Fmake_list): * alloc.c (Fmake_vector): * alloc.c (Fmake_bit_vector): * alloc.c (Fmake_byte_code): * alloc.c (Fmake_string): * alloc.c (vars_of_alloc): * bytecode.c (UNUSED): * bytecode.c (Fbyte_code): * chartab.c (decode_char_table_range): * cmds.c (Fself_insert_command): * data.c (check_integer_range): * data.c (Fnatnump): * data.c (Fnonnegativep): * data.c (Fstring_to_number): * elhash.c (hash_table_size_validate): * elhash.c (decode_hash_table_size): * eval.c (Fbacktrace_frame): * event-stream.c (lisp_number_to_milliseconds): * event-stream.c (Faccept_process_output): * event-stream.c (Frecent_keys): * event-stream.c (Fdispatch_event): * events.c (Fmake_event): * events.c (Fevent_timestamp): * events.c (Fevent_timestamp_lessp): * events.h: * events.h (struct command_builder): * file-coding.c (gzip_putprop): * fns.c: * fns.c (check_sequence_range): * fns.c (Frandom): * fns.c (Fnthcdr): * fns.c (Flast): * fns.c (Fnbutlast): * fns.c (Fbutlast): * fns.c (Fmember): * fns.c (Ffill): * fns.c (Freduce): * fns.c (replace_string_range_1): * fns.c (Freplace): * font-mgr.c (Ffc_pattern_get): * frame-msw.c (msprinter_set_frame_properties): * glyphs.c (check_valid_xbm_inline): * indent.c (Fmove_to_column): * intl-win32.c (mswindows_multibyte_to_unicode_putprop): * lisp.h: * lisp.h (ARRAY_DIMENSION_LIMIT): * lread.c (decode_mode_1): * mule-ccl.c (ccl_get_compiled_code): * number.h: * process-unix.c (unix_open_multicast_group): * process.c (Fset_process_window_size): * profile.c (Fstart_profiling): * unicode.c (Funicode_to_char): Change NATNUMP to return 1 for positive bignums; changes uses of it and of CHECK_NATNUM appropriately, usually by checking for an integer in an appropriate range. Add array-dimension-limit and use it in #'make-vector, #'make-string. Add array-total-size-limit, array-rank-limit while we're at it, for the sake of any Common Lisp-oriented code that uses these limits. Rename check_int_range to check_integer_range, have it take Lisp_Objects (and thus bignums) instead. Remove bignum_butlast(), just set int_n to an appropriately large integer if N is a bignum. Accept bignums in check_sequence_range(), change the functions that use check_sequence_range() appropriately. Move the definition of NATNUMP() to number.h; document why it's a reasonable name, contradicting an old comment. tests/ChangeLog addition: 2010-11-20 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: * automated/lisp-tests.el (featurep): * automated/lisp-tests.el (wrong-type-argument): * automated/mule-tests.el (featurep): Check for args-out-of-range errors instead of wrong-type-argument errors in various places when code is handed a large bignum instead of a fixnum. Also check for the wrong-type-argument errors when giving the same code a non-integer value.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 20 Nov 2010 16:49:11 +0000
parents cde1608596d0
children 17c381a2f377
files src/ChangeLog src/abbrev.c src/alloc.c src/bytecode.c src/chartab.c src/cmds.c src/data.c src/elhash.c src/eval.c src/event-stream.c src/events.c src/events.h src/file-coding.c src/fileio.c src/fns.c src/font-mgr.c src/frame-msw.c src/glyphs.c src/indent.c src/intl-win32.c src/lisp.h src/lread.c src/mule-ccl.c src/number.h src/process-unix.c src/process.c src/profile.c src/unicode.c tests/ChangeLog tests/automated/lisp-tests.el tests/automated/mule-tests.el
diffstat 31 files changed, 591 insertions(+), 213 deletions(-) [+]
line wrap: on
line diff
--- a/src/ChangeLog	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/ChangeLog	Sat Nov 20 16:49:11 2010 +0000
@@ -1,3 +1,76 @@
+2010-11-20  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* abbrev.c (Fexpand_abbrev):
+	* alloc.c:
+	* alloc.c (Fmake_list):
+	* alloc.c (Fmake_vector):
+	* alloc.c (Fmake_bit_vector):
+	* alloc.c (Fmake_byte_code):
+	* alloc.c (Fmake_string):
+	* alloc.c (vars_of_alloc):
+	* bytecode.c (UNUSED):
+	* bytecode.c (Fbyte_code):
+	* chartab.c (decode_char_table_range):
+	* cmds.c (Fself_insert_command):
+	* data.c (check_integer_range):
+	* data.c (Fnatnump):
+	* data.c (Fnonnegativep):
+	* data.c (Fstring_to_number):
+	* elhash.c (hash_table_size_validate):
+	* elhash.c (decode_hash_table_size):
+	* eval.c (Fbacktrace_frame):
+	* event-stream.c (lisp_number_to_milliseconds):
+	* event-stream.c (Faccept_process_output):
+	* event-stream.c (Frecent_keys):
+	* event-stream.c (Fdispatch_event):
+	* events.c (Fmake_event):
+	* events.c (Fevent_timestamp):
+	* events.c (Fevent_timestamp_lessp):
+	* events.h:
+	* events.h (struct command_builder):
+	* file-coding.c (gzip_putprop):
+	* fns.c:
+	* fns.c (check_sequence_range):
+	* fns.c (Frandom):
+	* fns.c (Fnthcdr):
+	* fns.c (Flast):
+	* fns.c (Fnbutlast):
+	* fns.c (Fbutlast):
+	* fns.c (Fmember):
+	* fns.c (Ffill):
+	* fns.c (Freduce):
+	* fns.c (replace_string_range_1):
+	* fns.c (Freplace):
+	* font-mgr.c (Ffc_pattern_get):
+	* frame-msw.c (msprinter_set_frame_properties):
+	* glyphs.c (check_valid_xbm_inline):
+	* indent.c (Fmove_to_column):
+	* intl-win32.c (mswindows_multibyte_to_unicode_putprop):
+	* lisp.h:
+	* lisp.h (ARRAY_DIMENSION_LIMIT):
+	* lread.c (decode_mode_1):
+	* mule-ccl.c (ccl_get_compiled_code):
+	* number.h:
+	* process-unix.c (unix_open_multicast_group):
+	* process.c (Fset_process_window_size):
+	* profile.c (Fstart_profiling):
+	* unicode.c (Funicode_to_char):
+	Change NATNUMP to return 1 for positive bignums; changes uses of
+	it and of CHECK_NATNUM appropriately, usually by checking for an
+	integer in an appropriate range.
+	Add array-dimension-limit and use it in #'make-vector,
+	#'make-string. Add array-total-size-limit, array-rank-limit while
+	we're at it, for the sake of any Common Lisp-oriented code that
+	uses these limits.
+	Rename check_int_range to check_integer_range, have it take
+	Lisp_Objects (and thus bignums) instead.
+	Remove bignum_butlast(), just set int_n to an appropriately large
+	integer if N is a bignum.
+	Accept bignums in check_sequence_range(), change the functions
+	that use check_sequence_range() appropriately.
+	Move the definition of NATNUMP() to number.h; document why it's a
+	reasonable name, contradicting an old comment.
+
 2010-11-17  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* fns.c (bignum_butlast): New.
--- a/src/abbrev.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/abbrev.c	Sat Nov 20 16:49:11 2010 +0000
@@ -343,7 +343,7 @@
     count = Qzero;
   else
     CHECK_NATNUM (count);
-  symbol_plist (abbrev_symbol) = make_int (1 + XINT (count));
+  symbol_plist (abbrev_symbol) = Fadd1 (count);
 
   /* Count the case in the original text. */
   abbrev_count_case (buf, abbrev_start, abbrev_length, &lccount, &uccount);
--- a/src/alloc.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/alloc.c	Sat Nov 20 16:49:11 2010 +0000
@@ -96,6 +96,8 @@
 static Fixnum debug_allocation_backtrace_length;
 #endif
 
+Fixnum Varray_dimension_limit, Varray_total_size_limit, Varray_rank_limit;
+
 int need_to_check_c_alloca;
 int need_to_signal_post_gc;
 int funcall_allocation_flag;
@@ -1500,16 +1502,17 @@
 */
        (length, object))
 {
-  CHECK_NATNUM (length);
-
-  {
-    Lisp_Object val = Qnil;
-    EMACS_INT size = XINT (length);
-
-    while (size--)
-      val = Fcons (object, val);
-    return val;
-  }
+  Lisp_Object val = Qnil;
+  Elemcount size;
+
+  check_integer_range (length, Qzero, make_integer (EMACS_INT_MAX));
+
+  size = XINT (length);
+
+  while (size--)
+    val = Fcons (object, val);
+
+  return val;
 }
 
 
@@ -1743,7 +1746,7 @@
 */
        (length, object))
 {
-  CONCHECK_NATNUM (length);
+  check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT));
   return make_vector (XINT (length), object);
 }
 
@@ -1925,8 +1928,7 @@
 */
        (length, bit))
 {
-  CONCHECK_NATNUM (length);
-
+  check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT));
   return make_bit_vector (XINT (length), bit);
 }
 
@@ -2052,7 +2054,7 @@
     CHECK_VECTOR (constants);
   f->constants = constants;
 
-  CHECK_NATNUM (stack_depth);
+  check_integer_range (stack_depth, Qzero, make_int (USHRT_MAX));
   f->stack_depth = (unsigned short) XINT (stack_depth);
 
 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
@@ -2884,7 +2886,7 @@
 */
        (length, character))
 {
-  CHECK_NATNUM (length);
+  check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT));
   CHECK_CHAR_COERCE_INT (character);
   {
     Ibyte init_str[MAX_ICHAR_LEN];
@@ -5739,6 +5741,34 @@
 void
 vars_of_alloc (void)
 {
+  DEFVAR_CONST_INT ("array-rank-limit", &Varray_rank_limit /*
+The exclusive upper bound on the number of dimensions an array may have.
+
+XEmacs does not support multidimensional arrays, meaning this constant is,
+for the moment, 2.
+*/);
+  Varray_rank_limit = 2;
+
+  DEFVAR_CONST_INT ("array-dimension-limit", &Varray_dimension_limit /*
+The exclusive upper bound of an array's dimension.
+Note that XEmacs may not have enough memory available to create an array
+with this dimension.
+*/);
+  Varray_dimension_limit = ARRAY_DIMENSION_LIMIT;
+
+  DEFVAR_CONST_INT ("array-total-size-limit", &Varray_total_size_limit /*
+The exclusive upper bound on the number of elements an array may contain.
+
+In Common Lisp, this is distinct from `array-dimension-limit', because
+arrays can have more than one dimension.  In XEmacs this is not the case,
+and multi-dimensional arrays need to be implemented by the user with arrays
+of arrays.
+
+Note that XEmacs may not have enough memory available to create an array
+with this dimension.
+*/);
+  Varray_total_size_limit = ARRAY_DIMENSION_LIMIT;
+
 #ifdef DEBUG_XEMACS
   DEFVAR_INT ("debug-allocation", &debug_allocation /*
 If non-zero, print out information to stderr about all objects allocated.
--- a/src/bytecode.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/bytecode.c	Sat Nov 20 16:49:11 2010 +0000
@@ -1731,8 +1731,9 @@
       {
         Lisp_Object upper = POP, first = TOP, speccount;
 
-        CHECK_NATNUM (upper);
-        CHECK_NATNUM (first);
+        check_integer_range (upper, Qzero,
+                             make_integer (Vmultiple_values_limit));
+        check_integer_range (first, Qzero, upper);
 
         speccount = make_int (bind_multiple_value_limits (XINT (first),
                                                           XINT (upper)));
@@ -2757,7 +2758,7 @@
 
   CHECK_STRING (instructions);
   CHECK_VECTOR (constants);
-  CHECK_NATNUM (stack_depth);
+  check_integer_range (stack_depth, Qzero, make_int (USHRT_MAX));
 
   /* Optimize the `instructions' string, just like when executing a
      regular compiled function, but don't save it for later since this is
--- a/src/chartab.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/chartab.c	Sat Nov 20 16:49:11 2010 +0000
@@ -257,10 +257,12 @@
 	  sferror ("Charset in row vector must be multi-byte",
 			       outrange->charset);
 	case CHARSET_TYPE_94X94:
-	  check_int_range (outrange->row, 33, 126);
+	  check_integer_range (make_int (outrange->row), make_int (33),
+                               make_int (126));
 	  break;
 	case CHARSET_TYPE_96X96:
-	  check_int_range (outrange->row, 32, 127);
+	  check_integer_range (make_int (outrange->row), make_int (32),
+                               make_int (127));
 	  break;
 	default:
 	  ABORT ();
--- a/src/cmds.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/cmds.c	Sat Nov 20 16:49:11 2010 +0000
@@ -334,7 +334,9 @@
   Lisp_Object c;
   EMACS_INT n;
 
-  CHECK_NATNUM (count);
+  /* Can't insert more than most-positive-fixnum characters, the buffer
+     won't hold that many. */
+  check_integer_range (count, Qzero, make_int (EMACS_INT_MAX));
   n = XINT (count);
 
   if (CHAR_OR_CHAR_INTP (Vlast_command_char))
--- a/src/data.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/data.c	Sat Nov 20 16:49:11 2010 +0000
@@ -158,10 +158,18 @@
 }
 
 void
-check_int_range (EMACS_INT val, EMACS_INT min, EMACS_INT max)
+check_integer_range (Lisp_Object val, Lisp_Object min, Lisp_Object max)
 {
-  if (val < min || val > max)
-    args_out_of_range_3 (make_int (val), make_int (min), make_int (max));
+  Lisp_Object args[] = { min, val, max };
+  int ii;
+
+  for (ii = 0; ii < countof (args); ii++)
+    {
+      CHECK_INTEGER (args[ii]);
+    }
+
+  if (NILP (Fleq (countof (args), args)))
+    args_out_of_range_3 (val, min, max);
 }
 
 
@@ -504,11 +512,7 @@
 */
        (object))
 {
-  return NATNUMP (object)
-#ifdef HAVE_BIGNUM
-    || (BIGNUMP (object) && bignum_sign (XBIGNUM_DATA (object)) >= 0)
-#endif
-    ? Qt : Qnil;
+  return NATNUMP (object) ? Qt : Qnil;
 }
 
 DEFUN ("nonnegativep", Fnonnegativep, 1, 1, 0, /*
@@ -517,9 +521,6 @@
        (object))
 {
   return NATNUMP (object)
-#ifdef HAVE_BIGNUM
-    || (BIGNUMP (object) && bignum_sign (XBIGNUM_DATA (object)) >= 0)
-#endif
 #ifdef HAVE_RATIO
     || (RATIOP (object) && ratio_sign (XRATIO_DATA (object)) >= 0)
 #endif
@@ -1295,9 +1296,8 @@
     b = 10;
   else
     {
-      CHECK_INT (base);
+      check_integer_range (base, make_int (2), make_int (16));
       b = XINT (base);
-      check_int_range (b, 2, 16);
     }
 
   p = XSTRING_DATA (string);
--- a/src/elhash.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/elhash.c	Sat Nov 20 16:49:11 2010 +0000
@@ -733,10 +733,27 @@
 			  Error_Behavior errb)
 {
   if (NATNUMP (value))
-    return 1;
+    {
+      if (BIGNUMP (value))
+        {
+          /* hash_table_size() can't handle excessively large sizes. */
+          maybe_signal_error_1 (Qargs_out_of_range,
+                                list3 (value, Qzero,
+                                       make_integer (EMACS_INT_MAX)),
+                                Qhash_table, errb);
+          return 0;
+        }
+      else
+        {
+          return 1;
+        }
+    }
+  else
+    {
+      maybe_signal_error_1 (Qwrong_type_argument, list2 (Qnatnump, value),
+                            Qhash_table, errb);
+    }
 
-  maybe_signal_error_1 (Qwrong_type_argument, list2 (Qnatnump, value),
-			Qhash_table, errb);
   return 0;
 }
 
--- a/src/eval.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/eval.c	Sat Nov 20 16:49:11 2010 +0000
@@ -4923,17 +4923,19 @@
     }
 
   argv[0] = IGNORE_MULTIPLE_VALUES (Feval (XCAR (args)));
-  CHECK_NATNUM (argv[0]);
-  first = XINT (argv[0]);
 
   GCPRO1 (argv[0]);
   gcpro1.nvars = 1;
 
   args = XCDR (args);
-
   argv[1] = IGNORE_MULTIPLE_VALUES (Feval (XCAR (args)));
-  CHECK_NATNUM (argv[1]);
+
+  check_integer_range (argv[1], Qzero, make_int (EMACS_INT_MAX));
+  check_integer_range (argv[0], Qzero, argv[1]);
+
   upper = XINT (argv[1]);
+  first = XINT (argv[0]);
+
   gcpro1.nvars = 2;
 
   /* The unintuitive order of things here is for the sake of the bytecode;
@@ -7205,7 +7207,7 @@
   REGISTER int i;
   Lisp_Object tem;
 
-  CHECK_NATNUM (nframes);
+  check_integer_range (nframes, Qzero, make_integer (EMACS_INT_MAX));
 
   /* Find the frame requested.  */
   for (i = XINT (nframes); backlist && (i-- > 0);)
--- a/src/event-stream.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/event-stream.c	Sat Nov 20 16:49:11 2010 +0000
@@ -1238,18 +1238,30 @@
 static unsigned long
 lisp_number_to_milliseconds (Lisp_Object secs, int allow_0)
 {
-  double fsecs;
-  CHECK_INT_OR_FLOAT (secs);
-  fsecs = XFLOATINT (secs);
-  if (fsecs < 0)
-    invalid_argument ("timeout is negative", secs);
-  if (!allow_0 && fsecs == 0)
-    invalid_argument ("timeout is non-positive", secs);
-  if (fsecs >= (((unsigned int) 0xFFFFFFFF) / 1000))
-    invalid_argument
-      ("timeout would exceed 32 bits when represented in milliseconds", secs);
-
-  return (unsigned long) (1000 * fsecs);
+  Lisp_Object args[] = { allow_0 ? Qzero : make_int (1),
+                         secs,
+                         /* (((unsigned int) 0xFFFFFFFF) / 1000) - 1 */
+                         make_int (4294967 - 1) };
+
+  if (!allow_0 && FLOATP (secs) && XFLOAT_DATA (secs) > 0)
+    {
+      args[0] = secs;
+    }
+
+  if (NILP (Fleq (countof (args), args)))
+    {
+      args_out_of_range_3 (secs, args[0], args[2]);
+    }
+  
+  args[0] = make_int (1000);
+  args[0] = Ftimes (2, args);
+
+  if (INTP (args[0]))
+    {
+      return XINT (args[0]);
+    }
+
+  return (unsigned long) extract_float (args[0]);
 }
 
 DEFUN ("add-timeout", Fadd_timeout, 3, 4, 0, /*
@@ -2615,7 +2627,8 @@
 	msecs = lisp_number_to_milliseconds (timeout_secs, 1);
       if (!NILP (timeout_msecs))
 	{
-	  CHECK_NATNUM (timeout_msecs);
+          check_integer_range (timeout_msecs, Qzero,
+                               make_integer (EMACS_INT_MAX));
 	  msecs += XINT (timeout_msecs);
 	}
       if (msecs)
@@ -3704,7 +3717,8 @@
     nwanted = recent_keys_ring_size;
   else
     {
-      CHECK_NATNUM (number);
+      check_integer_range (number, Qzero,
+                           make_integer (ARRAY_DIMENSION_LIMIT));
       nwanted = XINT (number);
     }
 
@@ -4519,7 +4533,7 @@
 	else /* key sequence is bound to a command */
 	  {
 	    int magic_undo = 0;
-	    int magic_undo_count = 20;
+	    Elemcount magic_undo_count = 20;
 
 	    Vthis_command = leaf;
 
@@ -4539,7 +4553,21 @@
 	      {
 		Lisp_Object prop = Fget (leaf, Qself_insert_defer_undo, Qnil);
 		if (NATNUMP (prop))
-		  magic_undo = 1, magic_undo_count = XINT (prop);
+                  {
+                    magic_undo = 1;
+                    if (INTP (prop))
+                      {
+                        magic_undo_count = XINT (prop);
+                      }
+#ifdef HAVE_BIGNUM
+                    else if (BIGNUMP (prop)
+                             && bignum_fits_emacs_int_p (XBIGNUM_DATA (prop)))
+                      {
+                        magic_undo_count
+                          = bignum_to_emacs_int (XBIGNUM_DATA (prop));
+                      }
+#endif
+                  }
 		else if (!NILP (prop))
 		  magic_undo = 1;
 		else if (EQ (leaf, Qself_insert_command))
--- a/src/events.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/events.c	Sat Nov 20 16:49:11 2010 +0000
@@ -641,8 +641,7 @@
 	  }
 	else if (EQ (keyword, Qbutton))
 	  {
-	    CHECK_NATNUM (value);
-	    check_int_range (XINT (value), 0, 7);
+	    check_integer_range (value, Qzero, make_int (26));
 
 	    switch (EVENT_TYPE (e))
 	      {
@@ -737,8 +736,23 @@
 	  }
 	else if (EQ (keyword, Qtimestamp))
 	  {
-	    CHECK_NATNUM (value);
-	    SET_EVENT_TIMESTAMP (e, XINT (value));
+#ifdef HAVE_BIGNUM
+            check_integer_range (value, Qzero, make_integer (UINT_MAX));
+            if (BIGNUMP (value))
+              {
+                SET_EVENT_TIMESTAMP (e, bignum_to_uint (XBIGNUM_DATA (value)));
+              }
+#else
+            check_integer_range (value, Qzero, make_integer (EMACS_INT_MAX));
+#endif
+            if (INTP (value))
+              {
+                SET_EVENT_TIMESTAMP (e, XINT (value));
+              }
+            else
+              {
+                ABORT ();
+              }
 	  }
 	else if (EQ (keyword, Qfunction))
 	  {
@@ -1747,7 +1761,9 @@
 {
   CHECK_LIVE_EVENT (event);
   /* This junk is so that timestamps don't get to be negative, but contain
-     as many bits as this particular emacs will allow.
+     as many bits as this particular emacs will allow. We could return
+     bignums on builds that support them, but that involves consing and
+     doesn't work on builds that don't support bignums.
    */
   return make_int (EMACS_INT_MAX & XEVENT_TIMESTAMP (event));
 }
@@ -1763,8 +1779,9 @@
 {
   EMACS_INT t1, t2;
 
-  CHECK_NATNUM (time1);
-  CHECK_NATNUM (time2);
+  check_integer_range (time1, Qzero, make_integer (EMACS_INT_MAX));
+  check_integer_range (time2, Qzero, make_integer (EMACS_INT_MAX));
+
   t1 = XINT (time1);
   t2 = XINT (time2);
 
--- a/src/events.h	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/events.h	Sat Nov 20 16:49:11 2010 +0000
@@ -1159,7 +1159,7 @@
      boundary: up to 20 consecutive self-inserts can happen before an undo-
      boundary is pushed.  This variable is that counter.
      */
-  int self_insert_countdown;
+  Elemcount self_insert_countdown;
 };
 
 #endif /* INCLUDED_events_h_ */
--- a/src/file-coding.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/file-coding.c	Sat Nov 20 16:49:11 2010 +0000
@@ -4310,8 +4310,7 @@
 	data->level = -1;
       else
 	{
-	  CHECK_INT (value);
-	  check_int_range (XINT (value), 0, 9);
+	  check_integer_range (value, Qzero, make_int (9));
 	  data->level = XINT (value);
 	}
     }
--- a/src/fileio.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/fileio.c	Sat Nov 20 16:49:11 2010 +0000
@@ -3294,7 +3294,7 @@
 	  Lisp_Object insval = call1 (p, make_int (inserted));
 	  if (!NILP (insval))
 	    {
-	      CHECK_NATNUM (insval);
+              check_integer_range (insval, Qzero, make_int (EMACS_INT_MAX));
 	      inserted = XINT (insval);
 	    }
 	}
--- a/src/fns.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/fns.c	Sat Nov 20 16:49:11 2010 +0000
@@ -78,13 +78,11 @@
 check_sequence_range (Lisp_Object sequence, Lisp_Object start,
 		      Lisp_Object end, Lisp_Object length)
 {
-  Elemcount starting = XINT (start), ending, len = XINT (length);
-
-  ending = NILP (end) ? XINT (length) : XINT (end);
-
-  if (!(0 <= starting && starting <= ending && ending <= len))
-    {
-      args_out_of_range_3 (sequence, start, make_int (ending));
+  Lisp_Object args[] = { Qzero, start, NILP (end) ? length : end, length };
+
+  if (NILP (Fleq (countof (args), args)))
+    {
+      args_out_of_range_3 (sequence, start, end);
     }
 }
 
@@ -228,6 +226,13 @@
     seed_random (qxe_getpid () + time (NULL));
   if (NATNUMP (limit) && !ZEROP (limit))
     {
+#ifdef HAVE_BIGNUM
+      if (BIGNUMP (limit))
+        {
+          bignum_random (scratch_bignum, XBIGNUM_DATA (limit));
+          return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+        }
+#endif
       /* Try to take our random number from the higher bits of VAL,
 	 not the lower, since (says Gentzel) the low bits of `random'
 	 are less random than the higher ones.  We do this by using the
@@ -240,13 +245,6 @@
 	val = get_random () / denominator;
       while (val >= XINT (limit));
     }
-#ifdef HAVE_BIGNUM
-  else if (BIGNUMP (limit))
-    {
-      bignum_random (scratch_bignum, XBIGNUM_DATA (limit));
-      return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
-    }
-#endif
   else
     val = get_random ();
 
@@ -1436,7 +1434,7 @@
   REGISTER EMACS_INT i;
   REGISTER Lisp_Object tail = list;
   CHECK_NATNUM (n);
-  for (i = XINT (n); i; i--)
+  for (i = BIGNUMP (n) ? 1 + EMACS_INT_MAX : XINT (n); i; i--)
     {
       if (CONSP (tail))
 	tail = XCDR (tail);
@@ -1556,7 +1554,7 @@
   else
     {
       CHECK_NATNUM (n);
-      int_n = XINT (n);
+      int_n = BIGNUMP (n) ? 1 + EMACS_INT_MAX : XINT (n);
     }
 
   for (retval = tortoise = hare = list, count = 0;
@@ -1576,9 +1574,6 @@
   return retval;
 }
 
-static Lisp_Object bignum_butlast (Lisp_Object list, Lisp_Object number,
-                                   Boolint copy);
-
 DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /*
 Modify LIST to remove the last N (default 1) elements.
 
@@ -1593,13 +1588,8 @@
 
   if (!NILP (n))
     {
-      if (BIGNUMP (n))
-        {
-          return bignum_butlast (list, n, 0);
-        }
-
       CHECK_NATNUM (n);
-      int_n = XINT (n);
+      int_n = BIGNUMP (n) ? 1 + EMACS_INT_MAX : XINT (n);
     }
 
   if (CONSP (list))
@@ -1646,13 +1636,8 @@
 
   if (!NILP (n))
     {
-      if (BIGNUMP (n))
-        {
-          return bignum_butlast (list, n, 1);
-        }
-
       CHECK_NATNUM (n);
-      int_n = XINT (n);
+      int_n = BIGNUMP (n) ? 1 + EMACS_INT_MAX : XINT (n);
     }
 
   if (CONSP (list))
@@ -1686,42 +1671,6 @@
   return retval;
 }
 
-/* This is sufficient to implement #'butlast and #'nbutlast with bignum N
-   under XEmacs, because #'list-length and #'safe-length can never return a
-   bignum. This means that #'nbutlast never has to modify and #'butlast
-   never has to copy. */
-static Lisp_Object
-bignum_butlast (Lisp_Object list, Lisp_Object number, Boolint copy)
-{
-  Boolint malformed = EQ (Fsafe_length (list), Qzero);
-  Boolint circular = !malformed && EQ (Flist_length (list), Qnil);
-
-  assert (BIGNUMP (number));
-
-#ifdef HAVE_BIGNUM
-
-  if (bignum_sign (XBIGNUM_DATA (number)) < 0)
-    {
-      dead_wrong_type_argument (Qnatnump, number);
-    }
-
-  number = Fcanonicalize_number (number);
-
-  if (INTP (number))
-    {
-      return copy ? Fbutlast (list, number) : Fnbutlast (list, number);
-    }
-
-#endif
-
-  if (circular)
-    {
-      signal_circular_list_error (list);
-    }
-
-  return Qnil;
-}
-
 DEFUN ("member", Fmember, 2, 2, 0, /*
 Return non-nil if ELT is an element of LIST.  Comparison done with `equal'.
 The value is actually the tail of LIST whose car is ELT.
@@ -4224,17 +4173,15 @@
 {
   Lisp_Object sequence = args[0];
   Lisp_Object item = args[1];
-  Elemcount starting = 0, ending = EMACS_INT_MAX, ii, len;
+  Elemcount starting = 0, ending = EMACS_INT_MAX + 1, ii, len;
 
   PARSE_KEYWORDS (Ffill, nargs, args, 2, (start, end), (start = Qzero));
 
   CHECK_NATNUM (start);
-  starting = XINT (start);
-
   if (!NILP (end))
     {
       CHECK_NATNUM (end);
-      ending = XINT (end);
+      ending = BIGNUMP (end) ? EMACS_INT_MAX + 1 : XINT (end);
     }
 
  retry:
@@ -4254,6 +4201,7 @@
 
       check_sequence_range (sequence, start, end, make_int (len));
       ending = min (ending, len);
+      starting = XINT (start);
 
       for (ii = starting; ii < ending; ++ii)
         {
@@ -4272,6 +4220,7 @@
 
       check_sequence_range (sequence, start, end, make_int (len));
       ending = min (ending, len);
+      starting = XINT (start);
 
       for (ii = starting; ii < ending; ++ii)
         {
@@ -4281,6 +4230,7 @@
   else if (LISTP (sequence))
     {
       Elemcount counting = 0;
+      starting = BIGNUMP (start) ? EMACS_INT_MAX + 1 : XINT (start);
 
       EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
         {
@@ -5235,7 +5185,7 @@
        (int nargs, Lisp_Object *args))
 {
   Lisp_Object function = args[0], sequence = args[1], accum = Qunbound;
-  Elemcount starting, ending = EMACS_INT_MAX, ii = 0;
+  Elemcount starting, ending = EMACS_INT_MAX + 1, ii = 0;
 
   PARSE_KEYWORDS (Freduce, nargs, args, 5,
                   (start, end, from_end, initial_value, key),
@@ -5243,7 +5193,7 @@
 
   CHECK_SEQUENCE (sequence);
   CHECK_NATNUM (start);
-
+  starting = BIGNUMP (start) ? EMACS_INT_MAX + 1 : XINT (start);
   CHECK_KEY_ARGUMENT (key);
 
 #define KEY(key, item) (EQ (Qidentity, key) ? item :			\
@@ -5251,16 +5201,10 @@
 #define CALL2(function, accum, item)				\
   IGNORE_MULTIPLE_VALUES (call2 (function, accum, item))
 
-  starting = XINT (start);
   if (!NILP (end))
     {
       CHECK_NATNUM (end);
-      ending = XINT (end);
-    }
-
-  if (!(starting <= ending))
-    {
-      check_sequence_range (sequence, start, end, Flength (sequence));
+      ending = BIGNUMP (end) ? EMACS_INT_MAX + 1 : XINT (end);
     }
 
   if (VECTORP (sequence))
@@ -5432,6 +5376,8 @@
 
 	  check_sequence_range (sequence, start, end, make_int (len));
           ending = min (ending, len);
+          starting = XINT (start);
+
           cursor = string_char_addr (sequence, ending - 1);
           cursor_offset = cursor - XSTRING_DATA (sequence);
 
@@ -5679,7 +5625,8 @@
   Ibyte *destp = XSTRING_DATA (dest), *p = destp,
     *pend = p + XSTRING_LENGTH (dest), *pcursor, item_buf[MAX_ICHAR_LEN];
   Bytecount prefix_bytecount, source_len = source_limit - source;
-  Charcount ii = 0, starting = XINT (start), ending, len;
+  Charcount ii = 0, ending, len;
+  Charcount starting = BIGNUMP (start) ? EMACS_INT_MAX + 1 : XINT (start);
   Elemcount delta;
 
   while (ii < starting && p < pend)
@@ -5702,7 +5649,7 @@
     }
   else
     {
-      ending = XINT (end);
+      ending = BIGNUMP (end) ? EMACS_INT_MAX + 1 : XINT (end);
       while (ii < ending && pcursor < pend)
 	{
 	  INC_IBYTEPTR (pcursor);
@@ -5782,8 +5729,8 @@
 {
   Lisp_Object sequence1 = args[0], sequence2 = args[1],
     result = sequence1;
-  Elemcount starting1, ending1 = EMACS_INT_MAX, starting2;
-  Elemcount ending2 = EMACS_INT_MAX, counting = 0, startcounting;
+  Elemcount starting1, ending1 = EMACS_INT_MAX + 1, starting2;
+  Elemcount ending2 = EMACS_INT_MAX + 1, counting = 0, startcounting;
   Boolint sequence1_listp, sequence2_listp,
     overwriting = EQ (sequence1, sequence2);
 
@@ -5796,30 +5743,20 @@
   CHECK_SEQUENCE (sequence2);
 
   CHECK_NATNUM (start1);
-  starting1 = XINT (start1);
+  starting1 = BIGNUMP (start1) ? EMACS_INT_MAX + 1 : XINT (start1);
   CHECK_NATNUM (start2);
-  starting2 = XINT (start2);
+  starting2 = BIGNUMP (start2) ? EMACS_INT_MAX + 1 : XINT (start2);
 
   if (!NILP (end1))
     {
       CHECK_NATNUM (end1);
-      ending1 = XINT (end1);
-
-      if (!(starting1 <= ending1))
-        {
-          args_out_of_range_3 (sequence1, start1, end1);
-        }
+      ending1 = BIGNUMP (end1) ? EMACS_INT_MAX + 1 : XINT (end1);
     }
 
   if (!NILP (end2))
     {
       CHECK_NATNUM (end2);
-      ending2 = XINT (end2);
-
-      if (!(starting2 <= ending2))
-        {
-          args_out_of_range_3 (sequence1, start2, end2);
-        }
+      ending2 = BIGNUMP (end2) ? EMACS_INT_MAX + 1 : XINT (end2);
     }
 
   sequence1_listp = LISTP (sequence1);
--- a/src/font-mgr.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/font-mgr.c	Sat Nov 20 16:49:11 2010 +0000
@@ -411,6 +411,7 @@
   Extbyte *fc_property;
   FcResult fc_result;
   FcValue fc_value;
+  int int_id = 0;
 
   /*
     process arguments
@@ -435,14 +436,21 @@
       dead_wrong_type_argument (Qstringp, property);
     }
 
-  if (!NILP (id)) CHECK_NATNUM (id);
+  if (!NILP (id))
+    {
+#ifdef HAVE_BIGNUM
+      check_integer_range (id, Qzero, make_integer (INT_MAX));
+      int_id = BIGNUMP (id) ? bignum_to_int (id) : XINT (id);
+#else
+      check_integer_range (id, Qzero, make_integer (EMACS_INT_MAX));
+      int_id = XINT (id);      
+#endif
+    }
   if (!NILP (type)) CHECK_SYMBOL (type);
 
   /* get property */
   fc_result = FcPatternGet (XFC_PATTERN_PTR (pattern),
-			    fc_property,
-			    NILP (id) ? 0 : XINT (id),
-			    &fc_value);
+			    fc_property, int_id, &fc_value);
 
   switch (fc_result)
     {
--- a/src/frame-msw.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/frame-msw.c	Sat Nov 20 16:49:11 2010 +0000
@@ -1093,8 +1093,15 @@
 	      maybe_error_if_job_active (f);
 	      if (!NILP (val))
 		{
-		  CHECK_NATNUM (val);
-		  FRAME_MSPRINTER_CHARWIDTH (f) = XINT (val);
+#ifdef HAVE_BIGNUM
+                  check_integer_range (val, Qzero, make_integer (INT_MAX));
+		  FRAME_MSPRINTER_CHARWIDTH (f) =
+                    BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) : 
+                    XINT (val);
+#else
+                  CHECK_NATNUM (val);
+                  FRAME_MSPRINTER_CHARWIDTH (f) = XINT (val);
+#endif
 		}
 	    }
 	  if (EQ (prop, Qheight))
@@ -1102,33 +1109,68 @@
 	      maybe_error_if_job_active (f);
 	      if (!NILP (val))
 		{
+#ifdef HAVE_BIGNUM
+                  check_integer_range (val, Qzero, make_integer (INT_MAX));
+		  FRAME_MSPRINTER_CHARHEIGHT (f) =
+                    BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) : 
+                    XINT (val);
+#else
 		  CHECK_NATNUM (val);
 		  FRAME_MSPRINTER_CHARHEIGHT (f) = XINT (val);
+#endif
 		}
 	    }
 	  else if (EQ (prop, Qleft_margin))
 	    {
 	      maybe_error_if_job_active (f);
+#ifdef HAVE_BIGNUM
+              check_integer_range (val, Qzero, make_integer (INT_MAX));
+	      FRAME_MSPRINTER_LEFT_MARGIN (f) =
+                BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) : 
+                XINT (val);
+#else
 	      CHECK_NATNUM (val);
 	      FRAME_MSPRINTER_LEFT_MARGIN (f) = XINT (val);
+#endif
 	    }
 	  else if (EQ (prop, Qtop_margin))
 	    {
 	      maybe_error_if_job_active (f);
+#ifdef HAVE_BIGNUM
+              check_integer_range (val, Qzero, make_integer (INT_MAX));
+	      FRAME_MSPRINTER_TOP_MARGIN (f) =
+                BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) : 
+                XINT (val);
+#else
 	      CHECK_NATNUM (val);
 	      FRAME_MSPRINTER_TOP_MARGIN (f) = XINT (val);
+#endif
 	    }
 	  else if (EQ (prop, Qright_margin))
 	    {
 	      maybe_error_if_job_active (f);
+#ifdef HAVE_BIGNUM
+              check_integer_range (val, Qzero, make_integer (INT_MAX));
+	      FRAME_MSPRINTER_RIGHT_MARGIN (f) =
+                BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) : 
+                XINT (val);
+#else
 	      CHECK_NATNUM (val);
 	      FRAME_MSPRINTER_RIGHT_MARGIN (f) = XINT (val);
+#endif
 	    }
 	  else if (EQ (prop, Qbottom_margin))
 	    {
 	      maybe_error_if_job_active (f);
+#ifdef HAVE_BIGNUM
+              check_integer_range (val, Qzero, make_integer (INT_MAX));
+	      FRAME_MSPRINTER_BOTTOM_MARGIN (f) = 
+                BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) : 
+                XINT (val);
+#else
 	      CHECK_NATNUM (val);
 	      FRAME_MSPRINTER_BOTTOM_MARGIN (f) = XINT (val);
+#endif
 	    }
 	}
     }
--- a/src/glyphs.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/glyphs.c	Sat Nov 20 16:49:11 2010 +0000
@@ -2630,7 +2630,7 @@
 static void
 check_valid_xbm_inline (Lisp_Object data)
 {
-  Lisp_Object width, height, bits;
+  Lisp_Object width, height, bits, args[2];
 
   if (!CONSP (data) ||
       !CONSP (XCDR (data)) ||
@@ -2650,7 +2650,16 @@
   if (!NATNUMP (height))
     invalid_argument ("Height must be a natural number", height);
 
-  if (((XINT (width) * XINT (height)) / 8) > string_char_length (bits))
+  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)))
     invalid_argument ("data is too short for width and height",
 			 vector3 (width, height, bits));
 }
--- a/src/indent.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/indent.c	Sat Nov 20 16:49:11 2010 +0000
@@ -412,7 +412,8 @@
 
   buffer = wrap_buffer (buf);
   if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
-  CHECK_NATNUM (column);
+
+  check_integer_range (column, Qzero, make_integer (EMACS_INT_MAX));
   goal = XINT (column);
 
  retry:
--- a/src/intl-win32.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/intl-win32.c	Sat Nov 20 16:49:11 2010 +0000
@@ -1792,9 +1792,14 @@
 	data->cp_type = MULTIBYTE_MAC;
       else
 	{
-	  CHECK_NATNUM (value);
 	  data->locale_type = MULTIBYTE_SPECIFIED_CODE_PAGE;
-	  data->cp = XINT (value);
+#ifdef HAVE_BIGNUM
+          check_integer_range (value, Qzero, make_integer (INT_MAX));
+	  data->cp = BIGNUMP (value) ? bignum_to_int (XBIGNUM_DATA (value)) : XINT (value);
+#else
+          CHECK_NATNUM (value);
+          data->cp = XINT (value);
+#endif
 	}
     }
   else if (EQ (key, Qlocale))
--- a/src/lisp.h	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/lisp.h	Sat Nov 20 16:49:11 2010 +0000
@@ -1679,6 +1679,10 @@
 
 #define INT_VALBITS (BITS_PER_EMACS_INT - INT_GCBITS)
 #define VALBITS (BITS_PER_EMACS_INT - GCBITS)
+/* This is badly named; it's not the maximum value that an EMACS_INT can
+   have, it's the maximum value that a Lisp-visible fixnum can have (half
+   the maximum value an EMACS_INT can have) and as such would be better
+   called MOST_POSITIVE_FIXNUM. Similarly for MOST_NEGATIVE_FIXNUM. */
 #define EMACS_INT_MAX ((EMACS_INT) ((1UL << (INT_VALBITS - 1)) -1UL))
 #define EMACS_INT_MIN (-(EMACS_INT_MAX) - 1)
 /* WARNING: evaluates its arg twice. */
@@ -2923,22 +2927,6 @@
     x = wrong_type_argument (Qfixnump, x);	\
 } while (0)
 
-/* NOTE NOTE NOTE! This definition of "natural number" is mathematically
-   wrong.  Mathematically, a natural number is a positive integer; 0
-   isn't included.  This would be better called NONNEGINT(). */
-
-#define NATNUMP(x) (INTP (x) && XINT (x) >= 0)
-
-#define CHECK_NATNUM(x) do {			\
-  if (!NATNUMP (x))				\
-    dead_wrong_type_argument (Qnatnump, x);	\
-} while (0)
-
-#define CONCHECK_NATNUM(x) do {			\
-  if (!NATNUMP (x))				\
-    x = wrong_type_argument (Qnatnump, x);	\
-} while (0)
-
 END_C_DECLS
 
 /* -------------- properties of internally-formatted text ------------- */
@@ -4318,6 +4306,8 @@
 void disksave_object_finalization (void);
 void finish_object_memory_usage_stats (void);
 extern int purify_flag;
+#define ARRAY_DIMENSION_LIMIT EMACS_INT_MAX
+extern Fixnum Varray_dimension_limit;
 #ifndef NEW_GC
 extern EMACS_INT gc_generation_number[1];
 #endif /* not NEW_GC */
@@ -4505,7 +4495,7 @@
 MODULE_API Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
 MODULE_API
 DECLARE_DOESNT_RETURN (dead_wrong_type_argument (Lisp_Object, Lisp_Object));
-void check_int_range (EMACS_INT, EMACS_INT, EMACS_INT);
+void check_integer_range (Lisp_Object, Lisp_Object, Lisp_Object);
 
 EXFUN (Fint_to_char, 1);
 EXFUN (Fchar_to_int, 1);
@@ -4531,11 +4521,11 @@
     Qnonnegativep, Qnumber_char_or_marker_p, Qnumberp, Qquote, Qtrue_list_p;
 extern MODULE_API Lisp_Object Qintegerp;
 
-extern Lisp_Object Qarith_error, Qbeginning_of_buffer, Qbuffer_read_only,
-    Qcircular_list, Qcircular_property_list, Qconversion_error,
-    Qcyclic_variable_indirection, Qdomain_error, Qediting_error,
-    Qend_of_buffer, Qend_of_file, Qerror, Qfile_error, Qinternal_error,
-    Qinvalid_change, Qinvalid_constant, Qinvalid_function, 
+extern Lisp_Object Qargs_out_of_range, Qarith_error, Qbeginning_of_buffer,
+    Qbuffer_read_only, Qcircular_list, Qcircular_property_list,
+    Qconversion_error, Qcyclic_variable_indirection, Qdomain_error,
+    Qediting_error, Qend_of_buffer, Qend_of_file, Qerror, Qfile_error,
+    Qinternal_error, Qinvalid_change, Qinvalid_constant, Qinvalid_function, 
     Qinvalid_keyword_argument, Qinvalid_operation,
     Qinvalid_read_syntax, Qinvalid_state, Qio_error, Qlist_formation_error,
     Qmalformed_list, Qmalformed_property_list, Qno_catch, Qout_of_memory,
@@ -4544,6 +4534,7 @@
     Qstructure_formation_error, Qtext_conversion_error, Qunderflow_error,
     Qvoid_function, Qvoid_variable, Qwrong_number_of_arguments,
     Qwrong_type_argument;
+
 extern Lisp_Object Qcdr;
 extern Lisp_Object Qerror_lacks_explanatory_string;
 extern Lisp_Object Qfile_error;
@@ -5010,6 +5001,7 @@
 MODULE_API void warn_when_safe (Lisp_Object, Lisp_Object, const Ascbyte *,
 				...) PRINTF_ARGS (3, 4);
 extern int backtrace_with_internal_sections;
+extern Fixnum Vmultiple_values_limit;
 
 extern Lisp_Object Qand_optional;
 extern Lisp_Object Qand_rest;
--- a/src/lread.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/lread.c	Sat Nov 20 16:49:11 2010 +0000
@@ -844,9 +844,9 @@
     return W_OK;
   else if (EQ (mode, Qreadable))
     return R_OK;
-  else if (INTP (mode))
+  else if (INTEGERP (mode))
     {
-      check_int_range (XINT (mode), 0, 7);
+      check_integer_range (mode, Qzero, make_int (7));
       return XINT (mode);
     }
   else
--- a/src/mule-ccl.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/mule-ccl.c	Sat Nov 20 16:49:11 2010 +0000
@@ -2123,7 +2123,7 @@
 
   val = Fget (ccl_prog, Qccl_program_idx, Qnil);
   if (! NATNUMP (val)
-      || XINT (val) >= XVECTOR_LENGTH (Vccl_program_table))
+      || -1 != bytecode_arithcompare (val, Flength (Vccl_program_table)))
     return Qnil;
   slot = XVECTOR_DATA (Vccl_program_table)[XINT (val)];
   if (! VECTORP (slot)
--- a/src/number.h	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/number.h	Sat Nov 20 16:49:11 2010 +0000
@@ -153,6 +153,40 @@
 EXFUN (Fevenp, 1);
 EXFUN (Foddp, 1);
 
+/* There are varying mathematical definitions of what a natural number is,
+   differing about whether 0 is inside or outside the set. The Oxford
+   English Dictionary, second edition, does say that they are whole numbers,
+   not fractional, but it doesn't give a bound, and gives a quotation
+   talking about the natural numbers from 1 to 100. Since 100 is certainly
+   *not* the upper bound on natural numbers, we can't take 1 as the lower
+   bound from that example. The Real Academia Española's dictionary, not of
+   English but certainly sharing the western academic tradition, says of
+   "número natural":
+
+   1.  m. Mat. Cada uno de los elementos de la sucesión 0, 1, 2, 3...
+
+   that is, "each of the elements of the succession 0, 1, 2, 3 ...". The
+   various Wikipedia articles in languages I can read agree.  It's
+   reasonable to call this macro and the associated Lisp function
+   NATNUMP. */
+
+#ifdef HAVE_BIGNUM
+#define NATNUMP(x) ((INTP (x) && XINT (x) >= 0) || \
+                    (BIGNUMP (x) && bignum_sign (XBIGNUM_DATA (x)) >= 0))
+#else
+#define NATNUMP(x) (INTP (x) && XINT (x) >= 0)
+#endif
+
+#define CHECK_NATNUM(x) do {			\
+  if (!NATNUMP (x))				\
+    dead_wrong_type_argument (Qnatnump, x);	\
+} while (0)
+
+#define CONCHECK_NATNUM(x) do {			\
+  if (!NATNUMP (x))				\
+    x = wrong_type_argument (Qnatnump, x);	\
+} while (0)
+
 
 /********************************** Ratios **********************************/
 #ifdef HAVE_RATIO
--- a/src/process-unix.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/process-unix.c	Sat Nov 20 16:49:11 2010 +0000
@@ -2120,10 +2120,10 @@
 
   CHECK_STRING (dest);
 
-  CHECK_NATNUM (port);
+  check_integer_range (port, Qzero, make_integer (USHRT_MAX));
   theport = htons ((unsigned short) XINT (port));
 
-  CHECK_NATNUM (ttl);
+  check_integer_range (ttl, Qzero, make_integer (UCHAR_MAX));
   thettl = (unsigned char) XINT (ttl);
 
   if ((udp = getprotobyname ("udp")) == NULL)
--- a/src/process.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/process.c	Sat Nov 20 16:49:11 2010 +0000
@@ -977,8 +977,8 @@
        (process, height, width))
 {
   CHECK_PROCESS (process);
-  CHECK_NATNUM (height);
-  CHECK_NATNUM (width);
+  check_integer_range (height, Qzero, make_integer (EMACS_INT_MAX));
+  check_integer_range (width, Qzero, make_integer (EMACS_INT_MAX));
   return
     MAYBE_INT_PROCMETH (set_window_size,
 			(XPROCESS (process), XINT (height), XINT (width))) <= 0
--- a/src/profile.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/profile.c	Sat Nov 20 16:49:11 2010 +0000
@@ -365,8 +365,16 @@
     msecs = default_profiling_interval;
   else
     {
-      CHECK_NATNUM (microsecs);
+#ifdef HAVE_BIGNUM
+      check_integer_range (microsecs, make_int (1000), make_integer (INT_MAX));
+      msecs =
+        BIGNUMP (microsecs) ? bignum_to_int (XBIGNUM_DATA (microsecs)) :
+                                             XINT (microsecs);
+#else
+      check_integer_range (microsecs, make_int (1000),
+                           make_integer (EMACS_INT_MAX));
       msecs = XINT (microsecs);
+#endif
     }
   if (msecs <= 0)
     msecs = 1000;
--- a/src/unicode.c	Wed Nov 17 14:37:26 2010 +0000
+++ b/src/unicode.c	Sat Nov 20 16:49:11 2010 +0000
@@ -1371,7 +1371,8 @@
   int ichar, unicode;
 
   CHECK_CHAR (character);
-  CHECK_NATNUM (code);
+
+  check_integer_range (code, Qzero, make_integer (EMACS_INT_MAX));
 
   unicode = XINT (code);
   ichar = XCHAR (character);
@@ -1447,7 +1448,7 @@
   int lbs[NUM_LEADING_BYTES];
   int c;
 
-  CHECK_NATNUM (code);
+  check_integer_range (code, Qzero, make_integer (EMACS_INT_MAX));
   c = XINT (code);
   {
     EXTERNAL_LIST_LOOP_2 (elt, charsets)
@@ -1473,7 +1474,7 @@
     return make_char (ret);
   }
 #else
-  CHECK_NATNUM (code);
+  check_integer_range (code, Qzero, make_integer (EMACS_INT_MAX));
   return Fint_to_char (code);
 #endif /* MULE */
 }
--- a/tests/ChangeLog	Wed Nov 17 14:37:26 2010 +0000
+++ b/tests/ChangeLog	Sat Nov 20 16:49:11 2010 +0000
@@ -1,3 +1,15 @@
+2010-11-20  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el:
+	* automated/lisp-tests.el (featurep):
+	* automated/lisp-tests.el (wrong-type-argument):
+	* automated/mule-tests.el (featurep):
+	Check for args-out-of-range errors instead of wrong-type-argument
+	errors in various places when code is handed a large bignum
+	instead of a fixnum.
+	Also check for the wrong-type-argument errors when giving the same
+	code a non-integer value.
+
 2010-11-06  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/lisp-tests.el (list-nreverse):
--- a/tests/automated/lisp-tests.el	Wed Nov 17 14:37:26 2010 +0000
+++ b/tests/automated/lisp-tests.el	Sat Nov 20 16:49:11 2010 +0000
@@ -213,6 +213,16 @@
 (Assert (eq (butlast  '()) nil))
 (Assert (eq (nbutlast '()) nil))
 
+(when (featurep 'bignum)
+  (let* ((x (list* 0 1 2 3 4 5 6.0 ?7 ?8 (vector 'a 'b 'c)))
+         (y (butlast x (* 2 most-positive-fixnum)))
+         (z (nbutlast x (* 3 most-positive-fixnum))))
+    (Assert (eq nil y) "checking butlast with a large bignum gives nil")
+    (Assert (eq nil z) "checking nbutlast with a large bignum gives nil")
+    (Check-Error wrong-type-argument
+		 (nbutlast x (1- most-negative-fixnum))
+                 "checking nbutlast with a negative bignum errors")))
+
 ;;-----------------------------------------------------
 ;; Test `copy-list'
 ;;-----------------------------------------------------
@@ -2511,4 +2521,152 @@
 			(mapcar fourth-bit
 				(loop for i from 0 to 6000 collect i)))))))
 
+(Check-Error wrong-type-argument (self-insert-command 'self-insert-command))
+(Check-Error wrong-type-argument (make-list 'make-list 'make-list))
+(Check-Error wrong-type-argument (make-vector 'make-vector 'make-vector))
+(Check-Error wrong-type-argument (make-bit-vector 'make-bit-vector
+						  'make-bit-vector))
+(Check-Error wrong-type-argument (make-byte-code '(&rest ignore) "\xc0\x87" [4]
+						 'ignore))
+(Check-Error wrong-type-argument (make-string ?a ?a))
+(Check-Error wrong-type-argument (nth-value 'nth-value (truncate pi e)))
+(Check-Error wrong-type-argument (make-hash-table :test #'eql :size :size))
+(Check-Error wrong-type-argument
+	     (accept-process-output nil 'accept-process-output))
+(Check-Error wrong-type-argument
+	     (accept-process-output nil 2000 'accept-process-output))
+(Check-Error wrong-type-argument
+             (self-insert-command 'self-insert-command))
+(Check-Error wrong-type-argument (string-to-number "16" 'string-to-number))
+(Check-Error wrong-type-argument (move-to-column 'move-to-column))
+(stop-profiling)
+(Check-Error wrong-type-argument (start-profiling (float most-positive-fixnum)))
+(stop-profiling)
+(Check-Error wrong-type-argument
+             (fill '(1 2 3 4 5) 1 :start (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+             (fill [1 2 3 4 5] 1 :start (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+             (fill "1 2 3 4 5" ?1 :start (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+             (fill #*10101010 1 :start (float most-positive-fixnum))
+(Check-Error wrong-type-argument
+             (fill '(1 2 3 4 5) 1 :end (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+             (fill [1 2 3 4 5] 1 :end (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+             (fill "1 2 3 4 5" ?1 :end (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+             (fill #*10101010 1 :end (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+             (reduce #'cons '(1 2 3 4 5) :start (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+             (reduce #'cons [1 2 3 4 5] :start (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+             (reduce #'cons "1 2 3 4 5" :start (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+             (reduce #'cons #*10101010 :start (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+             (reduce #'cons '(1 2 3 4 5) :end (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+             (reduce #'cons [1 2 3 4 5] :end (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+             (reduce #'cons "1 2 3 4 5" :end (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+             (reduce #'cons #*10101010 :end (float most-positive-fixnum)))
+
+(when (featurep 'bignum)
+  (Check-Error args-out-of-range
+	       (self-insert-command (* 2 most-positive-fixnum)))
+  (Check-Error args-out-of-range
+	       (make-list (* 3 most-positive-fixnum) 'make-list))
+  (Check-Error args-out-of-range
+	       (make-vector (* 4 most-positive-fixnum) 'make-vector))
+  (Check-Error args-out-of-range
+	       (make-bit-vector (+ 2 most-positive-fixnum) 'make-bit-vector))
+  (Check-Error args-out-of-range
+	       (make-byte-code '(&rest ignore) "\xc0\x87" [4]
+			       (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+	       (make-byte-code '(&rest ignore) "\xc0\x87" [4]
+			       #x10000))
+  (Check-Error args-out-of-range
+	       (make-string (* 4 most-positive-fixnum) ?a))
+  (Check-Error args-out-of-range
+	       (nth-value most-positive-fixnum (truncate pi e)))
+  (Check-Error args-out-of-range
+	       (make-hash-table :test #'equalp :size (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+	       (accept-process-output nil 4294967))
+  (Check-Error args-out-of-range
+	       (accept-process-output nil 10 (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (self-insert-command (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (string-to-number "16" (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (recent-keys (1+ most-positive-fixnum)))
+  (when (featurep 'xbm)
+    (Check-Error-Message
+     invalid-argument
+     "^data is too short for width and height"
+     (set-face-background-pixmap
+      'left-margin
+      `[xbm :data (20 ,(* 2 most-positive-fixnum) "random-text")])))
+  (Check-Error args-out-of-range
+               (move-to-column (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (move-to-column (1- most-negative-fixnum)))
+  (stop-profiling)
+  (when (< most-positive-fixnum (lsh 1 32))
+    ;; We only support machines with integers of 32 bits or more. If
+    ;; most-positive-fixnum is less than 2^32, we're on a 32-bit machine,
+    ;; and it's appropriate to test start-profiling with a bignum.
+    (Assert (eq nil (start-profiling (* most-positive-fixnum 2)))))
+  (stop-profiling)
+  (Check-Error args-out-of-range
+               (fill '(1 2 3 4 5) 1 :start (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (fill [1 2 3 4 5] 1 :start (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (fill "1 2 3 4 5" ?1 :start (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (fill #*10101010 1 :start (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (fill '(1 2 3 4 5) 1 :end (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (fill [1 2 3 4 5] 1 :end (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (fill "1 2 3 4 5" ?1 :end (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (fill #*10101010 1 :end (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (reduce #'cons '(1 2 3 4 5) :start (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (reduce #'cons [1 2 3 4 5] :start (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (reduce #'cons "1 2 3 4 5" :start (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (reduce #'cons #*10101010 :start (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (reduce #'cons '(1 2 3 4 5) :end (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (reduce #'cons [1 2 3 4 5] :end (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (reduce #'cons "1 2 3 4 5" :end (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (reduce #'cons #*10101010 :end (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (replace '(1 2 3 4 5) [5 4 3 2 1]
+                        :start1 (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (replace '(1 2 3 4 5) [5 4 3 2 1]
+                        :start2 (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (replace '(1 2 3 4 5) [5 4 3 2 1]
+                        :end1 (1+ most-positive-fixnum)))
+  (Check-Error args-out-of-range
+               (replace '(1 2 3 4 5) [5 4 3 2 1]
+                        :end2 (1+ most-positive-fixnum))))
+
 ;;; end of lisp-tests.el
--- a/tests/automated/mule-tests.el	Wed Nov 17 14:37:26 2010 +0000
+++ b/tests/automated/mule-tests.el	Sat Nov 20 16:49:11 2010 +0000
@@ -461,7 +461,7 @@
 	(Assert (eq code (char-to-unicode scaron)))
 	(Assert (eq scaron (unicode-to-char code '(latin-iso8859-2)))))
       finally (set-unicode-conversion scaron initial-unicode))
-    (Check-Error wrong-type-argument (set-unicode-conversion scaron -10000)))
+    (Check-Error args-out-of-range (set-unicode-conversion scaron -10000)))
 
   (dolist (utf-8-char 
 	   '("\xc6\x92"		  ;; U+0192 LATIN SMALL LETTER F WITH HOOK