C++ CAMLlocal3函数代码示例

CAMLprim value getFileInfos (value path, value need_size) {
#ifdef __APPLE__

  CAMLparam1(path);
  CAMLlocal3(res, fInfo, length);
  int retcode;
  struct attrlist attrList;
  unsigned long options = FSOPT_REPORT_FULLSIZE;
  struct {
    u_int32_t length;
    char      finderInfo [32];
    off_t     rsrcLength;
  } __attribute__ ((packed)) attrBuf;

  attrList.bitmapcount = ATTR_BIT_MAP_COUNT;
  attrList.reserved = 0;
  attrList.commonattr = ATTR_CMN_FNDRINFO;
  attrList.volattr = 0;     /* volume attribute group */
  attrList.dirattr = 0;     /* directory attribute group */
  if (Bool_val (need_size))
    attrList.fileattr = ATTR_FILE_RSRCLENGTH;    /* file attribute group */
  else
    attrList.fileattr = 0;
  attrList.forkattr = 0;    /* fork attribute group */

  retcode = getattrlist(String_val (path), &attrList, &attrBuf,
                        sizeof attrBuf, options);

  if (retcode == -1) uerror("getattrlist", path);

  if (Bool_val (need_size)) {
    if (attrBuf.length != sizeof attrBuf)
      unix_error (EINVAL, "getattrlist", path);
  } else {
    if (attrBuf.length != sizeof (u_int32_t) + 32)
      unix_error (EINVAL, "getattrlist", path);
  }

  fInfo = alloc_string (32);
  memcpy (String_val (fInfo), attrBuf.finderInfo, 32);
  if (Bool_val (need_size))
    length = copy_int64 (attrBuf.rsrcLength);
  else
    length = copy_int64 (0);

  res = alloc_small (2, 0);
  Field (res, 0) = fInfo;
  Field (res, 1) = length;

  CAMLreturn (res);

#else

  unix_error (ENOSYS, "getattrlist", path);

#endif
}

static value val_of_result_pair (gsl_sf_result *re, gsl_sf_result *im)
{
  CAMLparam0 ();
  CAMLlocal3 (v, v_re, v_im);
  v_re = val_of_result (re);
  v_im = val_of_result (im);
  v = alloc_small (2, 0);
  Field (v, 0) = v_re;
  Field (v, 1) = v_im;
  CAMLreturn (v);
}

CAMLprim value caml_sys_get_argv(value unit)
{
  CAMLparam0 ();   /* unit is unused */
  CAMLlocal3 (exe_name, argv, res);
  exe_name = caml_copy_string(caml_exe_name);
  argv = caml_copy_string_array((char const **) caml_main_argv);
  res = caml_alloc_small(2, 0);
  Field(res, 0) = exe_name;
  Field(res, 1) = argv;
  CAMLreturn(res);
}

Eina_Bool ml_Elm_Gen_Item_State_Get_Cb(
        void* data, Evas_Object* obj, const char* part)
{
        CAMLparam0();
        CAMLlocal3(v_obj, v_part, v);
        value* v_class = data;
        v_obj = copy_Evas_Object(obj);
        v_part = copy_string(part);
        v = caml_callback2(Field(*v_class, 3), v_obj, v_part);
        CAMLreturnT(Eina_Bool, Eina_Bool_val(v));
}

void QWidget_twin::acceptDrops() {
    CAMLparam0();
    CAMLlocal3(camlobj,_ans,meth);
    printf("Calling QSpinBox::acceptDrops of object = %p\n",this);
    GET_CAML_OBJECT(this,the_caml_object)
    camlobj = (value) the_caml_object;
    meth = caml_get_public_method( camlobj, caml_hash_variant("acceptDrops"));
    assert(meth!=0);
    _ans = caml_callback(meth, camlobj);;
    bool ans = Bool_val(_ans);;
    CAMLreturnT(bool,ans);
}

struct ev_info *process_debug_events(code_t code_start, value events_heap, mlsize_t *num_events) {
  CAMLparam1(events_heap);
  CAMLlocal3(l, ev, ev_start);
  mlsize_t i, j;
  struct ev_info *events;

