diff src/fns.c @ 5437:002cb5224e4f

Merge with 21.5 trunk.
author Mats Lidell <matsl@xemacs.org>
date Mon, 15 Nov 2010 22:33:52 +0100
parents 46491edfd94a 4c4085177ca5
children 8d29f1c4bb98
line wrap: on
line diff
--- a/src/fns.c	Sat Nov 13 00:15:58 2010 +0100
+++ b/src/fns.c	Mon Nov 15 22:33:52 2010 +0100
@@ -212,9 +212,10 @@
 DEFUN ("random", Frandom, 0, 1, 0, /*
 Return a pseudo-random number.
 All fixnums are equally likely.  On most systems, this is 31 bits' worth.
-With positive integer argument N, return random number in interval [0,N).
-N can be a bignum, in which case the range of possible values is extended.
-With argument t, set the random number seed from the current time and pid.
+With positive integer argument LIMIT, return random number in interval [0,
+LIMIT).  LIMIT can be a bignum, in which case the range of possible values
+is extended.  With argument t, set the random number seed from the current
+time and pid.
 */
        (limit))
 {
@@ -1105,11 +1106,12 @@
           sequence = Fnthcdr (make_int (ss), sequence);
         }
 
+      ii = ss + 1;
+
       if (ss < ee && !NILP (sequence))
         {
 	  result = result_tail = Fcons (Fcar (sequence), Qnil);
 	  sequence = Fcdr (sequence);
-	  ii = ss + 1;
 
 	  {
 	    EXTERNAL_LIST_LOOP_2 (elt, sequence)
@@ -2125,6 +2127,7 @@
       Elemcount length = XVECTOR_LENGTH (sequence), ii = length;
       Elemcount half = length / 2;
       Lisp_Object swap = Qnil;
+      CHECK_LISP_WRITEABLE (sequence);
 
       while (ii > half)
 	{
@@ -2141,6 +2144,7 @@
       Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length;
       Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length;
 
+      CHECK_LISP_WRITEABLE (sequence);
       while (cursor < endp)
 	{
 	  staging_end -= itext_ichar_len (cursor);
@@ -2162,6 +2166,7 @@
       Elemcount half = length / 2;
       int swap = 0;
 
+      CHECK_LISP_WRITEABLE (sequence);
       while (ii > half)
 	{
 	  swap = bit_vector_bit (bv, length - ii);
@@ -4447,7 +4452,7 @@
 {
   Lisp_Object called, *args;
   struct gcpro gcpro1, gcpro2;
-  Ibyte *lisp_vals_staging, *cursor;
+  Ibyte *lisp_vals_staging = NULL, *cursor = NULL;
   int i, j;
 
   assert ((EQ (caller, Qsome) || EQ (caller, Qevery)) ? vals == NULL : 1);
@@ -4494,7 +4499,7 @@
     }
   else
     {
-      enum lrecord_type lisp_vals_type;
+      enum lrecord_type lisp_vals_type = lrecord_type_symbol;
       Binbyte *sequence_types = alloca_array (Binbyte, nsequences);
       for (j = 0; j < nsequences; ++j)
 	{
@@ -4513,6 +4518,10 @@
 	      lisp_vals_staging = cursor
 		= alloca_ibytes (call_count * MAX_ICHAR_LEN);
 	    }
+          else if (ARRAYP (lisp_vals))
+            {
+              CHECK_LISP_WRITEABLE (lisp_vals);
+            }
         }
 
       for (i = 0; i < call_count; ++i)
@@ -4638,9 +4647,9 @@
             }
 	}
 
-      if (!EQ (caller, Qsome) && !EQ (caller, Qevery) &&
-	  lrecord_type_string == lisp_vals_type)
+      if (lisp_vals_staging != NULL)
 	{
+          CHECK_LISP_WRITEABLE (lisp_vals);
 	  replace_string_range (lisp_vals, Qzero, make_int (call_count),
 				lisp_vals_staging, cursor);
 	}
@@ -4656,7 +4665,7 @@
 shortest_length_among_sequences (int nsequences, Lisp_Object *sequences)
 {
   Elemcount len = EMACS_INT_MAX;
-  Lisp_Object length;
+  Lisp_Object length = Qnil;
   int i;
 
   for (i = 0; i < nsequences; ++i)
@@ -4950,6 +4959,10 @@
 With optional SEQUENCES, call PREDICATE each time with as many arguments as
 there are SEQUENCES (plus one for the element from SEQUENCE).
 
+See also `find-if', which returns the corresponding element of SEQUENCE,
+rather than the value given by PREDICATE, and accepts bounding index
+keywords.
+
 arguments: (PREDICATE SEQUENCE &rest SEQUENCES)
 */
        (int nargs, Lisp_Object *args))
@@ -5202,11 +5215,14 @@
   if (VECTORP (sequence))
     {
       Lisp_Vector *vv = XVECTOR (sequence);
+      struct gcpro gcpro1;
 
       check_sequence_range (sequence, start, end, make_int (vv->size));
 
       ending = min (ending, vv->size);
 
+      GCPRO1 (accum);
+
       if (!UNBOUNDP (initial_value))
         {
           accum = initial_value;
@@ -5239,15 +5255,19 @@
               accum = CALL2 (function, KEY (key, vv->contents[ii]), accum);
             }
         }
+
+      UNGCPRO;
     }
   else if (BIT_VECTORP (sequence))
     {
       Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
+      struct gcpro gcpro1;
 
       check_sequence_range (sequence, start, end, make_int (bv->size));
-
       ending = min (ending, bv->size);
 
+      GCPRO1 (accum);
+
       if (!UNBOUNDP (initial_value))
         {
           accum = initial_value;
@@ -5284,9 +5304,16 @@
                              accum);
             }
         }
+
+      UNGCPRO;
+
     }
   else if (STRINGP (sequence))
     {
+      struct gcpro gcpro1;
+
+      GCPRO1 (accum);
+
       if (NILP (from_end))
         {
           Bytecount byte_len = XSTRING_LENGTH (sequence);
@@ -5304,7 +5331,7 @@
             {
               accum = initial_value;
             }
-          else if (ending - starting)
+          else if (ending - starting && cursor_offset < byte_len)
             {
               accum = KEY (key, make_char (itext_ichar (cursor)));
               starting++;
@@ -5319,6 +5346,7 @@
 
               INC_IBYTEPTR (cursor);
               cursor_offset = cursor - startp;
+	      ii++;
             }
 
           while (cursor_offset < byte_len && ii < ending)
@@ -5343,7 +5371,6 @@
 	  if (ii < starting || (ii < ending && !NILP (end)))
 	    {
 	      check_sequence_range (sequence, start, end, Flength (sequence));
-	      ABORT ();
 	    }
         }
       else
@@ -5353,7 +5380,6 @@
           const Ibyte *cursor;
 
 	  check_sequence_range (sequence, start, end, make_int (len));
-
           ending = min (ending, len);
           cursor = string_char_addr (sequence, ending - 1);
           cursor_offset = cursor - XSTRING_DATA (sequence);
@@ -5400,15 +5426,17 @@
                 }
             }
         }
+
+      UNGCPRO;
     }
   else if (LISTP (sequence))
     {
       if (NILP (from_end))
         {
-	  struct gcpro gcpro1;
+	  struct gcpro gcpro1, gcpro2;
 	  Lisp_Object tailed = Qnil;
 
-	  GCPRO1 (tailed);
+	  GCPRO2 (tailed, accum);
 
           if (!UNBOUNDP (initial_value))
             {
@@ -5461,7 +5489,6 @@
 	  if (ii < starting || (ii < ending && !NILP (end)))
 	    {
 	      check_sequence_range (sequence, start, end, Flength (sequence));
-	      ABORT ();
 	    }
         }
       else
@@ -5927,12 +5954,12 @@
 
       if (NILP (sequence1))
         {
-          check_sequence_range (sequence1, start1, end1,
+          check_sequence_range (args[0], start1, end1,
                                 make_int (XINT (start1) + shortest_len));
         }
       else if (NILP (sequence2))
         {
-          check_sequence_range (sequence2, start2, end2,
+          check_sequence_range (args[1], start2, end2,
                                 make_int (XINT (start2) + shortest_len));
         }
     }
@@ -5995,7 +6022,7 @@
 
           if (NILP (sequence1))
             {
-              check_sequence_range (sequence1, start1, end1,
+              check_sequence_range (args[0], start1, end1,
                                     make_int (XINT (start1) + starting1));
             }
         }
@@ -6052,7 +6079,7 @@
 
           if (NILP (sequence2))
             {
-              check_sequence_range (sequence2, start2, end2,
+              check_sequence_range (args[1], start2, end2,
                                     make_int (XINT (start2) + starting2));
             }
         }