diff --git a/code/array.lisp b/code/array.lisp
index 586cf628cae5aa7ec5119fc099590b6db869e890..15022f8a51bbee7e1768f33085bf7360840d0f34 100644
--- a/code/array.lisp
+++ b/code/array.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/array.lisp,v 1.11 1991/05/08 15:38:00 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/array.lisp,v 1.12 1991/05/28 17:13:35 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -143,11 +143,11 @@
 			      initial-contents adjustable fill-pointer
 			      displaced-to displaced-index-offset)
   "Creates an array of the specified Dimensions.  See manual for details."
-  (unless (listp dimensions) (setq dimensions (list dimensions)))
-  (let ((array-rank (length (the list dimensions)))
-	(simple (and (null fill-pointer)
-		     (not adjustable)
-		     (null displaced-to))))
+  (let* ((dimensions (if (listp dimensions) dimensions (list dimensions)))
+	 (array-rank (length (the list dimensions)))
+	 (simple (and (null fill-pointer)
+		      (not adjustable)
+		      (null displaced-to))))
     (declare (fixnum array-rank))
     (when (and displaced-index-offset (null displaced-to))
       (error "Can't specify :displaced-index-offset without :displaced-to"))
@@ -209,13 +209,12 @@
 		 (when (or initial-element-p initial-contents)
 		   (error "Neither :initial-element nor :initial-contents ~
 		   can be specified along with :displaced-to"))
-		 (unless displaced-index-offset
-		   (setf displaced-index-offset 0))
-		 (when (> (+ displaced-index-offset total-size)
-			  (array-total-size displaced-to))
-		   (error "~S doesn't have enough elements." displaced-to))
-		 (setf (%array-displacement array) displaced-index-offset)
-		 (setf (%array-displaced-p array) t))
+		 (let ((offset (or displaced-index-offset 0)))
+		   (when (> (+ offset total-size)
+			    (array-total-size displaced-to))
+		     (error "~S doesn't have enough elements." displaced-to))
+		   (setf (%array-displacement array) offset)
+		   (setf (%array-displaced-p array) t)))
 		(t
 		 (setf (%array-displaced-p array) nil)))
 	  (let ((axis 0))
@@ -610,89 +609,92 @@
 			   initial-contents fill-pointer
 			   displaced-to displaced-index-offset)
   "Adjusts the Array's dimensions to the given Dimensions and stuff."
-  (unless (listp dimensions) (setq dimensions (list dimensions)))
-  (cond ((not (array-header-p array))
-	 (error "~S is not an adjustable array." array))
-	((/= (the fixnum (length (the list dimensions)))
-	     (the fixnum (array-rank array)))
-	 (error "Number of dimensions not equal to rank of array."))
-	((not (subtypep element-type (array-element-type array)))
-	 (error "New element type, ~S, is incompatible with old."
-		element-type)))
-  (let ((array-rank (length (the list dimensions))))
-    (declare (fixnum array-rank))
-    (when (and fill-pointer (> array-rank 1))
-      (error "Multidimensional arrays can't have fill pointers."))
-    (cond (initial-contents
-	   (if (or initial-element-p displaced-to)
-	       (error "Initial contents may not be specified with ~
-		       the :initial-element or :displaced-to option."))
-	   (let* ((array-size (apply #'* dimensions))
-		  (array-data (data-vector-from-inits
-			       dimensions array-size element-type
-			       initial-contents initial-element
-			       initial-element-p)))
-	     (set-array-header array array-data array-size
-			       (get-new-fill-pointer array array-size
-						     fill-pointer)
-			       0 dimensions nil)))
-	  (displaced-to
-	   (when initial-element ;no initial-contents supplied is already known
+  (let ((dimensions (if (listp dimensions) dimensions (list dimensions))))
+    (cond ((not (array-header-p array))
+	   (error "~S is not an adjustable array." array))
+	  ((/= (the fixnum (length (the list dimensions)))
+	       (the fixnum (array-rank array)))
+	   (error "Number of dimensions not equal to rank of array."))
+	  ((not (subtypep element-type (array-element-type array)))
+	   (error "New element type, ~S, is incompatible with old."
+		  element-type)))
+    (let ((array-rank (length (the list dimensions))))
+      (declare (fixnum array-rank))
+      (when (and fill-pointer (> array-rank 1))
+	(error "Multidimensional arrays can't have fill pointers."))
+      (cond (initial-contents
+	     (if (or initial-element-p displaced-to)
+		 (error "Initial contents may not be specified with ~
+		 the :initial-element or :displaced-to option."))
+	     (let* ((array-size (apply #'* dimensions))
+		    (array-data (data-vector-from-inits
+				 dimensions array-size element-type
+				 initial-contents initial-element
+				 initial-element-p)))
+	       (set-array-header array array-data array-size
+				 (get-new-fill-pointer array array-size
+						       fill-pointer)
+				 0 dimensions nil)))
+	    (displaced-to
+	     ;; no initial-contents supplied is already known
+	     (when initial-element
 	       (error "The :initial-element option may not be specified ~
-		       with :displaced-to."))
-	   (unless (subtypep element-type (array-element-type displaced-to))
-	     (error "One can't displace an array of type ~S into another of ~
-		     type ~S." element-type (array-element-type displaced-to)))
-	   (let ((displacement (or displaced-index-offset 0))
-		 (array-size (apply #'* dimensions)))
-	     (declare (fixnum displacement array-size))
-	     (if (< (the fixnum (array-total-size displaced-to))
-		    (the fixnum (+ displacement array-size)))
-		 (error "The :displaced-to array is too small."))
-	     (set-array-header array displaced-to array-size
-			       (get-new-fill-pointer array array-size
-						     fill-pointer)
-			       displacement dimensions t)))
-	  ((= array-rank 1)
-	   (let ((old-length (%array-available-elements array))
-		 (new-length (car dimensions))
-		 new-data)
-	     (declare (fixnum old-length new-length))
-	     (with-array-data ((old-data array) (old-start)
-			       (old-end old-length))
-	       (cond ((or (%array-displaced-p array) (< old-length new-length))
-		      (setf new-data
-			    (data-vector-from-inits
-			     dimensions new-length element-type
-			     initial-contents initial-element
-			     initial-element-p))
-		      (replace new-data old-data
-			       :start2 old-start :end2 old-end))
-		      (t (setf new-data
-			       (shrink-vector old-data new-length))))
-	       (set-array-header array new-data new-length
-				 (get-new-fill-pointer array new-length
+	       with :displaced-to."))
+	     (unless (subtypep element-type (array-element-type displaced-to))
+	       (error "One can't displace an array of type ~S into another of ~
+	               type ~S."
+		      element-type (array-element-type displaced-to)))
+	     (let ((displacement (or displaced-index-offset 0))
+		   (array-size (apply #'* dimensions)))
+	       (declare (fixnum displacement array-size))
+	       (if (< (the fixnum (array-total-size displaced-to))
+		      (the fixnum (+ displacement array-size)))
+		   (error "The :displaced-to array is too small."))
+	       (set-array-header array displaced-to array-size
+				 (get-new-fill-pointer array array-size
 						       fill-pointer)
-				 0 dimensions nil))))
-	  (t
-	   (let ((old-length (%array-available-elements array))
-		 (new-length (apply #'* dimensions)))
-	     (declare (fixnum old-length new-length))
-	     (with-array-data ((old-data array) (old-start)
-			       (old-end old-length))
-	       (declare (ignore old-end))
-	       (let ((new-data (if (or (%array-displaced-p array)
-				       (> new-length old-length))
-				   (data-vector-from-inits
-				    dimensions new-length
-				    element-type () initial-element
-				    initial-element-p)
-				   old-data)))
-		 (zap-array-data old-data (array-dimensions array) old-start
-				 new-data dimensions new-length element-type
-				 initial-element initial-element-p)
+				 displacement dimensions t)))
+	    ((= array-rank 1)
+	     (let ((old-length (%array-available-elements array))
+		   (new-length (car dimensions))
+		   new-data)
+	       (declare (fixnum old-length new-length))
+	       (with-array-data ((old-data array) (old-start)
+				 (old-end old-length))
+		 (cond ((or (%array-displaced-p array)
+			    (< old-length new-length))
+			(setf new-data
+			      (data-vector-from-inits
+			       dimensions new-length element-type
+			       initial-contents initial-element
+			       initial-element-p))
+			(replace new-data old-data
+				 :start2 old-start :end2 old-end))
+		       (t (setf new-data
+				(shrink-vector old-data new-length))))
 		 (set-array-header array new-data new-length
-				   new-length 0 dimensions nil)))))))
+				   (get-new-fill-pointer array new-length
+							 fill-pointer)
+				   0 dimensions nil))))
+	    (t
+	     (let ((old-length (%array-available-elements array))
+		   (new-length (apply #'* dimensions)))
+	       (declare (fixnum old-length new-length))
+	       (with-array-data ((old-data array) (old-start)
+				 (old-end old-length))
+		 (declare (ignore old-end))
+		 (let ((new-data (if (or (%array-displaced-p array)
+					 (> new-length old-length))
+				     (data-vector-from-inits
+				      dimensions new-length
+				      element-type () initial-element
+				      initial-element-p)
+				     old-data)))
+		   (zap-array-data old-data (array-dimensions array) old-start
+				   new-data dimensions new-length element-type
+				   initial-element initial-element-p)
+		   (set-array-header array new-data new-length
+				     new-length 0 dimensions nil))))))))
   array)
 
 (defun get-new-fill-pointer (old-array new-array-size fill-pointer)