static int domain_build_info_val (caml_gc *gc, libxl_domain_build_info *c_val, value v) { CAMLparam1(v); CAMLlocal1(infopriv); c_val->max_vcpus = Int_val(Field(v, 0)); c_val->cur_vcpus = Int_val(Field(v, 1)); c_val->max_memkb = Int64_val(Field(v, 2)); c_val->target_memkb = Int64_val(Field(v, 3)); c_val->video_memkb = Int64_val(Field(v, 4)); c_val->shadow_memkb = Int64_val(Field(v, 5)); c_val->kernel.path = dup_String_val(gc, Field(v, 6)); c_val->is_hvm = Tag_val(Field(v, 7)) == 0; infopriv = Field(Field(v, 7), 0); if (c_val->hvm) { c_val->u.hvm.pae = Bool_val(Field(infopriv, 0)); c_val->u.hvm.apic = Bool_val(Field(infopriv, 1)); c_val->u.hvm.acpi = Bool_val(Field(infopriv, 2)); c_val->u.hvm.nx = Bool_val(Field(infopriv, 3)); c_val->u.hvm.viridian = Bool_val(Field(infopriv, 4)); c_val->u.hvm.timeoffset = dup_String_val(gc, Field(infopriv, 5)); c_val->u.hvm.timer_mode = Int_val(Field(infopriv, 6)); c_val->u.hvm.hpet = Int_val(Field(infopriv, 7)); c_val->u.hvm.vpt_align = Int_val(Field(infopriv, 8)); } else { c_val->u.pv.slack_memkb = Int64_val(Field(infopriv, 0)); c_val->u.pv.cmdline = dup_String_val(gc, Field(infopriv, 1)); c_val->u.pv.ramdisk.path = dup_String_val(gc, Field(infopriv, 2)); c_val->u.pv.features = dup_String_val(gc, Field(infopriv, 3)); } CAMLreturn(0); }
/* Guestfs.create */ value ocaml_guestfs_create (value environmentv, value close_on_exitv, value unitv) { CAMLparam3 (environmentv, close_on_exitv, unitv); CAMLlocal1 (gv); unsigned flags = 0; guestfs_h *g; if (environmentv != Val_int (0) && !Bool_val (Field (environmentv, 0))) flags |= GUESTFS_CREATE_NO_ENVIRONMENT; if (close_on_exitv != Val_int (0) && !Bool_val (Field (close_on_exitv, 0))) flags |= GUESTFS_CREATE_NO_CLOSE_ON_EXIT; g = guestfs_create_flags (flags); if (g == NULL) caml_failwith ("failed to create guestfs handle"); guestfs_set_error_handler (g, NULL, NULL); gv = Val_guestfs (g); CAMLreturn (gv); }
static int device_pci_val(caml_gc *gc, libxl_device_pci *c_val, value v) { union { unsigned int value; struct { unsigned int reserved1:2; unsigned int reg:6; unsigned int func:3; unsigned int dev:5; unsigned int bus:8; unsigned int reserved2:7; unsigned int enable:1; }fields; }u; CAMLparam1(v); /* FIXME: propagate API change to ocaml */ u.value = Int_val(Field(v, 0)); c_val->reg = u.fields.reg; c_val->func = u.fields.func; c_val->dev = u.fields.dev; c_val->bus = u.fields.bus; c_val->enable = u.fields.enable; c_val->domain = Int_val(Field(v, 1)); c_val->vdevfn = Int_val(Field(v, 2)); c_val->msitranslate = Bool_val(Field(v, 3)); c_val->power_mgmt = Bool_val(Field(v, 4)); CAMLreturn(0); }
value start_interp(value may_free, value prog, value offset, value vlen) /* ML */ { bytecode_t bprog = (bytecode_t)&Byte(prog, Long_val(offset)); // In ML heap int len = Long_val(vlen); value res; #if defined(MOSML_BIG_ENDIAN) && !defined(ALIGNMENT) fixup_endianness(&Byte(prog, 0), (asize_t) len); #endif #if defined(DIRECT_JUMP) && defined(THREADED) { realcode_t generated_code; res = interprete(/* mode=byte exec */ 1, bprog, len, &generated_code); if (Bool_val(may_free)) { // printf("start_interp freeing: generated_code=%d, len=%d\n", // (int)*generated_code, len); free(generated_code); // Allocated by the call to interprete() } } #else { // Copy bytecode to memory outside the ML heap bytecode_t actualprog = (bytecode_t)malloc(len); bcopy(bprog, actualprog, len); res = interprete(/* mode=byte exec */ 1, actualprog, len, NULL); if (Bool_val(may_free)) free(actualprog); // Allocated above } #endif return res; }
CAMLprim value tun_opendev(value devname, value kind, value pi, value persist, value user, value group) { CAMLparam5(devname, kind, pi, persist, user); CAMLxparam1(group); CAMLlocal2(res, dev_caml); char dev[IFNAMSIZ]; int fd; #if defined (__APPLE__) && defined (__MACH__) if (caml_string_length(devname) < 4) caml_failwith("On MacOSX, you need to specify the name of the device, e.g. tap0"); #endif memset(dev, 0, sizeof dev); memcpy(dev, String_val(devname), caml_string_length(devname)); // All errors are already checked by tun_alloc, returned fd is valid // otherwise it would have crashed before fd = tun_alloc(dev, Int_val(kind), Bool_val(pi), Bool_val(persist), Int_val(user), Int_val(group)); res = caml_alloc_tuple(2); dev_caml = caml_copy_string(dev); Store_field(res, 0, Val_int(fd)); Store_field(res, 1, dev_caml); CAMLreturn(res); }
PREFIX Elm_Actionslider_Pos Elm_Actionslider_Pos_vals( value v_left, value v_center, value v_right) { Elm_Actionslider_Pos pos = 0; if(Bool_val(v_left)) pos = pos | ELM_ACTIONSLIDER_LEFT; if(Bool_val(v_center)) pos = pos | ELM_ACTIONSLIDER_CENTER; if(Bool_val(v_right)) pos = pos | ELM_ACTIONSLIDER_RIGHT; return pos; }
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 int lsolver_translate_exception(value vexn) { CAMLparam1(vexn); CAMLlocal1(vtag); int r; vtag = Field(vexn, 0); if (vtag == SUNDIALS_EXN_TAG(RecoverableFailure)) { r = 100; } else if (vtag == LSOLVER_EXN_TAG(ATimesFailure)) { r = Bool_val(Field(vexn, 1)) ? SUNLS_ATIMES_FAIL_REC : SUNLS_ATIMES_FAIL_UNREC; } else if (vtag == LSOLVER_EXN_TAG(PSetFailure)) { r = Bool_val(Field(vexn, 1)) ? SUNLS_PSET_FAIL_REC : SUNLS_PSET_FAIL_UNREC; } else if (vtag == LSOLVER_EXN_TAG(PSolveFailure)) { r = Bool_val(Field(vexn, 1)) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; } else if (vtag == LSOLVER_EXN_TAG(GSFailure)) { r = SUNLS_GS_FAIL; } else if (vtag == LSOLVER_EXN_TAG(QRSolFailure)) { r = SUNLS_QRSOL_FAIL; } else if (vtag == LSOLVER_EXN_TAG(ResReduced)) { r = SUNLS_RES_REDUCED; } else if (vtag == LSOLVER_EXN_TAG(ConvFailure)) { r = SUNLS_CONV_FAIL; } else if (vtag == LSOLVER_EXN_TAG(QRfactFailure)) { r = SUNLS_QRFACT_FAIL; } else if (vtag == LSOLVER_EXN_TAG(LUfactFailure)) { r = SUNLS_LUFACT_FAIL; } else if (vtag == LSOLVER_EXN_TAG(PackageFailure)) { r = Bool_val(Field(vexn, 1)) ? SUNLS_PACKAGE_FAIL_REC : SUNLS_PACKAGE_FAIL_UNREC; } else if (vtag == LSOLVER_EXN_TAG(InvalidArgument)) { r = SUNLS_ILL_INPUT; } else { r = -100; } CAMLreturnT(int, r); }
extern "C" CAMLprim value ml_IGUIContextMenu_addItem_native( value v_cm, value v_text, value v_cmd_id, value v_enabled, value v_has_submenu, value v_checked, value v_auto_checking) { int text_size = caml_string_length(v_text); IGUIContextMenu* cm = (IGUIContextMenu*) v_cm; wchar_t text[text_size + 1]; u32 idx; mbstowcs(text, String_val(v_text), text_size); idx = cm->addItem(text, Bool_val(v_enabled), Bool_val(v_has_submenu), Bool_val(v_checked), Bool_val(v_auto_checking)); return Val_int(idx); }
CAMLprim value ocaml_ssl_set_mode(value socket, value mode) { CAMLparam2(socket,mode); long m; ssl_socket_t *ssl = ssl_socket_of_block(socket); m = 0; if (Bool_val(Field(mode, 0))) m |= SSL_MODE_ENABLE_PARTIAL_WRITE; if (Bool_val(Field(mode, 1))) m |= SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER; if (Bool_val(Field(mode, 2))) m |= SSL_MODE_AUTO_RETRY; SSL_set_mode(ssl->handler, m); CAMLreturn(Val_unit); }
extern "C" CAMLprim value ml_IGUIEnvironment_addStaticText_native( value v_env, value v_text, value v_rect, value v_border, value v_word_warp, value v_parent, value v_id, value v_fill_bg) { IGUIElement* parent; if(v_parent == Val_int(0)) parent = NULL; else parent = (IGUIElement*) Field(v_parent, 0); int text_size = strlen(String_val(v_text)); wchar_t text[text_size + 1]; mbstowcs(text, String_val(v_text), text_size + 1); return (value) ((IGUIEnvironment*) v_env)->addStaticText(text, Rect_s32_val(v_rect), Bool_val(v_border), Bool_val(v_word_warp), parent, Int_val(v_id), Bool_val(v_fill_bg)); }
static int device_disk_val(caml_gc *gc, libxl_device_disk *c_val, value v) { CAMLparam1(v); c_val->backend_domid = Int_val(Field(v, 0)); c_val->pdev_path = dup_String_val(gc, Field(v, 1)); c_val->vdev = dup_String_val(gc, Field(v, 2)); c_val->backend = (Int_val(Field(v, 3))); c_val->format = (Int_val(Field(v, 4))); c_val->unpluggable = Bool_val(Field(v, 5)); c_val->readwrite = Bool_val(Field(v, 6)); c_val->is_cdrom = Bool_val(Field(v, 7)); CAMLreturn(0); }
CAMLprim value pattern_font_sort(value plist, value trim) { CAMLparam0(); CAMLlocal2(res, nres); FcPattern *pat; FcFontSet *match; FcResult result; int i; pat = FcPattern_val(plist); FcConfigSubstitute(NULL, pat, FcMatchPattern); FcDefaultSubstitute(pat); match = FcFontSort(NULL, pat, Bool_val(trim) ? FcTrue : FcFalse, NULL, &result); /* Reconstruire la belle liste */ res = Val_int(0); /* empty list */ for(i = match->nfont; i >= 0; i--) { nres = caml_alloc(2, 0); Store_field(nres, 0, caml_copy_pattern(match->fonts[i])); Store_field(nres, 1, res); res = nres; } FcFontSetDestroy(match); FcPatternDestroy(pat); CAMLreturn(res); }
CAMLprim value ml_skin_init (value use_vbo_v, value geom_v) { CAMLparam2 (use_vbo_v, geom_v); CAMLlocal5 (vertexa_v, normala_v, uva_v, skin_v, colors_v); State *s = &glob_state; use_vbo = Bool_val (use_vbo_v); #ifdef _WIN32 if (use_vbo) { GETPA (BindBuffer); GETPA (GenBuffers); GETPA (BufferData); GETPA (BufferSubData); GETPA (MapBuffer); GETPA (UnmapBuffer); } #endif vertexa_v = Field (geom_v, 0); normala_v = Field (geom_v, 1); uva_v = Field (geom_v, 2); skin_v = Field (geom_v, 3); colors_v = Field (geom_v, 4); skin_init (s, vertexa_v, normala_v, uva_v, skin_v, colors_v); CAMLreturn (Val_unit); }
CAMLprim value caml_sqlite3_enable_load_extension(value v_db, value v_onoff) { int ret; db_wrap *dbw = Sqlite3_val(v_db); ret = sqlite3_enable_load_extension(dbw->db, Bool_val(v_onoff)); return Val_bool(ret); }
CAMLprim value sunml_idas_superlumtb_init (value vparent_which, value vneqs, value vnnz, value vnthreads, value vusesens) { CAMLparam5(vparent_which, vneqs, vnnz, vnthreads, vusesens); #if SUNDIALS_LIB_VERSION < 300 void *ida_mem = IDA_MEM_FROM_ML (Field(vparent_which, 0)); int which = Int_val(Field(vparent_which, 1)); int flag; flag = IDASuperLUMTB (ida_mem, which, Int_val(vnthreads), Int_val(vneqs), Int_val(vnnz)); CHECK_FLAG ("IDASuperLUMTB", flag); if (Bool_val(vusesens)) { flag = IDASlsSetSparseJacFnBS(ida_mem, which, jacfn_withsens); CHECK_FLAG("IDASlsSetSparseJacFnBS", flag); } else { flag = IDASlsSetSparseJacFnB (ida_mem, which, jacfn_nosens); CHECK_FLAG("IDASlsSetSparseJacFnB", flag); } #else caml_raise_constant(SUNDIALS_EXN(NotImplementedBySundialsVersion)); #endif CAMLreturn (Val_unit); }
CAMLprim value caml_mdb_drop(value txn,value dbi,value del){ CAMLparam3(txn,dbi,del); if(mdb_drop((MDB_txn*)txn,(MDB_dbi) Int_val(dbi),Bool_val(del))){ caml_failwith("error in mdb_drop"); } CAMLreturn0; }
CAMLexport int triunsuitable(vertex triorg, vertex tridest, vertex triapex, REAL area) { CAMLparam0(); CAMLlocal1(vd); static value * closure = NULL; value args[NARGS_TRIUNSUITABLE]; if (closure == NULL) { closure = caml_named_value("triunsuitable_callback"); } #define COPY_DOUBLE(dest, d) \ vd = caml_copy_double(d); \ dest = vd COPY_DOUBLE(args[0], triorg[0]); COPY_DOUBLE(args[1], triorg[1]); COPY_DOUBLE(args[2], tridest[0]); COPY_DOUBLE(args[3], tridest[1]); COPY_DOUBLE(args[4], triapex[0]); COPY_DOUBLE(args[5], triapex[1]); COPY_DOUBLE(args[6], area); CAMLreturn(Bool_val(callbackN(*closure, NARGS_TRIUNSUITABLE, args))); #undef COPY_DOUBLE }
CAMLprim value stub_gnttab_map_fresh( value xgh, value reference, value domid, value writable ) { CAMLparam4(xgh, reference, domid, writable); CAMLlocal2(pair, contents); void *map = xc_gnttab_map_grant_ref(_G(xgh), Int_val(domid), Int_val(reference), Bool_val(writable)?PROT_READ | PROT_WRITE:PROT_READ); if(map==NULL) { caml_failwith("Failed to map grant ref"); } contents = caml_ba_alloc_dims(XC_GNTTAB_BIGARRAY, 1, map, 1 << XC_PAGE_SHIFT); pair = caml_alloc_tuple(2); Store_field(pair, 0, contents); /* grant_handle */ Store_field(pair, 1, contents); /* Io_page.t */ CAMLreturn(pair); }
//+ external ajoin : ?nosort:bool -> db -> cursor array -> get_flag list -> //+ cursor = "caml_join_cursors" //+ let join ?nosort db cursor_list get_flag_list = //+ ajoin ?nosort db (Array.of_list cursor_list) get_flag_list value caml_join_cursors(value vnosort, value db, value vcursors, value vflags) { CAMLparam4(vnosort,db,vcursors,vflags); CAMLlocal1(rval); DBC *jcurs; // pointer to joined cursor int carray_len = Wosize_val(vcursors); int flags = convert_flag_list(vflags,cursor_get_flags); DBC *cursors[carray_len + 1]; int i; if (Is_Some(vnosort) && Bool_val(vnosort)) { flags = flags | DB_JOIN_NOSORT; } for (i=0; i < carray_len; i++) { if (UW_cursor_closed(Field(vcursors,i))) { invalid_argument("caml_join_cursors: Attempt to use closed cursor"); } cursors[i] = UW_cursor(Field(vcursors,i)); } cursors[i] = NULL; test_db_closed(db); UW_db(db)->join(UW_db(db),cursors,&jcurs,flags); rval = alloc_custom(&cursor_custom,Camlcursor_wosize,0,1); UW_cursor(rval) = jcurs; UW_cursor_closed(rval) = False; CAMLreturn (rval); }
CAMLprim value LFUN(sqr_nrm2_stub)( value vSTABLE, value vN, value vOFSX, value vINCX, value vX) { CAMLparam1(vX); integer GET_INT(N), GET_INT(INCX); REAL res; VEC_PARAMS(X); caml_enter_blocking_section(); /* Allow other threads */ if (Bool_val(vSTABLE)) { #ifndef LACAML_DOUBLE res = scnrm2_(&N, X_data, &INCX); #else res = dznrm2_(&N, X_data, &INCX); #endif res *= res; } else { COMPLEX cres = FUN(dotc)(&N, X_data, &INCX, X_data, &INCX); res = cres.r; } caml_leave_blocking_section(); /* Disallow other threads */ CAMLreturn(caml_copy_double(res)); }
/* Allocate a page-aligned bigarray of length [n_pages] pages. Since CAML_BA_MANAGED is set the bigarray C finaliser will call free() whenever all sub-bigarrays are unreachable. */ CAMLprim value mirage_alloc_pages(value did_gc, value n_pages) { CAMLparam2(did_gc, n_pages); size_t len = Int_val(n_pages) * PAGE_SIZE; /* If the allocation fails, return None. The ocaml layer will be able to trigger a full GC which just might run finalizers of unused bigarrays which will free some memory. */ void* block = malloc(len); if (block == NULL) { if (Bool_val(did_gc)) printf("ERROR: Io_page: memalign(%d, %zu) failed, even after GC.\n", PAGE_SIZE, len); caml_raise_out_of_memory(); } /* Explicitly zero the page before returning it */ memset(block, 0, len); /* OCaml 4.02 introduced bigarray element type CAML_BA_CHAR, which needs to be used - otherwise type t in io_page.ml is different from the allocated bigarray and equality won't hold. Only since 4.02 there is a <caml/version.h>, thus we cannot include it in order to detect the version of the OCaml runtime. Instead, we use definitions which were introduced by 4.02 - and cross fingers that they'll stay there in the future. Once <4.02 support is removed, we should get rid of this hack. -- hannes, 16th Feb 2015 */ #ifdef Caml_ba_kind_val CAMLreturn(caml_ba_alloc_dims(CAML_BA_CHAR | CAML_BA_C_LAYOUT | CAML_BA_MANAGED, 1, block, len)); #else CAMLreturn(caml_ba_alloc_dims(CAML_BA_UINT8 | CAML_BA_C_LAYOUT | CAML_BA_MANAGED, 1, block, len)); #endif }
CAMLextern_C value caml_sfRenderWindow_setActive(value win, value active) { bool status = SfRenderWindow_val(win)->setActive(Bool_val(active)); if (!status) caml_failwith("SFRenderWindow.setActive"); return Val_unit; }
CAMLprim value caml_sfSprite_setTexture(value sprite, value texture, value resetRect) { sfSprite_setTexture( SfSprite_val(sprite), SfTexture_val(texture), Bool_val(resetRect)); return Val_unit; }
//+ (* Note: A cursor created with a transaction must be closed before //+ the transaction is committed or aborted *) //+ external create : ?writecursor:bool -> ?txn:txn -> Db.t -> t //+ = "caml_cursor_create" value caml_cursor_create(value vwritecursor, value txn_opt, value db) { CAMLparam3(vwritecursor,txn_opt,db); int err; int flags = 0; CAMLlocal1(rval); DBC *cursor; DB_TXN *txn; if (Is_None(txn_opt)) { txn = NULL; } else { test_txn_closed(Some_val(txn_opt)); txn = UW_txn(Some_val(txn_opt)); } test_db_closed(db); // setup flags from vwritecursor if (Is_Some(vwritecursor) && Bool_val(Some_val(vwritecursor))) { flags = DB_WRITECURSOR; } // printf("%d\n",ctr++); fflush(stdout); err = UW_db(db)->cursor(UW_db(db),txn,&cursor,flags); if (err != 0) { UW_db(db)->err(UW_db(db),err, "caml_cursor_create"); } rval = alloc_custom(&cursor_custom,Camlcursor_wosize,0,1); UW_cursor(rval) = cursor; UW_cursor_closed(rval) = False; CAMLreturn (rval); }
FcValue fcvalue_from_caml(value c) { FcValue res; if(Is_block(c)) { switch(Tag_val(c)) { case 0: /* Integer */ res.type = FcTypeInteger; res.u.i = Int_val(Field(c, 0)); break; case 1: /* Double */ res.type = FcTypeDouble; res.u.d = Double_val(Field(c, 0)); break; case 2: /* String */ res.type = FcTypeString; res.u.s = FcStrCopy((FcChar8 *)String_val(Field(c, 0))); break; case 3: /* Bool */ res.type = FcTypeBool; res.u.b = Bool_val(Field(c, 0)) ? FcTrue : FcFalse; break; case 4: /* Matrix */ res.type = FcTypeMatrix; res.u.m = fcmatrix_from_caml(Field(c, 0)); break; } } else { /* C'est void */ res.type = FcTypeVoid; } return res; }
CAMLprim value stub_gnttab_mapv_batched( value xgh, value array, value writable) { CAMLparam3(xgh, array, writable); CAMLlocal4(domid, reference, contents, pair); int count = Wosize_val(array) / 2; uint32_t domids[count]; uint32_t refs[count]; int i; for (i = 0; i < count; i++) { domids[i] = Int_val(Field(array, i * 2 + 0)); refs[i] = Int_val(Field(array, i * 2 + 1)); } void *map = xc_gnttab_map_grant_refs(_G(xgh), count, domids, refs, Bool_val(writable)?PROT_READ | PROT_WRITE : PROT_READ); if(map==NULL) { caml_failwith("Failed to map grant ref"); } contents = caml_ba_alloc_dims(XC_GNTTAB_BIGARRAY, 1, map, count << XC_PAGE_SHIFT); pair = caml_alloc_tuple(2); Store_field(pair, 0, contents); /* grant_handle */ Store_field(pair, 1, contents); /* Io_page.t */ CAMLreturn(pair); }
CAMLprim value ocaml_faad_mp4_open_read_fd(value metaonly, value fd) { CAMLparam2(metaonly, fd); CAMLlocal1(ans); mp4_t *mp = malloc(sizeof(mp4_t)); mp->fd = GET_FD(fd); mp->ff_cb.read = read_cb; mp->read_cb = 0; mp->ff_cb.write = write_cb; mp->write_cb = 0; mp->ff_cb.seek = seek_cb; mp->seek_cb = 0; mp->ff_cb.truncate = trunc_cb; mp->trunc_cb = 0; mp->ff_cb.user_data = mp; caml_enter_blocking_section(); if(Bool_val(metaonly)) mp->ff = mp4ff_open_read_metaonly(&mp->ff_cb); else mp->ff = mp4ff_open_read(&mp->ff_cb); caml_leave_blocking_section(); assert(mp->ff); ans = caml_alloc_custom(&mp4_ops, sizeof(mp4_t*), 1, 0); Mp4_val(ans) = mp; CAMLreturn(ans); }
value guestfs_int_mllib_progress_bar_init (value machine_readablev) { CAMLparam1 (machine_readablev); CAMLlocal1 (barv); struct progress_bar *bar; const int machine_readable = Bool_val (machine_readablev); unsigned flags = 0; /* XXX Have to do this to get nl_langinfo to work properly. However * we should really only call this from main. */ setlocale (LC_ALL, ""); if (machine_readable) flags |= PROGRESS_BAR_MACHINE_READABLE; bar = progress_bar_init (flags); if (bar == NULL) caml_raise_out_of_memory (); barv = caml_alloc_custom (&progress_bar_custom_operations, sizeof (struct progress_bar *), 0, 1); Bar_val (barv) = bar; CAMLreturn (barv); }
value caml_QQmlPropertyMap_insert(value _map, value _propName, value _variant) { CAMLparam3(_map, _propName, _variant); // copy and paste from the generated file for QAbstractModel subclass // TODO: move this conversion to the lablqml QVariant newval; if (Is_block(_variant)) { if (caml_hash_variant("bool") == Field(_variant,0) ) // without cast it will create Qvariant of int newval = QVariant::fromValue( (bool)Bool_val(Field(_variant,1)) ); else if (caml_hash_variant("string") == Field(_variant,0) ) newval = QVariant::fromValue(QString(String_val(Field(_variant,1)))); else if (caml_hash_variant("int") == Field(_variant,0) ) newval = QVariant::fromValue(Int_val(Field(_variant,1))); else if (caml_hash_variant("float") == Field(_variant,0) ) newval = QVariant::fromValue(Double_val(Field(_variant,1))); else if (caml_hash_variant("qobject") == Field(_variant,0) ) newval = QVariant::fromValue((QObject*) (Field(Field(_variant,1),0))); else Q_ASSERT_X(false, "While converting OCaml value to QVariant", "Unknown variant tag"); } else { // empty QVariant newval = QVariant(); } CamlPropertyMap *map = (*(CamlPropertyMap**) (Data_custom_val(_map))); Q_ASSERT_X(map != NULL, __func__, "Trying to use QQmlPropertyMap object which is NULL"); map->insert( QString(String_val(_propName)), newval); CAMLreturn(Val_unit); }