Пример #1
0
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;
}
Пример #2
0
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;
    }
  }
}
Пример #3
0
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;
}
Пример #4
0
value gb_classic_set(value vblock, value newval)
{
  CAMLparam2(vblock, newval);
  caml_modify_root(Root_val(vblock), newval);
  CAMLreturn (Val_unit);
}