diff --git a/code/defstruct.lisp b/code/defstruct.lisp
index d3a2f2191e69485e5b1d60f6e40b78659b922c80..4a68ec8ded6a735a41c26552218120069fa7d0c6 100644
--- a/code/defstruct.lisp
+++ b/code/defstruct.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.94 2004/09/03 03:05:58 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.95 2004/10/05 21:57:27 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1272,12 +1272,29 @@
 	(if (eq ltype 'list)
 	    `((defun ,pred (object)
 		(and (typep object 'list)
-		     (eq (nth ,index object) ',name))))
+		     (defstruct-list-p ,index object ',name))))
 	    `((defun ,pred (object)
 		(and (typep object 'vector)
 		     (array-in-bounds-p object ,index)
 		     (eq (aref object ,index) ',name)))))))))
 
+;; A predicate to determine if the given list is a defstruct object of
+;; :type list.  This used to be done using (eq (nth index object)
+;; name), but that fails if the (nth index object) doesn't work
+;; because object is not a proper list.
+(defun defstruct-list-p (index list name)
+  ;; Basically do (nth index list), but don't crash if the list is not
+  ;; a proper list.
+  (declare (type index index)
+	   (type list list))
+  (do ((i index (1- i))
+       (result list (cdr result)))
+      ((or (atom result) (not (plusp i)))
+       (unless (atom result)
+	 (eq (car result) name)))
+    (declare (type index i))))
+
+
 
 ;;;; Load time support for default structures (%DEFSTRUCT)
 ;;;