1 files changed, 92 insertions, 0 deletions
diff --git a/asmrun/array.c b/asmrun/array.c
new file mode 100644
index 000000000..09793ff8a
--- /dev/null
+++ b/asmrun/array.c
@@ -0,0 +1,92 @@
+/* Operations on arrays */
+
+#include "alloc.h"
+#include "fail.h"
+#include "memory.h"
+#include "misc.h"
+#include "mlvalues.h"
+
+value make_vect(len, init)
+     value len, init;
+{
+  value res;
+  mlsize_t size, wsize, i;
+  double d;
+  Push_roots(root, 1);
+
+  size = Long_val(len);
+  if (size == 0) {
+    res = Atom(0);
+  }
+  else if (Is_block(init) && Tag_val(init) == Double_tag) {
+    d = Double_val(init);
+    wsize = size * Double_wosize;
+    if (wsize > Max_wosize) {
+      Pop_roots();
+      invalid_argument("Array.new");
+    }
+    if (wsize < Max_young_wosize)
+      res = alloc(wsize, Double_array_tag);
+    else
+      res = alloc_shr(wsize, Double_array_tag);
+    for (i = 0; i < size; i++) {
+      Store_double_field(res, i, d);
+    }
+  } else {
+    if (size > Max_wosize) {
+      Pop_roots();
+      invalid_argument("Array.new");
+    }
+    if (size < Max_young_wosize) {
+      root[0] = init;
+      res = alloc(size, 0);
+      init = root[0];
+      for (i = 0; i < size; i++) Field(res, i) = init;
+    }
+    else if (Is_block(init) && Is_young(init)) {
+      root[0] = init;
+      minor_collection();
+      res = alloc_shr(size, 0);
+      init = root[0];
+      for (i = 0; i < size; i++) Field(res, i) = init;
+    }
+    else {
+      root[0] = init;
+      res = alloc_shr(size, 0);
+      init = root[0];
+      for (i = 0; i < size; i++) initialize(&Field(res, i), init);
+    }
+  }
+  Pop_roots();
+  return res;
+}
+
+value make_array(init)
+     value init;
+{
+  mlsize_t wsize, size, i;
+  value res;
+
+  size = Wosize_val(init);
+  if (size == 0 || Tag_val(Field(init, 0)) != Double_tag) {
+    return init;
+  } else {
+    Push_roots(root, 1);
+    root[0] = init;
+    wsize = size * Double_wosize;
+    if (wsize > Max_wosize) {
+      Pop_roots();
+      invalid_argument("Array.new");
+    }
+    if (wsize < Max_young_wosize)
+      res = alloc(wsize, Double_array_tag);
+    else
+      res = alloc_shr(wsize, Double_array_tag);
+    init = root[0];
+    for (i = 0; i < size; i++) {
+      Store_double_field(res, i, Double_val(Field(init, i)));
+    }
+    return res;
+  }
+}
+