Port runtime of #1420 (local immutable array) (#2084)

Author: riaqn

ocaml/runtime/array.c

@@ -73,6 +73,22 @@ CAMLprim value caml_floatarray_get(value array, value index)
   return res;
 }
 
+/* [ floatarray -> int -> local_ float ] */
+CAMLprim value caml_floatarray_get_local(value array, value index)
+{
+  intnat idx = Long_val(index);
+  double d;
+  value res;
+
+  CAMLassert (Tag_val(array) == Double_array_tag);
+  if (idx < 0 || idx >= Wosize_val(array) / Double_wosize)
+    caml_array_bound_error();
+  d = Double_flat_field(array, idx);
+  res = caml_alloc_local(Double_wosize, Double_tag);
+  Store_double_val(res, d);
+  return res;
+}
+
 /* [ 'a array -> int -> 'a ] */
 CAMLprim value caml_array_get(value array, value index)
 {
@@ -85,6 +101,18 @@ CAMLprim value caml_array_get(value array, value index)
   return caml_array_get_addr(array, index);
 }
 
+/* [ local_ 'a array -> int -> local_ 'a ] */
+CAMLprim value caml_array_get_local(value array, value index)
+{
+#ifdef FLAT_FLOAT_ARRAY
+  if (Tag_val(array) == Double_array_tag)
+    return caml_floatarray_get_local(array, index);
+#else
+  CAMLassert (Tag_val(array) != Double_array_tag);
+#endif
+  return caml_array_get_addr(array, index);
+}
+
 /* [ 'a array -> int -> 'a -> unit ] where 'a != float */
 CAMLprim value caml_array_set_addr(value array, value index, value newval)
 {
@@ -94,7 +122,20 @@ CAMLprim value caml_array_set_addr(value array, value index, value newval)
   return Val_unit;
 }
 
-/* [ floatarray -> int -> float -> unit ] */
+/* [ local_ 'a array -> int -> local_ 'a -> unit ] where 'a != float
+
+   Must be used carefully, as it can violate the "no forward pointers"
+   restriction on the local stack. */
+CAMLprim value caml_array_set_addr_local(value array, value index, value newval)
+{
+  intnat idx = Long_val(index);
+  if (idx < 0 || idx >= Wosize_val(array)) caml_array_bound_error();
+  caml_modify_local(array, idx, newval);
+  return Val_unit;
+}
+
+/* [ floatarray -> int -> float -> unit ]
+   [ local_ floatarray -> int -> local_ float -> unit ] */
 CAMLprim value caml_floatarray_set(value array, value index, value newval)
 {
   intnat idx = Long_val(index);
@@ -118,6 +159,22 @@ CAMLprim value caml_array_set(value array, value index, value newval)
   return caml_array_set_addr(array, index, newval);
 }
 
+/* [ local_ 'a array -> int -> local_ 'a -> unit ]
+
+   Must be used carefully, as it can violate the "no forward pointers"
+   restriction on the local stack if the array contains pointers (vs. [int]s or
+   unboxed floats). */
+CAMLprim value caml_array_set_local(value array, value index, value newval)
+{
+#ifdef FLAT_FLOAT_ARRAY
+  if (Tag_val(array) == Double_array_tag)
+    return caml_floatarray_set(array, index, newval);
+#else
+  CAMLassert (Tag_val(array) != Double_array_tag);
+#endif
+  return caml_array_set_addr_local(array, index, newval);
+}
+
 /* [ floatarray -> int -> float ] */
 CAMLprim value caml_floatarray_unsafe_get(value array, value index)
 {
@@ -132,6 +189,20 @@ CAMLprim value caml_floatarray_unsafe_get(value array, value index)
   return res;
 }
 
+/* [ floatarray -> int -> local_ float ] */
+CAMLprim value caml_floatarray_unsafe_get_local(value array, value index)
+{
+  intnat idx = Long_val(index);
+  double d;
+  value res;
+
+  CAMLassert (Tag_val(array) == Double_array_tag);
+  d = Double_flat_field(array, idx);
+  res = caml_alloc_local(Double_wosize, Double_tag);
+  Store_double_val(res, d);
+  return res;
+}
+
 /* [ 'a array -> int -> 'a ] */
 CAMLprim value caml_array_unsafe_get(value array, value index)
 {
@@ -144,6 +215,18 @@ CAMLprim value caml_array_unsafe_get(value array, value index)
   return Field(array, Long_val(index));
 }
 
+/* [ local_ 'a array -> int -> local_ 'a ] */
+CAMLprim value caml_array_unsafe_get_local(value array, value index)
+{
+#ifdef FLAT_FLOAT_ARRAY
+  if (Tag_val(array) == Double_array_tag)
+    return caml_floatarray_unsafe_get_local(array, index);
+#else
+  CAMLassert (Tag_val(array) != Double_array_tag);
+#endif
+  return Field(array, Long_val(index));
+}
+
 /* [ 'a array -> int -> 'a -> unit ] where 'a != float */
 static value caml_array_unsafe_set_addr(value array, value index,value newval)
 {
@@ -152,7 +235,20 @@ static value caml_array_unsafe_set_addr(value array, value index,value newval)
   return Val_unit;
 }
 
-/* [ floatarray -> int -> float -> unit ] */
+/* [ local_ 'a array -> int -> local_ 'a -> unit ] where 'a != float
+
+   Must be used carefully, as it can violate the "no forward pointers"
+   restriction on the local stack. */
+static value caml_array_unsafe_set_addr_local(value array, value index,
+                                              value newval)
+{
+  intnat idx = Long_val(index);
+  caml_modify_local(array, idx, newval);
+  return Val_unit;
+}
+
+/* [ floatarray -> int -> float -> unit ]
+   [ local_ floatarray -> int -> local_ float -> unit ] */
 /* [MM]: [caml_array_unsafe_set_addr] has a fence for enforcing the OCaml
    memory model through its use of [caml_modify].
    [MM] [TODO]: [caml_floatarray_unsafe_set] will also need a similar fence in
@@ -177,6 +273,23 @@ CAMLprim value caml_array_unsafe_set(value array, value index, value newval)
   return caml_array_unsafe_set_addr(array, index, newval);
 }
 
+/* [ local_ 'a array -> int -> local_ 'a -> unit ]
+
+   Must be used carefully, as it can violate the "no forward pointers"
+   restriction on the local stack if the array contains pointers (vs. [int]s or
+   unboxed floats). */
+CAMLprim value caml_array_unsafe_set_local(value array, value index,
+                                           value newval)
+{
+#ifdef FLAT_FLOAT_ARRAY
+  if (Tag_val(array) == Double_array_tag)
+    return caml_floatarray_unsafe_set(array, index, newval);
+#else
+  CAMLassert (Tag_val(array) != Double_array_tag);
+#endif
+  return caml_array_unsafe_set_addr_local(array, index, newval);
+}
+
 /* [len] is a [value] representing number of floats. */
 /* [ int -> floatarray ] */
 CAMLprim value caml_floatarray_create(value len)
@@ -658,17 +771,12 @@ CAMLprim value caml_array_fill(value array,
   return Val_unit;
 }
 
-/* Linker compatibility with stdlib externals
-   CR ocaml 5 runtime: implement iarrays */
-
 CAMLprim value caml_iarray_of_array(value a)
 {
   return a;
 }
 
-extern value caml_obj_dup(value);
-
 CAMLprim value caml_array_of_iarray(value a)
 {
-  return caml_obj_dup(a);
+  return a;
 }