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