diff --git a/msvc/ecl-threads.def b/msvc/ecl-threads.def
index a03b0e0bd..5ea74b410 100755
--- a/msvc/ecl-threads.def
+++ b/msvc/ecl-threads.def
@@ -57,6 +57,8 @@ EXPORTS
 	array_elttype
 	ecl_symbol_to_elttype
 	ecl_elttype_to_symbol
+	ecl_copy_subarray
+	ecl_reverse_subarray
 
 
 	; assignment.c
diff --git a/msvc/ecl.def b/msvc/ecl.def
index 86282cd6f..dcec4985c 100644
--- a/msvc/ecl.def
+++ b/msvc/ecl.def
@@ -57,6 +57,8 @@ EXPORTS
 	array_elttype
 	ecl_symbol_to_elttype
 	ecl_elttype_to_symbol
+	ecl_copy_subarray
+	ecl_reverse_subarray
 
 
 	; assignment.c
diff --git a/src/c/array.d b/src/c/array.d
index 7b54b3e9e..ec401678a 100644
--- a/src/c/array.d
+++ b/src/c/array.d
@@ -15,8 +15,21 @@
 */
 
 #include <limits.h>
+#include <string.h>
 #include "ecl.h"
 
+static const cl_index ecl_aet_size[] = {
+  sizeof(cl_object),          /* aet_object */
+  sizeof(float),              /* aet_sf */
+  sizeof(double),             /* aet_lf */
+  0,                          /* aet_bit: cannot be handled with this code */
+  sizeof(cl_fixnum),          /* aet_fix */
+  sizeof(cl_index),           /* aet_index */
+  sizeof(uint8_t),            /* aet_b8 */
+  sizeof(int8_t),             /* aet_i8 */
+  sizeof(unsigned char)       /* aet_ch */
+};
+
 static void displace (cl_object from, cl_object to, cl_object offset);
 static void check_displaced (cl_object dlist, cl_object orig, cl_index newdim);
 
@@ -842,3 +855,104 @@ si_replace_array(cl_object olda, cl_object newa)
  OUTPUT:
 	@(return olda)
 }
