diff --git a/code/seq.lisp b/code/seq.lisp
index 203737b193913ba131d23787a7d08825c4c27179..02de45ecb012a59527473d844ebce0a604ad3033 100644
--- a/code/seq.lisp
+++ b/code/seq.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/seq.lisp,v 1.28 1998/04/03 03:45:39 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.29 1998/05/09 22:15:15 pw Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -80,7 +80,24 @@
       (t
        (error "~S is a bad type specifier for sequence functions." type)))))
 
-  
+(define-condition index-too-large-error (type-error)
+  ()
+  (:report
+   (lambda(condition stream)
+     (format stream "Error in ~S: ~S: Index too large."
+	     (condition-function-name condition)
+	     (type-error-datum condition)))))
+
+(defun signal-index-too-large-error (sequence index)
+  (let* ((length (length sequence))
+	 (max-index (and (plusp length)(1- length))))
+    (error 'index-too-large-error
+	   :datum index
+	   :expected-type (if max-index
+			      `(integer 0 ,max-index)
+			      ;; This seems silly, is there something better?
+			      '(integer (0) (0))))))
+
 (defun make-sequence-of-type (type length)
   "Returns a sequence of the given TYPE and LENGTH."
   (declare (fixnum length))
@@ -103,13 +120,14 @@
     (list
      (do ((count index (1- count))
 	  (list sequence (cdr list)))
-	 ((= count 0) (car list))
-       (declare (fixnum count))
-       (when (endp list)
-	 (error "~S: index too large." index))))
+	 ((= count 0)
+	  (if (endp list)
+	      (signal-index-too-large-error sequence index)
+	      (car list)))
+       (declare (type (integer 0) count))))
     (vector
      (when (>= index (length sequence))
-       (error "~S: index too large." index))
+       (signal-index-too-large-error sequence index))
      (aref sequence index))))
 
 (defun %setelt (sequence index newval)
@@ -121,11 +139,11 @@
  	 ((= count 0) (rplaca seq newval) newval)
        (declare (fixnum count))
        (if (atom (cdr seq))
-	   (error "~S: index too large." index)
+	   (signal-index-too-large-error sequence index)
 	   (setq seq (cdr seq)))))
     (vector
      (when (>= index (length sequence))
-       (error "~S: index too large." index))
+       (signal-index-too-large-error sequence index))
      (setf (aref sequence index) newval))))