CAMLprim value netsys_fallocate(value fd, value start, value len) { #ifdef HAVE_POSIX_FALLOCATE int r; int64 start_int, len_int; off_t start_off, len_off; /* Att: off_t might be 64 bit even on 32 bit systems! */ start_int = Int64_val(start); len_int = Int64_val(len); if ( ((int64) ((off_t) start_int)) != start_int ) failwith("Netsys.fadvise: large files not supported on this OS"); if ( ((int64) ((off_t) len_int)) != len_int ) failwith("Netsys.fadvise: large files not supported on this OS"); start_off = start_int; len_off = len_int; r = posix_fallocate(Int_val(fd), start_off, len_off); /* does not set errno! */ if (r != 0) unix_error(r, "posix_fallocate64", Nothing); return Val_unit; #else invalid_argument("Netsys.fallocate not available"); #endif }
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); }
CAMLprim value caml_int64_div(value v1, value v2) { int64 dividend = Int64_val(v1); int64 divisor = Int64_val(v2); if (I64_is_zero(divisor)) caml_raise_zero_divide(); /* PR#4740: on some processors, division crashes on overflow. Implement the same behavior as for type "int". */ if (I64_is_min_int(dividend) && I64_is_minus_one(divisor)) return v1; return caml_copy_int64(I64_div(Int64_val(v1), divisor)); }
static int domain_build_state_val(caml_gc *gc, libxl_domain_build_state *c_val, value v) { CAMLparam1(v); c_val->store_port = Int_val(Field(v, 0)); c_val->store_mfn = Int64_val(Field(v, 1)); c_val->console_port = Int_val(Field(v, 2)); c_val->console_mfn = Int64_val(Field(v, 3)); CAMLreturn(0); }
/* NB: "noalloc" function. */ value guestfs_int_mllib_progress_bar_set (value barv, value positionv, value totalv) { struct progress_bar *bar = Bar_val (barv); uint64_t position = Int64_val (positionv); uint64_t total = Int64_val (totalv); progress_bar_set (bar, position, total); return Val_unit; }
CAMLprim value brlapiml_acceptKeyRanges(value handle, value camlRanges) { CAMLparam2(handle, camlRanges); CAMLlocal1(r); unsigned int i, size = Wosize_val(camlRanges); brlapi_range_t ranges[size]; for (i=0; i<size; i++) { r = Field(camlRanges, i); ranges[i].first = Int64_val(Field(r, 0)); ranges[i].last = Int64_val(Field(r, 1)); } brlapiCheckError(acceptKeyRanges, ranges, size); CAMLreturn(Val_unit); }
value tigertree_unsafe64_fd (value digest_v, value fd_v, value pos_v, value len_v) { OS_FD fd = Fd_val(fd_v); OFF_T pos = Int64_val(pos_v); OFF_T len = Int64_val(len_v); unsigned char *digest = String_val(digest_v); /* int nread; */ os_lseek(fd, pos, SEEK_SET); tiger_tree_fd(fd, len, 0, tiger_block_size(len), digest); return Val_unit; }
CAMLprim value stub_blk_read(value sector, value buffer, value num) { CAMLparam3(sector, buffer, num); uint64_t sec = Int64_val(sector); uint8_t *data = Caml_ba_data_val(buffer); int n = Int_val(num); int ret = 0; assert(Caml_ba_array_val(buffer)->num_dims == 1); //printf("Solo5 blk read: sec=%d num=%d\n", sec, n); ret = solo5_blk_read_sync(sec, data, &n); if ( ret ) printf("virtio read failed... %d from sector=%d\n", n, sec); #if 0 { int i; for (i = 0; i < n; i++) { printf("%02x ", (uint8_t) data[i]); if ( i % 16 == 15 ) printf("\n"); } printf("\n"); } #endif CAMLreturn(Val_bool(!ret)); }
CAMLprim value stub_sendfile64(value in_fd, value out_fd, value len){ CAMLparam3(in_fd, out_fd, len); CAMLlocal1(result); size_t c_len = Int64_val(len); size_t bytes; int c_in_fd = Int_val(in_fd); int c_out_fd = Int_val(out_fd); int rc = NOT_IMPLEMENTED; enter_blocking_section(); #ifdef __linux__ rc = TRIED_AND_FAILED; bytes = sendfile(c_out_fd, c_in_fd, NULL, c_len); if (bytes != -1) rc = OK; #endif leave_blocking_section(); switch (rc) { case NOT_IMPLEMENTED: caml_failwith("This platform does not support sendfile()"); break; case TRIED_AND_FAILED: uerror("sendfile", Nothing); break; default: break; } result = caml_copy_int64(bytes); CAMLreturn(result); }
value c_sprint_int64(value s, value index, value x) { CAMLparam3 (s, index, x); int64_t *p = (int64_t*) (String_val(s) + Int_val(index)); *p = (int64_t)Int64_val(x); CAMLreturn (Val_unit); }
/* lseek is used inside Uwt_io. Therefore, I can't be seperated like the other unix functions */ CAMLprim value uwt_lseek(value o_fd, value o_pos, value o_mode, value o_loop, value o_cb) { CAMLparam1(o_cb); int erg; uv_loop_t * loop = Uv_loop_val(o_loop); const int fd = FD_VAL(o_fd); const int64_t offset = Int64_val(o_pos); const int whence = seek_command_table[ Long_val(o_mode) ]; GR_ROOT_ENLARGE(); value o_ret; struct req * req = uwt__req_create_res(UV_WORK, &o_ret); req->buf.len = (size_t)fd; req->offset = whence; req->c_cb = lseek_cb; int64_t_to_voids(offset,&req->c); erg = uv_queue_work(loop, (uv_work_t*)req->req, lseek_work_cb, uwork_cb); if ( erg >= 0 ){ uwt__gr_register(&req->cb,o_cb); } else { uwt__req_free(req); Field(o_ret,0) = Val_uwt_error(erg); Tag_val(o_ret) = Error_tag; } CAMLreturn(o_ret); }
CAMLprim value unix_lseek_64(value fd, value ofs, value cmd) { __int64 ret; ret = caml_set_file_pointer(Handle_val(fd), Int64_val(ofs), seek_command_table[Int_val(cmd)]); return copy_int64(ret); }
CAMLprim value caml_int64_float_of_bits(value vi) { union { double d; int64 i; int32 h[2]; } u; u.i = Int64_val(vi); #if defined(__arm__) && !defined(__ARM_EABI__) { int32 t = u.h[0]; u.h[0] = u.h[1]; u.h[1] = t; } #endif return caml_copy_double(u.d); }
CAMLprim value brlapiml_acceptKeys(value handle, value rt, value camlKeys) { CAMLparam3(handle, rt, camlKeys); unsigned int i, size = Wosize_val(camlKeys); brlapi_keyCode_t keys[size]; for (i=0; i<size; i++) keys[i] = Int64_val(Field(camlKeys, i)); brlapiCheckError(acceptKeys, Int_val(rt), keys, size); CAMLreturn(Val_unit); }
CAMLprim value ocaml_gstreamer_buffer_set_presentation_time(value _buf, value _t) { CAMLparam2(_buf, _t); GstBuffer *b = Buffer_val(_buf); GstClockTime t = Int64_val(_t); b->pts = t; CAMLreturn(Val_unit); }
value mld_ftruncate_64(value fd_v, value len_v, value sparse) { OFF_T len = Int64_val(len_v); OS_FD fd = Fd_val(fd_v); int use_sparse = Bool_val(sparse); os_ftruncate(fd, len, use_sparse); return Val_unit; }
CAMLprim value ocaml_gstreamer_buffer_set_duration(value _buf, value _t) { CAMLparam2(_buf, _t); GstBuffer *b = Buffer_val(_buf); GstClockTime t = Int64_val(_t); b->duration = t; CAMLreturn(Val_unit); }
static value caml_ba_set_aux(value vb, value * vind, intnat nind, value newval) { struct caml_ba_array * b = Caml_ba_array_val(vb); intnat index[CAML_BA_MAX_NUM_DIMS]; int i; intnat offset; /* Check number of indices = number of dimensions of array (maybe not necessary if ML typing guarantees this) */ if (nind != b->num_dims) caml_invalid_argument("Bigarray.set: wrong number of indices"); /* Compute offset and check bounds */ for (i = 0; i < b->num_dims; i++) index[i] = Long_val(vind[i]); offset = caml_ba_offset(b, index); /* Perform write */ switch (b->flags & CAML_BA_KIND_MASK) { default: Assert(0); #ifdef _KERNEL #else case CAML_BA_FLOAT32: ((float *) b->data)[offset] = Double_val(newval); break; case CAML_BA_FLOAT64: ((double *) b->data)[offset] = Double_val(newval); break; #endif case CAML_BA_SINT8: case CAML_BA_UINT8: ((int8 *) b->data)[offset] = Int_val(newval); break; case CAML_BA_SINT16: case CAML_BA_UINT16: ((int16 *) b->data)[offset] = Int_val(newval); break; case CAML_BA_INT32: ((int32 *) b->data)[offset] = Int32_val(newval); break; case CAML_BA_INT64: ((int64 *) b->data)[offset] = Int64_val(newval); break; case CAML_BA_NATIVE_INT: ((intnat *) b->data)[offset] = Nativeint_val(newval); break; case CAML_BA_CAML_INT: ((intnat *) b->data)[offset] = Long_val(newval); break; #ifdef _KERNEL #else case CAML_BA_COMPLEX32: { float * p = ((float *) b->data) + offset * 2; p[0] = Double_field(newval, 0); p[1] = Double_field(newval, 1); break; } case CAML_BA_COMPLEX64: { double * p = ((double *) b->data) + offset * 2; p[0] = Double_field(newval, 0); p[1] = Double_field(newval, 1); break; } #endif } return Val_unit; }
/* noalloc */ value bap_disasm_set_memory_stub(value d, value base, value data, value off, value len) { bap_disasm_set_memory(Int_val(d), Int64_val(base), (const char *)Caml_ba_data_val(data), Int_val(off), Int_val(len)); return Val_unit; }
CAMLprim value caml_poll(value v_until) { CAMLparam1(v_until); CAMLlocal1(work_to_do); uint64_t until = (Int64_val(v_until)); int rc = solo5_poll(until); work_to_do = Val_bool(rc); CAMLreturn(work_to_do); }
CAMLprim value setsockopt_stub(value sock, value sockopt, value val) { CAMLparam3 (sock, sockopt, val); int native_sockopt = Int_val(sockopt); struct wrap *socket = Socket_val(sock); int result = -1; switch (native_sockopt) { case ZMQ_SNDHWM: case ZMQ_RCVHWM: case ZMQ_RATE: case ZMQ_RECOVERY_IVL: case ZMQ_SNDBUF: case ZMQ_RCVBUF: case ZMQ_LINGER: case ZMQ_RECONNECT_IVL_MAX: case ZMQ_BACKLOG: case ZMQ_MULTICAST_HOPS: case ZMQ_RCVTIMEO: case ZMQ_SNDTIMEO: { int optval = Int_val(val); result = zmq_setsockopt(socket->wrapped, native_sockopt, &optval, sizeof(optval)); } break; case ZMQ_IDENTITY: case ZMQ_SUBSCRIBE: case ZMQ_UNSUBSCRIBE: { result = zmq_setsockopt(socket->wrapped, native_sockopt, String_val(val), caml_string_length(val)); } break; case ZMQ_AFFINITY: case ZMQ_MAXMSGSIZE: { int64 optval = Int64_val(val); result = zmq_setsockopt(socket->wrapped, native_sockopt, &optval, sizeof(optval)); } break; default: caml_failwith("Bidings error"); } stub_raise_if (result == -1); CAMLreturn (Val_unit); }
CAMLexport value caml_copy_int64(int64 i) { value res = caml_alloc_custom(&caml_int64_ops, 8, 0, 1); #ifndef ARCH_ALIGN_INT64 Int64_val(res) = i; #else union { int32 i[2]; int64 j; } buffer; buffer.j = i; ((int32 *) Data_custom_val(res))[0] = buffer.i[0]; ((int32 *) Data_custom_val(res))[1] = buffer.i[1]; #endif return res; }
CAMLprim value brlapiml_expandKeyCode(value handle, value camlKeyCode) { CAMLparam2(handle, camlKeyCode); CAMLlocal1(result); brlapi_expandedKeyCode_t ekc; brlapiCheckError(expandKeyCode, Int64_val(camlKeyCode), &ekc); result = caml_alloc_tuple(4); Store_field(result, 0, caml_copy_int32(ekc.type)); Store_field(result, 1, caml_copy_int32(ekc.command)); Store_field(result, 2, caml_copy_int32(ekc.argument)); Store_field(result, 2, caml_copy_int32(ekc.flags)); CAMLreturn(result); }
/* string_of_prim : 'a prim -> 'a -> string */ value ctypes_string_of_prim(value prim_, value v) { CAMLparam2(prim_, v); CAMLlocal1(s); char buf[64]; int len = 0; switch (Int_val(prim_)) { case Char: len = snprintf(buf, sizeof buf, "'%c'", Int_val(v)); break; case Schar: len = snprintf(buf, sizeof buf, "%d", Int_val(v)); break; case Uchar: len = snprintf(buf, sizeof buf, "%d", (unsigned char)Uint8_val(v)); break; case Short: len = snprintf(buf, sizeof buf, "%hd", (short)Int_val(v)); break; case Int: len = snprintf(buf, sizeof buf, "%d", Int_val(v)); break; case Long: len = snprintf(buf, sizeof buf, "%ld", (long)ctypes_long_val(v)); break; case Llong: len = snprintf(buf, sizeof buf, "%lld", (long long)ctypes_llong_val(v)); break; case Ushort: len = snprintf(buf, sizeof buf, "%hu", (unsigned short)ctypes_ushort_val(v)); break; case Uint: len = snprintf(buf, sizeof buf, "%u", (unsigned)ctypes_uint_val(v)); break; case Ulong: len = snprintf(buf, sizeof buf, "%lu", (unsigned long)ctypes_ulong_val(v)); break; case Ullong: len = snprintf(buf, sizeof buf, "%llu", (unsigned long long)ctypes_ullong_val(v)); break; case Size_t: len = snprintf(buf, sizeof buf, "%zu", (size_t)ctypes_size_t_val(v)); break; case Int8_t: len = snprintf(buf, sizeof buf, "%" PRId8, (int8_t)Int_val(v)); break; case Int16_t: len = snprintf(buf, sizeof buf, "%" PRId16, (int16_t)Int_val(v)); break; case Int32_t: len = snprintf(buf, sizeof buf, "%" PRId32, Int32_val(v)); break; case Int64_t: len = snprintf(buf, sizeof buf, "%" PRId64, Int64_val(v)); break; case Uint8_t: len = snprintf(buf, sizeof buf, "%" PRIu8, Uint8_val(v)); break; case Uint16_t: len = snprintf(buf, sizeof buf, "%" PRIu16, Uint16_val(v)); break; case Uint32_t: len = snprintf(buf, sizeof buf, "%" PRIu32, Uint32_val(v)); break; case Uint64_t: len = snprintf(buf, sizeof buf, "%" PRIu64, Uint64_val(v)); break; case Camlint: len = snprintf(buf, sizeof buf, "%" ARCH_INTNAT_PRINTF_FORMAT "d", (intnat)Int_val(v)); break; case Nativeint: len = snprintf(buf, sizeof buf, "%" ARCH_INTNAT_PRINTF_FORMAT "d", (intnat)Nativeint_val(v)); break; case Float: len = snprintf(buf, sizeof buf, "%.12g", Double_val(v)); break; case Double: len = snprintf(buf, sizeof buf, "%.12g", Double_val(v)); break; case Complex32: { float complex c = ctypes_float_complex_val(v); len = snprintf(buf, sizeof buf, "%.12g+%.12gi", crealf(c), cimagf(c)); break; } case Complex64: { double complex c = ctypes_double_complex_val(v); len = snprintf(buf, sizeof buf, "%.12g+%.12gi", creal(c), cimag(c)); break; } default: assert(0); } s = caml_alloc_string(len); memcpy(String_val(s), buf, len); CAMLreturn (s); }
CAMLprim value caml_extunix_fadvise64(value vfd, value voff, value vlen, value vadvise) { int errcode = 0; int fd = -1; off64_t off = 0; off64_t len = 0; int advise = 0; CAMLparam4(vfd, voff, vlen, vadvise); fd = Int_val(vfd); off = Int64_val(voff); len = Int64_val(vlen); advise = caml_advises[Int_val(vadvise)]; errcode = posix_fadvise64(fd, off, len, advise); if (errcode != 0) { unix_error(errcode, "fadvise64", Nothing); }; CAMLreturn(Val_unit); }
CAMLprim value caml_int64_format(value fmt, value arg) { char format_string[FORMAT_BUFFER_SIZE]; char default_format_buffer[FORMAT_BUFFER_SIZE]; char * buffer; char conv; value res; buffer = parse_format(fmt, ARCH_INT64_PRINTF_FORMAT, format_string, default_format_buffer, &conv); I64_format(buffer, format_string, Int64_val(arg)); res = caml_copy_string(buffer); if (buffer != default_format_buffer) caml_stat_free(buffer); return res; }
/* The stub creating the job structure. */ CAMLprim value lwt_unix_lseek_64_job(value fd, value offset, value whence) { /* Allocate a new job. */ struct job_lseek* job = lwt_unix_new(struct job_lseek); /* Initializes function fields. */ job->job.worker = (lwt_unix_job_worker)worker_lseek; job->job.result = (lwt_unix_job_result)result_lseek_64; /* Copy the fd parameter. */ job->fd = Int_val(fd); /* Copy the offset parameter. */ job->offset = Int64_val(offset); /* Copy the whence parameter. */ job->whence = seek_command_table[Int_val(whence)]; /* Wrap the structure into a caml value. */ return lwt_unix_alloc_job(&job->job); }
void camlidl_ml2c_libbfd_struct_bfd_symbol(value _v1, struct bfd_symbol * _c2, camlidl_ctx _ctx) { value _v3; value _v4; value _v5; value _v6; value _v7; _v3 = Field(_v1, 0); camlidl_ml2c_libbfd_bfdp(_v3, &(*_c2).the_bfd, _ctx); _v4 = Field(_v1, 1); (*_c2).name = camlidl_malloc_string(_v4, _ctx); _v5 = Field(_v1, 2); (*_c2).value = Int64_val(_v5); _v6 = Field(_v1, 3); (*_c2).flags = Int_val(_v6); _v7 = Field(_v1, 4); camlidl_ml2c_libbfd_section_ptr(_v7, &(*_c2).section, _ctx); }
value guestfs_int_mllib_visit (value gv, value dirv, value fv) { CAMLparam3 (gv, dirv, fv); value *visit_failure_exn; guestfs_h *g = (guestfs_h *) (intptr_t) Int64_val (gv); struct visitor_function_wrapper_args args; /* The dir string could move around when we call the * visitor_function, so we have to take a full copy of it. */ char *dir = strdup (String_val (dirv)); /* This stack address is used to point to the exception, if one is * raised in the visitor_function. */ CAMLlocal1 (exn); exn = Val_unit; args.exnp = &exn; args.fvp = &fv; if (visit (g, dir, visitor_function_wrapper, &args) == -1) { free (dir); if (exn != Val_unit) { /* The failure was caused by visitor_function raising an * exception. Re-raise it here. */ caml_raise (exn); } /* Otherwise it's some other failure. The visit function has * already printed the error to stderr (XXX - fix), so we raise a * generic exception. */ visit_failure_exn = caml_named_value ("Visit.Failure"); caml_raise (*visit_failure_exn); } free (dir); CAMLreturn (Val_unit); }
CAMLprim value ocaml_gstreamer_element_seek_simple(value _e, value _fmt, value _flags, value _pos) { CAMLparam4(_e, _fmt, _flags, _pos); GstElement *e = Element_val(_e); GstFormat fmt = format_val(_fmt); GstSeekFlags flags = 0; gint64 pos = Int64_val(_pos); gboolean ret; int i; for (i = 0; i < Wosize_val(_flags); i++) flags |= seek_flags_val(Field(_flags,i)); caml_release_runtime_system(); ret = gst_element_seek_simple(e, fmt, flags, pos); caml_acquire_runtime_system(); if (!ret) caml_raise_constant(*caml_named_value("gstreamer_exn_failure")); CAMLreturn(Val_unit); }