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);
}
static value Val_physinfo(libxl_physinfo *c_val)
{
CAMLparam0();
CAMLlocal2(v, hwcap);
int i;
hwcap = caml_alloc_tuple(8);
for (i = 0; i < 8; i++)
Store_field(hwcap, i, caml_copy_int32(c_val->hw_cap[i]));
v = caml_alloc_tuple(11);
Store_field(v, 0, Val_int(c_val->threads_per_core));
Store_field(v, 1, Val_int(c_val->cores_per_socket));
Store_field(v, 2, Val_int(c_val->max_cpu_id));
Store_field(v, 3, Val_int(c_val->nr_cpus));
Store_field(v, 4, Val_int(c_val->cpu_khz));
Store_field(v, 5, caml_copy_int64(c_val->total_pages));
Store_field(v, 6, caml_copy_int64(c_val->free_pages));
Store_field(v, 7, caml_copy_int64(c_val->scrub_pages));
Store_field(v, 8, Val_int(c_val->nr_nodes));
Store_field(v, 9, hwcap);
Store_field(v, 10, caml_copy_int32(c_val->phys_cap));
CAMLreturn(v);
}
CAMLprim value ocaml_faad_mp4_metadata(value m)
{
CAMLparam1(m);
CAMLlocal2(ans,v);
mp4_t *mp = Mp4_val(m);
int i, n;
char *tag, *item;
caml_enter_blocking_section();
n = mp4ff_meta_get_num_items(mp->ff);
caml_leave_blocking_section();
ans = caml_alloc_tuple(n);
for (i = 0; i < n; i++)
{
tag = NULL;
item = NULL;
caml_enter_blocking_section();
mp4ff_meta_get_by_index(mp->ff, i, &item, &tag);
caml_leave_blocking_section();
assert(item && tag);
v = caml_alloc_tuple(2);
Store_field(v, 0, caml_copy_string(item));
Store_field(v, 1, caml_copy_string(tag));
Store_field(ans, i, v);
free(item);
free(tag);
}
CAMLreturn(ans);
}
CAMLprim value caml_gc_get(value v)
{
CAMLparam0 (); /* v is ignored */
CAMLlocal1 (res);
res = caml_alloc_tuple (7);
#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);
#if 0
CAMLparam0 (); /* v is ignored */
CAMLlocal1 (res);
res = caml_alloc_tuple (7);
Store_field (res, 0, Val_long (Wsize_bsize (Caml_state->minor_heap_size))); /* s */
Store_field (res, 1, Val_long (caml_major_heap_increment)); /* i */
Store_field (res, 2, Val_long (caml_percent_free)); /* o */
Store_field (res, 3, Val_long (caml_params->verb_gc)); /* v */
Store_field (res, 4, Val_long (caml_percent_max)); /* O */
#ifndef NATIVE_CODE
Store_field (res, 5, Val_long (caml_max_stack_size)); /* l */
#else
Store_field (res, 5, Val_long (0));
#endif
Store_field (res, 6, Val_long (caml_allocation_policy)); /* a */
Store_field (res, 7, Val_long (caml_major_window)); /* w */
CAMLreturn (res);
#endif
}
CAMLprim value ocaml_gstreamer_message_parse_tag(value _msg)
{
CAMLparam1(_msg);
CAMLlocal4(v,s,t,ans);
GstMessage *msg = Message_val(_msg);
GstTagList *tags = NULL;
const GValue *val;
const gchar *tag;
int taglen;
int i, j, n;
caml_release_runtime_system();
gst_message_parse_tag(msg, &tags);
taglen = gst_tag_list_n_tags(tags);
caml_acquire_runtime_system();
ans = caml_alloc_tuple(taglen);
for(i = 0; i < taglen; i++)
{
t = caml_alloc_tuple(2);
// Tag name
tag = gst_tag_list_nth_tag_name(tags, i);
Store_field(t, 0, caml_copy_string(tag));
// Tag fields
n = gst_tag_list_get_tag_size(tags, tag);
v = caml_alloc_tuple(n);
for (j = 0; j < n; j++)
{
val = gst_tag_list_get_value_index(tags, tag, j);
if (G_VALUE_HOLDS_STRING(val)) {
s = caml_copy_string(g_value_get_string(val));
}
else if (GST_VALUE_HOLDS_DATE_TIME(val)) {
GstDateTime *dt = g_value_get_boxed(val);
gchar *dt_str = gst_date_time_to_iso8601_string(dt);
s = caml_copy_string(dt_str);
g_free(dt_str);
}
else {
//TODO: better typed handling of non-string values?
char *vc = g_strdup_value_contents(val);
s = caml_copy_string(vc);
free(vc);
}
Store_field(v, j, s);
}
Store_field(t, 1, v);
Store_field(ans, i, t);
}
gst_tag_list_unref(tags);
CAMLreturn(ans);
}
CAMLprim value caml_gc_quick_stat(value v)
{
CAMLparam0 ();
CAMLlocal1 (res);
/* get a copy of these before allocating anything... */
double minwords = caml_stat_minor_words
+ (double) Wsize_bsize (caml_young_end - caml_young_ptr);
double prowords = caml_stat_promoted_words;
double majwords = caml_stat_major_words + (double) caml_allocated_words;
intnat mincoll = caml_stat_minor_collections;
intnat majcoll = caml_stat_major_collections;
intnat heap_words = caml_stat_heap_size / sizeof (value);
intnat top_heap_words = caml_stat_top_heap_size / sizeof (value);
intnat cpct = caml_stat_compactions;
intnat heap_chunks = caml_stat_heap_chunks;
res = caml_alloc_tuple (15);
Store_field (res, 0, caml_copy_double (minwords));
Store_field (res, 1, caml_copy_double (prowords));
Store_field (res, 2, caml_copy_double (majwords));
Store_field (res, 3, Val_long (mincoll));
Store_field (res, 4, Val_long (majcoll));
Store_field (res, 5, Val_long (heap_words));
Store_field (res, 6, Val_long (heap_chunks));
Store_field (res, 7, Val_long (0));
Store_field (res, 8, Val_long (0));
Store_field (res, 9, Val_long (0));
Store_field (res, 10, Val_long (0));
Store_field (res, 11, Val_long (0));
Store_field (res, 12, Val_long (0));
Store_field (res, 13, Val_long (cpct));
Store_field (res, 14, Val_long (top_heap_words));
CAMLreturn (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);
}
CAMLprim value stub_get_blktap3_stats(value filename)
{
CAMLparam1(filename);
CAMLlocal1(stats);
FILE *c_fd;
struct stats c_stats;
c_fd = fopen(String_val(filename), "rb");
if (!c_fd) uerror("fopen", Nothing);
if (fread(&c_stats, sizeof(struct stats), 1, c_fd) < 1) uerror("fread", Nothing);
stats = caml_alloc_tuple(10);
Store_field(stats, 0, caml_copy_int64((int64_t) c_stats.read_reqs_submitted));
Store_field(stats, 1, caml_copy_int64((int64_t) c_stats.read_reqs_completed));
Store_field(stats, 2, caml_copy_int64((int64_t) c_stats.read_sectors));
Store_field(stats, 3, caml_copy_int64((int64_t) c_stats.read_total_ticks));
Store_field(stats, 4, caml_copy_int64((int64_t) c_stats.write_reqs_submitted));
Store_field(stats, 5, caml_copy_int64((int64_t) c_stats.write_reqs_completed));
Store_field(stats, 6, caml_copy_int64((int64_t) c_stats.write_sectors));
Store_field(stats, 7, caml_copy_int64((int64_t) c_stats.write_total_ticks));
Store_field(stats, 8, caml_copy_int64((int64_t) c_stats.io_errors));
if ((c_stats.flags) & BT3_LOW_MEMORY_MODE)
Store_field(stats, 9, Val_true);
else
Store_field(stats, 9, Val_false);
fclose(c_fd);
CAMLreturn(stats);
}
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);
}
bool check_mems_taint( memorylog_entry* memlog, unsigned int cnt )
{
CAMLparam0();
CAMLlocal4( addrs, ret, v, tupl );
static value *proc_check_mems_taint = NULL;
if ( !proc_check_mems_taint ) {
proc_check_mems_taint = caml_named_value( "check_mems_taint" );
}
addrs = Val_emptylist;
for ( unsigned int i = 0; i < cnt; i ++ ) {
tupl = caml_alloc_tuple( 2 );
Store_field( tupl, 0, caml_copy_nativeint( memlog[i].addr ) );
Store_field( tupl, 1, Val_int( memlog[i].size * 8 ) );
v = caml_alloc_small( 2, 0 );
Field( v, 0 ) = tupl;
Field( v, 1 ) = addrs;
addrs = v;
}
ret = caml_callback( *proc_check_mems_taint, addrs );
CAMLreturnT( bool, Bool_val( ret ) );
}
value stub_inotify_convert(value buf)
{
CAMLparam1(buf);
CAMLlocal3(event, l, tmpl);
struct inotify_event ev;
int i;
l = Val_emptylist;
tmpl = Val_emptylist;
memcpy(&ev, String_val(buf), sizeof(struct inotify_event));
for (i = 0; inotify_return_table[i]; i++) {
if (!(ev.mask & inotify_return_table[i]))
continue;
tmpl = caml_alloc_small(2, Tag_cons);
Field(tmpl, 0) = Val_int(i);
Field(tmpl, 1) = l;
l = tmpl;
}
event = caml_alloc_tuple(4);
Store_field(event, 0, Val_int(ev.wd));
Store_field(event, 1, l);
Store_field(event, 2, caml_copy_int32(ev.cookie));
Store_field(event, 3, Val_int(ev.len));
CAMLreturn(event);
}
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);
}
CAMLprim value stub_launch_activate_socket(value name) {
CAMLparam1(name);
CAMLlocal1(result);
const char *c_name = caml_strdup(String_val(name));
int *listening_fds = NULL;
size_t n_listening_fds = 0;
int err;
caml_release_runtime_system();
err = launch_activate_socket(c_name, &listening_fds, &n_listening_fds);
caml_acquire_runtime_system();
caml_stat_free((void*)c_name);
switch (err) {
case 0:
result = caml_alloc_tuple(n_listening_fds);
for (int i = 0; i < n_listening_fds; i++) {
Store_field(result, i, Val_int(*(listening_fds + i)));
}
break;
default:
unix_error(err, "launch_activate_socket", name);
break;
}
CAMLreturn(result);
}
CAMLprim value caml_natdynlink_open(value filename, value global)
{
CAMLparam2 (filename, global);
CAMLlocal3 (res, handle, header);
void *sym;
void *dlhandle;
char *p;
/* TODO: dlclose in case of error... */
p = caml_strdup(String_val(filename));
caml_enter_blocking_section();
dlhandle = caml_dlopen(String_val(filename), 1, Int_val(global));
caml_leave_blocking_section();
caml_stat_free(p);
if (NULL == dlhandle)
caml_failwith(caml_dlerror());
sym = caml_dlsym(dlhandle, "caml_plugin_header");
if (NULL == sym)
caml_failwith("not an OCaml plugin");
handle = Val_handle(dlhandle);
header = caml_input_value_from_malloc(sym, 0);
res = caml_alloc_tuple(2);
Init_field(res, 0, handle);
Init_field(res, 1, header);
CAMLreturn(res);
}
CAMLprim value get_capabilities() {
CAMLparam0();
CAMLlocal1(out_val);
out_val = caml_alloc_tuple(5);
#if defined(WIN32) || defined (__CYGWIN__)
int info[4];
int max_eax;
__cpuid(info, 0);
max_eax = info[0];
if(max_eax >= 1) {
__cpuid(info, 1);
} else {
info[0] = 0;
info[1] = 0;
info[2] = 0;
info[3] = 0;
}
Store_field(out_val, 0, Val_bool(info[3] & (1 << 25)));
Store_field(out_val, 1, Val_bool(info[3] & (1 << 26)));
Store_field(out_val, 2, Val_bool(info[2] & (1 << 0)));
Store_field(out_val, 3, Val_bool(info[2] & (1 << 9)));
Store_field(out_val, 4, Val_bool(info[2] & (1 << 19)));
#else
// Don't use SSE stuff - other OSes may be on any random architecture
Store_field(out_val, 0, Val_bool(0));
Store_field(out_val, 1, Val_bool(0));
Store_field(out_val, 2, Val_bool(0));
Store_field(out_val, 3, Val_bool(0));
Store_field(out_val, 4, Val_bool(0));
#endif
CAMLreturn(out_val);
}
CAMLprim value ocaml_faad_init(value dh, value _buf, value _ofs, value _len)
{
CAMLparam2(dh,_buf);
CAMLlocal1(ans);
unsigned long samplerate;
uint8_t channels;
int32_t offset;
int32_t pre_offset = 0;
int ofs = Int_val(_ofs);
int len = Int_val(_len);
unsigned char *buf = (unsigned char*)String_val(_buf);
int i;
/* ADTS mpeg file can be a stream and start in the middle of a
* frame so we need to have extra loop check here */
for (i = ofs; i < len - 1; i++)
{
if (buf[i] == 0xff && (buf[i+1] & 0xf6) == 0xf0)
{
pre_offset = i;
break;
}
}
offset = NeAACDecInit(Dec_val(dh), buf+ofs+pre_offset, len-pre_offset, &samplerate, &channels);
check_err(offset);
ans = caml_alloc_tuple(3);
Store_field(ans, 0, Val_int(offset+pre_offset));
Store_field(ans, 1, Val_int(samplerate));
Store_field(ans, 2, Val_int(channels));
CAMLreturn(ans);
}
CAMLprim value ocaml_faad_mp4_init(value m, value dh, value track)
{
CAMLparam3(m, dh, track);
CAMLlocal1(ans);
mp4_t *mp = Mp4_val(m);
int t = Int_val(track);
int ret;
long unsigned int samplerate;
unsigned char channels;
NeAACDecHandle dec = Dec_val(dh);
unsigned char *mp4_buffer = NULL;
unsigned int mp4_buffer_size = 0;
caml_enter_blocking_section();
mp4ff_get_decoder_config(mp->ff, t, &mp4_buffer, &mp4_buffer_size);
ret = NeAACDecInit2(dec, mp4_buffer, mp4_buffer_size, &samplerate, &channels);
caml_leave_blocking_section();
free(mp4_buffer);
check_err(ret);
ans = caml_alloc_tuple(2);
Store_field(ans, 0, Val_int(samplerate));
Store_field(ans, 1, Val_int(channels));
CAMLreturn(ans);
}
value get_section_data_internal( bhp _p )
{
CAMLparam0();
CAMLlocal4( data, v, str, tupl );
bh* p = (bh*) _p;
struct bfd* abfd = p->bfdp;
asection *sect;
bfd_size_type datasize = 0;
data = Val_emptylist;
if ( p->is_from_file ) {
for ( sect = abfd->sections; sect != NULL; sect = sect->next ) {
datasize = bfd_get_section_size( sect );
str = caml_alloc_string( datasize );
bfd_get_section_contents( abfd, sect,
(bfd_byte*)String_val(str),
0, datasize );
tupl = caml_alloc_tuple( 3 );
Store_field( tupl, 0, str );
Store_field( tupl, 1, caml_copy_int64( sect->vma ) );
Store_field( tupl, 2, caml_copy_int64( sect->vma + datasize ) );
v = caml_alloc_small( 2, 0 );
Field( v, 0 ) = tupl;
Field( v, 1 ) = data;
data = v;
}
}
CAMLreturn( data );
}
value simulation_get_pose2d_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, a;
DPRINTF("getting sim %p pose2d: name - %s\n", sim, name);
if(playerc_simulation_get_pose2d(sim, name, &x, &y, &a))
exception_playerc_error();
DPRINTF("got sim %p pose2d: name - %s x = %f y = %f a = %f\n",
sim, name, x, y, a);
result = caml_alloc_tuple(3);
Store_field(result, 0, copy_double(x));
Store_field(result, 1, copy_double(y));
Store_field(result, 2, copy_double(a));
CAMLreturn(result);
}
CAMLprim value caml_gc_quick_stat(value v)
{
CAMLparam0 ();
CAMLlocal1 (res);
/* get a copy of these before allocating anything... */
struct gc_stats s;
caml_sample_gc_stats(&s);
intnat majcoll = Caml_state->stat_major_collections;
res = caml_alloc_tuple (16);
Store_field (res, 0, caml_copy_double ((double)s.minor_words));
Store_field (res, 1, caml_copy_double ((double)s.promoted_words));
Store_field (res, 2, caml_copy_double ((double)s.major_words));
Store_field (res, 3, Val_long (s.minor_collections));
Store_field (res, 4, Val_long (majcoll));
Store_field (res, 5, Val_long (
s.major_heap.pool_words + s.major_heap.large_words));
Store_field (res, 6, Val_long (0));
Store_field (res, 7, Val_long (
s.major_heap.pool_live_words + s.major_heap.large_words));
Store_field (res, 8, Val_long (
s.major_heap.pool_live_blocks + s.major_heap.large_blocks));
Store_field (res, 9, Val_long (
s.major_heap.pool_words - s.major_heap.pool_live_words - s.major_heap.pool_frag_words));
Store_field (res, 10, Val_long (0));
Store_field (res, 11, Val_long (0));
Store_field (res, 12, Val_long (s.major_heap.pool_frag_words));
Store_field (res, 13, Val_long (0));
Store_field (res, 14, Val_long (
s.major_heap.pool_max_words + s.major_heap.large_max_words));
Store_field (res, 15, Val_long (0));
CAMLreturn (res);
}
CAMLprim value
caml_udpv4_recvfrom(value v_fd, value v_str, value v_off, value v_len, value v_src)
{
CAMLparam5(v_fd, v_str, v_off, v_len, v_src);
CAMLlocal3(v_ret, v_err, v_inf);
unsigned char *buf = String_val(v_str) + Int_val(v_off);
size_t len = Int_val(v_len);
int fd = Int_val(v_fd);
struct sockaddr_in sa;
socklen_t sa_len = sizeof(sa);
int r = recvfrom(fd, (void *)buf, len, MSG_DONTWAIT, (struct sockaddr *)&sa, &sa_len);
if (r < 0) {
if (errno == EAGAIN || errno==EWOULDBLOCK)
Val_WouldBlock(v_ret);
else {
v_err = caml_copy_string(strerror(errno));
Val_Err(v_ret, v_err);
}
} else {
v_inf = caml_alloc_tuple(3);
Store_field(v_inf, 0, caml_copy_int32(ntohl(sa.sin_addr.s_addr)));
Store_field(v_inf, 1, Val_int(ntohs(sa.sin_port)));
Store_field(v_inf, 2, Val_int(r));
Val_OK(v_ret, v_inf);
}
CAMLreturn(v_ret);
}
static value
convert_json_t (json_t *val, int level)
{
CAMLparam0 ();
CAMLlocal5 (rv, v, tv, sv, consv);
if (level > 20)
caml_invalid_argument ("too many levels of object/array nesting");
if (json_is_object (val)) {
const char *key;
json_t *jvalue;
rv = caml_alloc (1, JSON_DICT_TAG);
v = Val_int (0);
/* This will create the OCaml list backwards, but JSON
* dictionaries are supposed to be unordered so that shouldn't
* matter, right? Well except that for some consumers this does
* matter (eg. simplestreams which incorrectly uses a dict when it
* really should use an array).
*/
json_object_foreach (val, key, jvalue) {
tv = caml_alloc_tuple (2);
sv = caml_copy_string (key);
Store_field (tv, 0, sv);
sv = convert_json_t (jvalue, level + 1);
Store_field (tv, 1, sv);
consv = caml_alloc (2, 0);
Store_field (consv, 1, v);
Store_field (consv, 0, tv);
v = consv;
}
Store_field (rv, 0, v);
}
value caml_inotify_convert(value buf) {
CAMLparam1(buf);
CAMLlocal3(event, list, next);
list = next = Val_emptylist;
struct inotify_event ievent;
memcpy(&ievent, String_val(buf), sizeof(struct inotify_event));
int flag;
for (flag = 0; inotify_return_table[flag]; flag++) {
if (!(ievent.mask & inotify_return_table[flag]))
continue;
next = caml_alloc_small(2, Tag_cons);
Field(next, 0) = Val_int(flag);
Field(next, 1) = list;
list = next;
}
event = caml_alloc_tuple(4);
Store_field(event, 0, Val_int(ievent.wd));
Store_field(event, 1, list);
Store_field(event, 2, caml_copy_int32(ievent.cookie));
Store_field(event, 3, Val_int(ievent.len));
CAMLreturn(event);
}
value
guestfs_int_mllib_parse_uri (value argv /* arg value, not an array! */)
{
CAMLparam1 (argv);
CAMLlocal4 (rv, sv, ssv, ov);
struct uri uri;
int r;
r = parse_uri (String_val (argv), &uri);
if (r == -1)
caml_invalid_argument ("URI.parse_uri");
/* Convert the struct into an OCaml tuple. */
rv = caml_alloc_tuple (5);
/* path : string */
sv = caml_copy_string (uri.path);
free (uri.path);
Store_field (rv, 0, sv);
/* protocol : string */
sv = caml_copy_string (uri.protocol);
free (uri.protocol);
Store_field (rv, 1, sv);
/* server : string array option */
if (uri.server) {
ssv = caml_copy_string_array ((const char **) uri.server);
guestfs_int_free_string_list (uri.server);
ov = caml_alloc (1, 0);
Store_field (ov, 0, ssv);
}
else
ov = Val_int (0);
Store_field (rv, 2, ov);
/* username : string option */
if (uri.username) {
sv = caml_copy_string (uri.username);
free (uri.username);
ov = caml_alloc (1, 0);
Store_field (ov, 0, sv);
}
else
ov = Val_int (0);
Store_field (rv, 3, ov);
/* password : string option */
if (uri.password) {
sv = caml_copy_string (uri.password);
free (uri.password);
ov = caml_alloc (1, 0);
Store_field (ov, 0, sv);
}
else
ov = Val_int (0);
Store_field (rv, 4, ov);
CAMLreturn (rv);
}
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 stub_xenctrlext_get_runstate_info(value xch, value domid)
{
CAMLparam2(xch, domid);
#if defined(XENCTRL_HAS_GET_RUNSTATE_INFO)
CAMLlocal1(result);
xc_runstate_info_t info;
int retval;
retval = xc_get_runstate_info(_H(xch), _D(domid), &info);
if (retval < 0)
failwith_xc(_H(xch));
/* Store
0 : state (int32)
1 : missed_changes (int32)
2 : state_entry_time (int64)
3-8 : times (int64s)
*/
result = caml_alloc_tuple(9);
Store_field(result, 0, caml_copy_int32(info.state));
Store_field(result, 1, caml_copy_int32(info.missed_changes));
Store_field(result, 2, caml_copy_int64(info.state_entry_time));
Store_field(result, 3, caml_copy_int64(info.time[0]));
Store_field(result, 4, caml_copy_int64(info.time[1]));
Store_field(result, 5, caml_copy_int64(info.time[2]));
Store_field(result, 6, caml_copy_int64(info.time[3]));
Store_field(result, 7, caml_copy_int64(info.time[4]));
Store_field(result, 8, caml_copy_int64(info.time[5]));
CAMLreturn(result);
#else
caml_failwith("XENCTRL_HAS_GET_RUNSTATE_INFO not defined");
#endif
}
CAMLprim value stub_xc_hvm_build_native(value xc_handle, value domid,
value mem_max_mib, value mem_start_mib, value image_name, value store_evtchn, value console_evtchn)
{
CAMLparam5(xc_handle, domid, mem_max_mib, mem_start_mib, image_name);
CAMLxparam2(store_evtchn, console_evtchn);
CAMLlocal1(result);
char *image_name_c = strdup(String_val(image_name));
char *error[256];
xc_interface *xch;
unsigned long store_mfn=0;
unsigned long console_mfn=0;
int r;
struct flags f;
/* The xenguest interface changed and was backported to XCP: */
#if defined(XENGUEST_HAS_HVM_BUILD_ARGS) || (__XEN_LATEST_INTERFACE_VERSION__ >= 0x00040200)
struct xc_hvm_build_args args;
#endif
get_flags(&f, _D(domid));
xch = _H(xc_handle);
configure_vcpus(xch, _D(domid), f);
configure_tsc(xch, _D(domid), f);
#if defined(XENGUEST_HAS_HVM_BUILD_ARGS) || (__XEN_LATEST_INTERFACE_VERSION__ >= 0x00040200)
args.mem_size = (uint64_t)Int_val(mem_max_mib) << 20;
args.mem_target = (uint64_t)Int_val(mem_start_mib) << 20;
args.mmio_size = f.mmio_size_mib << 20;
args.image_file_name = image_name_c;
#endif
caml_enter_blocking_section ();
#if defined(XENGUEST_HAS_HVM_BUILD_ARGS) || (__XEN_LATEST_INTERFACE_VERSION__ >= 0x00040200)
r = xc_hvm_build(xch, _D(domid), &args);
#else
r = xc_hvm_build_target_mem(xch, _D(domid),
Int_val(mem_max_mib),
Int_val(mem_start_mib),
image_name_c);
#endif
caml_leave_blocking_section ();
free(image_name_c);
if (r)
failwith_oss_xc(xch, "hvm_build");
r = hvm_build_set_params(xch, _D(domid), Int_val(store_evtchn), &store_mfn,
Int_val(console_evtchn), &console_mfn, f);
if (r)
failwith_oss_xc(xch, "hvm_build_params");
result = caml_alloc_tuple(2);
Store_field(result, 0, caml_copy_nativeint(store_mfn));
Store_field(result, 1, caml_copy_nativeint(console_mfn));
CAMLreturn(result);
}
CAMLprim value caml_gc_counters(value v)
{
CAMLparam0 (); /* v is ignored */
CAMLlocal1 (res);
/* get a copy of these before allocating anything... */
#ifdef _KERNEL
uintnat minwords = caml_stat_minor_words
+ Wsize_bsize (caml_young_end - caml_young_ptr);
uintnat prowords = caml_stat_promoted_words;
uintnat majwords = caml_stat_major_words + caml_allocated_words;
#else
double minwords = caml_stat_minor_words
+ (double) Wsize_bsize (caml_young_end - caml_young_ptr);
double prowords = caml_stat_promoted_words;
double majwords = caml_stat_major_words + (double) caml_allocated_words;
#endif
res = caml_alloc_tuple (3);
#ifdef _KERNEL
Store_field (res, 0, Val_long (minwords));
Store_field (res, 1, Val_long (prowords));
Store_field (res, 2, Val_long (majwords));
#else
Store_field (res, 0, caml_copy_double (minwords));
Store_field (res, 1, caml_copy_double (prowords));
Store_field (res, 2, caml_copy_double (majwords));
#endif
CAMLreturn (res);
}
CAMLprim value stub_xenctrlext_get_boot_cpufeatures(value xch)
{
CAMLparam1(xch);
#if defined(XENCTRL_HAS_GET_CPUFEATURES)
CAMLlocal1(v);
uint32_t a, b, c, d, e, f, g, h;
int ret;
ret = xc_get_boot_cpufeatures(_H(xch), &a, &b, &c, &d, &e, &f, &g, &h);
if (ret < 0)
failwith_xc(_H(xch));
v = caml_alloc_tuple(8);
Store_field(v, 0, caml_copy_int32(a));
Store_field(v, 1, caml_copy_int32(b));
Store_field(v, 2, caml_copy_int32(c));
Store_field(v, 3, caml_copy_int32(d));
Store_field(v, 4, caml_copy_int32(e));
Store_field(v, 5, caml_copy_int32(f));
Store_field(v, 6, caml_copy_int32(g));
Store_field(v, 7, caml_copy_int32(h));
CAMLreturn(v);
#else
caml_failwith("XENCTRL_HAS_GET_CPUFEATURES not defined");
#endif
}
/** @brief caml api, reutrn all maps in g_maps to a list[tuple(7 items)] */
value
ml_upnpGetMaps(value unused)
{
CAMLparam0 ();
int i;
CAMLlocal3( maps, map, cons );
maps = Val_emptylist;
if ( ! g_inited ){
dbg_printf("g_maps not initialize!\n");
CAMLreturn( Val_unit );
}
for (i = MAX_MAPS - 1; i > 0; i--){
if ( ! g_maps[i].enabled ){
continue;
}
map = caml_alloc_tuple( 7 );
Store_field( map, 0, Val_int(g_maps[i].enabled) );
Store_field( map, 1, Val_int(g_maps[i].intPort) );
Store_field( map, 2, Val_int(g_maps[i].extPort) );
Store_field( map, 3, Val_int(g_maps[i].isTcp) );
Store_field( map, 4, Val_int(g_maps[i].natpmpStatus) );
Store_field( map, 5, Val_int(g_maps[i].upnpStatus) );
Store_field( map, 6, caml_copy_string(g_maps[i].notes) );
cons = caml_alloc( 2, 0 );
Store_field( cons, 0, map ); // head
Store_field( cons, 1, maps ); // tail
maps = cons;
}
CAMLreturn( maps );
}
