Mercurial > hg > xemacs-beta

changeset 5437:002cb5224e4f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge with 21.5 trunk.
author Mats Lidell <matsl@xemacs.org>
date Mon, 15 Nov 2010 22:33:52 +0100
parents da1365dd3f07 (current diff) 6784adb405ad (diff)
children 8d29f1c4bb98
files lisp/bytecomp.el lisp/cl-macs.el src/.gdbinit.in.in src/fns.c
diffstat 6 files changed, 117 insertions(+), 39 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sat Nov 13 00:15:58 2010 +0100
+++ b/lisp/ChangeLog	Mon Nov 15 22:33:52 2010 +0100
@@ -1,3 +1,17 @@
+2010-11-14  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-macs.el (eql): Don't remove the byte-compile property of this
+	symbol. That was necessary to override a bug in bytecomp.el where
+	#'eql was confused with #'eq, which bug we no longer have.
+	If neither expression is constant, don't attempt to handle the
+	expression in this compiler macro, leave it to byte-compile-eql,
+	which produces better code anyway.
+	* bytecomp.el (eq): #'eql is not the function associated with the
+	byte-eq byte code.
+	(byte-compile-eql): Add an explicit compile method for this
+	function, for cases where the cl-macs compiler macro hasn't
+	reduced it to #'eq or #'equal.
+
 2010-10-25  Aidan Kehoe  <kehoea@parhasard.net>
 
 	Add compiler macros and compilation sanity-checking for various
--- a/lisp/bytecomp.el	Sat Nov 13 00:15:58 2010 +0100
+++ b/lisp/bytecomp.el	Mon Nov 15 22:33:52 2010 +0100
@@ -3158,7 +3158,7 @@
 (byte-defop-compiler fixnump		1)
 (byte-defop-compiler skip-chars-forward     1-2+1)
 (byte-defop-compiler skip-chars-backward    1-2+1)
-(byte-defop-compiler (eql byte-eq) 	2)
+(byte-defop-compiler eq			2)
 (byte-defop-compiler20 old-eq 	 	2)
 (byte-defop-compiler20 old-memq		2)
 (byte-defop-compiler cons		2)
@@ -3907,6 +3907,7 @@
 (byte-defop-compiler-1 let*)
 
 (byte-defop-compiler-1 integerp)
+(byte-defop-compiler-1 eql)
 (byte-defop-compiler-1 fillarray)
 
 (defun byte-compile-progn (form)
@@ -4141,6 +4142,24 @@
       (byte-compile-constant t)
       (byte-compile-out-tag donetag))))
 
