diff --git a/code/array.lisp b/code/array.lisp
index d1d2c20d12c7ed6314ca56c457f0cc099f04baa8..8863d07ec34832d1b006a6a8e366c139fcab4ac1 100644
--- a/code/array.lisp
+++ b/code/array.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/array.lisp,v 1.37 2003/07/23 09:39:25 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/array.lisp,v 1.38 2004/04/06 17:18:03 emarsden Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -778,26 +778,34 @@
 	    (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 () nil
-                                      initial-element initial-element-p)
-				     old-data)))
-		   (if (or (zerop old-length) (zerop new-length))
-		       (when initial-element-p (fill new-data initial-element))
-		       (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)))))))))
+               (declare (fixnum old-length new-length))
+               (cond ((null dimensions)
+                      array)
+                     (t
+                      (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 () nil
+                                             initial-element initial-element-p)
+                                            old-data)))
+                          (if (or (zerop old-length) (zerop new-length))
+                              (when initial-element-p (fill new-data initial-element))
+                              (zap-array-data old-data (array-dimensions array)
+                                              old-start
+                                              new-data dimensions new-length
+                                              element-type initial-element
+                                              initial-element-p))
+                          (if (adjustable-array-p array)
+                              (set-array-header array new-data new-length
+                                                new-length 0 dimensions nil)
+                              (let ((new-array
+                                     (make-array-header vm:simple-array-type array-rank)))
+                                (set-array-header new-array new-data new-length
+                                                  new-length 0 dimensions nil)))))))))))))
 
 (defun get-new-fill-pointer (old-array new-array-size fill-pointer)
   (cond ((not fill-pointer)