changeset 5438:8d29f1c4bb98

Merge with 21.5 trunk.
author Mats Lidell <matsl@xemacs.org>
date Fri, 26 Nov 2010 06:43:36 +0100
parents 002cb5224e4f (current diff) 17c381a2f377 (diff)
children 771bf922ab2b
files lisp/cl-extra.el lisp/cl-macs.el 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/automated/lisp-tests.el tests/automated/mule-tests.el
diffstat 34 files changed, 664 insertions(+), 191 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Mon Nov 15 22:33:52 2010 +0100
+++ b/lisp/ChangeLog	Fri Nov 26 06:43:36 2010 +0100
@@ -1,3 +1,13 @@
+2010-11-17  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-extra.el (coerce):
+	In the argument list, name the first argument OBJECT, not X; the
+	former name was always used in the doc string and is clearer.
+	Handle vector type specifications which include the length of the
+	target sequence, error if there's a mismatch.
+	* cl-macs.el (cl-make-type-test): Handle type specifications
+	starting with the symbol 'eql.
+
 2010-11-14  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* cl-macs.el (eql): Don't remove the byte-compile property of this
--- a/lisp/cl-extra.el	Mon Nov 15 22:33:52 2010 +0100
+++ b/lisp/cl-extra.el	Fri Nov 26 06:43:36 2010 +0100
@@ -51,47 +51,67 @@
 
 ;;; Type coercion.
 
