--- a/lisp/ChangeLog	Tue Oct 12 21:11:46 2010 +0100
+++ b/lisp/ChangeLog	Thu Oct 14 18:50:38 2010 +0100
@@ -1,3 +1,17 @@
+2010-10-14  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* byte-optimize.el (side-effect-free-fns): 
+	* cl-macs.el (remf, getf): 
+	* cl-extra.el (tailp, cl-set-getf, cl-do-remf): 
+	* cl.el (ldiff, endp):
+	Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp;
+	add circularity checking for the first two.
+
+	#'cl-set-getf and #'cl-do-remf were Lisp implementations of
+	#'plist-put and #'plist-remprop; change the names to aliases,
+	changes the macros that use them to using #'plist-put and
+	#'plist-remprop directly.
+
 2010-10-12  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table):

--- a/lisp/byte-optimize.el	Tue Oct 12 21:11:46 2010 +0100
+++ b/lisp/byte-optimize.el	Thu Oct 14 18:50:38 2010 +0100
@@ -1225,7 +1225,7 @@
 	 ;; coordinates-in-window-p not in XEmacs
 	 copy-marker cos count-lines
 	 default-boundp default-value denominator documentation downcase
-	 elt exp expt fboundp featurep
+	 elt endp exp expt fboundp featurep
 	 file-directory-p file-exists-p file-locked-p file-name-absolute-p
 	 file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
 	 float floor format

--- a/lisp/cl-extra.el	Tue Oct 12 21:11:46 2010 +0100
+++ b/lisp/cl-extra.el	Thu Oct 14 18:50:38 2010 +0100
@@ -405,11 +405,17 @@
   "Equivalent to (nconc (nreverse X) Y)."
   (nconc (nreverse x) y))
 