+
+void
+ecl_copy_subarray(cl_object dest, cl_index i0, cl_object orig, cl_index i1, cl_index l)
+{
+	cl_elttype t = array_elttype(dest);
+	if (i0 + l > dest->array.dim) {
+		l = dest->array.dim - i0;
+	}
+	if (i1 + l > orig->array.dim) {
+		l = orig->array.dim - i1;
+	}
+	if (t != array_elttype(orig) || t == aet_bit) {
+		while (l--) {
+			aset(dest, i0++, aref(orig, i1++));
+		}
+	} else if (t >= 0 && t <= aet_last_type) {
+		cl_index elt_size = ecl_aet_size[t];
+		memcpy(dest->array.self.ch + i0 * elt_size,
+		       orig->array.self.ch + i1 * elt_size,
+		       l * elt_size);
+	} else {
+		FEerror("Bad array type", 0);
+	}		
+}
+
+void
+ecl_reverse_subarray(cl_object x, cl_index i0, cl_index i1)
+{
+	cl_elttype t = array_elttype(x);
+	cl_index i, j;
+	if (i1 >= x->array.dim) {
+		i1 = x->array.dim;
+	}
+	switch (t) {
+	case aet_object:
+	case aet_fix:
+	case aet_index:
+		for (i = 0, j = i1-1;  i < j;  i++, --j) {
+			cl_object y = x->vector.self.t[i];
+			x->vector.self.t[i] = x->vector.self.t[j];
+			x->vector.self.t[j] = y;
+		}
+		break;
+	case aet_sf:
+		for (i = 0, j = i1-1;  i < j;  i++, --j) {
+			float y = x->array.self.sf[i];
+			x->array.self.sf[i] = x->array.self.sf[j];
+			x->array.self.sf[j] = y;
+		}
+		break;
+	case aet_lf:
+		for (i = 0, j = i1-1;  i < j;  i++, --j) {
+			double y = x->array.self.lf[i];
+			x->array.self.lf[i] = x->array.self.lf[j];
+			x->array.self.lf[j] = y;
+		}
+		break;
+	case aet_b8:
+		for (i = 0, j = i1-1;  i < j;  i++, --j) {
+			uint8_t y = x->array.self.b8[i];
+			x->array.self.b8[i] = x->array.self.b8[j];
+			x->array.self.b8[j] = y;
+		}
+		break;
+	case aet_i8:
+		for (i = 0, j = i1-1;  i < j;  i++, --j) {
+			int8_t y = x->array.self.i8[i];
+			x->array.self.i8[i] = x->array.self.i8[j];
+				x->array.self.i8[j] = y;
+		}
+		break;
+	case aet_ch:
+		for (i = 0, j = i1-1;  i < j;  i++, --j) {
+			unsigned char y = x->array.self.ch[i];
+			x->array.self.ch[i] = x->array.self.ch[j];
+				x->array.self.ch[j] = y;
+		}
+		break;
+	case aet_bit:
+		for (i = x->vector.offset,
+		     j = i1 + x->vector.offset - 1;
+		     i < j;
+		     i++, --j) {
+			int k = x->array.self.bit[i/CHAR_BIT]&(0200>>i%CHAR_BIT);
+			if (x->array.self.bit[j/CHAR_BIT]&(0200>>j%CHAR_BIT))
+				x->array.self.bit[i/CHAR_BIT]
+				|= 0200>>i%CHAR_BIT;
+			else
+				x->array.self.bit[i/CHAR_BIT]
+				&= ~(0200>>i%CHAR_BIT);
+			if (k)
+				x->array.self.bit[j/CHAR_BIT]
+				|= 0200>>j%CHAR_BIT;
+			else
+				x->array.self.bit[j/CHAR_BIT]
+				&= ~(0200>>j%CHAR_BIT);
+		}
+	default:
+		FEerror("Bad array type", 0);
+	}
+}
diff --git a/src/c/read.d b/src/c/read.d
index aea6b3b2d..651c2336e 100644
--- a/src/c/read.d
+++ b/src/c/read.d
@@ -801,7 +801,6 @@ sharp_left_parenthesis_reader(cl_object in, cl_object c, cl_object d)
 		}
 	} else if (fixed_size) {
 		v = cl_alloc_simple_vector(dim, aet_object);
-		v->vector.self.t = (cl_object *)cl_alloc_align(dim * sizeof(cl_object), sizeof(cl_object));
 		for (i = 0; i < dim; i++) {
 			if (in != OBJNULL) {
 				x = read_object_with_delimiter(in, ')');
@@ -871,7 +870,6 @@ sharp_asterisk_reader(cl_object in, cl_object c, cl_object d)
 		dim = dimcount;
 	}
 	x = cl_alloc_simple_bitvector(dim);
-	x->vector.self.bit = (byte *)cl_alloc_atomic((dim + CHAR_BIT - 1)/CHAR_BIT);
 	for (i = 0; i < dim; i++) {
 		elt = (i < dimcount) ? cl_env.stack[sp+i] : last;
 		if (elt == MAKE_FIXNUM(0))
diff --git a/src/c/sequence.d b/src/c/sequence.d
index 07a4e2649..387c952b8 100644
--- a/src/c/sequence.d
+++ b/src/c/sequence.d
@@ -26,28 +26,26 @@ cl_alloc_simple_vector(cl_index l, cl_elttype aet)
 {
 	cl_object x;
 
-	x = cl_alloc_object(t_vector);
-	x->vector.hasfillp = FALSE;
-	x->vector.adjustable = FALSE;
-	x->vector.displaced = Cnil;
-	x->vector.dim = x->vector.fillp = l;
-	x->vector.self.t = NULL;
-	x->vector.elttype = (short)aet;
-	return(x);
-}
-
-cl_object
-cl_alloc_simple_bitvector(cl_index l)
-{
-	cl_object x;
-
-	x = cl_alloc_object(t_bitvector);
-	x->vector.hasfillp = FALSE;
-	x->vector.adjustable = FALSE;
-	x->vector.displaced = Cnil;
-	x->vector.dim = x->vector.fillp = l;
-	x->vector.offset = 0;
-	x->vector.self.bit = NULL;
+	if (aet == aet_ch)
+		return cl_alloc_simple_string(l);
+	if (aet == aet_bit) {
+		x = cl_alloc_object(t_bitvector);
+		x->vector.hasfillp = FALSE;
+		x->vector.adjustable = FALSE;
+		x->vector.displaced = Cnil;
+		x->vector.dim = x->vector.fillp = l;
+		x->vector.offset = 0;
+		x->vector.self.bit = NULL;
+	} else {
+		x = cl_alloc_object(t_vector);
+		x->vector.hasfillp = FALSE;
+		x->vector.adjustable = FALSE;
+		x->vector.displaced = Cnil;
+		x->vector.dim = x->vector.fillp = l;
+		x->vector.self.t = NULL;
+		x->vector.elttype = (short)aet;
+	}
+	array_allocself(x);
 	return(x);
 }
 
@@ -184,68 +182,16 @@ E:
 		@(return x)
 
 	case t_vector:
-		if (s > sequence->vector.fillp)
-			goto ILLEGAL_START_END;
-		if (e < 0)
-			e = sequence->vector.fillp;
-		else if (e < s || e > sequence->vector.fillp)
-			goto ILLEGAL_START_END;
-		x = cl_alloc_simple_vector(e - s, (cl_elttype)sequence->vector.elttype);
-		array_allocself(x);
-		switch ((cl_elttype)sequence->vector.elttype) {
-		case aet_object:
-		case aet_fix:
-		case aet_index:
-		case aet_sf:
-			for (i = s, j = 0;  i < e;  i++, j++)
-				x->vector.self.t[j] = sequence->vector.self.t[i];
-			break;
-
-		case aet_lf:
-			for (i = s, j = 0;  i < e;  i++, j++)
-				x->array.self.lf[j] =
-				sequence->array.self.lf[i];
-			break;
-		case aet_b8:
-		case aet_i8:
-			for (i = s, j = 0;  i < e;  i++, j++)
-				x->vector.self.b8[j] = sequence->vector.self.b8[i];
-			break;
-		default:
-			internal_error("subseq");
-		}
-		@(return x)
-
-	case t_string:
-		if (s > sequence->string.fillp)
-			goto ILLEGAL_START_END;
-		if (e < 0)
-			e = sequence->string.fillp;
-		else if (e < s || e > sequence->string.fillp)
-			goto ILLEGAL_START_END;
-		x = cl_alloc_simple_string(e - s);
-		for (i = s, j = 0;  i < e;  i++, j++)
-			x->string.self[j] = sequence->string.self[i];
-		@(return x)
-
 	case t_bitvector:
+	case t_string:
 		if (s > sequence->vector.fillp)
 			goto ILLEGAL_START_END;
 		if (e < 0)
 			e = sequence->vector.fillp;
 		else if (e < s || e > sequence->vector.fillp)
 			goto ILLEGAL_START_END;
-		x = cl_alloc_simple_bitvector(e - s);
-		x->vector.self.bit = (byte *)cl_alloc_atomic((e-s+CHAR_BIT-1)/CHAR_BIT);
-		s += sequence->vector.offset;
-		e += sequence->vector.offset;
-		for (i = s, j = 0;  i < e;  i++, j++)
-			if (sequence->vector.self.bit[i/CHAR_BIT]&(0200>>i%CHAR_BIT))
-				x->vector.self.bit[j/CHAR_BIT]
-				|= 0200>>j%CHAR_BIT;
-			else
-				x->vector.self.bit[j/CHAR_BIT]
-				&= ~(0200>>j%CHAR_BIT);
+		x = cl_alloc_simple_vector(e - s, array_elttype(sequence));
+		ecl_copy_subarray(x, 0, sequence, s, e-s);
 		@(return x)
 
 	default:
@@ -301,92 +247,44 @@ length(cl_object x)
 cl_object
 cl_reverse(cl_object seq)
 {
-	cl_object x, y;
-	cl_fixnum i, j, k;
+	cl_object output, x;
 
 	switch (type_of(seq)) {
 	case t_symbol:
 		if (Null(seq))
-			y = Cnil;
+			output = Cnil;
 		else
 			FEwrong_type_argument(@'sequence', seq);
 		break;
-
-	case t_cons:
-		y = Cnil;
-		for (x = seq;  !endp(x);  x = CDR(x))
-			y = CONS(CAR(x), y);
+	case t_cons: {
+		for (x = seq, output = Cnil;  !endp(x);  x = CDR(x))
+			output = CONS(CAR(x), output);
 		break;
-
+	}
 	case t_vector:
-		x = seq;
-		k = x->vector.fillp;
-		y = cl_alloc_simple_vector(k, (cl_elttype)x->vector.elttype);
-		array_allocself(y);
-		switch ((cl_elttype)x->vector.elttype) {
-		case aet_object:
-		case aet_fix:
-		case aet_index:
-		case aet_sf:
-			for (j = k - 1, i = 0;  j >=0;  --j, i++)
-				y->vector.self.t[j] = x->vector.self.t[i];
-			break;
-		case aet_lf:
-			for (j = k - 1, i = 0;  j >=0;  --j, i++)
-				y->array.self.lf[j] = x->array.self.lf[i];
-			break;
-		case aet_b8:
-			for (j = k - 1, i = 0;  j >=0;  --j, i++)
-				y->array.self.b8[j] = x->array.self.b8[i];
-			break;
-		case aet_i8:
-			for (j = k - 1, i = 0;  j >=0;  --j, i++)
-				y->array.self.i8[j] = x->array.self.i8[i];
-			break;
-		default:
-			internal_error("reverse");
-		}
-		break;
-
-	case t_string:
-		x = seq;
-		y = cl_alloc_simple_string(x->string.fillp);
-		for (j = x->string.fillp - 1, i = 0;  j >=0;  --j, i++)
-			y->string.self[j] = x->string.self[i];
-		break;
-
 	case t_bitvector:
-		x = seq;
-		y = cl_alloc_simple_bitvector(x->vector.fillp);
-		y->vector.self.bit = (byte *)cl_alloc_atomic((x->vector.fillp+CHAR_BIT-1)/CHAR_BIT);
-		for (j = x->vector.fillp - 1, i = x->vector.offset;
-		     j >=0;
-		     --j, i++)
-			if (x->vector.self.bit[i/CHAR_BIT]&(0200>>i%CHAR_BIT))
-				y->vector.self.bit[j/CHAR_BIT] |= 0200>>j%CHAR_BIT;
-			else
-				y->vector.self.bit[j/CHAR_BIT] &= ~(0200>>j%CHAR_BIT);
+	case t_string:
+		output = cl_alloc_simple_vector(seq->vector.fillp, array_elttype(seq));
+		ecl_copy_subarray(output, 0, seq, 0, seq->vector.fillp);
+		ecl_reverse_subarray(output, 0, seq->vector.fillp);
 		break;
 
 	default:
 		FEwrong_type_argument(@'sequence', seq);
 	}
-	@(return y)
+	@(return output)
 }
 
 cl_object
 cl_nreverse(cl_object seq)
 {
-	cl_object x, y, z;
-	cl_fixnum i, j, k;
-
 	switch (type_of(seq)) {
 	case t_symbol:
 		if (!Null(seq))
 			FEwrong_type_argument(@'sequence', seq);
 		break;
-
-	case t_cons:
+	case t_cons: {
+		cl_object x, y, z;
 		for (x = Cnil, y = seq;  !endp(CDR(y));) {
 			z = y;
 			y = CDR(y);
@@ -396,82 +294,11 @@ cl_nreverse(cl_object seq)
 		CDR(y) = x;
 		seq = y;
 		break;
-
+	}
 	case t_vector:
-		x = seq;
-		k = x->vector.fillp;
-		switch ((cl_elttype)x->vector.elttype) {
-		case aet_object:
-		case aet_fix:
-		case aet_index:
-			for (i = 0, j = k - 1;  i < j;  i++, --j) {
-				y = x->vector.self.t[i];
-				x->vector.self.t[i] = x->vector.self.t[j];
-				x->vector.self.t[j] = y;
-			}
-			break;
-		case aet_sf:
-			for (i = 0, j = k - 1;  i < j;  i++, --j) {
-				float y = x->array.self.sf[i];
-				x->array.self.sf[i] = x->array.self.sf[j];
-				x->array.self.sf[j] = y;
-			}
-			break;
-		case aet_lf:
-			for (i = 0, j = k - 1;  i < j;  i++, --j) {
-				double y = x->array.self.lf[i];
-				x->array.self.lf[i] = x->array.self.lf[j];
-				x->array.self.lf[j] = y;
-			}
-			break;
-		case aet_b8:
-			for (i = 0, j = k - 1;  i < j;  i++, --j) {
-				uint8_t y = x->array.self.b8[i];
-				x->array.self.b8[i] = x->array.self.b8[j];
-				x->array.self.b8[j] = y;
-			}
-			break;
-		case aet_i8:
-			for (i = 0, j = k - 1;  i < j;  i++, --j) {
-				int8_t y = x->array.self.i8[i];
-				x->array.self.i8[i] = x->array.self.i8[j];
-				x->array.self.i8[j] = y;
-			}
-			break;
-		default:
-			internal_error("subseq");
-		}
-		break;
-
 	case t_string:
-		x = seq;
-		for (i = 0, j = x->string.fillp - 1;  i < j;  i++, --j) {
-			k = x->string.self[i];
-			x->string.self[i] = x->string.self[j];
-			x->string.self[j] = k;
-		}
-		break;
-
 	case t_bitvector:
-		x = seq;
-		for (i = x->vector.offset,
-		     j = x->vector.fillp + x->vector.offset - 1;
-		     i < j;
-		     i++, --j) {
-			k = x->vector.self.bit[i/CHAR_BIT]&(0200>>i%CHAR_BIT);
-			if (x->vector.self.bit[j/CHAR_BIT]&(0200>>j%CHAR_BIT))
-				x->vector.self.bit[i/CHAR_BIT]
-				|= 0200>>i%CHAR_BIT;
-			else
-				x->vector.self.bit[i/CHAR_BIT]
-				&= ~(0200>>i%CHAR_BIT);
-			if (k)
-				x->vector.self.bit[j/CHAR_BIT]
-				|= 0200>>j%CHAR_BIT;
-			else
-				x->vector.self.bit[j/CHAR_BIT]
-				&= ~(0200>>j%CHAR_BIT);
-		}
+		ecl_reverse_subarray(seq, 0, seq->vector.fillp);
 		break;
 	default:
 		FEwrong_type_argument(@'sequence', seq);
diff --git a/src/cmp/sysfun.lsp b/src/cmp/sysfun.lsp
index 8e51e53b1..356f676d2 100644
--- a/src/cmp/sysfun.lsp
+++ b/src/cmp/sysfun.lsp
@@ -778,6 +778,8 @@
 		"@0;type_of(#0)==t_vector||
 type_of(#0)==t_string||
 type_of(#0)==t_bitvector"))
+(VECTOR-PUSH (T VECTOR) FIXNUM T NIL)
+(VECTOR-PUSH-EXTEND (T VECTOR) FIXNUM T NIL)
 (SIMPLE-STRING-P (T) T NIL T)
 (SIMPLE-BIT-VECTOR-P (T) T NIL T)
 (SIMPLE-VECTOR-P (T) T NIL T)
diff --git a/src/h/external.h b/src/h/external.h
index cbd246fa5..56a7acec9 100644
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -271,6 +271,8 @@ extern void adjust_displaced(cl_object x, ptrdiff_t diff);
 extern cl_elttype array_elttype(cl_object x);
 extern cl_elttype ecl_symbol_to_elttype(cl_object x);
 extern cl_object ecl_elttype_to_symbol(cl_elttype aet);
+extern void ecl_copy_subarray(cl_object dest, cl_index i0, cl_object orig, cl_index i1, cl_index l);
+extern void ecl_reverse_subarray(cl_object dest, cl_index i0, cl_index i1);
 
 
 /* assignment.c */
@@ -1189,7 +1191,7 @@ extern cl_object cl_nreverse(cl_object x);
 extern cl_object cl_subseq _ARGS((cl_narg narg, cl_object sequence, cl_object start, ...));
 
 extern cl_object cl_alloc_simple_vector(cl_index l, cl_elttype aet);
-extern cl_object cl_alloc_simple_bitvector(cl_index l);
+#define cl_alloc_simple_bitvector(l) cl_alloc_simple_vector((l), aet_bit)
 extern cl_object elt(cl_object seq, cl_fixnum index);
 extern cl_object elt_set(cl_object seq, cl_fixnum index, cl_object val);
 extern cl_fixnum length(cl_object x);
diff --git a/src/h/object.h b/src/h/object.h
index ddd0771fc..f85dff938 100644
--- a/src/h/object.h
+++ b/src/h/object.h
@@ -212,6 +212,7 @@ typedef enum {			/*  array element type  */
 	aet_b8,			/*  byte8	     */
 	aet_i8,			/*  integer8	     */
 	aet_ch,			/*  string-char      */
+	aet_last_type = aet_ch
 } cl_elttype;
 
 union ecl_array_data {
diff --git a/src/lsp/arraylib.lsp b/src/lsp/arraylib.lsp
index 699110eb4..dac8ff2bd 100644
--- a/src/lsp/arraylib.lsp
+++ b/src/lsp/arraylib.lsp
@@ -87,30 +87,6 @@ contiguous block."
 	  (iterate-over-contents array initial-contents dims 0)
 	  (setf (aref array) initial-contents)))))
 
-(defun increment-cursor (cursor dimensions)
-  (declare (si::c-local))
-  (if (null cursor)
-      t
-      (let ((carry (increment-cursor (cdr cursor) (cdr dimensions))))
-	(if carry
-	    (cond ((>= (the fixnum (1+ (the fixnum (car cursor))))
-	               (the fixnum (car dimensions)))
-		   (rplaca cursor 0)
-		   t)
-		  (t
-		   (rplaca cursor
-		           (the fixnum (1+ (the fixnum (car cursor)))))
-		   nil))
-	    nil))))
-
-
-(defun sequence-cursor (sequence cursor)
-  (declare (si::c-local))
-  (if (null cursor)
-      sequence
-      (sequence-cursor (elt sequence (the fixnum (car cursor)))
-                       (cdr cursor))))
-
 
 (defun vector (&rest objects)
   "Args: (&rest objects)
@@ -280,25 +256,17 @@ Replaces ITEM for the element of VECTOR that is pointed to by the fill-pointer
 of VECTOR and then increments the fill-pointer by one.  If the new value of
 the fill-pointer becomes too large, extends VECTOR for N more elements.
 Returns the new value of the fill-pointer."
-  (let ((fp (fill-pointer vector)))
-    (declare (fixnum fp))
-    (cond ((< fp (the fixnum (array-dimension vector 0)))
-	   (sys:aset new-element vector fp)
-	   (sys:fill-pointer-set vector (the fixnum (1+ fp)))
-	   fp)
-	  (t
-	   (adjust-array vector
-	                 (list (+ (array-dimension vector 0)
-				  (or extension
-				      (if (> (array-dimension vector 0)  0)
-					  (array-dimension vector 0)
-					5))))
-	                 :element-type (array-element-type vector)
-			 :fill-pointer fp)
-	   (sys:aset new-element vector fp)
-	   (sys:fill-pointer-set vector (the fixnum (1+ fp)))
-	   fp))))
-
+  (let ((fp (fill-pointer vector))
+	(d (array-dimension vector 0)))
+    (declare (fixnum fp d))
+    (unless (< fp d)
+      (adjust-array vector
+		    (list (+ d (or extension (max d 4))))
+		    :element-type (array-element-type vector)
+		    :fill-pointer fp))
+    (sys:aset new-element vector fp)
+    (sys:fill-pointer-set vector (the fixnum (1+ fp)))
+    fp))
 
 (defun vector-pop (vector)
   "Args: (vector)
@@ -312,6 +280,38 @@ pointer is 0 already."
     (sys:fill-pointer-set vector (the fixnum (1- fp)))
     (aref vector (the fixnum (1- fp)))))
 
+(defun copy-array-contents (dest orig)
+  (declare (si::c-local))
+  (labels
+      ((do-copy (dest orig dims1 dims2 start1 start2)
+	 (declare (array dest orig))
+	 (let* ((d1 (pop dims1))
+		(d2 (pop dims2))
+		(l (min d1 d2))
+		(step1 (apply #'* dims1))
+		(step2 (apply #'* dims2))
+		(i1 start1)
+		(i2 start2))
+	   (declare (fixnum d1 d2 l step1 step2 i1 i2))
+	   (if (null dims1)
+	       #+ecl-min
+	       (dotimes (i l)
+		 (declare (fixnum i))
+		 (row-major-aset dest i1 (row-major-aref orig i2))
+		 (incf i1)
+		 (incf i2))
+	       #-ecl-min
+	       (ffi::c-inline (dest i1 orig i2 l)
+			      (array :fixnum array :fixnum :fixnum) :void
+			      "ecl_copy_subarray(#0, #1, #2, #3, #4)"
+			      :one-liner t
+			      :side-effects t)
+	       (dotimes (i l)
+		 (declare (fixnum i))
+		 (do-copy dest orig dims1 dims2 i1 i2)
+		 (incf i1 step1)
+		 (incf i2 step2))))))
+    (do-copy dest orig (array-dimensions dest) (array-dimensions orig) 0 0)))
 
 (defun adjust-array (array new-dimensions
                      &rest r
@@ -339,11 +339,6 @@ adjustable array."
   (let ((x (apply #'make-array new-dimensions :adjustable t :element-type element-type r)))
     (declare (array x))
     (unless (or displaced-to initial-contents)
-      (do ((cursor (make-list (length new-dimensions) :initial-element 0)))
-	  (nil)
-	(when (apply #'array-in-bounds-p array cursor)
-	  (apply #'aset (apply #'aref array cursor) x cursor))
-	(when (increment-cursor cursor new-dimensions)
-	  (return nil))))
+      (copy-array-contents x array))
     (sys:replace-array array x)
     ))