Skip to content

Commit

Permalink
ports #1420 (local immutable array)
Browse files Browse the repository at this point in the history
  • Loading branch information
@riaqn
riaqn committed Nov 24, 2023
1 parent d71173d commit 3fc14e5
Showing 1 changed file with 115 additions and 2 deletions.
117 changes: 115 additions & 2 deletions ocaml/runtime/array.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
{
Expand All @@ -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)
{
Expand All @@ -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);
Expand All @@ -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)
{
Expand All @@ -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)
{
Expand All @@ -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)
{
Expand All @@ -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
Expand All @@ -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)
Expand Down

0 comments on commit 3fc14e5

Please sign in to comment.