diff --git a/src/c/array.d b/src/c/array.d
index c4217f7be..90557f10d 100644
--- a/src/c/array.d
+++ b/src/c/array.d
@@ -1122,3 +1122,128 @@ ecl_reverse_subarray(cl_object x, cl_index i0, cl_index i1)
 		FEbad_aet();
 	}
 }
+
+cl_object
+si_fill_array_with_elt(cl_object x, cl_object elt, cl_object start, cl_object end)
+{
+	cl_elttype t = ecl_array_elttype(x);
+        cl_index first = fixnnint(start);
+        cl_index last = Null(end)? x->array.dim : fixnnint(end);
+        if (first >= last) {
+                goto END;
+        }
+	switch (t) {
+	case aet_object: {
+                cl_object *p = x->vector.self.t + first;
+		for (first = last - first; first; --first, ++p) { *p = elt; }
+		break;
+        }
+	case aet_bc: {
+                ecl_base_char e = ecl_char_code(elt);
+                ecl_base_char *p = x->vector.self.bc + first;
+		for (first = last - first; first; --first, ++p) { *p = e; }
+		break;
+        }
+#ifdef ECL_UNICODE
+	case aet_ch: {
+                ecl_character e = ecl_char_code(elt);
+                ecl_character *p = x->vector.self.ch + first;
+		for (first = last - first; first; --first, ++p) { *p = e; }
+		break;
+        }
+#endif
+	case aet_fix: {
+                cl_fixnum e = fixint(elt);
+                cl_fixnum *p = x->vector.self.fix + first;
+		for (first = last - first; first; --first, ++p) { *p = e; }
+		break;
+        }
+	case aet_index: {
+                cl_index e = fixnnint(elt);
+                cl_index *p = x->vector.self.index + first;
+		for (first = last - first; first; --first, ++p) { *p = e; }
+		break;
+        }
+	case aet_sf: {
+                float e = ecl_to_float(elt);
+                float *p = x->vector.self.sf + first;
+		for (first = last - first; first; --first, ++p) { *p = e; }
+		break;
+        }
+	case aet_df: {
+                double e = ecl_to_double(elt);
+                double *p = x->vector.self.df + first;
+		for (first = last - first; first; --first, ++p) { *p = e; }
+		break;
+        }
+	case aet_b8: {
+                uint8_t e = ecl_to_uint8_t(elt);
+                uint8_t *p = x->vector.self.b8 + first;
+		for (first = last - first; first; --first, ++p) { *p = e; }
+		break;
+        }
+	case aet_i8: {
+                int8_t e = ecl_to_int8_t(elt);
+                int8_t *p = x->vector.self.i8 + first;
+		for (first = last - first; first; --first, ++p) { *p = e; }
+		break;
+        }
+#ifdef ecl_uint16_t
+	case aet_b16: {
+                ecl_uint16_t e = ecl_to_uint16_t(elt);
+                ecl_uint16_t *p = x->vector.self.b16 + first;
+		for (first = last - first; first; --first, ++p) { *p = e; }
+		break;
+        }
+	case aet_i16: {
+                ecl_int16_t e = ecl_to_int16_t(elt);
+                ecl_int16_t *p = x->vector.self.i16 + first;
+		for (first = last - first; first; --first, ++p) { *p = e; }
+		break;
+        }
+#endif
+#ifdef ecl_uint32_t
+	case aet_b32: {
+                ecl_uint32_t e = ecl_to_uint32_t(elt);
+                ecl_uint32_t *p = x->vector.self.b32 + first;
+		for (first = last - first; first; --first, ++p) { *p = e; }
+		break;
+        }
+	case aet_i32: {
+                ecl_int32_t e = ecl_to_int32_t(elt);
+                ecl_int32_t *p = x->vector.self.i32 + first;
+		for (first = last - first; first; --first, ++p) { *p = e; }
+		break;
+        }
+#endif
+#ifdef ecl_uint64_t
+	case aet_b64: {
+                ecl_uint64_t e = ecl_to_uint64_t(elt);
+                ecl_uint64_t *p = x->vector.self.b64 + first;
+		for (first = last - first; first; --first, ++p) { *p = e; }
+		break;
+        }
+	case aet_i64: {
+                ecl_int64_t e = ecl_to_int64_t(elt);
+                ecl_int64_t *p = x->vector.self.i64 + first;
+		for (first = last - first; first; --first, ++p) { *p = e; }
+		break;
+        }
+#endif
+	case aet_bit: {
+                int i = ecl_fixnum_in_range(@'si::aset',"bit",elt,0,1);
+		for (last -= first, first += x->vector.offset; last; --last, ++first) {
+                        int mask = 0200>>first%CHAR_BIT;
+                        if (i == 0)
+                                x->vector.self.bit[first/CHAR_BIT] &= ~mask;
+                        else
+                                x->vector.self.bit[first/CHAR_BIT] |= mask;
+		}
+		break;
+        }
+	default:
+		FEbad_aet();
+	}
+ END:
+        @(return x)
+}
diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index d26bcd28b..b88e6401a 100644
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -1769,5 +1769,7 @@ cl_symbols[] = {
 {EXT_ "HEAP-SIZE", EXT_ORDINARY, si_heap_size, -1, OBJNULL},
 #endif
 
+{EXT_ "FILL-ARRAY-WITH-ELT", EXT_ORDINARY, si_fill_array_with_elt, 4, OBJNULL},
+
 /* Tag for end of list */
 {NULL, CL_ORDINARY, NULL, -1, OBJNULL}};
diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h
index 219632328..b3d142333 100644
--- a/src/c/symbols_list2.h
+++ b/src/c/symbols_list2.h
@@ -1769,5 +1769,7 @@ cl_symbols[] = {
 {EXT_ "HEAP-SIZE","si_heap_size"},
 #endif
 
+{EXT_ "FILL-ARRAY-WITH-ELT","si_fill_array_with_elt"},
+
 /* Tag for end of list */
 {NULL,NULL}};
diff --git a/src/h/external.h b/src/h/external.h
index a189c0bd6..b5c3cfe96 100644
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -302,6 +302,7 @@ extern ECL_API cl_object si_replace_array(cl_object old_obj, cl_object new_obj);
 extern ECL_API cl_object cl_aref _ARGS((cl_narg narg, cl_object x, ...));
 extern ECL_API cl_object si_aset _ARGS((cl_narg narg, cl_object v, cl_object x, ...));
 extern ECL_API cl_object si_make_pure_array(cl_object etype, cl_object dims, cl_object adj, cl_object fillp, cl_object displ, cl_object disploff);
+extern ECL_API cl_object si_fill_array_with_elt(cl_object array, cl_object elt, cl_object start, cl_object end);
 
 extern ECL_API cl_index ecl_to_index(cl_object n);
 extern ECL_API cl_object ecl_aref(cl_object x, cl_index index);
@@ -1663,6 +1664,7 @@ extern ECL_API cl_object ecl_alloc_adjustable_extended_string(cl_index l);
 
 /* arraylib.lsp */
 extern ECL_API cl_object cl_make_array _ARGS((cl_narg narg, cl_object V1, ...));
+extern ECL_API cl_object si_fill_array_with_seq _ARGS((cl_narg narg, cl_object V1, cl_object V2, ...));
 extern ECL_API cl_object cl_vector _ARGS((cl_narg narg, ...));
 extern ECL_API cl_object cl_array_dimensions _ARGS((cl_narg narg, cl_object V1, ...));
 extern ECL_API cl_object cl_array_in_bounds_p _ARGS((cl_narg narg, cl_object V1, ...));
diff --git a/src/h/object.h b/src/h/object.h
index 686cae822..52a140103 100644
--- a/src/h/object.h
+++ b/src/h/object.h
@@ -391,16 +391,16 @@ union ecl_array_data {
 	uint8_t       *b8;
 	int8_t        *i8;
 #ifdef ecl_uint16_t
-        uint16_t      *b16;
-        int16_t       *i16;
+        ecl_uint16_t  *b16;
+        ecl_int16_t   *i16;
 #endif
 #ifdef ecl_uint32_t
-        uint32_t      *b32;
-        int32_t       *i32;
+        ecl_uint32_t  *b32;
+        ecl_int32_t   *i32;
 #endif
 #ifdef ecl_uint64_t
-        uint64_t      *b64;
-        int64_t       *i64;
+        ecl_uint64_t  *b64;
+        ecl_int64_t   *i64;
 #endif
 	float         *sf;
 	double        *df;
diff --git a/src/lsp/arraylib.lsp b/src/lsp/arraylib.lsp
index 7fb23c5e8..20c5d53f7 100644
--- a/src/lsp/arraylib.lsp
+++ b/src/lsp/arraylib.lsp
@@ -46,16 +46,16 @@ contiguous block."
   (let ((x (sys:make-pure-array element-type dimensions adjustable
 				fill-pointer displaced-to displaced-index-offset)))
     (declare (array x))
-    (when initial-element-supplied-p
-      (dotimes (i (array-total-size x))
-	(declare (fixnum i))
-	(sys::row-major-aset x i initial-element)))
-    (when initial-contents-supplied-p
-      (fill-array x initial-contents))
-    x))
+    (cond (initial-element-supplied-p
+           (when initial-contents-supplied-p
+             (error "MAKE-ARRAY: Cannot supply both :INITIAL-ELEMENT and :INITIAL-CONTENTS"))
+           (fill-array-with-elt x initial-element 0 nil))
+          (initial-contents-supplied-p
+           (fill-array-with-seq x initial-contents))
+          (t
+           x))))
 
-(defun fill-array (array initial-contents)
-  (declare (si::c-local))
+(defun fill-array-with-seq (array initial-contents)
   (labels ((iterate-over-contents (array contents dims written)
 	     (declare (fixnum written)
 		      (array array)
@@ -77,7 +77,8 @@ contiguous block."
     (let ((dims (array-dimensions array)))
       (if dims
 	  (iterate-over-contents array initial-contents dims 0)
-	  (setf (aref array) initial-contents)))))
+	  (setf (aref array) initial-contents))))
+  array)
 
 
 (defun vector (&rest objects)
@@ -85,8 +86,7 @@ contiguous block."
 Creates and returns a simple-vector, with the N-th OBJECT being the N-th
 element."
   (let ((a (si:make-vector t (length objects) nil nil nil 0)))
-    (fill-array a objects)
-    a))
+    (fill-array-with-seq a objects)))
 
 (defun array-dimensions (array)
   "Args: (array)