Mercurial > hg > xemacs-beta

diff src/fns.c @ 5307:c096d8051f89

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 c290121b0c3f 8d29f1c4bb98
line wrap: on
line diff
--- 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);