+;; XEmacs; check LIST for type and circularity.
 (defun tailp (sublist list)
   "Return true if SUBLIST is a tail of LIST."
-  (while (and (consp list) (not (eq sublist list)))
-    (setq list (cdr list)))
-  (if (numberp sublist) (equal sublist list) (eq sublist list)))
+  (check-argument-type #'listp list)
+  (let ((before list) (evenp t))
+    (while (and (consp list) (not (eq sublist list)))
+      (setq list (cdr list)
+	    evenp (not evenp))
+      (if evenp (setq before (cdr before)))
+      (if (eq before list) (error 'circular-list list)))
+    (eql sublist list)))
 
 (defalias 'cl-copy-tree 'copy-tree)
 
@@ -419,17 +425,9 @@
 (defalias 'get* 'get)
 (defalias 'getf 'plist-get)
 
-(defun cl-set-getf (plist tag val)
-  (let ((p plist))
-    (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p))))
-    (if p (progn (setcar (cdr p) val) plist) (list* tag val plist))))
-
-(defun cl-do-remf (plist tag)
-  (let ((p (cdr plist)))
-    (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p))))
-    (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t))))
-
-;; XEmacs change: we have a builtin remprop
+;; XEmacs; these are built-in.
+(defalias 'cl-set-getf 'plist-put)
+(defalias 'cl-do-remf 'plist-remprop)
 (defalias 'cl-remprop 'remprop)
 
 (defun get-properties (plist indicator-list)

--- a/lisp/cl-macs.el	Tue Oct 12 21:11:46 2010 +0100
+++ b/lisp/cl-macs.el	Thu Oct 14 18:50:38 2010 +0100
@@ -2407,7 +2407,7 @@
 	  (append (nth 1 method) (list tag def))
 	  (list store-temp)
 	  (list 'let (list (list (car (nth 2 method))
-				 (list 'cl-set-getf (nth 4 method)
+				 (list 'plist-put (nth 4 method)
 				       tag-temp store-temp)))
 		(nth 3 method) store-temp)
 	  (list 'getf (nth 4 method) tag-temp def-temp))))
@@ -2597,7 +2597,7 @@
 		(list 'progn
 		      (cl-setf-do-store (nth 1 method) (list 'cddr tval))
 		      t)
-		(list 'cl-do-remf tval ttag)))))
+		(list 'plist-remprop tval ttag)))))
 
 ;;;###autoload
 (defmacro shiftf (place &rest args)
@@ -3805,7 +3805,7 @@
  '((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x)
    (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x)
    (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x)
-   (rest 'cdr x) (endp 'null x) (plusp '> x 0) (minusp '< x 0)
+   (rest 'cdr x) (plusp '> x 0) (minusp '< x 0)
    (oddp  'eq (list 'logand x 1) 1)
    (evenp 'eq (list 'logand x 1) 0)
    (caar car car) (cadr car cdr) (cdar cdr car) (cddr cdr cdr)

--- a/lisp/cl.el	Tue Oct 12 21:11:46 2010 +0100
+++ b/lisp/cl.el	Thu Oct 14 18:50:38 2010 +0100
@@ -365,7 +365,13 @@
 
 (defalias 'first 'car)
 (defalias 'rest 'cdr)
-(defalias 'endp 'null)
+
+;; XEmacs change; this needs to error if handed a non-list.
+(defun endp (list)
+  "Return t if LIST is nil, or nil if LIST is a cons. Error otherwise."
+  (prog1
+      (null list)
+    (and list (atom list) (error 'wrong-type-argument #'listp list))))
 
 ;; XEmacs change: make it a real function
 (defun second (x)
@@ -521,12 +527,26 @@
 
 ;;; XEmacs: `list*' is in subr.el.
 
+;; XEmacs; handle dotted lists properly, error on circularity and if LIST is
+;; not a list.
 (defun ldiff (list sublist)
-  "Return a copy of LIST with the tail SUBLIST removed."
-  (let ((res nil))
-    (while (and (consp list) (not (eq list sublist)))
-      (push (pop list) res))
-    (nreverse res)))
+  "Return a copy of LIST with the tail SUBLIST removed.
+
+If SUBLIST is the same Lisp object as LIST, return nil.  If SUBLIST is
+not present in the list structure of LIST (that is, it is not the cdr
+of some cons making up LIST), this function is equivalent to
+`copy-list'.  LIST may be dotted."
+  (check-argument-type #'listp list)
+  (and list (not (eq list sublist))
+       (let ((before list) (evenp t) result)
+	 (prog1
+	     (setq result (list (car list)))
+	   (while (and (setq list (cdr-safe list)) (not (eql list sublist)))
+	     (setf (cdr result) (if (consp list) (list (car list)) list)
+		   result (cdr result)
+		   evenp (not evenp))
+	     (if evenp (setq before (cdr before)))
+	     (if (eq before list) (error 'circular-list list)))))))
 
 ;;; `copy-list' is implemented as a C primitive, as of 1998-11
 

--- a/src/ChangeLog	Tue Oct 12 21:11:46 2010 +0100
+++ b/src/ChangeLog	Thu Oct 14 18:50:38 2010 +0100
@@ -1,3 +1,9 @@
+2010-10-14  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* fns.c (Fnbutlast, Fbutlast):
+	Tighten up Common Lisp compatibility for these two functions; they
+	need to operate on dotted lists without erroring.
+
 2010-10-12  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* fns.c (list_merge):

--- a/src/fns.c	Tue Oct 12 21:11:46 2010 +0100
+++ b/src/fns.c	Thu Oct 14 18:50:38 2010 +0100
@@ -1570,72 +1570,99 @@
 
 DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /*
 Modify LIST to remove the last N (default 1) elements.
+
 If LIST has N or fewer elements, nil is returned and LIST is unmodified.
+Otherwise, LIST may be dotted, but not circular.
 */
        (list, n))
 {
-  EMACS_INT int_n;
+  Elemcount int_n = 1;
 
   CHECK_LIST (list);
 
-  if (NILP (n))
-    int_n = 1;
-  else
+  if (!NILP (n))
     {
       CHECK_NATNUM (n);
       int_n = XINT (n);
     }
 
-  {
-    Lisp_Object last_cons = list;
-
-    EXTERNAL_LIST_LOOP_1 (list)
-      {
-	if (int_n-- < 0)
-	  last_cons = XCDR (last_cons);
-      }
-
-    if (int_n >= 0)
-      return Qnil;
-
-    XCDR (last_cons) = Qnil;
-    return list;
-  }
+  if (CONSP (list))
+    {
+      Lisp_Object last_cons = list;
+
+      EXTERNAL_LIST_LOOP_3 (elt, list, tail)
+	{
+	  if (int_n-- < 0)
+	    {
+	      last_cons = XCDR (last_cons);
+	    }
+
+	  if (!CONSP (XCDR (tail)))
+	    {
+	      break;
+	    }
+	}
+
+      if (int_n >= 0)
+	{
+	  return Qnil;
+	}
+
+      XCDR (last_cons) = Qnil;
+    }
+
+  return list;
 }
 
 DEFUN ("butlast", Fbutlast, 1, 2, 0, /*
 Return a copy of LIST with the last N (default 1) elements removed.
+
 If LIST has N or fewer elements, nil is returned.
+Otherwise, LIST may be dotted, but not circular, and `(butlast LIST 0)'
+converts a dotted into a true list.
 */
        (list, n))
 {
-  EMACS_INT int_n;
+  Lisp_Object retval = Qnil, retval_tail = Qnil;
+  Elemcount int_n = 1;
 
   CHECK_LIST (list);
 
-  if (NILP (n))
-    int_n = 1;
-  else
+  if (!NILP (n))
     {
       CHECK_NATNUM (n);
       int_n = XINT (n);
     }
 
-  {
-    Lisp_Object retval = Qnil;
-    Lisp_Object tail = list;
-
-    EXTERNAL_LIST_LOOP_1 (list)
-      {
-	if (--int_n < 0)
-	  {
-	    retval = Fcons (XCAR (tail), retval);
-	    tail = XCDR (tail);
-	  }
-      }
-
-    return Fnreverse (retval);
-  }
+  if (CONSP (list))
+    {
+      Lisp_Object tail = list;
+
+      EXTERNAL_LIST_LOOP_3 (elt, list, list_tail)
+	{
+	  if (--int_n < 0)
+	    {
+	      if (NILP (retval_tail))
+		{
+		  retval = retval_tail = Fcons (XCAR (tail), Qnil);
+		}
+	      else
+		{
+		  XSETCDR (retval_tail, Fcons (XCAR (tail), Qnil));
+		  retval_tail = XCDR (retval_tail);
+		}
+
+	      tail = XCDR (tail);
+	    }
+
+	  if (!CONSP (XCDR (list_tail)))
+	    {
+	      break;
+	    }
+	}
+    }
+
+  return retval;
 }
 
 DEFUN ("member", Fmember, 2, 2, 0, /*

--- a/tests/ChangeLog	Tue Oct 12 21:11:46 2010 +0100
+++ b/tests/ChangeLog	Thu Oct 14 18:50:38 2010 +0100
@@ -1,3 +1,11 @@
+2010-10-14  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el (x):
+	Test #'nbutlast, #'butlast with dotted lists.
+	Check that #'ldiff and #'tailp don't hang on circular lists; check
+	that #'tailp returns t with circular lists when that is
+	appropriate.  Test them both with dotted lists.
+
 2010-10-12  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/lisp-tests.el:

--- a/tests/automated/lisp-tests.el	Tue Oct 12 21:11:46 2010 +0100
+++ b/tests/automated/lisp-tests.el	Thu Oct 14 18:50:38 2010 +0100
@@ -200,6 +200,14 @@
   (Assert (equal y '(0 1 2 3)))
   (Assert (equal z y)))
 
+(let* ((x (list* 0 1 2 3 4 5 6.0 ?7 ?8 (vector 'a 'b 'c)))
+       (y (butlast x 0))
+       (z (nbutlast x 0)))
+  (Assert (eq z x))
+  (Assert (not (eq y x)))
+  (Assert (equal y '(0 1 2 3 4 5 6.0 ?7 ?8)))
+  (Assert (equal z y)))
+
 (Assert (eq (butlast  '(x)) nil))
 (Assert (eq (nbutlast '(x)) nil))
 (Assert (eq (butlast  '()) nil))
@@ -219,6 +227,58 @@
     (Assert (and (equal x y) (not (eq x y))))))
 
 ;;-----------------------------------------------------
+;; Test `ldiff'
+;;-----------------------------------------------------
+(Check-Error wrong-type-argument (ldiff 'foo pi))
+(Check-Error wrong-number-of-arguments (ldiff))
+(Check-Error wrong-number-of-arguments (ldiff '(1 2)))
+(Check-Error circular-list (ldiff (make-circular-list 1) nil))
+(Check-Error circular-list (ldiff (make-circular-list 2000) nil))
+(Assert (eq '() (ldiff '() pi)))
+(dolist (x '((1) (1 2) (1 2 3) (1 2 . 3)))
+  (let ((y (ldiff x nil)))
+    (Assert (and (equal x y) (not (eq x y))))))
+
+(let* ((vector (vector 'foo))
+       (dotted `(1 2 3 ,pi 40 50 . ,vector))
+       (dotted-pi `(1 2 3 . ,pi))
+       without-vector without-pi)
+  (Assert (equal dotted (ldiff dotted nil))
+	  "checking ldiff handles dotted lists properly")
+  (Assert (equal (butlast dotted 0) (ldiff dotted vector))
+	  "checking ldiff discards dotted elements correctly")
+  (Assert (equal (butlast dotted-pi 0) (ldiff dotted-pi (* 4 (atan 1))))
+	  "checking ldiff handles float equivalence correctly"))
+
+;;-----------------------------------------------------
+;; Test `tailp'
+;;-----------------------------------------------------
+(Check-Error wrong-type-argument (tailp pi 'foo))
+(Check-Error wrong-number-of-arguments (tailp))
+(Check-Error wrong-number-of-arguments (tailp '(1 2)))
+(Check-Error circular-list (tailp nil (make-circular-list 1)))
+(Check-Error circular-list (tailp nil (make-circular-list 2000)))
+(Assert (null (tailp pi '()))
+	"checking pi is not a tail of the list nil")
+(Assert (tailp 3 '(1 2 . 3))
+	"checking #'tailp works with a dotted integer.")
+(Assert (tailp pi `(1 2 . ,(* 4 (atan 1))))
+	"checking tailp works with non-eq dotted floats.")
+(let ((list (make-list 2048 nil)))
+  (Assert (tailp (nthcdr 2000 list) (nconc list list))
+	  "checking #'tailp succeeds with circular LIST containing SUBLIST"))
+
+;;-----------------------------------------------------
+;; Test `endp'
+;;-----------------------------------------------------
+(Check-Error wrong-type-argument (endp 'foo))
+(Check-Error wrong-number-of-arguments (endp))
+(Check-Error wrong-number-of-arguments (endp '(1 2) 'foo))
+(Assert (endp nil) "checking nil is recognized as the end of a list")
+(Assert (not (endp (list 200 200 4 0 9)))
+	"checking a cons is not recognised as the end of a list")
+
+;;-----------------------------------------------------
 ;; Arithmetic operations
 ;;-----------------------------------------------------