예제 #1
0
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);
}
예제 #2
0
파일: ml_gtk.c 프로젝트: CRogers/obc
/* 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);
}
예제 #3
0
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;
}
예제 #4
0
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);
}
예제 #5
0
파일: brlapi_stubs.c 프로젝트: mlang/brltty
/* 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;
}
예제 #6
0
static inline value Val_some(value v)
{
    CAMLparam1(v);
    CAMLlocal1(some);
    some = caml_alloc(1, 0);
    Store_field(some, 0, v);
    CAMLreturn(some);
}
예제 #7
0
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));
    }
  }
}
예제 #8
0
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]);
}
예제 #9
0
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));
}
예제 #10
0
파일: ml_cairo.c 프로젝트: DMClambo/pfff
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);
  }
}
예제 #11
0
value copy_Some(value v)
{
    CAMLparam1(v);
    CAMLlocal1(some);
    some = caml_alloc_small(1, 0);
    Store_field(some, 0, v);
    CAMLreturn(some);
}
예제 #12
0
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);
}
예제 #13
0
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));
    }
  }
}
예제 #14
0
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;
}
예제 #15
0
파일: gc_ctrl.c 프로젝트: vouillon/ocaml
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);
}
예제 #16
0
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);
}
예제 #17
0
/* 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);
}
예제 #18
0
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);
}
예제 #19
0
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));
}
예제 #20
0
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);
}
예제 #21
0
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));
}
예제 #22
0
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));
}
예제 #23
0
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));
}
예제 #24
0
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));
}
예제 #25
0
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));
}
예제 #26
0
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));
}
예제 #27
0
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));
}
예제 #28
0
파일: ml_gtktext.c 프로젝트: knuton/lablgtk
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);
}
예제 #29
0
파일: flowlib_elf.c 프로젝트: AKST/flow
CAMLprim static value SOME(value v) {
  CAMLparam1(v);
  CAMLlocal1(result);

  result = caml_alloc(1, 0);
  Store_field(result, 0, v);

  CAMLreturn(result);
}
예제 #30
0
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);
}