+(defun byte-compile-eql (form)
+  (if (eql 3 (length form))
+    (let ((donetag (byte-compile-make-tag))
+	  (eqtag (byte-compile-make-tag)))
+      (mapc 'byte-compile-form (cdr form))
+      (byte-compile-out 'byte-dup 0)
+      (byte-compile-out 'byte-numberp 0)
+      (byte-compile-goto 'byte-goto-if-nil eqtag)
+      (byte-compile-out 'byte-dup 0)
+      (byte-compile-out 'byte-fixnump 0)
+      (byte-compile-goto 'byte-goto-if-not-nil eqtag)
+      (byte-compile-out 'byte-equal 0)
+      (byte-compile-goto 'byte-goto donetag)
+      (byte-compile-out-tag eqtag)
+      (byte-compile-out 'byte-eq 0)
+      (byte-compile-out-tag donetag))
+    (byte-compile-subr-wrong-args form 2)))
+
 ;;(byte-defop-compiler-1 /= byte-compile-negated)
 (byte-defop-compiler-1 atom byte-compile-negated)
 (byte-defop-compiler-1 nlistp byte-compile-negated)
--- a/lisp/cl-macs.el	Sat Nov 13 00:15:58 2010 +0100
+++ b/lisp/cl-macs.el	Mon Nov 15 22:33:52 2010 +0100
@@ -3268,7 +3268,6 @@
 (defun cl-non-fixnum-number-p (object)
   (and (numberp object) (not (fixnump object))))
 
-(put 'eql 'byte-compile nil)
 (define-compiler-macro eql (&whole form a b)
   (cond ((eq (cl-const-expr-p a) t)
 	 (let ((val (cl-const-expr-val a)))
@@ -3280,15 +3279,6 @@
 	   (if (cl-non-fixnum-number-p val)
 	       (list 'equal a b)
 	     (list 'eq a b))))
-	((cl-simple-expr-p a 5)
-	 (list 'if (list 'numberp a)
-	       (list 'equal a b)
-	       (list 'eq a b)))
-	((and (cl-safe-expr-p a)
-	      (cl-simple-expr-p b 5))
-	 (list 'if (list 'numberp b)
-	       (list 'equal a b)
-	       (list 'eq a b)))
 	(t form)))
 
 (macrolet
--- a/src/.gdbinit.in.in	Sat Nov 13 00:15:58 2010 +0100
+++ b/src/.gdbinit.in.in	Mon Nov 15 22:33:52 2010 +0100
@@ -409,9 +409,6 @@
   if $lrecord_type == lrecord_type_opaque_ptr
     pptype Lisp_Opaque_Ptr
   else
-  if $lrecord_type == lrecord_type_popup_data
-    pptype popup_data
-  else
   if $lrecord_type == lrecord_type_process
     pptype Lisp_Process
   else
@@ -454,9 +451,6 @@
   if $lrecord_type == lrecord_type_window
     pstructtype window
   else
-  if $lrecord_type == lrecord_type_window_configuration
-    pstructtype window_config
-  else
   if $lrecord_type == lrecord_type_fc_pattern
     pstructtype fc_pattern
   else
@@ -483,8 +477,6 @@
   end
   end
   end
-  end
-  end
   ## Repeat after me... gdb sux, gdb sux, gdb sux...
   end
   end
--- a/src/ChangeLog	Sat Nov 13 00:15:58 2010 +0100
+++ b/src/ChangeLog	Mon Nov 15 22:33:52 2010 +0100
@@ -1,3 +1,39 @@
+2010-11-15  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* .gdbinit.in: Remove lrecord_type_popup_data,
+	lrecord_type_window_configuration from this file, they're not
+	used, and their presence breaks pobj in GDB at runtime for me.
+
+2010-11-14  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* fns.c (Fnreverse):
+	Check that non-list sequences are writable from Lisp before
+	modifying them. (There's an argument that we should do this for
+	list sequences too, but for the moment other code (e.g. #'setcar)
+	doesn't.)
+	(mapcarX): Initialise lisp_vals_staging, lisp_vals_type
+	explicitly, for the sake of compile warnings. Check if
+	lisp_vals_staging is non-NULL when deciding whether to replace a
+	string's range.
+	(Fsome): Cross-reference to #'find-if in the doc string for this
+	function.
+	(Freduce): GCPRO accum in this function, when a key argument is
+	specicified it can be silently garbage-collected.  When deciding
+	whether to iterate across a string, check whether the cursor
+	exceeds the byte len; while iterating, increment an integer
+	counter.  Don't ABORT() if check_sequence_range() returns when
+	handed a suspicious sequence; it is legal to supply the length of
+	SEQUENCE as the :end keyword value, and this will provoke our
+	suspicions, legitimately enough. (Problems with this function
+	revealed by Paul Dietz' ANSI test suite, thank you Paul Dietz.)
+	(Freplace): Check list sequence lengths using the arguments, not
+	the conses we're currently looking at, thank you Paul Dietz.
+
+2010-11-14  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* fns.c (Frandom): Correct the docstring here, the name of the
+	argument is LIMIT, not N.
+
 2010-11-06  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* bytecode.c (bytecode_nreverse): Call Fnreverse() if SEQUENCE is
--- 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));
             }
         }