diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py index 1e956abb2e..bdae88670f 100644 --- a/tools/ocaml/libs/xl/genwrap.py +++ b/tools/ocaml/libs/xl/genwrap.py @@ -8,23 +8,23 @@ import idl builtins = { "bool": ("bool", "%(c)s = Bool_val(%(o)s)", "Val_bool(%(c)s)" ), "int": ("int", "%(c)s = Int_val(%(o)s)", "Val_int(%(c)s)" ), - "char *": ("string", "%(c)s = dup_String_val(gc, %(o)s)", "caml_copy_string(%(c)s)"), + "char *": ("string", "%(c)s = dup_String_val(%(o)s)", "caml_copy_string(%(c)s)"), "libxl_domid": ("domid", "%(c)s = Int_val(%(o)s)", "Val_int(%(c)s)" ), "libxl_devid": ("devid", "%(c)s = Int_val(%(o)s)", "Val_int(%(c)s)" ), "libxl_defbool": ("bool option", "%(c)s = Defbool_val(%(o)s)", "Val_defbool(%(c)s)" ), - "libxl_uuid": ("int array", "Uuid_val(gc, lg, &%(c)s, %(o)s)", "Val_uuid(&%(c)s)"), - "libxl_bitmap": ("bool array", "Bitmap_val(gc, lg, &%(c)s, %(o)s)", "Val_bitmap(&%(c)s)"), - "libxl_key_value_list": ("(string * string) list", "libxl_key_value_list_val(gc, lg, &%(c)s, %(o)s)", "Val_key_value_list(&%(c)s)"), - "libxl_string_list": ("string list", "libxl_string_list_val(gc, lg, &%(c)s, %(o)s)", "Val_string_list(&%(c)s)"), - "libxl_mac": ("int array", "Mac_val(gc, lg, &%(c)s, %(o)s)", "Val_mac(&%(c)s)"), + "libxl_uuid": ("int array", "Uuid_val(&%(c)s, %(o)s)", "Val_uuid(&%(c)s)"), + "libxl_bitmap": ("bool array", "Bitmap_val(ctx, &%(c)s, %(o)s)", "Val_bitmap(&%(c)s)"), + "libxl_key_value_list": ("(string * string) list", "libxl_key_value_list_val(&%(c)s, %(o)s)", "Val_key_value_list(&%(c)s)"), + "libxl_string_list": ("string list", "libxl_string_list_val(&%(c)s, %(o)s)", "Val_string_list(&%(c)s)"), + "libxl_mac": ("int array", "Mac_val(&%(c)s, %(o)s)", "Val_mac(&%(c)s)"), "libxl_hwcap": ("int32 array", None, "Val_hwcap(&%(c)s)"), # The following needs to be sorted out later "libxl_cpuid_policy_list": ("unit", "%(c)s = 0", "Val_unit"), } -DEVICE_FUNCTIONS = [ ("add", ["t", "domid", "unit"]), - ("remove", ["t", "domid", "unit"]), - ("destroy", ["t", "domid", "unit"]), +DEVICE_FUNCTIONS = [ ("add", ["ctx", "t", "domid", "unit"]), + ("remove", ["ctx", "t", "domid", "unit"]), + ("destroy", ["ctx", "t", "domid", "unit"]), ] functions = { # ( name , [type1,type2,....] ) @@ -33,13 +33,13 @@ functions = { # ( name , [type1,type2,....] ) "device_disk": DEVICE_FUNCTIONS, "device_nic": DEVICE_FUNCTIONS, "device_pci": DEVICE_FUNCTIONS, - "physinfo": [ ("get", ["unit", "t"]), + "physinfo": [ ("get", ["ctx", "t"]), ], - "cputopology": [ ("get", ["unit", "t array"]), + "cputopology": [ ("get", ["ctx", "t array"]), ], "domain_sched_params": - [ ("get", ["domid", "t"]), - ("set", ["domid", "t", "unit"]), + [ ("get", ["ctx", "domid", "t"]), + ("set", ["ctx", "domid", "t", "unit"]), ], } def stub_fn_name(ty, name): @@ -236,7 +236,7 @@ def c_val(ty, c, o, indent="", parent = None): for e in ty.values: s += " case %d: *%s = %s; break;\n" % (n, c, e.name) n += 1 - s += " default: failwith_xl(\"cannot convert value to %s\", lg); break;\n" % ty.typename + s += " default: failwith_xl(\"cannot convert value to %s\"); break;\n" % ty.typename s += "}" elif isinstance(ty, idl.KeyedUnion): s += "{\n" @@ -249,7 +249,7 @@ def c_val(ty, c, o, indent="", parent = None): parent + ty.keyvar.name, f.enumname) n += 1 - s += "\t\t default: failwith_xl(\"variant handling bug %s%s (long)\", lg); break;\n" % (parent, ty.keyvar.name) + s += "\t\t default: failwith_xl(\"variant handling bug %s%s (long)\"); break;\n" % (parent, ty.keyvar.name) s += "\t\t}\n" s += "\t} else {\n" s += "\t\t/* Is block... */\n" @@ -265,7 +265,7 @@ def c_val(ty, c, o, indent="", parent = None): s += "%s" % c_val(f.type, fexpr, "Field(%s, 0)" % o, indent=indent+"\t\t ") s += "break;\n" n += 1 - s += "\t\t default: failwith_xl(\"variant handling bug %s%s (block)\", lg); break;\n" % (parent, ty.keyvar.name) + s += "\t\t default: failwith_xl(\"variant handling bug %s%s (block)\"); break;\n" % (parent, ty.keyvar.name) s += "\t\t}\n" s += "\t}\n" s += "}" @@ -278,14 +278,14 @@ def c_val(ty, c, o, indent="", parent = None): s += "%s\n" % c_val(f.type, fexpr, "Field(%s, %d)" % (o,n), parent=nparent) n = n + 1 else: - s += "%s_val(gc, lg, %s, %s);" % (ty.rawname, ty.pass_arg(c, parent is None, passby=idl.PASS_BY_REFERENCE), o) + s += "%s_val(ctx, %s, %s);" % (ty.rawname, ty.pass_arg(c, parent is None, passby=idl.PASS_BY_REFERENCE), o) return s.replace("\n", "\n%s" % indent) def gen_c_val(ty, indent=""): s = "/* Convert caml value to %s */\n" % ty.rawname - s += "static int %s_val (caml_gc *gc, struct caml_logger *lg, %s, value v)\n" % (ty.rawname, ty.make_arg("c_val", passby=idl.PASS_BY_REFERENCE)) + s += "static int %s_val (libxl_ctx *ctx, %s, value v)\n" % (ty.rawname, ty.make_arg("c_val", passby=idl.PASS_BY_REFERENCE)) s += "{\n" s += "\tCAMLparam1(v);\n" s += "\n" @@ -334,7 +334,7 @@ def ocaml_Val(ty, o, c, indent="", parent = None): for e in ty.values: s += " case %s: %s = Int_val(%d); break;\n" % (e.name, o, n) n += 1 - s += " default: failwith_xl(\"cannot convert value from %s\", lg); break;\n" % ty.typename + s += " default: failwith_xl(\"cannot convert value from %s\"); break;\n" % ty.typename s += "}" elif isinstance(ty, idl.KeyedUnion): n = 0 @@ -363,7 +363,7 @@ def ocaml_Val(ty, o, c, indent="", parent = None): m += 1 #s += "\t %s = caml_alloc(%d,%d);\n" % (o,len(f.type.fields),n) s += "\t break;\n" - s += "\t default: failwith_xl(\"cannot convert value from %s\", lg); break;\n" % ty.typename + s += "\t default: failwith_xl(\"cannot convert value from %s\"); break;\n" % ty.typename s += "\t}" elif isinstance(ty,idl.Aggregate) and (parent is None or ty.rawname is None): s += "{\n" @@ -388,14 +388,14 @@ def ocaml_Val(ty, o, c, indent="", parent = None): n = n + 1 s += "}" else: - s += "%s = Val_%s(gc, lg, %s);" % (o, ty.rawname, ty.pass_arg(c, parent is None)) + s += "%s = Val_%s(%s);" % (o, ty.rawname, ty.pass_arg(c, parent is None)) return s.replace("\n", "\n%s" % indent).rstrip(indent) def gen_Val_ocaml(ty, indent=""): s = "/* Convert %s to a caml value */\n" % ty.rawname - s += "static value Val_%s (caml_gc *gc, struct caml_logger *lg, %s)\n" % (ty.rawname, ty.make_arg(ty.rawname+"_c")) + s += "static value Val_%s (%s)\n" % (ty.rawname, ty.make_arg(ty.rawname+"_c")) s += "{\n" s += "\tCAMLparam0();\n" s += "\tCAMLlocal1(%s_ocaml);\n" % ty.rawname diff --git a/tools/ocaml/libs/xl/xenlight.ml.in b/tools/ocaml/libs/xl/xenlight.ml.in index 3d663d8b23..dffba72d92 100644 --- a/tools/ocaml/libs/xl/xenlight.ml.in +++ b/tools/ocaml/libs/xl/xenlight.ml.in @@ -15,17 +15,16 @@ exception Error of string +type ctx type domid = int type devid = int (* @@LIBXL_TYPES@@ *) -type ctx - external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc" -external send_trigger : domid -> trigger -> int -> unit = "stub_xl_send_trigger" -external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq" -external send_debug_keys : domid -> string -> unit = "stub_xl_send_debug_keys" +external send_trigger : ctx -> domid -> trigger -> int -> unit = "stub_xl_send_trigger" +external send_sysrq : ctx -> domid -> char -> unit = "stub_xl_send_sysrq" +external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys" -let _ = Callback.register_exception "xl.error" (Error "register_callback") +let _ = Callback.register_exception "Xenlight.Error" (Error("")) diff --git a/tools/ocaml/libs/xl/xenlight.mli.in b/tools/ocaml/libs/xl/xenlight.mli.in index 96d859c8c0..e2686bb284 100644 --- a/tools/ocaml/libs/xl/xenlight.mli.in +++ b/tools/ocaml/libs/xl/xenlight.mli.in @@ -15,15 +15,14 @@ exception Error of string +type ctx type domid = int type devid = int (* @@LIBXL_TYPES@@ *) -type ctx - external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc" -external send_trigger : domid -> trigger -> int -> unit = "stub_xl_send_trigger" -external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq" -external send_debug_keys : domid -> string -> unit = "stub_xl_send_debug_keys" +external send_trigger : ctx -> domid -> trigger -> int -> unit = "stub_xl_send_trigger" +external send_sysrq : ctx -> domid -> char -> unit = "stub_xl_send_sysrq" +external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys" diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c index c26226f2e0..dd6c781124 100644 --- a/tools/ocaml/libs/xl/xenlight_stubs.c +++ b/tools/ocaml/libs/xl/xenlight_stubs.c @@ -35,47 +35,7 @@ #define Ctx_val(x)(*((libxl_ctx **) Data_custom_val(x))) #define CTX ((libxl_ctx *) Ctx_val(ctx)) -struct caml_logger { - struct xentoollog_logger logger; - int log_offset; - char log_buf[2048]; -}; - -typedef struct caml_gc { - int offset; - void *ptrs[64]; -} caml_gc; - -static void log_vmessage(struct xentoollog_logger *logger, xentoollog_level level, - int errnoval, const char *context, const char *format, va_list al) -{ - struct caml_logger *ologger = (struct caml_logger *) logger; - - ologger->log_offset += vsnprintf(ologger->log_buf + ologger->log_offset, - 2048 - ologger->log_offset, format, al); -} - -static void log_destroy(struct xentoollog_logger *logger) -{ -} - -#define INIT_STRUCT() libxl_ctx *ctx; struct caml_logger lg; struct caml_gc gc; gc.offset = 0; - -#define INIT_CTX() \ - lg.logger.vmessage = log_vmessage; \ - lg.logger.destroy = log_destroy; \ - lg.logger.progress = NULL; \ - caml_enter_blocking_section(); \ - ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (struct xentoollog_logger *) &lg); \ - if (ret != 0) \ - failwith_xl("cannot init context", &lg); - -#define FREE_CTX() \ - gc_free(&gc); \ - caml_leave_blocking_section(); \ - libxl_ctx_free(ctx) - -static char * dup_String_val(caml_gc *gc, value s) +static char * dup_String_val(value s) { int len; char *c; @@ -83,24 +43,16 @@ static char * dup_String_val(caml_gc *gc, value s) c = calloc(len + 1, sizeof(char)); if (!c) caml_raise_out_of_memory(); - gc->ptrs[gc->offset++] = c; memcpy(c, String_val(s), len); return c; } -static void gc_free(caml_gc *gc) +static void failwith_xl(char *fname) { - int i; - for (i = 0; i < gc->offset; i++) { - free(gc->ptrs[i]); - } -} - -static void failwith_xl(char *fname, struct caml_logger *lg) -{ - char *s; - s = (lg) ? lg->log_buf : fname; - caml_raise_with_string(*caml_named_value("xl.error"), s); + value *exc = caml_named_value("Xenlight.Error"); + if (!exc) + caml_invalid_argument("Exception Xenlight.Error not initialized, please link xl.cma"); + caml_raise_with_string(*exc, fname); } void ctx_finalize(value ctx) @@ -126,7 +78,7 @@ CAMLprim value stub_libxl_ctx_alloc(value logger) ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (xentoollog_logger *) Xtl_val(logger)); if (ret != 0) \ - failwith_xl("cannot init context", NULL); + failwith_xl("cannot init context"); handle = caml_alloc_custom(&libxl_ctx_custom_operations, sizeof(ctx), 0, 1); Ctx_val(handle) = ctx; @@ -134,16 +86,6 @@ CAMLprim value stub_libxl_ctx_alloc(value logger) CAMLreturn(handle); } -static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size) -{ - void *ptr; - ptr = calloc(nmemb, size); - if (!ptr) - caml_raise_out_of_memory(); - gc->ptrs[gc->offset++] = ptr; - return ptr; -} - static int list_len(value v) { int len = 0; @@ -154,9 +96,8 @@ static int list_len(value v) return len; } -static int libxl_key_value_list_val(caml_gc *gc, struct caml_logger *lg, - libxl_key_value_list *c_val, - value v) +static int libxl_key_value_list_val(libxl_key_value_list *c_val, + value v) { CAMLparam1(v); CAMLlocal1(elem); @@ -165,15 +106,15 @@ static int libxl_key_value_list_val(caml_gc *gc, struct caml_logger *lg, nr = list_len(v); - array = gc_calloc(gc, (nr + 1) * 2, sizeof(char *)); + array = calloc((nr + 1) * 2, sizeof(char *)); if (!array) caml_raise_out_of_memory(); for (i=0; v != Val_emptylist; i++, v = Field(v, 1) ) { elem = Field(v, 0); - array[i * 2] = dup_String_val(gc, Field(elem, 0)); - array[i * 2 + 1] = dup_String_val(gc, Field(elem, 1)); + array[i * 2] = dup_String_val(Field(elem, 0)); + array[i * 2 + 1] = dup_String_val(Field(elem, 1)); } *c_val = array; @@ -203,9 +144,7 @@ static value Val_key_value_list(libxl_key_value_list *c_val) CAMLreturn(list); } -static int libxl_string_list_val(caml_gc *gc, struct caml_logger *lg, - libxl_string_list *c_val, - value v) +static int libxl_string_list_val(libxl_string_list *c_val, value v) { CAMLparam1(v); int nr, i; @@ -213,12 +152,12 @@ static int libxl_string_list_val(caml_gc *gc, struct caml_logger *lg, nr = list_len(v); - array = gc_calloc(gc, (nr + 1), sizeof(char *)); + array = calloc(nr + 1, sizeof(char *)); if (!array) caml_raise_out_of_memory(); for (i=0; v != Val_emptylist; i++, v = Field(v, 1) ) - array[i] = dup_String_val(gc, Field(v, 0)); + array[i] = dup_String_val(Field(v, 0)); *c_val = array; CAMLreturn(0); @@ -269,7 +208,7 @@ static value Val_mac (libxl_mac *c_val) CAMLreturn(v); } -static int Mac_val(caml_gc *gc, struct caml_logger *lg, libxl_mac *c_val, value v) +static int Mac_val(libxl_mac *c_val, value v) { CAMLparam1(v); int i; @@ -300,10 +239,21 @@ static value Val_bitmap (libxl_bitmap *c_val) CAMLreturn(v); } -static int Bitmap_val(caml_gc *gc, struct caml_logger *lg, - libxl_bitmap *c_val, value v) +static int Bitmap_val(libxl_ctx *ctx, libxl_bitmap *c_val, value v) { - abort(); /* XXX */ + CAMLparam1(v); + int i, len = Wosize_val(v); + + c_val->size = 0; + if (len > 0 && libxl_bitmap_alloc(ctx, c_val, len)) + failwith_xl("cannot allocate bitmap"); + for (i=0; i