/* [size] is a number of bytes */
CAMLexport value caml_alloc_custom(struct custom_operations * ops,
uintnat size,
mlsize_t mem,
mlsize_t max)
{
mlsize_t wosize;
value result;
wosize = 1 + (size + sizeof(value) - 1) / sizeof(value);
if (wosize <= Max_young_wosize) {
result = caml_alloc_small(wosize, Custom_tag);
Custom_ops_val(result) = ops;
if (ops->finalize != NULL) {
/* Remembered that the block has a finalizer */
if (caml_finalize_table.ptr >= caml_finalize_table.limit){
CAMLassert (caml_finalize_table.ptr == caml_finalize_table.limit);
caml_realloc_ref_table (&caml_finalize_table);
}
*caml_finalize_table.ptr++ = (value *)result;
}
} else {
result = caml_alloc_shr(wosize, Custom_tag);
Custom_ops_val(result) = ops;
caml_adjust_gc_speed(mem, max);
result = caml_check_urgent_gc(result);
}
return result;
}
CAMLprim value caml_make_vect(value len, value init)
{
CAMLparam2 (len, init);
CAMLlocal1 (res);
mlsize_t size, wsize, i;
double d;
size = Long_val(len);
if (size == 0) {
res = Atom(0);
}
else if (Is_block(init)
&& Is_in_value_area(init)
&& Tag_val(init) == Double_tag) {
d = Double_val(init);
wsize = size * Double_wosize;
if (wsize > Max_wosize) caml_invalid_argument("Array.make");
res = caml_alloc(wsize, Double_array_tag);
for (i = 0; i < size; i++) {
Store_double_field(res, i, d);
}
} else {
if (size > Max_wosize) caml_invalid_argument("Array.make");
if (size < Max_young_wosize) {
res = caml_alloc_small(size, 0);
for (i = 0; i < size; i++) Field(res, i) = init;
}
else if (Is_block(init) && Is_young(init)) {
caml_minor_collection();
res = caml_alloc_shr(size, 0);
for (i = 0; i < size; i++) Field(res, i) = init;
res = caml_check_urgent_gc (res);
}
else {
res = caml_alloc_shr(size, 0);
for (i = 0; i < size; i++) caml_initialize(&Field(res, i), init);
res = caml_check_urgent_gc (res);
}
}
CAMLreturn (res);
}
void caml_process_event(void)
{
void (*async_action)(void);
caml_check_urgent_gc (Val_unit);
caml_process_pending_signals();
async_action = caml_async_action_hook;
if (async_action != NULL) {
caml_async_action_hook = NULL;
(*async_action)();
}
}
static value netsys_alloc_string_shr(mlsize_t len)
{
/* Always allocate in major heap */
value result;
mlsize_t offset_index;
mlsize_t wosize = (len + sizeof (value)) / sizeof (value);
result = caml_alloc_shr (wosize, String_tag);
result = caml_check_urgent_gc (result);
Field (result, wosize - 1) = 0;
offset_index = Bsize_wsize (wosize) - 1;
Byte (result, offset_index) = offset_index - len;
return result;
}
CAMLexport value caml_alloc_string (mlsize_t len)
{
value result;
mlsize_t offset_index;
mlsize_t wosize = (len + sizeof (value)) / sizeof (value);
if (wosize <= Max_young_wosize) {
Alloc_small (result, wosize, String_tag);
}else{
result = caml_alloc_shr (wosize, String_tag);
result = caml_check_urgent_gc (result);
}
Field (result, wosize - 1) = 0;
offset_index = Bsize_wsize (wosize) - 1;
Byte (result, offset_index) = offset_index - len;
return result;
}
CAMLexport value caml_alloc_custom(struct custom_operations * ops,
uintnat size,
mlsize_t mem,
mlsize_t max)
{
mlsize_t wosize;
value result;
wosize = 1 + (size + sizeof(value) - 1) / sizeof(value);
if (ops->finalize == NULL && wosize <= Max_young_wosize) {
result = caml_alloc_small(wosize, Custom_tag);
Custom_ops_val(result) = ops;
} else {
result = caml_alloc_shr(wosize, Custom_tag);
Custom_ops_val(result) = ops;
caml_adjust_gc_speed(mem, max);
result = caml_check_urgent_gc(result);
}
return result;
}
CAMLexport value caml_alloc (mlsize_t wosize, tag_t tag)
{
value result;
mlsize_t i;
Assert (tag < 256);
Assert (tag != Infix_tag);
if (wosize == 0){
result = Atom (tag);
}else if (wosize <= Max_young_wosize){
Alloc_small (result, wosize, tag);
if (tag < No_scan_tag){
for (i = 0; i < wosize; i++) Field (result, i) = 0;
}
}else{
result = caml_alloc_shr (wosize, tag);
if (tag < No_scan_tag) memset (Bp_val (result), 0, Bsize_wsize (wosize));
result = caml_check_urgent_gc (result);
}
return result;
}
