From 3fc14e5d612eb6cae286380fefbfbdf7b6f306df Mon Sep 17 00:00:00 2001 From: Zesen Qian Date: Fri, 24 Nov 2023 18:04:49 +0000 Subject: [PATCH] ports #1420 (local immutable array) --- ocaml/runtime/array.c | 117 +++++++++++++++++++++++++++++++++++++++++- 1 file changed, 115 insertions(+), 2 deletions(-) diff --git a/ocaml/runtime/array.c b/ocaml/runtime/array.c index d265f6a99e3..1f27ef7c6ae 100644 --- a/ocaml/runtime/array.c +++ b/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)