-(defun coerce (x type)
+(defun coerce (object type)
   "Coerce OBJECT to type TYPE.
 TYPE is a Common Lisp type specifier."
-  (cond ((eq type 'list) (if (listp x) x (append x nil)))
-	((eq type 'vector) (if (vectorp x) x (vconcat x)))
-	((eq type 'string) (if (stringp x) x (concat x)))
-	((eq type 'array) (if (arrayp x) x (vconcat x)))
-	((and (eq type 'character) (stringp x) (= (length x) 1)) (aref x 0))
-	((and (eq type 'character) (symbolp x)) (coerce (symbol-name x) type))
+  (cond ((eq type 'list) (if (listp object) object (append object nil)))
+	((eq type 'vector) (if (vectorp object) object (vconcat object)))
+	((eq type 'string) (if (stringp object) object (concat object)))
+	((eq type 'array) (if (arrayp object) object (vconcat object)))
+	((and (eq type 'character) (stringp object)
+	      (eql (length object) 1)) (aref object 0))
+	((and (eq type 'character) (symbolp object))
+	 (coerce (symbol-name object) type))
 	;; XEmacs addition character <-> integer coercions
-	((and (eq type 'character) (char-int-p x)) (int-char x))
-	((and (memq type '(integer fixnum)) (characterp x)) (char-int x))
-	((eq type 'float) (float x))
+	((and (eq type 'character) (char-int-p object)) (int-char object))
+	((and (memq type '(integer fixnum)) (characterp object))
+	 (char-int object))
+	((eq type 'float) (float object))
 	;; XEmacs addition: enhanced numeric type coercions
 	((and-fboundp 'coerce-number
 	   (memq type '(integer ratio bigfloat fixnum))
-	   (coerce-number x type)))
+	   (coerce-number object type)))
 	;; XEmacs addition: bit-vector coercion
 	((or (eq type 'bit-vector)
 	     (eq type 'simple-bit-vector))
-	 (if (bit-vector-p x) x (apply 'bit-vector (append x nil))))
+	 (if (bit-vector-p object)
+	     object
+	   (apply 'bit-vector (append object nil))))
 	;; XEmacs addition: weak-list coercion
 	((eq type 'weak-list)
-	 (if (weak-list-p x) x
+	 (if (weak-list-p object) object
 	   (let ((wl (make-weak-list)))
-	     (set-weak-list-list wl (if (listp x) x (append x nil)))
+	     (set-weak-list-list wl (if (listp object)
+					object
+				      (append object nil)))
 	     wl)))
 	((and
-	  (consp type)
-	  (or (eq (car type) 'vector)
-	      (eq (car type) 'simple-array)
-	      (eq (car type) 'simple-vector))
-	  (cond
-	   ((equal (cdr-safe type) '(*))
-	    (coerce x 'vector))
-	   ((equal (cdr-safe type) '(bit))
-	    (coerce x 'bit-vector))
-	   ((equal (cdr-safe type) '(character))
-	    (coerce x 'string)))))
-	((typep x type) x)
-	(t (error "Can't coerce %s to type %s" x type))))
+	  (memq (car-safe type) '(vector simple-array))
+	  (loop
+	    for (ignore elements length) = type
+	    initially (declare (special ignore))
+	    return (if (or (memq length '(* nil)) (eql length (length object)))
+		       (cond
+			((memq elements '(t * nil))
+			 (coerce object 'vector))
+			((memq elements '(string-char character))
+			 (coerce object 'string))
+			((eq elements 'bit)
+			 (coerce object 'bit-vector)))
+		     (error 
+		      'wrong-type-argument
+		      "Type specifier length must equal sequence length"
+		      type)))))
+	((eq (car-safe type) 'simple-vector)
+	 (coerce object (list* 'vector t (cdr type))))
+	((memq (car-safe type)
+	       '(string simple-string base-string simple-base-string))
+	 (coerce object (list* 'vector 'character (cdr type))))
+	((eq (car-safe type) 'bit-vector)
+	 (coerce object (list* 'vector 'bit (cdr type))))
+	((typep object type) object)
+	(t (error 'invalid-operation
+		  "Can't coerce object to type" object type))))
 
 ;; XEmacs; #'equalp is in C.
 
--- a/lisp/cl-macs.el	Mon Nov 15 22:33:52 2010 +0100
+++ b/lisp/cl-macs.el	Fri Nov 26 06:43:36 2010 +0100
@@ -3114,6 +3114,8 @@
 			 (cdr type))))
 	  ((memq (car-safe type) '(member member*))
 	   (list 'and (list 'member* val (list 'quote (cdr type))) t))
+	  ((eq (car-safe type) 'eql)
+	   (list 'eql (cadr type) val))
 	  ((eq (car-safe type) 'satisfies) (list (cadr type) val))
 	  (t (error "Bad type spec: %s" type)))))
 
--- a/src/ChangeLog	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/ChangeLog	Fri Nov 26 06:43:36 2010 +0100
@@ -1,3 +1,90 @@
+2010-11-24  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* font-mgr.c (Ffc_pattern_get): Fix my last change when both
+	--with-union-type and --with-xft are specified, thank you Robert
+	Delius Royar!
+
+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.
+	(Fnbutlast, Fbutlast): Use it.
+	In #'butlast and #'nbutlast, if N is a bignum, we should always
+	return nil. Bug revealed by Paul Dietz' test suite, thank you
+	Paul.
+
 2010-11-15  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* .gdbinit.in: Remove lrecord_type_popup_data,
--- a/src/abbrev.c	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/abbrev.c	Fri Nov 26 06:43:36 2010 +0100
@@ -341,7 +341,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/alloc.c	Fri Nov 26 06:43:36 2010 +0100
@@ -94,6 +94,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;
@@ -1498,16 +1500,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;
 }
 
 
@@ -1741,7 +1744,7 @@
 */
        (length, object))
 {
-  CONCHECK_NATNUM (length);
+  check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT));
   return make_vector (XINT (length), object);
 }
 
@@ -1923,8 +1926,7 @@
 */
        (length, bit))
 {
-  CONCHECK_NATNUM (length);
-
+  check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT));
   return make_bit_vector (XINT (length), bit);
 }
 
@@ -2050,7 +2052,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
@@ -2882,7 +2884,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];
@@ -5737,6 +5739,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/bytecode.c	Fri Nov 26 06:43:36 2010 +0100
@@ -1729,8 +1729,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)));
@@ -2755,7 +2756,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/chartab.c	Fri Nov 26 06:43:36 2010 +0100
@@ -255,10 +255,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/cmds.c	Fri Nov 26 06:43:36 2010 +0100
@@ -332,7 +332,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/data.c	Fri Nov 26 06:43:36 2010 +0100
@@ -156,10 +156,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);
 }
 
 
@@ -502,11 +510,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, /*
@@ -515,9 +519,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
@@ -1293,9 +1294,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/elhash.c	Fri Nov 26 06:43:36 2010 +0100
@@ -731,10 +731,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/eval.c	Fri Nov 26 06:43:36 2010 +0100
@@ -4921,17 +4921,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;
@@ -7203,7 +7205,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/event-stream.c	Fri Nov 26 06:43:36 2010 +0100
@@ -1236,18 +1236,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, /*
@@ -2613,7 +2625,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)
@@ -3702,7 +3715,8 @@
     nwanted = recent_keys_ring_size;
   else
     {
-      CHECK_NATNUM (number);
+      check_integer_range (number, Qzero,
+                           make_integer (ARRAY_DIMENSION_LIMIT));
       nwanted = XINT (number);
     }
 
@@ -4517,7 +4531,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;
 
@@ -4537,7 +4551,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/events.c	Fri Nov 26 06:43:36 2010 +0100
@@ -639,8 +639,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))
 	      {
@@ -735,8 +734,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))
 	  {
@@ -1745,7 +1759,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));
 }
@@ -1761,8 +1777,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/events.h	Fri Nov 26 06:43:36 2010 +0100
@@ -1157,7 +1157,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/file-coding.c	Fri Nov 26 06:43:36 2010 +0100
@@ -4308,8 +4308,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/fileio.c	Fri Nov 26 06:43:36 2010 +0100
@@ -3292,7 +3292,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/fns.c	Fri Nov 26 06:43:36 2010 +0100
@@ -76,13 +76,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);
     }
 }
 
@@ -226,6 +224,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
@@ -238,13 +243,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 ();
 
@@ -1434,7 +1432,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);
@@ -1554,7 +1552,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;
@@ -1589,7 +1587,7 @@
   if (!NILP (n))
     {
       CHECK_NATNUM (n);
-      int_n = XINT (n);
+      int_n = BIGNUMP (n) ? 1 + EMACS_INT_MAX : XINT (n);
     }
 
   if (CONSP (list))
@@ -1637,7 +1635,7 @@
   if (!NILP (n))
     {
       CHECK_NATNUM (n);
-      int_n = XINT (n);
+      int_n = BIGNUMP (n) ? 1 + EMACS_INT_MAX : XINT (n);
     }
 
   if (CONSP (list))
@@ -4173,17 +4171,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:
@@ -4203,6 +4199,7 @@
 
       check_sequence_range (sequence, start, end, make_int (len));
       ending = min (ending, len);
+      starting = XINT (start);
 
       for (ii = starting; ii < ending; ++ii)
         {
@@ -4221,6 +4218,7 @@
 
       check_sequence_range (sequence, start, end, make_int (len));
       ending = min (ending, len);
+      starting = XINT (start);
 
       for (ii = starting; ii < ending; ++ii)
         {
@@ -4230,6 +4228,7 @@
   else if (LISTP (sequence))
     {
       Elemcount counting = 0;
+      starting = BIGNUMP (start) ? EMACS_INT_MAX + 1 : XINT (start);
 
       EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
         {
@@ -5184,7 +5183,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),
@@ -5192,7 +5191,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 :			\
@@ -5200,16 +5199,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))
@@ -5381,6 +5374,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);
 
@@ -5628,7 +5623,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)
@@ -5651,7 +5647,7 @@
     }
   else
     {
-      ending = XINT (end);
+      ending = BIGNUMP (end) ? EMACS_INT_MAX + 1 : XINT (end);
       while (ii < ending && pcursor < pend)
 	{
 	  INC_IBYTEPTR (pcursor);
@@ -5731,8 +5727,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);
 
@@ -5745,30 +5741,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/font-mgr.c	Fri Nov 26 06:43:36 2010 +0100
@@ -409,6 +409,7 @@
   Extbyte *fc_property;
   FcResult fc_result;
   FcValue fc_value;
+  int int_id = 0;
 
   /*
     process arguments
@@ -433,14 +434,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 (XBIGNUM_DATA (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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/frame-msw.c	Fri Nov 26 06:43:36 2010 +0100
@@ -1091,8 +1091,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))
@@ -1100,33 +1107,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/glyphs.c	Fri Nov 26 06:43:36 2010 +0100
@@ -2628,7 +2628,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)) ||
@@ -2648,7 +2648,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/indent.c	Fri Nov 26 06:43:36 2010 +0100
@@ -410,7 +410,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/intl-win32.c	Fri Nov 26 06:43:36 2010 +0100
@@ -1790,9 +1790,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/lisp.h	Fri Nov 26 06:43:36 2010 +0100
@@ -1677,6 +1677,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. */
@@ -2921,22 +2925,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 ------------- */
@@ -4316,6 +4304,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 */
@@ -4503,7 +4493,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);
@@ -4529,11 +4519,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,
@@ -4542,6 +4532,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;
@@ -5008,6 +4999,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/lread.c	Fri Nov 26 06:43:36 2010 +0100
@@ -842,9 +842,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/mule-ccl.c	Fri Nov 26 06:43:36 2010 +0100
@@ -2121,7 +2121,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/number.h	Fri Nov 26 06:43:36 2010 +0100
@@ -151,6 +151,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/process-unix.c	Fri Nov 26 06:43:36 2010 +0100
@@ -2118,10 +2118,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/process.c	Fri Nov 26 06:43:36 2010 +0100
@@ -975,8 +975,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/profile.c	Fri Nov 26 06:43:36 2010 +0100
@@ -363,8 +363,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/src/unicode.c	Fri Nov 26 06:43:36 2010 +0100
@@ -1369,7 +1369,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);
@@ -1445,7 +1446,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)
@@ -1471,7 +1472,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/tests/ChangeLog	Fri Nov 26 06:43:36 2010 +0100
@@ -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	Mon Nov 15 22:33:52 2010 +0100
+++ b/tests/automated/lisp-tests.el	Fri Nov 26 06:43:36 2010 +0100
@@ -211,6 +211,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'
 ;;-----------------------------------------------------
@@ -2509,4 +2519,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	Mon Nov 15 22:33:52 2010 +0100
+++ b/tests/automated/mule-tests.el	Fri Nov 26 06:43:36 2010 +0100
@@ -459,7 +459,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