tools: ocaml: Add an ocaml binding for libxl_get_topologyinfo

Add an ocaml binding for libxl_get_topologyinfo in the style of
libxl_get_physinfo.

The function returns an array of optional records, one per possible pCPU.

Signed-off-by: David Scott <dave.scott@eu.citrix.com>
Committed-by: Ian Jackson <ian.jackson@eu.citrix.com>

3 files changed, 63 insertions, 0 deletions

diff --git a/tools/ocaml/libs/xl/xl.ml b/tools/ocaml/libs/xl/xl.ml
index c856eef88b..11a04bca13 100644
--- a/tools/ocaml/libs/xl/xl.ml
+++ b/tools/ocaml/libs/xl/xl.ml
@@ -169,6 +169,15 @@ type physinfo =
 	physcap: int32;
 }
 
+type topology = 
+{
+	core: int;
+	socket: int;
+	node: int;
+}
+
+type topologyinfo = topology option array
+
 type sched_credit =
 {
 	weight: int;
@@ -205,6 +214,8 @@ type button =
 external button_press : domid -> button -> unit = "stub_xl_button_press"
 external physinfo : unit -> physinfo = "stub_xl_physinfo"
 
+external topologyinfo: unit -> topologyinfo = "stub_xl_topologyinfo"
+
 external domain_sched_credit_get : domid -> sched_credit = "stub_xl_sched_credit_domain_get"
 external domain_sched_credit_set : domid -> sched_credit -> unit = "stub_xl_sched_credit_domain_set"
 
diff --git a/tools/ocaml/libs/xl/xl.mli b/tools/ocaml/libs/xl/xl.mli
index fcf4b2e0a9..b1d3f43d62 100644
--- a/tools/ocaml/libs/xl/xl.mli
+++ b/tools/ocaml/libs/xl/xl.mli
@@ -169,6 +169,15 @@ type physinfo =
 	physcap: int32;
 }
 
+type topology = 
+{
+	core: int;
+	socket: int;
+	node: int;
+}
+
+type topologyinfo = topology option array
+
 type sched_credit =
 {
 	weight: int;
@@ -205,6 +214,8 @@ type button =
 external button_press : domid -> button -> unit = "stub_xl_button_press"
 external physinfo : unit -> physinfo = "stub_xl_physinfo"
 
+external topologyinfo: unit -> topologyinfo = "stub_xl_topologyinfo"
+
 external domain_sched_credit_get : domid -> sched_credit = "stub_xl_sched_credit_domain_get"
 external domain_sched_credit_set : domid -> sched_credit -> unit = "stub_xl_sched_credit_domain_set"
 
diff --git a/tools/ocaml/libs/xl/xl_stubs.c b/tools/ocaml/libs/xl/xl_stubs.c
index ab08962bf2..33aba54ab0 100644
--- a/tools/ocaml/libs/xl/xl_stubs.c
+++ b/tools/ocaml/libs/xl/xl_stubs.c
@@ -345,6 +345,29 @@ static value Val_physinfo(libxl_physinfo *c_val)
 	CAMLreturn(v);
 }
 
+static value Val_topologyinfo(libxl_topologyinfo *c_val)
+{
+	CAMLparam0();
+	CAMLlocal3(v, topology, topologyinfo);
+	int i;
+
+	topologyinfo = caml_alloc_tuple(c_val->coremap.entries);
+	for (i = 0; i < c_val->coremap.entries; i++) {	
+		v = Val_int(0); /* None */
+		if (c_val->coremap.array[i] != LIBXL_CPUARRAY_INVALID_ENTRY) {
+			topology = caml_alloc_tuple(3);
+			Store_field(topology, 0, Val_int(c_val->coremap.array[i]));
+			Store_field(topology, 1, Val_int(c_val->socketmap.array[i]));
+			Store_field(topology, 2, Val_int(c_val->nodemap.array[i]));
+			v = caml_alloc(1, 0); /* Some */
+			Store_field(v, 0, topology);
+		}
+		Store_field(topologyinfo, i, v);
+	}
+
+	CAMLreturn(topologyinfo);
+}
+
 value stub_xl_disk_add(value info, value domid)
 {
 	CAMLparam2(info, domid);
@@ -620,6 +643,24 @@ value stub_xl_physinfo(value unit)
 	CAMLreturn(physinfo);
 }
 
+value stub_xl_topologyinfo(value unit)
+{
+	CAMLparam1(unit);
+	CAMLlocal1(topologyinfo);
+	libxl_topologyinfo c_topologyinfo;
+	int ret;
+	INIT_STRUCT();
+
+	INIT_CTX();
+	ret = libxl_get_topologyinfo(&ctx, &c_topologyinfo);
+	if (ret != 0)
+		failwith_xl("topologyinfo", &lg);
+	FREE_CTX();
+	
+	topologyinfo = Val_topologyinfo(&c_topologyinfo);
+	CAMLreturn(topologyinfo);
+}
+
 value stub_xl_sched_credit_domain_get(value domid)
 {
 	CAMLparam1(domid);