  /* Compute the size of the required event buffer. */
  *num_events = 0;
  for (i = 0; i < caml_array_length(events_heap); i++)
    for (l = Field(events_heap, i); l != Val_int(0); l = Field(l, 1))
      (*num_events)++;

  events = malloc(*num_events * sizeof(struct ev_info));
  if(events == NULL)
    caml_fatal_error ("caml_add_debug_info: out of memory");

  j = 0;
  for (i = 0; i < caml_array_length(events_heap); i++) {
    for (l = Field(events_heap, i); l != Val_int(0); l = Field(l, 1)) {
      ev = Field(l, 0);

      events[j].ev_pc = (code_t)((char*)code_start + Long_val(Field(ev, EV_POS)));

      ev_start = Field(Field(ev, EV_LOC), LOC_START);

      {
        uintnat fnsz = caml_string_length(Field(ev_start, POS_FNAME)) + 1;
        events[j].ev_filename = (char*)malloc(fnsz);
        if(events[j].ev_filename == NULL)
          caml_fatal_error ("caml_add_debug_info: out of memory");
        memcpy(events[j].ev_filename,
               String_val(Field(ev_start, POS_FNAME)),
               fnsz);
      }

      events[j].ev_lnum = Int_val(Field(ev_start, POS_LNUM));
      events[j].ev_startchr =
        Int_val(Field(ev_start, POS_CNUM))
        - Int_val(Field(ev_start, POS_BOL));
      events[j].ev_endchr =
        Int_val(Field(Field(Field(ev, EV_LOC), LOC_END), POS_CNUM))
        - Int_val(Field(ev_start, POS_BOL));

      j++;
    }
  }

  Assert(j == *num_events);

  qsort(events, *num_events, sizeof(struct ev_info), cmp_ev_info);

  CAMLreturnT(struct ev_info *, events);
}

Evas_Object* ml_Elm_Gen_Item_Content_Get_Cb(
        void* data, Evas_Object* obj, const char* part)
{
        CAMLparam0();
        CAMLlocal3(v_obj, v_part, v);
        value* v_class = data;
        v_part = copy_string(part);
        v_obj = copy_Evas_Object(obj);
        v = caml_callback2(Field(*v_class, 2), v_obj, v_part);
        if(v == Val_int(0)) CAMLreturnT(Evas_Object*, NULL);
        else CAMLreturnT(Evas_Object*, Evas_Object_val(Field(v, 0)));
}

static inline value val_of_result_e10(gsl_sf_result_e10 *result)
{
  CAMLparam0();
  CAMLlocal3(r, v, e) ;
  v = copy_double(result->val);
  e = copy_double(result->err);
  r = alloc_small(3, 0);
  Field(r, 0) = v;
  Field(r, 1) = e;
  Field(r, 2) = Val_int(result->e10);
  CAMLreturn(r);
}

static void read_main_debug_info(struct debug_info *di)
{
  CAMLparam0();
  CAMLlocal3(events, evl, l);
  char_os *exec_name;
  int fd, num_events, orig, i;
  struct channel *chan;
  struct exec_trailer trail;

  CAMLassert(di->already_read == 0);
  di->already_read = 1;

  if (caml_params->cds_file != NULL) {
    exec_name = (char_os*) caml_params->cds_file;
  } else {
    exec_name = (char_os*) caml_params->exe_name;
  }

  fd = caml_attempt_open(&exec_name, &trail, 1);
  if (fd < 0){
    caml_fatal_error ("executable program file not found");
    CAMLreturn0;
  }

  caml_read_section_descriptors(fd, &trail);
  if (caml_seek_optional_section(fd, &trail, "DBUG") != -1) {
    chan = caml_open_descriptor_in(fd);

    num_events = caml_getword(chan);
    events = caml_alloc(num_events, 0);

    for (i = 0; i < num_events; i++) Op_val(events)[i] = Val_unit;

    for (i = 0; i < num_events; i++) {
      orig = caml_getword(chan);
      evl = caml_input_val(chan);
      caml_input_val(chan); /* Skip the list of absolute directory names */
      /* Relocate events in event list */
      for (l = evl; l != Val_int(0); l = Field_imm(l, 1)) {
        value ev = Field_imm(l, 0);
        Store_field (ev, EV_POS, Val_long(Long_val(Field(ev, EV_POS)) + orig));
      }
      /* Record event list */
      Store_field(events, i, evl);
    }

    caml_close_channel(chan);

    di->events = process_debug_events(caml_start_code, events, &di->num_events);
  }

  CAMLreturn0;
}

