diff --git a/code/seq.lisp b/code/seq.lisp
index defe412c9b6baa4f0167dad1953e29e7dc4d2ee1..4e1d4bbef37dff2c31e6efcca2b77ddcff9a8cde 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.36 2002/07/30 16:18:46 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/seq.lisp,v 1.37 2002/08/08 15:28:54 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -163,48 +163,71 @@
     (vector (length (truly-the vector sequence)))
     (list (length (truly-the list sequence)))))
 
+;; Check that the specifier-type SPEC-TYPE has a length compatible
+;; with the given length.  Return T if so.  SPEC-TYPE must be some
+;; kind of vector.  If the type system isn't initialized, we return T.
+(defun valid-sequence-and-length-p (spec-type length)
+  (if *type-system-initialized*
+      (let ((type-len (first (array-type-dimensions spec-type))))
+	(or (eq type-len '*)
+	    (= type-len length)))
+      ;; Type system not ready, so assume it's ok.
+      t))
+	 
 (defun make-sequence (type length &key (initial-element NIL iep))
   "Returns a sequence of the given Type and Length, with elements initialized
   to :Initial-Element."
   (declare (fixnum length))
-  (let ((type (specifier-type type)))
-    (cond ((csubtypep type (specifier-type 'list))
-	   (make-list length :initial-element initial-element))
-	  ((csubtypep type (specifier-type 'string))
-	   (if iep
-	       (make-string length :initial-element initial-element)
-	       (make-string length)))
-	  ((csubtypep type (specifier-type 'simple-vector))
-	   (make-array length :initial-element initial-element))
-	  ((csubtypep type (specifier-type 'bit-vector))
-	   (if iep
-	       (make-array length :element-type '(mod 2)
-			   :initial-element initial-element)
-	       (make-array length :element-type '(mod 2))))
-	  ((csubtypep type (specifier-type 'vector))
-	   (if (typep type 'array-type)
-               (let ((etype (type-specifier
-                             (array-type-specialized-element-type type)))
-                     (vlen (car (array-type-dimensions type))))
-                 (if (and (numberp vlen) (/= vlen length))
-                   (error 'simple-type-error
-			  ;; these two are under-specified by ANSI
-			  :datum (type-specifier type)
-			  :expected-type (type-specifier type)
-			  :format-control
-			  "The length of ~S does not match the specified length  of ~S."
-			  :format-arguments
-			  (list (type-specifier type) length)))
-		 (if iep
-		     (make-array length :element-type etype
-				 :initial-element initial-element)
-		     (make-array length :element-type etype)))
-	       (make-array length :initial-element initial-element)))
-	  (t (error 'simple-type-error
-		    :datum type
-		    :expected-type 'sequence
-		    :format-control "~S is a bad type specifier for sequences."
-		    :format-arguments (list type))))))
+  (flet ((check-seq-len (spec-type length)
+	   (unless (valid-sequence-and-length-p spec-type length)
+	     (error 'simple-type-error
+		    :format-control
+		    "The length of ~S does not match the specified length of ~S."
+		    :format-arguments
+		    (list (type-specifier spec-type) length)))))
+
+    (let ((type (specifier-type type)))
+      (if (csubtypep type (specifier-type 'list))
+	  (make-list length :initial-element initial-element)
+	  (progn
+	    (cond ((csubtypep type (specifier-type 'string))
+		   (check-seq-len type length)
+		   (if iep
+		       (make-string length :initial-element initial-element)
+		       (make-string length)))
+		  ((csubtypep type (specifier-type 'simple-vector))
+		   (check-seq-len type length)
+		   (make-array length :initial-element initial-element))
+		  ((csubtypep type (specifier-type 'bit-vector))
+		   (check-seq-len type length)
+		   (if iep
+		       (make-array length :element-type '(mod 2)
+				   :initial-element initial-element)
+		       (make-array length :element-type '(mod 2))))
+		  ((csubtypep type (specifier-type 'vector))
+		   (if (typep type 'array-type)
+		       (let ((etype (type-specifier
+				     (array-type-specialized-element-type type)))
+			     (vlen (car (array-type-dimensions type))))
+			 (if (and (numberp vlen) (/= vlen length))
+			     (error 'simple-type-error
+				    ;; these two are under-specified by ANSI
+				    :datum (type-specifier type)
+				    :expected-type (type-specifier type)
+				    :format-control
+				    "The length of ~S does not match the specified length  of ~S."
+				    :format-arguments
+				    (list (type-specifier type) length)))
+			 (if iep
+			     (make-array length :element-type etype
+					 :initial-element initial-element)
+			     (make-array length :element-type etype)))
+		       (make-array length :initial-element initial-element)))
+		  (t (error 'simple-type-error
+			    :datum type
+			    :expected-type 'sequence
+			    :format-control "~S is a bad type specifier for sequences."
+			    :format-arguments (list (type-specifier type))))))))))
 
 
 
@@ -571,7 +594,7 @@
 	(do ((sequences ,sequences (cdr sequences))
 	     (lengths lengths (cdr lengths))
 	     (index 0)
-	     (result (make-sequence-of-type ,output-type-spec total-length)))
+	     (result (make-sequence ,output-type-spec total-length)))
 	    ((= index total-length) result)
 	  (declare (fixnum index))
 	  (let ((sequence (car sequences)))
@@ -703,7 +726,9 @@
 		    min-length)))))
     (let* ((args (make-list (length sequences)))
 	   (min-length (seqlen sequences))
-	   (result (make-sequence-of-type output-type-spec min-length)))
+	   (result (if *type-system-initialized*
+		       (make-sequence output-type-spec min-length)
+		       (make-sequence-of-type output-type-spec min-length))))
       (declare (type index min-length))
       (do ((index 0 (1+ index)))
 	  ((>= index min-length))
@@ -905,10 +930,13 @@
 
 (defun coerce (object output-type-spec)
   "Coerces the Object to an object of type Output-Type-Spec."
-  (flet ((coerce-error ()
-	   (error 'simple-type-error
-		  :format-control "~S can't be converted to type ~S."
-		  :format-arguments (list object output-type-spec))))
+  (labels ((coerce-error ()
+	     (error 'simple-type-error
+		    :format-control "~S can't be converted to type ~S."
+		    :format-arguments (list object output-type-spec)))
+	   (check-seq-len (type length)
+	     (unless (valid-sequence-and-length-p type length)
+	       (coerce-error))))
     (let ((type (specifier-type output-type-spec)))
       (cond
 	((%typep object output-type-spec)
@@ -963,6 +991,7 @@
 	     (vector-to-list* object)
 	     (coerce-error)))
 	((csubtypep type (specifier-type 'string))
+	 (check-seq-len type (length object))
 	 (typecase object
 	   (list (list-to-string* object))
 	   (string (string-to-simple-string* object))
@@ -970,12 +999,14 @@
 	   (t
 	    (coerce-error))))
 	((csubtypep type (specifier-type 'bit-vector))
+	 (check-seq-len type (length object))
 	 (typecase object
 	   (list (list-to-bit-vector* object))
 	   (vector (vector-to-bit-vector* object))
 	   (t
 	    (coerce-error))))
 	((csubtypep type (specifier-type 'vector))
+	 (check-seq-len type (length object))
 	 (typecase object
 	   (list (list-to-vector* object output-type-spec))
 	   (vector (vector-to-vector* object output-type-spec))
diff --git a/code/sort.lisp b/code/sort.lisp
index 1b40adc043573ffc0a16136dd20cf18a7285bfdb..769bceb17bb50c2be6d3aead08f26c62d12c7f15 100644
--- a/code/sort.lisp
+++ b/code/sort.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/sort.lisp,v 1.7 1998/11/27 22:17:04 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sort.lisp,v 1.8 2002/08/08 15:28:54 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -434,7 +434,7 @@
 	     (vector-2 (coerce sequence2 'vector))
 	     (length-1 (length vector-1))
 	     (length-2 (length vector-2))
-	     (result (make-sequence-of-type result-type (+ length-1 length-2))))
+	     (result (make-sequence result-type (+ length-1 length-2))))
 	(declare (vector vector-1 vector-2)
 		 (fixnum length-1 length-2))
 	(if (and (simple-vector-p result)