CAMLprim value caml_register_named_value(value vname, value val)
{
struct named_value * nv;
const char * name = String_val(vname);
size_t namelen = strlen(name);
unsigned int h = hash_value_name(name);
int found = 0;
caml_plat_lock(&named_value_lock);
for (nv = named_value_table[h]; nv != NULL; nv = nv->next) {
if (strcmp(name, nv->name) == 0) {
caml_modify_root(nv->val, val);
found = 1;
break;
}
}
if (!found) {
nv = (struct named_value *)
caml_stat_alloc(sizeof(struct named_value) + namelen);
memcpy(nv->name, name, namelen + 1);
nv->val = caml_create_root(val);
nv->next = named_value_table[h];
named_value_table[h] = nv;
}
caml_plat_unlock(&named_value_lock);
return Val_unit;
}
void caml_stash_backtrace(value exn, code_t pc, value * sp, int reraise)
{
if (pc != NULL) pc = pc - 1;
if (exn != caml_read_root(Caml_state->backtrace_last_exn) || !reraise) {
Caml_state->backtrace_pos = 0;
caml_modify_root(Caml_state->backtrace_last_exn, exn);
}
if (Caml_state->backtrace_buffer == NULL &&
caml_alloc_backtrace_buffer() == -1)
return;
if (Caml_state->backtrace_pos >= BACKTRACE_BUFFER_SIZE) return;
/* testing the code region is needed: PR#1554 */
if (find_debug_info(pc) != NULL)
Caml_state->backtrace_buffer[Caml_state->backtrace_pos++] = pc;
/* Traverse the stack and put all values pointing into bytecode
into the backtrace buffer. */
value *trap_sp = Stack_high(Caml_state->current_stack) + Caml_state->trap_sp_off;
for (/*nothing*/; sp < trap_sp; sp++) {
if (Is_long(*sp)) {
code_t p = Pc_val(*sp);
if (Caml_state->backtrace_pos >= BACKTRACE_BUFFER_SIZE) break;
if (find_debug_info(p) != NULL)
Caml_state->backtrace_buffer[Caml_state->backtrace_pos++] = p;
}
}
}
CAMLprim value caml_realloc_global(value size)
{
mlsize_t requested_size, actual_size, i;
value old_global_data = caml_read_root(caml_global_data);
value new_global_data;
requested_size = Long_val(size);
actual_size = Wosize_val(old_global_data);
if (requested_size >= actual_size) {
requested_size = (requested_size + 0x100) & 0xFFFFFF00;
caml_gc_log ("Growing global data to %u entries",
(unsigned)requested_size);
new_global_data = caml_alloc_shr(requested_size, 0);
for (i = 0; i < actual_size; i++)
caml_initialize_field(new_global_data, i, Field(old_global_data, i));
for (i = actual_size; i < requested_size; i++){
caml_initialize_field(new_global_data, i, Val_long(0));
}
caml_modify_root(caml_global_data, new_global_data);
}
return Val_unit;
}
value gb_classic_set(value vblock, value newval)
{
CAMLparam2(vblock, newval);
caml_modify_root(Root_val(vblock), newval);
CAMLreturn (Val_unit);
}