return_val_t run_function(int id, 
    host_val *globals, int num_globals,
    host_val *args, int num_args, 
    char** kwd_arg_names, host_val* kwd_arg_values, int num_kwd_args) {
  CAMLparam0();
  CAMLlocal3(ocaml_globals, ocaml_actuals, ocaml_result);
  printf("[run_function] %d globals, %d args, %d kwd args\n", num_globals, num_args, num_kwd_args);
  ocaml_globals = build_host_val_list(globals, num_globals);
  ocaml_actuals = mk_actual_args(args, num_args, kwd_arg_names, kwd_arg_values, num_kwd_args); 
  ocaml_result = caml_callback3(*ocaml_run_function, Val_int(id), ocaml_globals, ocaml_actuals);
  CAMLreturnT(return_val_t, translate_return_value(ocaml_result));
}

char* ml_Elm_Gen_Item_Text_Get_Cb(
        void* data, Evas_Object* obj, const char* part)
{
        CAMLparam0();
        CAMLlocal3(v_obj, v_part, v);
        value* v_class = data;
        v_obj = copy_Evas_Object(obj);
        v_part = copy_string(part);
        v = caml_callback2(Field(*v_class, 1), v_obj, v_part);
        char* r = strdup(String_val(v));
        if(r == NULL) caml_raise_out_of_memory();
        CAMLreturnT(char*, r);
}

paranode mk_whileloop(paranode test, paranode body, source_info_t *src_info) {
  CAMLparam0();
  CAMLlocal3(val_test, val_body, loop);

  val_test = get_value_and_remove_root(test);
  val_body = get_value_and_remove_root(body);

  loop = caml_alloc(2, Exp_WhileLoop);
  Store_field(loop, 0, val_test);
  Store_field(loop, 1, val_body);

  CAMLreturnT(paranode, mk_node(loop, src_info));
}

paranode mk_countloop(paranode count, paranode body, source_info_t *src_info) {
  CAMLparam0();
  CAMLlocal3(val_count, val_body, loop);

  val_count = get_value_and_remove_root(count);
  val_body  = get_value_and_remove_root(body);

  loop = caml_alloc(2, Exp_CountLoop);
  Store_field(loop, 0, val_count);
  Store_field(loop, 1, val_body);

  CAMLreturnT(paranode, mk_node(loop, src_info));
}

char * range_compress(const char ** c_nodes, const char* c_separator) {
  CAMLparam0();
  CAMLlocal3(caml_result, caml_nodes, caml_separator);

  caml_nodes = copy_string_array(c_nodes);
  caml_separator = caml_copy_string(c_separator);
  caml_result = callback2_exn(*cb_range_compress, caml_nodes, caml_separator);

  if (range_set_exception(caml_result))
    CAMLreturn(NULL);
  else
    CAMLreturn(strdup(String_val(caml_result)));
}

CAMLprim value spoc_cublasSscal (value n, value alpha, value x, value incx, value dev){
	CAMLparam5(n, alpha, x,incx, dev);
	CAMLlocal3(dev_vec_array, dev_vec, gi);
	CUdeviceptr d_A;
	int id;
	GET_VEC(x, d_A);
	CUBLAS_GET_CONTEXT;

	cublasSscal(Int_val(n), (float)(Double_val(alpha)), (float*)d_A, Int_val(incx));
	CUBLAS_CHECK_CALL(cublasGetError());
	CUDA_RESTORE_CONTEXT;
	CAMLreturn(Val_unit);
}