[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[xen master] tools/ocaml/xc: Don't reference Custom objects with the GC lock released



commit 5fb7851ff2f5ef1de69c4c9598da09b110428c36
Author:     Edwin Török <edwin.torok@xxxxxxxxx>
AuthorDate: Thu Jan 26 16:44:05 2023 +0000
Commit:     Andrew Cooper <andrew.cooper3@xxxxxxxxxx>
CommitDate: Mon Feb 6 10:22:12 2023 +0000

    tools/ocaml/xc: Don't reference Custom objects with the GC lock released
    
    The modification to the _H() macro for Ocaml 5 support introduced a subtle
    bug.  From the manual:
    
      
https://ocaml.org/manual/intfc.html#ss:parallel-execution-long-running-c-code
    
    "After caml_release_runtime_system() was called and until
    caml_acquire_runtime_system() is called, the C code must not access any 
OCaml
    data, nor call any function of the run-time system, nor call back into OCaml
    code."
    
    Previously, the value was a naked C pointer, so dereferencing it wasn't
    "accessing any Ocaml data", but the fix to avoid naked C pointers added a
    layer of indirection through an Ocaml Custom object, meaning that the common
    pattern of using _H() in a blocking section is unsafe.
    
    In order to fix:
    
     * Drop the _H() macro and replace it with a static inline xch_of_val().
     * Opencode the assignment into Data_custom_val() in the constructors.
     * Rename "value xch" parameters to "value xch_val" so we can consistently
       have "xc_interface *xch" on the stack, and obtain the pointer with the GC
       lock still held.
     * Drop the _D() macro while at it, because it's just pointless indirection.
    
    Fixes: 8b3c06a3e545 ("tools/ocaml/xenctrl: OCaml 5 support, fix 
use-after-free")
    Signed-off-by: Edwin Török <edwin.torok@xxxxxxxxx>
    Signed-off-by: Andrew Cooper <andrew.cooper3@xxxxxxxxxx>
    Acked-by: Christian Lindig <christian.lindig@xxxxxxxxxx>
---
 tools/ocaml/libs/xc/xenctrl_stubs.c | 454 ++++++++++++++++++++----------------
 1 file changed, 251 insertions(+), 203 deletions(-)

diff --git a/tools/ocaml/libs/xc/xenctrl_stubs.c 
b/tools/ocaml/libs/xc/xenctrl_stubs.c
index e5277f6f19..f9006c6623 100644
--- a/tools/ocaml/libs/xc/xenctrl_stubs.c
+++ b/tools/ocaml/libs/xc/xenctrl_stubs.c
@@ -37,9 +37,6 @@
 
 #include "mmap_stubs.h"
 
-#define _H(__h) (*((xc_interface **)Data_custom_val(__h)))
-#define _D(__d) ((uint32_t)Int_val(__d))
-
 #ifndef Val_none
 #define Val_none (Val_int(0))
 #endif
@@ -48,9 +45,18 @@
 #define Tag_some 0
 #endif
 
+static inline xc_interface *xch_of_val(value v)
+{
+       xc_interface *xch = *(xc_interface **)Data_custom_val(v);
+
+       return xch;
+}
+
 static void stub_xenctrl_finalize(value v)
 {
-       xc_interface_close(_H(v));
+       xc_interface *xch = xch_of_val(v);
+
+       xc_interface_close(xch);
 }
 
 static struct custom_operations xenctrl_ops = {
@@ -100,7 +106,7 @@ CAMLprim value stub_xc_interface_open(value unit)
                failwith_xc(xch);
 
        result = caml_alloc_custom(&xenctrl_ops, sizeof(xch), 0, 1);
-       _H(result) = xch;
+       *(xc_interface **)Data_custom_val(result) = xch;
 
        CAMLreturn(result);
 }
@@ -187,10 +193,11 @@ static unsigned int ocaml_list_to_c_bitmap(value l)
        return val;
 }
 
-CAMLprim value stub_xc_domain_create(value xch, value wanted_domid, value 
config)
+CAMLprim value stub_xc_domain_create(value xch_val, value wanted_domid, value 
config)
 {
-       CAMLparam3(xch, wanted_domid, config);
+       CAMLparam3(xch_val, wanted_domid, config);
        CAMLlocal2(l, arch_domconfig);
+       xc_interface *xch = xch_of_val(xch_val);
 
        /* Mnemonics for the named fields inside domctl_create_config */
 #define VAL_SSIDREF             Field(config, 0)
@@ -282,98 +289,104 @@ CAMLprim value stub_xc_domain_create(value xch, value 
wanted_domid, value config
 #undef VAL_SSIDREF
 
        caml_enter_blocking_section();
-       result = xc_domain_create(_H(xch), &domid, &cfg);
+       result = xc_domain_create(xch, &domid, &cfg);
        caml_leave_blocking_section();
 
        if (result < 0)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        CAMLreturn(Val_int(domid));
 }
 
-CAMLprim value stub_xc_domain_max_vcpus(value xch, value domid,
+CAMLprim value stub_xc_domain_max_vcpus(value xch_val, value domid,
                                         value max_vcpus)
 {
-       CAMLparam3(xch, domid, max_vcpus);
+       CAMLparam3(xch_val, domid, max_vcpus);
+       xc_interface *xch = xch_of_val(xch_val);
        int r;
 
-       r = xc_domain_max_vcpus(_H(xch), _D(domid), Int_val(max_vcpus));
+       r = xc_domain_max_vcpus(xch, Int_val(domid), Int_val(max_vcpus));
        if (r)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        CAMLreturn(Val_unit);
 }
 
 
-value stub_xc_domain_sethandle(value xch, value domid, value handle)
+value stub_xc_domain_sethandle(value xch_val, value domid, value handle)
 {
-       CAMLparam3(xch, domid, handle);
+       CAMLparam3(xch_val, domid, handle);
+       xc_interface *xch = xch_of_val(xch_val);
        xen_domain_handle_t h;
        int i;
 
        domain_handle_of_uuid_string(h, String_val(handle));
 
-       i = xc_domain_sethandle(_H(xch), _D(domid), h);
+       i = xc_domain_sethandle(xch, Int_val(domid), h);
        if (i)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        CAMLreturn(Val_unit);
 }
 
-static value dom_op(value xch, value domid, int (*fn)(xc_interface *, 
uint32_t))
+static value dom_op(value xch_val, value domid,
+                   int (*fn)(xc_interface *, uint32_t))
 {
-       CAMLparam2(xch, domid);
+       CAMLparam2(xch_val, domid);
+       xc_interface *xch = xch_of_val(xch_val);
        int result;
 
-       uint32_t c_domid = _D(domid);
+       uint32_t c_domid = Int_val(domid);
 
        caml_enter_blocking_section();
-       result = fn(_H(xch), c_domid);
+       result = fn(xch, c_domid);
        caml_leave_blocking_section();
         if (result)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
        CAMLreturn(Val_unit);
 }
 
-CAMLprim value stub_xc_domain_pause(value xch, value domid)
+CAMLprim value stub_xc_domain_pause(value xch_val, value domid)
 {
-       return dom_op(xch, domid, xc_domain_pause);
+       return dom_op(xch_val, domid, xc_domain_pause);
 }
 
 
-CAMLprim value stub_xc_domain_unpause(value xch, value domid)
+CAMLprim value stub_xc_domain_unpause(value xch_val, value domid)
 {
-       return dom_op(xch, domid, xc_domain_unpause);
+       return dom_op(xch_val, domid, xc_domain_unpause);
 }
 
-CAMLprim value stub_xc_domain_destroy(value xch, value domid)
+CAMLprim value stub_xc_domain_destroy(value xch_val, value domid)
 {
-       return dom_op(xch, domid, xc_domain_destroy);
+       return dom_op(xch_val, domid, xc_domain_destroy);
 }
 
-CAMLprim value stub_xc_domain_resume_fast(value xch, value domid)
+CAMLprim value stub_xc_domain_resume_fast(value xch_val, value domid)
 {
-       CAMLparam2(xch, domid);
+       CAMLparam2(xch_val, domid);
+       xc_interface *xch = xch_of_val(xch_val);
        int result;
 
-       uint32_t c_domid = _D(domid);
+       uint32_t c_domid = Int_val(domid);
 
        caml_enter_blocking_section();
-       result = xc_domain_resume(_H(xch), c_domid, 1);
+       result = xc_domain_resume(xch, c_domid, 1);
        caml_leave_blocking_section();
         if (result)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
        CAMLreturn(Val_unit);
 }
 
-CAMLprim value stub_xc_domain_shutdown(value xch, value domid, value reason)
+CAMLprim value stub_xc_domain_shutdown(value xch_val, value domid, value 
reason)
 {
-       CAMLparam3(xch, domid, reason);
+       CAMLparam3(xch_val, domid, reason);
+       xc_interface *xch = xch_of_val(xch_val);
        int ret;
 
-       ret = xc_domain_shutdown(_H(xch), _D(domid), Int_val(reason));
+       ret = xc_domain_shutdown(xch, Int_val(domid), Int_val(reason));
        if (ret < 0)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        CAMLreturn(Val_unit);
 }
@@ -433,10 +446,11 @@ static value alloc_domaininfo(xc_domaininfo_t * info)
        CAMLreturn(result);
 }
 
-CAMLprim value stub_xc_domain_getinfolist(value xch, value first_domain, value 
nb)
+CAMLprim value stub_xc_domain_getinfolist(value xch_val, value first_domain, 
value nb)
 {
-       CAMLparam3(xch, first_domain, nb);
+       CAMLparam3(xch_val, first_domain, nb);
        CAMLlocal2(result, temp);
+       xc_interface *xch = xch_of_val(xch_val);
        xc_domaininfo_t * info;
        int i, ret, toalloc, retval;
        unsigned int c_max_domains;
@@ -450,16 +464,16 @@ CAMLprim value stub_xc_domain_getinfolist(value xch, 
value first_domain, value n
 
        result = temp = Val_emptylist;
 
-       c_first_domain = _D(first_domain);
+       c_first_domain = Int_val(first_domain);
        c_max_domains = Int_val(nb);
        caml_enter_blocking_section();
-       retval = xc_domain_getinfolist(_H(xch), c_first_domain,
+       retval = xc_domain_getinfolist(xch, c_first_domain,
                                       c_max_domains, info);
        caml_leave_blocking_section();
 
        if (retval < 0) {
                free(info);
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
        }
        for (i = 0; i < retval; i++) {
                result = caml_alloc_small(2, Tag_cons);
@@ -474,38 +488,39 @@ CAMLprim value stub_xc_domain_getinfolist(value xch, 
value first_domain, value n
        CAMLreturn(result);
 }
 
-CAMLprim value stub_xc_domain_getinfo(value xch, value domid)
+CAMLprim value stub_xc_domain_getinfo(value xch_val, value domid)
 {
-       CAMLparam2(xch, domid);
+       CAMLparam2(xch_val, domid);
        CAMLlocal1(result);
+       xc_interface *xch = xch_of_val(xch_val);
        xc_domaininfo_t info;
        int ret;
 
-       ret = xc_domain_getinfolist(_H(xch), _D(domid), 1, &info);
+       ret = xc_domain_getinfolist(xch, Int_val(domid), 1, &info);
        if (ret != 1)
-               failwith_xc(_H(xch));
-       if (info.domain != _D(domid))
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
+       if (info.domain != Int_val(domid))
+               failwith_xc(xch);
 
        result = alloc_domaininfo(&info);
        CAMLreturn(result);
 }
 
-CAMLprim value stub_xc_vcpu_getinfo(value xch, value domid, value vcpu)
+CAMLprim value stub_xc_vcpu_getinfo(value xch_val, value domid, value vcpu)
 {
-       CAMLparam3(xch, domid, vcpu);
+       CAMLparam3(xch_val, domid, vcpu);
        CAMLlocal1(result);
+       xc_interface *xch = xch_of_val(xch_val);
        xc_vcpuinfo_t info;
        int retval;
 
-       uint32_t c_domid = _D(domid);
+       uint32_t c_domid = Int_val(domid);
        uint32_t c_vcpu = Int_val(vcpu);
        caml_enter_blocking_section();
-       retval = xc_vcpu_getinfo(_H(xch), c_domid,
-                                c_vcpu, &info);
+       retval = xc_vcpu_getinfo(xch, c_domid, c_vcpu, &info);
        caml_leave_blocking_section();
        if (retval < 0)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        result = caml_alloc_tuple(5);
        Store_field(result, 0, Val_bool(info.online));
@@ -517,17 +532,18 @@ CAMLprim value stub_xc_vcpu_getinfo(value xch, value 
domid, value vcpu)
        CAMLreturn(result);
 }
 
-CAMLprim value stub_xc_vcpu_context_get(value xch, value domid,
+CAMLprim value stub_xc_vcpu_context_get(value xch_val, value domid,
                                         value cpu)
 {
-       CAMLparam3(xch, domid, cpu);
+       CAMLparam3(xch_val, domid, cpu);
+       xc_interface *xch = xch_of_val(xch_val);
        CAMLlocal1(context);
        int ret;
        vcpu_guest_context_any_t ctxt;
 
-       ret = xc_vcpu_getcontext(_H(xch), _D(domid), Int_val(cpu), &ctxt);
+       ret = xc_vcpu_getcontext(xch, Int_val(domid), Int_val(cpu), &ctxt);
        if ( ret < 0 )
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        context = caml_alloc_string(sizeof(ctxt));
        memcpy((char *) String_val(context), &ctxt.c, sizeof(ctxt.c));
@@ -535,10 +551,10 @@ CAMLprim value stub_xc_vcpu_context_get(value xch, value 
domid,
        CAMLreturn(context);
 }
 
-static int get_cpumap_len(value xch, value cpumap)
+static int get_cpumap_len(xc_interface *xch, value cpumap)
 {
        int ml_len = Wosize_val(cpumap);
-       int xc_len = xc_get_max_cpus(_H(xch));
+       int xc_len = xc_get_max_cpus(xch);
 
        if (ml_len < xc_len)
                return ml_len;
@@ -546,56 +562,58 @@ static int get_cpumap_len(value xch, value cpumap)
                return xc_len;
 }
 
-CAMLprim value stub_xc_vcpu_setaffinity(value xch, value domid,
+CAMLprim value stub_xc_vcpu_setaffinity(value xch_val, value domid,
                                         value vcpu, value cpumap)
 {
-       CAMLparam4(xch, domid, vcpu, cpumap);
+       CAMLparam4(xch_val, domid, vcpu, cpumap);
+       xc_interface *xch = xch_of_val(xch_val);
        int i, len = get_cpumap_len(xch, cpumap);
        xc_cpumap_t c_cpumap;
        int retval;
 
-       c_cpumap = xc_cpumap_alloc(_H(xch));
+       c_cpumap = xc_cpumap_alloc(xch);
        if (c_cpumap == NULL)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        for (i=0; i<len; i++) {
                if (Bool_val(Field(cpumap, i)))
                        c_cpumap[i/8] |= 1 << (i&7);
        }
-       retval = xc_vcpu_setaffinity(_H(xch), _D(domid),
+       retval = xc_vcpu_setaffinity(xch, Int_val(domid),
                                     Int_val(vcpu),
                                     c_cpumap, NULL,
                                     XEN_VCPUAFFINITY_HARD);
        free(c_cpumap);
 
        if (retval < 0)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
        CAMLreturn(Val_unit);
 }
 
-CAMLprim value stub_xc_vcpu_getaffinity(value xch, value domid,
+CAMLprim value stub_xc_vcpu_getaffinity(value xch_val, value domid,
                                         value vcpu)
 {
-       CAMLparam3(xch, domid, vcpu);
+       CAMLparam3(xch_val, domid, vcpu);
        CAMLlocal1(ret);
+       xc_interface *xch = xch_of_val(xch_val);
        xc_cpumap_t c_cpumap;
-       int i, len = xc_get_max_cpus(_H(xch));
+       int i, len = xc_get_max_cpus(xch);
        int retval;
 
        if (len < 1)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
-       c_cpumap = xc_cpumap_alloc(_H(xch));
+       c_cpumap = xc_cpumap_alloc(xch);
        if (c_cpumap == NULL)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
-       retval = xc_vcpu_getaffinity(_H(xch), _D(domid),
+       retval = xc_vcpu_getaffinity(xch, Int_val(domid),
                                     Int_val(vcpu),
                                     c_cpumap, NULL,
                                     XEN_VCPUAFFINITY_HARD);
        if (retval < 0) {
                free(c_cpumap);
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
        }
 
        ret = caml_alloc(len, 0);
@@ -612,63 +630,68 @@ CAMLprim value stub_xc_vcpu_getaffinity(value xch, value 
domid,
        CAMLreturn(ret);
 }
 
-CAMLprim value stub_xc_sched_id(value xch)
+CAMLprim value stub_xc_sched_id(value xch_val)
 {
-       CAMLparam1(xch);
+       CAMLparam1(xch_val);
+       xc_interface *xch = xch_of_val(xch_val);
        int sched_id;
 
-       if (xc_sched_id(_H(xch), &sched_id))
-               failwith_xc(_H(xch));
+       if (xc_sched_id(xch, &sched_id))
+               failwith_xc(xch);
+
        CAMLreturn(Val_int(sched_id));
 }
 
-CAMLprim value stub_xc_evtchn_alloc_unbound(value xch,
+CAMLprim value stub_xc_evtchn_alloc_unbound(value xch_val,
                                             value local_domid,
                                             value remote_domid)
 {
-       CAMLparam3(xch, local_domid, remote_domid);
+       CAMLparam3(xch_val, local_domid, remote_domid);
+       xc_interface *xch = xch_of_val(xch_val);
        int result;
 
-       uint32_t c_local_domid = _D(local_domid);
-       uint32_t c_remote_domid = _D(remote_domid);
+       uint32_t c_local_domid = Int_val(local_domid);
+       uint32_t c_remote_domid = Int_val(remote_domid);
 
        caml_enter_blocking_section();
-       result = xc_evtchn_alloc_unbound(_H(xch), c_local_domid,
+       result = xc_evtchn_alloc_unbound(xch, c_local_domid,
                                             c_remote_domid);
        caml_leave_blocking_section();
 
        if (result < 0)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
        CAMLreturn(Val_int(result));
 }
 
-CAMLprim value stub_xc_evtchn_reset(value xch, value domid)
+CAMLprim value stub_xc_evtchn_reset(value xch_val, value domid)
 {
-       CAMLparam2(xch, domid);
+       CAMLparam2(xch_val, domid);
+       xc_interface *xch = xch_of_val(xch_val);
        int r;
 
-       r = xc_evtchn_reset(_H(xch), _D(domid));
+       r = xc_evtchn_reset(xch, Int_val(domid));
        if (r < 0)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
        CAMLreturn(Val_unit);
 }
 
-CAMLprim value stub_xc_evtchn_status(value xch, value domid, value port)
+CAMLprim value stub_xc_evtchn_status(value xch_val, value domid, value port)
 {
-       CAMLparam3(xch, domid, port);
+       CAMLparam3(xch_val, domid, port);
        CAMLlocal4(result, result_status, stat, interdomain);
+       xc_interface *xch = xch_of_val(xch_val);
        xc_evtchn_status_t status = {
-               .dom = _D(domid),
+               .dom = Int_val(domid),
                .port = Int_val(port),
        };
        int rc;
 
        caml_enter_blocking_section();
-       rc = xc_evtchn_status(_H(xch), &status);
+       rc = xc_evtchn_status(xch, &status);
        caml_leave_blocking_section();
 
        if ( rc < 0 )
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        switch ( status.status )
        {
@@ -716,7 +739,7 @@ CAMLprim value stub_xc_evtchn_status(value xch, value 
domid, value port)
        CAMLreturn(result);
 }
 
-CAMLprim value stub_xc_readconsolering(value xch)
+CAMLprim value stub_xc_readconsolering(value xch_val)
 {
        /* Safe to use outside of blocking sections because of Ocaml GC lock. */
        static unsigned int conring_size = 16384 + 1;
@@ -725,8 +748,9 @@ CAMLprim value stub_xc_readconsolering(value xch)
        char *str = NULL, *ptr;
        int ret;
 
-       CAMLparam1(xch);
+       CAMLparam1(xch_val);
        CAMLlocal1(ring);
+       xc_interface *xch = xch_of_val(xch_val);
 
        str = malloc(size);
        if (!str)
@@ -734,12 +758,12 @@ CAMLprim value stub_xc_readconsolering(value xch)
 
        /* Hopefully our conring_size guess is sufficient */
        caml_enter_blocking_section();
-       ret = xc_readconsolering(_H(xch), str, &count, 0, 0, &index);
+       ret = xc_readconsolering(xch, str, &count, 0, 0, &index);
        caml_leave_blocking_section();
 
        if (ret < 0) {
                free(str);
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
        }
 
        while (count == size && ret >= 0) {
@@ -755,7 +779,7 @@ CAMLprim value stub_xc_readconsolering(value xch)
                count = size - count;
 
                caml_enter_blocking_section();
-               ret = xc_readconsolering(_H(xch), str, &count, 0, 1, &index);
+               ret = xc_readconsolering(xch, str, &count, 0, 1, &index);
                caml_leave_blocking_section();
 
                count += str - ptr;
@@ -777,30 +801,32 @@ CAMLprim value stub_xc_readconsolering(value xch)
        CAMLreturn(ring);
 }
 
-CAMLprim value stub_xc_send_debug_keys(value xch, value keys)
+CAMLprim value stub_xc_send_debug_keys(value xch_val, value keys)
 {
-       CAMLparam2(xch, keys);
+       CAMLparam2(xch_val, keys);
+       xc_interface *xch = xch_of_val(xch_val);
        int r;
 
-       r = xc_send_debug_keys(_H(xch), String_val(keys));
+       r = xc_send_debug_keys(xch, String_val(keys));
        if (r)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
        CAMLreturn(Val_unit);
 }
 
-CAMLprim value stub_xc_physinfo(value xch)
+CAMLprim value stub_xc_physinfo(value xch_val)
 {
-       CAMLparam1(xch);
+       CAMLparam1(xch_val);
        CAMLlocal4(physinfo, cap_list, arch_cap_flags, arch_cap_list);
+       xc_interface *xch = xch_of_val(xch_val);
        xc_physinfo_t c_physinfo;
        int r, arch_cap_flags_tag;
 
        caml_enter_blocking_section();
-       r = xc_physinfo(_H(xch), &c_physinfo);
+       r = xc_physinfo(xch, &c_physinfo);
        caml_leave_blocking_section();
 
        if (r)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        /*
         * capabilities: physinfo_cap_flag list;
@@ -837,10 +863,11 @@ CAMLprim value stub_xc_physinfo(value xch)
        CAMLreturn(physinfo);
 }
 
-CAMLprim value stub_xc_pcpu_info(value xch, value nr_cpus)
+CAMLprim value stub_xc_pcpu_info(value xch_val, value nr_cpus)
 {
-       CAMLparam2(xch, nr_cpus);
+       CAMLparam2(xch_val, nr_cpus);
        CAMLlocal2(pcpus, v);
+       xc_interface *xch = xch_of_val(xch_val);
        xc_cpuinfo_t *info;
        int r, size;
 
@@ -852,12 +879,12 @@ CAMLprim value stub_xc_pcpu_info(value xch, value nr_cpus)
                caml_raise_out_of_memory();
 
        caml_enter_blocking_section();
-       r = xc_getcpuinfo(_H(xch), Int_val(nr_cpus), info, &size);
+       r = xc_getcpuinfo(xch, Int_val(nr_cpus), info, &size);
        caml_leave_blocking_section();
 
        if (r) {
                free(info);
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
        }
 
        if (size > 0) {
@@ -873,79 +900,82 @@ CAMLprim value stub_xc_pcpu_info(value xch, value nr_cpus)
        CAMLreturn(pcpus);
 }
 
-CAMLprim value stub_xc_domain_setmaxmem(value xch, value domid,
+CAMLprim value stub_xc_domain_setmaxmem(value xch_val, value domid,
                                         value max_memkb)
 {
-       CAMLparam3(xch, domid, max_memkb);
+       CAMLparam3(xch_val, domid, max_memkb);
+       xc_interface *xch = xch_of_val(xch_val);
        int retval;
 
-       uint32_t c_domid = _D(domid);
+       uint32_t c_domid = Int_val(domid);
        unsigned int c_max_memkb = Int64_val(max_memkb);
        caml_enter_blocking_section();
-       retval = xc_domain_setmaxmem(_H(xch), c_domid,
-                                        c_max_memkb);
+       retval = xc_domain_setmaxmem(xch, c_domid, c_max_memkb);
        caml_leave_blocking_section();
        if (retval)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
        CAMLreturn(Val_unit);
 }
 
-CAMLprim value stub_xc_domain_set_memmap_limit(value xch, value domid,
+CAMLprim value stub_xc_domain_set_memmap_limit(value xch_val, value domid,
                                                value map_limitkb)
 {
-       CAMLparam3(xch, domid, map_limitkb);
+       CAMLparam3(xch_val, domid, map_limitkb);
+       xc_interface *xch = xch_of_val(xch_val);
        unsigned long v;
        int retval;
 
        v = Int64_val(map_limitkb);
-       retval = xc_domain_set_memmap_limit(_H(xch), _D(domid), v);
+       retval = xc_domain_set_memmap_limit(xch, Int_val(domid), v);
        if (retval)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        CAMLreturn(Val_unit);
 }
 
-CAMLprim value stub_xc_domain_memory_increase_reservation(value xch,
+CAMLprim value stub_xc_domain_memory_increase_reservation(value xch_val,
                                                           value domid,
                                                           value mem_kb)
 {
-       CAMLparam3(xch, domid, mem_kb);
+       CAMLparam3(xch_val, domid, mem_kb);
+       xc_interface *xch = xch_of_val(xch_val);
        int retval;
 
        unsigned long nr_extents = ((unsigned long)(Int64_val(mem_kb))) >> 
(XC_PAGE_SHIFT - 10);
 
-       uint32_t c_domid = _D(domid);
+       uint32_t c_domid = Int_val(domid);
        caml_enter_blocking_section();
-       retval = xc_domain_increase_reservation_exact(_H(xch), c_domid,
+       retval = xc_domain_increase_reservation_exact(xch, c_domid,
                                                          nr_extents, 0, 0, 
NULL);
        caml_leave_blocking_section();
 
        if (retval)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
        CAMLreturn(Val_unit);
 }
 
-CAMLprim value stub_xc_version_version(value xch)
+CAMLprim value stub_xc_version_version(value xch_val)
 {
-       CAMLparam1(xch);
+       CAMLparam1(xch_val);
        CAMLlocal1(result);
+       xc_interface *xch = xch_of_val(xch_val);
        xen_extraversion_t extra;
        long packed;
        int retval;
 
        caml_enter_blocking_section();
-       packed = xc_version(_H(xch), XENVER_version, NULL);
+       packed = xc_version(xch, XENVER_version, NULL);
        caml_leave_blocking_section();
 
        if (packed < 0)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        caml_enter_blocking_section();
-       retval = xc_version(_H(xch), XENVER_extraversion, &extra);
+       retval = xc_version(xch, XENVER_extraversion, &extra);
        caml_leave_blocking_section();
 
        if (retval)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        result = caml_alloc_tuple(3);
 
@@ -957,19 +987,20 @@ CAMLprim value stub_xc_version_version(value xch)
 }
 
 
-CAMLprim value stub_xc_version_compile_info(value xch)
+CAMLprim value stub_xc_version_compile_info(value xch_val)
 {
-       CAMLparam1(xch);
+       CAMLparam1(xch_val);
        CAMLlocal1(result);
+       xc_interface *xch = xch_of_val(xch_val);
        xen_compile_info_t ci;
        int retval;
 
        caml_enter_blocking_section();
-       retval = xc_version(_H(xch), XENVER_compile_info, &ci);
+       retval = xc_version(xch, XENVER_compile_info, &ci);
        caml_leave_blocking_section();
 
        if (retval)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        result = caml_alloc_tuple(4);
 
@@ -982,35 +1013,36 @@ CAMLprim value stub_xc_version_compile_info(value xch)
 }
 
 
-static value xc_version_single_string(value xch, int code, void *info)
+static value xc_version_single_string(value xch_val, int code, void *info)
 {
-       CAMLparam1(xch);
+       CAMLparam1(xch_val);
+       xc_interface *xch = xch_of_val(xch_val);
        int retval;
 
        caml_enter_blocking_section();
-       retval = xc_version(_H(xch), code, info);
+       retval = xc_version(xch, code, info);
        caml_leave_blocking_section();
 
        if (retval)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        CAMLreturn(caml_copy_string((char *)info));
 }
 
 
-CAMLprim value stub_xc_version_changeset(value xch)
+CAMLprim value stub_xc_version_changeset(value xch_val)
 {
        xen_changeset_info_t ci;
 
-       return xc_version_single_string(xch, XENVER_changeset, &ci);
+       return xc_version_single_string(xch_val, XENVER_changeset, &ci);
 }
 
 
-CAMLprim value stub_xc_version_capabilities(value xch)
+CAMLprim value stub_xc_version_capabilities(value xch_val)
 {
        xen_capabilities_info_t ci;
 
-       return xc_version_single_string(xch, XENVER_capabilities, &ci);
+       return xc_version_single_string(xch_val, XENVER_capabilities, &ci);
 }
 
 
@@ -1022,11 +1054,12 @@ CAMLprim value stub_pages_to_kib(value pages)
 }
 
 
-CAMLprim value stub_map_foreign_range(value xch, value dom,
+CAMLprim value stub_map_foreign_range(value xch_val, value dom,
                                       value size, value mfn)
 {
-       CAMLparam4(xch, dom, size, mfn);
+       CAMLparam4(xch_val, dom, size, mfn);
        CAMLlocal1(result);
+       xc_interface *xch = xch_of_val(xch_val);
        struct mmap_interface *intf;
        unsigned long c_mfn = Nativeint_val(mfn);
        int len = Int_val(size);
@@ -1037,7 +1070,7 @@ CAMLprim value stub_map_foreign_range(value xch, value 
dom,
                            Abstract_tag);
 
        caml_enter_blocking_section();
-       ptr = xc_map_foreign_range(_H(xch), _D(dom), len,
+       ptr = xc_map_foreign_range(xch, Int_val(dom), len,
                                   PROT_READ|PROT_WRITE, c_mfn);
        caml_leave_blocking_section();
 
@@ -1050,18 +1083,19 @@ CAMLprim value stub_map_foreign_range(value xch, value 
dom,
        CAMLreturn(result);
 }
 
-CAMLprim value stub_sched_credit_domain_get(value xch, value domid)
+CAMLprim value stub_sched_credit_domain_get(value xch_val, value domid)
 {
-       CAMLparam2(xch, domid);
+       CAMLparam2(xch_val, domid);
        CAMLlocal1(sdom);
+       xc_interface *xch = xch_of_val(xch_val);
        struct xen_domctl_sched_credit c_sdom;
        int ret;
 
        caml_enter_blocking_section();
-       ret = xc_sched_credit_domain_get(_H(xch), _D(domid), &c_sdom);
+       ret = xc_sched_credit_domain_get(xch, Int_val(domid), &c_sdom);
        caml_leave_blocking_section();
        if (ret != 0)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        sdom = caml_alloc_tuple(2);
        Store_field(sdom, 0, Val_int(c_sdom.weight));
@@ -1070,67 +1104,71 @@ CAMLprim value stub_sched_credit_domain_get(value xch, 
value domid)
        CAMLreturn(sdom);
 }
 
-CAMLprim value stub_sched_credit_domain_set(value xch, value domid,
+CAMLprim value stub_sched_credit_domain_set(value xch_val, value domid,
                                             value sdom)
 {
-       CAMLparam3(xch, domid, sdom);
+       CAMLparam3(xch_val, domid, sdom);
+       xc_interface *xch = xch_of_val(xch_val);
        struct xen_domctl_sched_credit c_sdom;
        int ret;
 
        c_sdom.weight = Int_val(Field(sdom, 0));
        c_sdom.cap = Int_val(Field(sdom, 1));
        caml_enter_blocking_section();
-       ret = xc_sched_credit_domain_set(_H(xch), _D(domid), &c_sdom);
+       ret = xc_sched_credit_domain_set(xch, Int_val(domid), &c_sdom);
        caml_leave_blocking_section();
        if (ret != 0)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        CAMLreturn(Val_unit);
 }
 
-CAMLprim value stub_shadow_allocation_get(value xch, value domid)
+CAMLprim value stub_shadow_allocation_get(value xch_val, value domid)
 {
-       CAMLparam2(xch, domid);
+       CAMLparam2(xch_val, domid);
        CAMLlocal1(mb);
+       xc_interface *xch = xch_of_val(xch_val);
        unsigned int c_mb;
        int ret;
 
        caml_enter_blocking_section();
-       ret = xc_shadow_control(_H(xch), _D(domid),
+       ret = xc_shadow_control(xch, Int_val(domid),
                                XEN_DOMCTL_SHADOW_OP_GET_ALLOCATION,
                                &c_mb, 0);
        caml_leave_blocking_section();
        if (ret != 0)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        mb = Val_int(c_mb);
        CAMLreturn(mb);
 }
 
-CAMLprim value stub_shadow_allocation_set(value xch, value domid,
+CAMLprim value stub_shadow_allocation_set(value xch_val, value domid,
                                          value mb)
 {
-       CAMLparam3(xch, domid, mb);
+       CAMLparam3(xch_val, domid, mb);
+       xc_interface *xch = xch_of_val(xch_val);
        unsigned int c_mb;
        int ret;
 
        c_mb = Int_val(mb);
        caml_enter_blocking_section();
-       ret = xc_shadow_control(_H(xch), _D(domid),
+       ret = xc_shadow_control(xch, Int_val(domid),
                                XEN_DOMCTL_SHADOW_OP_SET_ALLOCATION,
                                &c_mb, 0);
        caml_leave_blocking_section();
        if (ret != 0)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        CAMLreturn(Val_unit);
 }
 
-CAMLprim value stub_xc_domain_ioport_permission(value xch, value domid,
+CAMLprim value stub_xc_domain_ioport_permission(value xch_val, value domid,
                                               value start_port, value nr_ports,
                                               value allow)
 {
-       CAMLparam5(xch, domid, start_port, nr_ports, allow);
+       CAMLparam5(xch_val, domid, start_port, nr_ports, allow);
+       xc_interface *xch = xch_of_val(xch_val);
        uint32_t c_start_port, c_nr_ports;
        uint8_t c_allow;
        int ret;
@@ -1139,19 +1177,20 @@ CAMLprim value stub_xc_domain_ioport_permission(value 
xch, value domid,
        c_nr_ports = Int_val(nr_ports);
        c_allow = Bool_val(allow);
 
-       ret = xc_domain_ioport_permission(_H(xch), _D(domid),
+       ret = xc_domain_ioport_permission(xch, Int_val(domid),
                                         c_start_port, c_nr_ports, c_allow);
        if (ret < 0)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        CAMLreturn(Val_unit);
 }
 
-CAMLprim value stub_xc_domain_iomem_permission(value xch, value domid,
+CAMLprim value stub_xc_domain_iomem_permission(value xch_val, value domid,
                                               value start_pfn, value nr_pfns,
                                               value allow)
 {
-       CAMLparam5(xch, domid, start_pfn, nr_pfns, allow);
+       CAMLparam5(xch_val, domid, start_pfn, nr_pfns, allow);
+       xc_interface *xch = xch_of_val(xch_val);
        unsigned long c_start_pfn, c_nr_pfns;
        uint8_t c_allow;
        int ret;
@@ -1160,18 +1199,19 @@ CAMLprim value stub_xc_domain_iomem_permission(value 
xch, value domid,
        c_nr_pfns = Nativeint_val(nr_pfns);
        c_allow = Bool_val(allow);
 
-       ret = xc_domain_iomem_permission(_H(xch), _D(domid),
+       ret = xc_domain_iomem_permission(xch, Int_val(domid),
                                         c_start_pfn, c_nr_pfns, c_allow);
        if (ret < 0)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        CAMLreturn(Val_unit);
 }
 
-CAMLprim value stub_xc_domain_irq_permission(value xch, value domid,
+CAMLprim value stub_xc_domain_irq_permission(value xch_val, value domid,
                                             value pirq, value allow)
 {
-       CAMLparam4(xch, domid, pirq, allow);
+       CAMLparam4(xch_val, domid, pirq, allow);
+       xc_interface *xch = xch_of_val(xch_val);
        uint32_t c_pirq;
        bool c_allow;
        int ret;
@@ -1179,41 +1219,44 @@ CAMLprim value stub_xc_domain_irq_permission(value xch, 
value domid,
        c_pirq = Int_val(pirq);
        c_allow = Bool_val(allow);
 
-       ret = xc_domain_irq_permission(_H(xch), _D(domid),
+       ret = xc_domain_irq_permission(xch, Int_val(domid),
                                       c_pirq, c_allow);
        if (ret < 0)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        CAMLreturn(Val_unit);
 }
 
-CAMLprim value stub_xc_hvm_param_get(value xch, value domid, value param)
+CAMLprim value stub_xc_hvm_param_get(value xch_val, value domid, value param)
 {
-       CAMLparam3(xch, domid, param);
+       CAMLparam3(xch_val, domid, param);
+       xc_interface *xch = xch_of_val(xch_val);
        uint64_t val;
        int ret;
 
        caml_enter_blocking_section();
-       ret = xc_hvm_param_get(_H(xch), _D(domid), Int_val(param), &val);
+       ret = xc_hvm_param_get(xch, Int_val(domid), Int_val(param), &val);
        caml_leave_blocking_section();
 
        if ( ret )
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        CAMLreturn(caml_copy_int64(val));
 }
 
-CAMLprim value stub_xc_hvm_param_set(value xch, value domid, value param, 
value val)
+CAMLprim value stub_xc_hvm_param_set(value xch_val, value domid, value param, 
value val)
 {
-       CAMLparam4(xch, domid, param, val);
+       CAMLparam4(xch_val, domid, param, val);
+       xc_interface *xch = xch_of_val(xch_val);
+       uint64_t val64 = Int64_val(val);
        int ret;
 
        caml_enter_blocking_section();
-       ret = xc_hvm_param_set(_H(xch), _D(domid), Int_val(param), 
Int64_val(val));
+       ret = xc_hvm_param_set(xch, Int_val(domid), Int_val(param), val64);
        caml_leave_blocking_section();
 
        if ( ret )
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        CAMLreturn(Val_unit);
 }
@@ -1226,9 +1269,10 @@ static uint32_t encode_sbdf(int domain, int bus, int 
dev, int func)
                ((uint32_t)func   &    0x7);
 }
 
-CAMLprim value stub_xc_domain_test_assign_device(value xch, value domid, value 
desc)
+CAMLprim value stub_xc_domain_test_assign_device(value xch_val, value domid, 
value desc)
 {
-       CAMLparam3(xch, domid, desc);
+       CAMLparam3(xch_val, domid, desc);
+       xc_interface *xch = xch_of_val(xch_val);
        int ret;
        int domain, bus, dev, func;
        uint32_t sbdf;
@@ -1239,14 +1283,15 @@ CAMLprim value stub_xc_domain_test_assign_device(value 
xch, value domid, value d
        func = Int_val(Field(desc, 3));
        sbdf = encode_sbdf(domain, bus, dev, func);
 
-       ret = xc_test_assign_device(_H(xch), _D(domid), sbdf);
+       ret = xc_test_assign_device(xch, Int_val(domid), sbdf);
 
        CAMLreturn(Val_bool(ret == 0));
 }
 
-CAMLprim value stub_xc_domain_assign_device(value xch, value domid, value desc)
+CAMLprim value stub_xc_domain_assign_device(value xch_val, value domid, value 
desc)
 {
-       CAMLparam3(xch, domid, desc);
+       CAMLparam3(xch_val, domid, desc);
+       xc_interface *xch = xch_of_val(xch_val);
        int ret;
        int domain, bus, dev, func;
        uint32_t sbdf;
@@ -1257,17 +1302,18 @@ CAMLprim value stub_xc_domain_assign_device(value xch, 
value domid, value desc)
        func = Int_val(Field(desc, 3));
        sbdf = encode_sbdf(domain, bus, dev, func);
 
-       ret = xc_assign_device(_H(xch), _D(domid), sbdf,
+       ret = xc_assign_device(xch, Int_val(domid), sbdf,
                               XEN_DOMCTL_DEV_RDM_RELAXED);
 
        if (ret < 0)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
        CAMLreturn(Val_unit);
 }
 
-CAMLprim value stub_xc_domain_deassign_device(value xch, value domid, value 
desc)
+CAMLprim value stub_xc_domain_deassign_device(value xch_val, value domid, 
value desc)
 {
-       CAMLparam3(xch, domid, desc);
+       CAMLparam3(xch_val, domid, desc);
+       xc_interface *xch = xch_of_val(xch_val);
        int ret;
        int domain, bus, dev, func;
        uint32_t sbdf;
@@ -1278,28 +1324,29 @@ CAMLprim value stub_xc_domain_deassign_device(value 
xch, value domid, value desc
        func = Int_val(Field(desc, 3));
        sbdf = encode_sbdf(domain, bus, dev, func);
 
-       ret = xc_deassign_device(_H(xch), _D(domid), sbdf);
+       ret = xc_deassign_device(xch, Int_val(domid), sbdf);
 
        if (ret < 0)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
        CAMLreturn(Val_unit);
 }
 
-CAMLprim value stub_xc_get_cpu_featureset(value xch, value idx)
+CAMLprim value stub_xc_get_cpu_featureset(value xch_val, value idx)
 {
-       CAMLparam2(xch, idx);
+       CAMLparam2(xch_val, idx);
        CAMLlocal1(bitmap_val);
 #if defined(__i386__) || defined(__x86_64__)
+       xc_interface *xch = xch_of_val(xch_val);
 
        /* Safe, because of the global ocaml lock. */
        static uint32_t fs_len;
 
        if (fs_len == 0)
        {
-               int ret = xc_get_cpu_featureset(_H(xch), 0, &fs_len, NULL);
+               int ret = xc_get_cpu_featureset(xch, 0, &fs_len, NULL);
 
                if (ret || (fs_len == 0))
-                       failwith_xc(_H(xch));
+                       failwith_xc(xch);
        }
 
        {
@@ -1307,10 +1354,10 @@ CAMLprim value stub_xc_get_cpu_featureset(value xch, 
value idx)
                uint32_t fs[fs_len], len = fs_len;
                unsigned int i;
 
-               int ret = xc_get_cpu_featureset(_H(xch), Int_val(idx), &len, 
fs);
+               int ret = xc_get_cpu_featureset(xch, Int_val(idx), &len, fs);
 
                if (ret)
-                       failwith_xc(_H(xch));
+                       failwith_xc(xch);
 
                bitmap_val = caml_alloc(len, 0);
 
@@ -1323,15 +1370,16 @@ CAMLprim value stub_xc_get_cpu_featureset(value xch, 
value idx)
        CAMLreturn(bitmap_val);
 }
 
-CAMLprim value stub_xc_watchdog(value xch, value domid, value timeout)
+CAMLprim value stub_xc_watchdog(value xch_val, value domid, value timeout)
 {
-       CAMLparam3(xch, domid, timeout);
+       CAMLparam3(xch_val, domid, timeout);
+       xc_interface *xch = xch_of_val(xch_val);
        int ret;
        unsigned int c_timeout = Int32_val(timeout);
 
-       ret = xc_watchdog(_H(xch), _D(domid), c_timeout);
+       ret = xc_watchdog(xch, Int_val(domid), c_timeout);
        if (ret < 0)
-               failwith_xc(_H(xch));
+               failwith_xc(xch);
 
        CAMLreturn(Val_int(ret));
 }
--
generated by git-patchbot for /home/xen/git/xen.git#master



 


Rackspace

Lists.xenproject.org is hosted with RackSpace, monitoring our
servers 24x7x365 and backed by RackSpace's Fanatical Support®.