CAMLprim value caml_gc_get(value v)
{
CAMLparam0 (); /* v is ignored */
CAMLlocal1 (res);
res = caml_alloc_tuple (8);
Store_field (res, 0, Val_long (Caml_state->minor_heap_wsz)); /* s */
Store_field (res, 2, Val_long (caml_percent_free)); /* o */
Store_field (res, 3, Val_long (caml_params->verb_gc)); /* v */
#ifndef NATIVE_CODE
Store_field (res, 5, Val_long (caml_max_stack_size)); /* l */
#else
Store_field (res, 5, Val_long (0));
#endif
CAMLreturn (res);
}
/* properties
ML_2 (gtk_file_selection_set_filename, GtkFileSelection_val, String_val, Unit)
ML_1 (gtk_file_selection_get_filename, GtkFileSelection_val, Val_string)
ML_1 (gtk_file_selection_show_fileop_buttons, GtkFileSelection_val, Unit)
ML_1 (gtk_file_selection_hide_fileop_buttons, GtkFileSelection_val, Unit)
ML_2 (gtk_file_selection_set_select_multiple, GtkFileSelection_val, Bool_val,
Unit)
ML_1 (gtk_file_selection_get_select_multiple, GtkFileSelection_val, Val_bool)
*/
CAMLprim value ml_gtk_file_selection_get_selections (value sel)
{
gchar** selections =
gtk_file_selection_get_selections(GtkFileSelection_val(sel));
gchar** orig = selections;
CAMLparam0();
CAMLlocal3(ret,prev,next);
for (prev = (value)((&ret)-1); *selections != NULL; selections++) {
next = alloc(2,0);
Store_field(prev, 1, next);
Store_field(next, 0, Val_string(*selections));
prev = next;
}
Field(prev,1) = Val_unit;
g_strfreev(orig);
CAMLreturn(ret);
}
PREFIX value ml_elm_naviframe_top_item_get(value v_obj)
{
Elm_Object_Item* it = elm_naviframe_top_item_get((Evas_Object*) v_obj);
if(it == NULL) return Val_int(0);
value v = caml_alloc(1, 0);
Store_field(v, 0, (value) it);
return v;
}
static value get_server_message(CS_CONNECTION* conn, CS_INT msgno)
{
CAMLparam0();
CAMLlocal2(result,str);
CS_SERVERMSG msg;
retval_inspect(
"ct_diag", ct_diag(conn, CS_GET, CS_SERVERMSG_TYPE, msgno, &msg) );
str = caml_alloc_initialized_string(msg.textlen, msg.text);
result = alloc(2, 0);
Store_field(result, 0, value_of_severity(msg.severity));
Store_field(result, 1, str);
CAMLreturn(result);
}
/* Raises Brlapi_exception */
static void BRLAPI_STDCALL raise_brlapi_exception(int err, brlapi_packetType_t type, const void *packet, size_t size)
{
static value *exception = NULL;
int i;
CAMLparam0();
CAMLlocal2(str, res);
str = caml_alloc_string(size);
for (i=0; i<size; i++) Byte(str, i) = ((char *) packet)[i];
if (exception==NULL) exception = caml_named_value("Brlapi_exception");
res = caml_alloc (4, 0);
Store_field(res, 0, *exception);
Store_field(res, 1, Val_int(err));
Store_field(res, 2, caml_copy_int32(type));
Store_field(res, 3, str);
caml_raise(res);
CAMLreturn0;
}
static inline value Val_some(value v)
{
CAMLparam1(v);
CAMLlocal1(some);
some = caml_alloc(1, 0);
Store_field(some, 0, v);
CAMLreturn(some);
}
static void run_mem(char *pc, value mem, value curr_pos) {
for (;;) {
unsigned char dst, src ;
dst = *pc++ ;
if (dst == 0xff)
return ;
src = *pc++ ;
if (src == 0xff) {
/* fprintf(stderr,"[%hhu] <- %d\n",dst,Int_val(curr_pos)) ;*/
Store_field(mem,dst,curr_pos);
} else {
/* fprintf(stderr,"[%hhu] <- [%hhu]\n",dst,src) ; */
Store_field(mem,dst,Field(mem, src));
}
}
}
value get_commands(value val_commands) {
int i;
for(i=0; i < COMMANDS_NB; i++)
Store_field(val_commands, i, Val_int(commands[i]));
return Val_int(commands[COMMAND_THROTTLE]);
}
paranode mk_none(source_info_t *src_info) {
CAMLparam0();
CAMLlocal1(v);
v = caml_alloc(1, Exp_None);
Store_field(v, 0, Val_int(0));
CAMLreturnT(paranode, mk_node(v, src_info));
}
CAMLprim value
ml_cairo_fill_extents (value v_cr)
{
double x1, y1, x2, y2;
cairo_fill_extents (cairo_t_val (v_cr), &x1, &y1, &x2, &y2);
check_cairo_status (v_cr);
{
CAMLparam0 ();
CAMLlocal1 (t);
t = caml_alloc_tuple (4);
Store_field (t, 0, caml_copy_double (x1));
Store_field (t, 1, caml_copy_double (y1));
Store_field (t, 2, caml_copy_double (x2));
Store_field (t, 3, caml_copy_double (y2));
CAMLreturn (t);
}
}
value copy_Some(value v)
{
CAMLparam1(v);
CAMLlocal1(some);
some = caml_alloc_small(1, 0);
Store_field(some, 0, v);
CAMLreturn(some);
}
value* gcc_cstr(value* array, value** cards, long* values, long len)
{
value a, distribution;
size_t i = 0;
CLOSURE("Gcc.cstr");
distribution = caml_alloc(len, 0);
for(; i<len; ++i)
{
value b = caml_alloc(2, 0);
Store_field(b, 0, cards[i]);
Store_field(b, 1, Val_long(values[i]));
Store_field(distribution, i, b);
}
a = caml_callback2(*closure, *array, distribution);
return fcl_wrap(a);
}
static void run_tag(char *pc, value mem) {
for (;;) {
unsigned char dst, src ;
dst = *pc++ ;
if (dst == 0xff)
return ;
src = *pc++ ;
if (src == 0xff) {
/* fprintf(stderr,"[%hhu] <- -1\n",dst) ; */
Store_field(mem,dst,Val_int(-1));
} else {
/* fprintf(stderr,"[%hhu] <- [%hhu]\n",dst,src) ; */
Store_field(mem,dst, Field(mem, src));
}
}
}
PREFIX value ml_elm_naviframe_item_pop(value v_obj)
{
Evas_Object* top = elm_naviframe_item_pop((Evas_Object*) v_obj);
if(top == NULL) return Val_int(0);
value v = caml_alloc(1, 0);
Store_field(v, 0, (value) top);
return v;
}
CAMLprim value caml_gc_counters(value v)
{
CAMLparam0 (); /* v is ignored */
CAMLlocal1 (res);
/* get a copy of these before allocating anything... */
double minwords = caml_stat_minor_words
+ (double) (caml_young_alloc_end - caml_young_ptr);
double prowords = caml_stat_promoted_words;
double majwords = caml_stat_major_words + (double) caml_allocated_words;
res = caml_alloc_tuple (3);
Store_field (res, 0, caml_copy_double (minwords));
Store_field (res, 1, caml_copy_double (prowords));
Store_field (res, 2, caml_copy_double (majwords));
CAMLreturn (res);
}
value simulation_get_pose3d_stub(value sim_val, value name_val)
{
CAMLparam2(sim_val, name_val);
CAMLlocal1(result);
playerc_simulation_t *sim = Simulation_val(sim_val);
char *name = String_val(name_val);
double x, y, z;
double roll, pitch, yaw;
double time;
DPRINTF("getting sim %p pose3d: name - %s\n", sim, name);
if(playerc_simulation_get_pose3d(sim, name, &x, &y, &z, &roll, &pitch, &yaw, &time))
exception_playerc_error();
DPRINTF("set sim %p pose3d: name - %s x = %f y = %f z = %f roll = %f pitch = %f yaw = %f time = %f\n",
sim, name, x, y, z, roll, pitch, yaw, time);
result = caml_alloc_tuple(7);
Store_field(result, 0, copy_double(x));
Store_field(result, 1, copy_double(y));
Store_field(result, 2, copy_double(z));
Store_field(result, 3, copy_double(roll));
Store_field(result, 4, copy_double(pitch));
Store_field(result, 5, copy_double(yaw));
Store_field(result, 6, copy_double(time));
CAMLreturn(result);
}
/* Inquire actual terminal size (this it what the kernel thinks - not
* was the user on the over end of the phone line has really). */
CAMLexport
value ANSITerminal_term_size(value vfd)
{
CAMLparam1(vfd);
CAMLlocal1(vsize);
int fd = Int_val(vfd);
int x, y;
#ifdef TIOCGSIZE
struct ttysize win;
#elif defined(TIOCGWINSZ)
struct winsize win;
#endif
#ifdef TIOCGSIZE
if (ioctl(fd, TIOCGSIZE, &win))
failwith("ANSITerminal.size");
x = win.ts_cols;
y = win.ts_lines;
#elif defined TIOCGWINSZ
if (ioctl(fd, TIOCGWINSZ, &win))
failwith("ANSITerminal.size");
x = win.ws_col;
y = win.ws_row;
#else
{
const char *s;
s = getenv("LINES");
if (s)
y = strtol(s,NULL,10);
else
y = 25;
s = getenv("COLUMNS");
if (s)
x = strtol(s,NULL,10);
else
x = 80;
}
#endif
vsize = caml_alloc_tuple(2);
Store_field(vsize, 0, Val_int(x));
Store_field(vsize, 1, Val_int(y));
CAMLreturn(vsize);
}
value mk_src_info(source_info_t *src_info) {
CAMLparam0();
CAMLlocal3(ocaml_src_info, file, some_none);
if (src_info != NULL) {
if (src_info->filename) {
//printf("Src info filename: %s\n", src_info->filename);
file = caml_copy_string(src_info->filename);
//int len = strlen(src_info->filename);
//file = caml_alloc_string(len);
//memcpy(String_val(file),src_info->filename , len);
some_none = caml_alloc_tuple(1);
Store_field(some_none, 0, file);
} else {
some_none = Val_int(0);
}
ocaml_src_info = caml_alloc_tuple(3);
Store_field(ocaml_src_info, 0, some_none);
Store_field(ocaml_src_info, 1, Val_int(src_info->line));
Store_field(ocaml_src_info, 2, Val_int(src_info->col));
} else {
ocaml_src_info = caml_alloc_tuple(3);
Store_field(ocaml_src_info, 0, Val_int(0));
Store_field(ocaml_src_info, 1, Val_int(0));
Store_field(ocaml_src_info, 2, Val_int(0));
}
CAMLreturn(ocaml_src_info);
}
paranode mk_lambda(char **args, int num_args, paranode body,
source_info_t *src_info) {
//printf("C: mk_lambda\n");
CAMLparam0();
CAMLlocal4(lam, args_list, node, val_body);
//TODO: Unbreak this by creating a formal_args object
val_body = get_value_and_remove_root(body);
args_list = build_str_list(args, num_args);
// Build the lambda expression
lam = caml_alloc(2, Exp_Lambda);
Store_field(lam, 0, args_list);
Store_field(lam, 1, val_body);
// Build the node and return
CAMLreturnT(paranode, mk_node(lam, src_info));
}
CAMLprim value
caml_backpack_mq_receive(value val_mq, value val_buff, value val_ofs, value val_len)
{
CAMLparam4(val_mq, val_buff, val_ofs, val_len);
CAMLlocal1(val_res);
unsigned int prio;
ssize_t size;
if ((size = mq_receive(Int_val(val_mq), &Byte(val_buff, Long_val(val_ofs)),
Long_val(val_len), &prio)) == -1)
uerror("mq_receive", Nothing);
val_res = caml_alloc_tuple(2);
Store_field(val_res, 0, Val_long(size));
Store_field(val_res, 1, Val_int(prio));
CAMLreturn(val_res);
}
paranode mk_num(value val, source_info_t *src_info) {
CAMLparam1(val);
CAMLlocal1(num);
num = caml_alloc(1, Exp_Num);
Store_field(num, 0, val);
CAMLreturnT(paranode, mk_node(num, src_info));
}
paranode mk_str(char *str, source_info_t *src_info) {
CAMLparam0();
CAMLlocal1(exp_str);
exp_str = caml_alloc(1, Exp_Str);
Store_field(exp_str, 0, caml_copy_string(str));
CAMLreturnT(paranode, mk_node(exp_str, src_info));
}
paranode mk_return(paranode* args, int num_args, source_info_t *src_info) {
//printf("C: ast_stubs.mk_return with %d args\n", num_args);
CAMLparam0();
CAMLlocal2(ret, ret_args);
ret_args = mk_val_list(args, num_args);
ret = caml_alloc(1, Exp_Return);
Store_field(ret, 0, ret_args);
CAMLreturnT(paranode, mk_node(ret, src_info));
}
paranode mk_float_paranode(float f, source_info_t *src_info) {
//printf("C: mk_float: %f\n", f);
CAMLparam0();
CAMLlocal1(val);
val = caml_alloc(1, PARNUM_FLOAT32);
Store_field(val, 0, caml_copy_double((double)f));
CAMLreturnT(paranode, mk_num(val, src_info));
}
paranode mk_double_paranode(double d, source_info_t *src_info) {
//printf("C: mk_double: %f\n", d);
CAMLparam0();
CAMLlocal1(val);
val = caml_alloc(1, PARNUM_FLOAT64);
Store_field(val, 0, caml_copy_double(d));
CAMLreturnT(paranode, mk_num(val, src_info));
}
paranode mk_int64_paranode(int64_t l, source_info_t *src_info) {
CAMLparam0();
CAMLlocal1(val);
val = caml_alloc(1, PARNUM_INT64);
Store_field(val, 0, caml_copy_int64(l));
CAMLreturnT(paranode, mk_num(val, src_info));
}
paranode mk_bool_paranode(int b, source_info_t *src_info) {
//printf("C: mk_bool: %d\n", b);
CAMLparam0();
CAMLlocal1(val);
val = caml_alloc(1, PARNUM_BOOL);
Store_field(val, 0, Val_int(b));
CAMLreturnT(paranode, mk_num(val, src_info));
}
CAMLprim value ml_gtk_text_view_window_to_buffer_coords (value tv,
value tt,
value x,
value y)
{
CAMLparam4(tv,tt,x,y);
CAMLlocal1(res);
int bx,by = 0;
gtk_text_view_window_to_buffer_coords(GtkTextView_val(tv),
Text_window_type_val(tt),
Int_val(x),Int_val(y),
&bx,&by);
res = alloc_tuple(2);
Store_field(res,0,Val_int(bx));
Store_field(res,1,Val_int(by));
CAMLreturn(res);
}
CAMLprim static value SOME(value v) {
CAMLparam1(v);
CAMLlocal1(result);
result = caml_alloc(1, 0);
Store_field(result, 0, v);
CAMLreturn(result);
}
static value llvm_target_option(LLVMTargetRef Target) {
if(Target != NULL) {
value Result = caml_alloc_small(1, 0);
Store_field(Result, 0, (value) Target);
return Result;
}
return Val_int(0);
}