C++ caml_alloc_small函数代码示例

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

CAMLprim value ocamlr_eval_sxp (value sexp_list) {

  /* sexp_list is an OCaml value containing a SEXP of sexptype LANGSXP.
     This is a LISP-style pairlist of SEXP values. r_eval_sxp executes
     the whole pairlist, and sends back the resulting SEXP wrapped up in
     an OCaml value. There's also an error handling mechanism. */

  /* r_eval_sxp handles values of type LANGSXP and PROMSXP. So we have two
     functions on the OCaml side associated to this stub, the first on
     with type lang sexp -> raw sexp, the other one with type
     prom sexp -> raw sexp. This also means that there is a dynamic type
     checking being done in the scope of the R_tryEval function, and it
     would be nice to shortcut it with statically typed equivalents. */

  CAMLparam0();

  SEXP e;        // Placeholder for the result of beta-reduction.
  int error = 0; // Error catcher boolean.

  SEXP our_call = Sexp_val(sexp_list);
  caml_enter_blocking_section();
  e = R_tryEval(our_call, R_GlobalEnv, &error);
  caml_leave_blocking_section();

  /* Implements error handling from R to Objective Caml. */
  if (error) {

    value ml_error_call = Val_unit;
    value ml_error_message = Val_unit;

    Begin_roots2(ml_error_call, ml_error_message);

    ml_error_call = Val_sexp(ocamlr_error_call);
    ocamlr_error_call = NULL;      //should check for a memory leak here...
                                   //depends on GC status of prior error_call.

    ml_error_message = caml_copy_string(ocamlr_error_message);
    ocamlr_error_message = NULL;   //should check for a memory leak here...
                                   //it seems to me that a string is leaked here.

    value error_result = caml_alloc_small(2, 0);
    Store_field(error_result, 0, ml_error_call);
    Store_field(error_result, 1, ml_error_message);

    /* The exception callback mechanism is described on the webpage
       http://www.pps.jussieu.fr/Livres/ora/DA-OCAML/book-ora118.html
       We should check to see if we could avoid the string-name lookup
       to avoid unnecessary delays in exception handling. */

    caml_raise_with_arg(*caml_named_value("OCaml-R generic error"), error_result);

    End_roots();
  }

  CAMLreturn(Val_sexp(e));
}

// constructor QWidget(QWidget* parent  = 0,Qt::WindowFlags f  = 0)
//argnames = (arg0 arg1)
    value native_pub_createeee_QWidget_QWidget_Qt_WindowFlags(value arg0,value arg1) {
        CAMLparam2(arg0,arg1);
        CAMLlocal1(_ans);
        QWidget* _arg0 = (arg0==Val_none) ? NULL : ((QWidget* )(Some_val(arg0)));
        Qt::WindowFlags _arg1 = enum_of_caml_Qt_WindowFlags(arg1);
        QWidget* ans = new QWidget(_arg0, _arg1);
        _ans = caml_alloc_small(1, Abstract_tag);
        (*((QWidget **) &Field(_ans, 0))) = ans;
        CAMLreturn(_ans);
    }

value coq_makeaccu (value i) {
  CAMLparam1(i);
  CAMLlocal1(res);
  code_t q = coq_stat_alloc(2 * sizeof(opcode_t));
  res = caml_alloc_small(1, Abstract_tag);
  Code_val(res) = q;
  *q++ = VALINSTR(MAKEACCU);
  *q = (opcode_t)Int_val(i);
  CAMLreturn(res);
}

value ml_physh_set_alloc(value empty, value null)
{
    CAMLparam2(empty, null);
    CAMLlocal2(v,vmin);

    vmin = caml_alloc_small(2, 0);
    Field(vmin, 0) = null;
    Field(vmin, 1) = null;

    v = caml_alloc_small(6, 0);
    Field(v, 0) = Val_int(caml_stat_minor_collections);
    Field(v, 1) = Val_int(0);
    Field(v, 2) = vmin;
    Field(v, 3) = Val_int(caml_stat_compactions);
    Field(v, 4) = Val_int(0);
    Field(v, 5) = empty;

    CAMLreturn(v);
}

static value
lseek_cb(uv_req_t * req)
{
  const struct req * r = req->data;
  value ret;
  const int64_t offset = voids_to_int64_t(&r->c);
  if ( offset == -1 ){
    ret = caml_alloc_small(1,Error_tag);
    Field(ret,0) = Val_uwt_error(r->offset);
  }
  else {
    value p = caml_copy_int64(offset);
    Begin_roots1(p);
    ret = caml_alloc_small(1,Ok_tag);
    Field(ret,0) = p;
    End_roots();
  }
  return ret;
}

CAMLexport void caml_raise_constant(value tag)
{
  CAMLparam1 (tag);
  CAMLlocal1 (bucket);

  bucket = caml_alloc_small (1, 0);
  Field(bucket, 0) = tag;
  caml_raise(bucket);
  CAMLnoreturn;
}

static inline void raise_with_two_args(value v_tag, value v_arg1, value v_arg2)
{
  CAMLparam3(v_tag, v_arg1, v_arg2);
  value v_exc = caml_alloc_small(3, 0);
  Field(v_exc, 0) = v_tag;
  Field(v_exc, 1) = v_arg1;
  Field(v_exc, 2) = v_arg2;
  caml_raise(v_exc);
  CAMLnoreturn;
}

