/* [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; }