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;
}
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;
}
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;
}
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);
}
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;
}
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;
}