CAMLprim value lightsource_process(value record_lightsource,
                                   value list_polygon_objects,
                                   value polygon_view) {
  CAMLparam3(record_lightsource, list_polygon_objects, polygon_view);
  CAMLlocal5(polygon_prev_head, list_polygon_head, vector_prev_head,
             list_vector_head, tmp_polygon);
  CAMLlocal1(tmp_vector);
  LightSource l = LightSource(Vector_val(Field(record_lightsource, 0)),
                              Double_val(Field(record_lightsource, 1)),
                              Double_val(Field(record_lightsource, 2)));
  std::vector<Polygon> tmp_polygon_list = std::vector<Polygon>();
  polygon_list_to_std_vector(list_polygon_objects, &tmp_polygon_list);
  std::vector<Vector> tmp_vector_list = std::vector<Vector>();
  vector_list_to_std_vector(Field(polygon_view, 0), &tmp_vector_list);
  Polygon polygon = Polygon(tmp_vector_list);
  // auto start = std::chrono::steady_clock::now();
  std::vector<Polygon> list_polygon = l.process(tmp_polygon_list);
  // auto duration = std::chrono::duration_cast<std::chrono::milliseconds>(
  //     std::chrono::steady_clock::now() - start);
  // printf("--> %lld\n", duration.count());
  polygon_prev_head = Val_unit;
  for (Polygon p : list_polygon) {
    vector_prev_head = Val_unit;
    for (Vector v : p.get_vertices()) {
      tmp_vector = caml_alloc_small(2, Double_array_tag);
      Double_field(tmp_vector, 0) = v.x;
      Double_field(tmp_vector, 1) = v.y;
      list_vector_head = caml_alloc_small(2, 0);
      Field(list_vector_head, 0) = tmp_vector;
      Field(list_vector_head, 1) = vector_prev_head;
      vector_prev_head = list_vector_head;
    }
    tmp_polygon = caml_alloc_small(1, 0);
    Field(tmp_polygon, 0) = list_vector_head;

    list_polygon_head = caml_alloc_small(2, 0);
    Field(list_polygon_head, 0) = tmp_polygon;
    Field(list_polygon_head, 1) = polygon_prev_head;
    polygon_prev_head = list_polygon_head;
  }
  CAMLreturn(list_polygon_head);
}

value my_alloc_sockaddr(struct sockaddr_storage *ss)
{
  value res, a;
  struct sockaddr_un *sun;
  struct sockaddr_in *sin;
  struct sockaddr_in6 *sin6;

  switch(ss->ss_family) {
  case AF_UNIX:
    sun = (struct sockaddr_un *) ss;
    a = caml_copy_string(sun->sun_path);
    Begin_root (a);
    res = caml_alloc_small(1, 0);
    Field(res,0) = a;
    End_roots();
    break;
  case AF_INET:
    sin = (struct sockaddr_in *) ss;
    a = caml_alloc_string(4);
    memcpy(String_val(a), &sin->sin_addr, 4);
    Begin_root (a);
    res = caml_alloc_small(2, 1);
    Field(res, 0) = a;
    Field(res, 1) = Val_int(ntohs(sin->sin_port));
    End_roots();
    break;
  case AF_INET6:
    sin6 = (struct sockaddr_in6 *) ss;
    a = caml_alloc_string(16);
    memcpy(String_val(a), &sin6->sin6_addr, 16);
    Begin_root (a);
    res = caml_alloc_small(2, 1);
    Field(res, 0) = a;
    Field(res, 1) = Val_int(ntohs(sin6->sin6_port));
    End_roots();
    break;
  default:
    unix_error(EAFNOSUPPORT, "", Nothing);
  }

  return res;
}

value
Val_cairo_font_extents (cairo_font_extents_t * s)
{
  value v = caml_alloc_small (5 * Double_wosize, Double_array_tag);
  Store_double_field (v, 0, s->ascent);
  Store_double_field (v, 1, s->descent);
  Store_double_field (v, 2, s->height);
  Store_double_field (v, 3, s->max_x_advance);
  Store_double_field (v, 4, s->max_y_advance);
  return v;
}

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 inline value Val_rc(int rc)
{
  value v_res;
  if (rc >= 0) {
    if (rc <= 26) return Val_int(rc);
    if (rc == 100 || rc == 101) return Val_int(rc - 73);
  }
  v_res = caml_alloc_small(1, 0);
  Field(v_res, 0) = Val_int(rc);
  return v_res;
}

static value value_of_mouse_button(Uint8 b)
{
  value r;
  if (SDL_BUTTON_LEFT <= b && b <= SDL_BUTTON_WHEELDOWN)
    r = Val_int(b - 1);
  else {
    r = caml_alloc_small(1, 0);
    Field(r, 0) = Val_int(b);
  }
  return r;
}

CAMLprim value lightsource_create_lightsource(value vector_position,
                                              value double_radius,
                                              value double_strength) {
  CAMLparam3(vector_position, double_radius, double_strength);
  CAMLlocal1(record_lightsource);
  record_lightsource = caml_alloc_small(3, 0);
  Field(record_lightsource, 0) = vector_position;
  Field(record_lightsource, 1) = double_radius;
  Field(record_lightsource, 2) = double_strength;
  CAMLreturn(record_lightsource);
}