Example #1
0
void caml_raise_with_arg(value tag, value arg)
{
  CAMLparam2 (tag, arg);
  CAMLlocal1 (bucket);

  bucket = caml_alloc_small (2, 0);
  caml_initialize_field(bucket, 0, tag);
  caml_initialize_field(bucket, 1, arg);
  caml_raise(bucket);
  CAMLnoreturn;
}
Example #2
0
static void encode_terminal_status(value res, int field)
{
  CAMLparam1(res);
  long * pc;
  int i;

  for(pc = terminal_io_descr; *pc != End; field++) {
    switch(*pc++) {
    case Bool:
      { int * src = (int *) (*pc++);
        int msk = *pc++;
        caml_initialize_field(res, field, Val_bool(*src & msk));
        break; }
    case Enum:
      { int * src = (int *) (*pc++);
        int ofs = *pc++;
        int num = *pc++;
        int msk = *pc++;
        for (i = 0; i < num; i++) {
          if ((*src & msk) == pc[i]) {
            caml_initialize_field(res, field, Val_int(i + ofs));
            break;
          }
        }
        pc += num;
        break; }
    case Speed:
      { int which = *pc++;
        speed_t speed = 0;
        caml_initialize_field(res, field, Val_int(9600));   /* in case no speed in speedtable matches */
        switch (which) {
        case Output:
          speed = cfgetospeed(&terminal_status); break;
        case Input:
          speed = cfgetispeed(&terminal_status); break;
        }
        for (i = 0; i < NSPEEDS; i++) {
          if (speed == speedtable[i].speed) {
            caml_initialize_field(res, field, Val_int(speedtable[i].baud));
            break;
          }
        }
        break; }
    case Char:
      { int which = *pc++;
        caml_initialize_field(res, field, Val_int(terminal_status.c_cc[which]));
        break; }
    }
  }
  CAMLreturn0;
}
Example #3
0
void caml_raise_with_args(value tag, int nargs, value args[])
{
  CAMLparam1 (tag);
  CAMLxparamN (args, nargs);
  CAMLlocal1 (bucket);
  int i;

  bucket = caml_alloc (1 + nargs, 0);
  caml_initialize_field(bucket, 0, tag);
  for (i = 0; i < nargs; i++)
    caml_initialize_field(bucket, 1 + i, args[i]);
  caml_raise(bucket);
  CAMLnoreturn;
}
Example #4
0
CAMLexport caml_root caml_create_root(value init) 
{
  CAMLparam1(init);
  value v = caml_alloc_shr(3, 0);
  caml_initialize_field(v, 0, init);
  caml_initialize_field(v, 1, Val_int(1));
  
  caml_plat_lock(&roots_mutex);
  caml_initialize_field(v, 2, roots_all);
  roots_all = v;
  caml_plat_unlock(&roots_mutex);

  CAMLreturnT(caml_root, (caml_root)v);
}
Example #5
0
CAMLprim value caml_weak_create (value len)
{
  value res = caml_alloc(len, 0);
  int i;
  for (i = 0; i < len; i++) 
    caml_initialize_field(res, i, None_val);
  return res;
}
Example #6
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;
}