[PATCH 1/2] tools/ocaml: Fix crash in Xenctrl.domain_getinfo{,list} on ARM

The Store_field(result, 16, arch_config) sits inside an ifdef x86, meaning
that on other archtiectures the pointer is not filled in.  The Ocaml runtime
then falls over a NULL pointer (really the Val_unit used to initialise
'result') when the layout in the heap doesn't match the type system.

Rearrange alloc_domaininfo() to avoid this.  Similarly to
physinfo_arch_caps(), raise an exception if the architecture code hasn't
filled in an appropriate tag.  Move the setup of arch_domainconfig to be
common logic.

In order to simplify the addition of other architectures, remove the
arch_config variable (resuing tmp as it's touched exactly once), and rename
x86_arch_config to be arch_config so each architecture can fill in a suitable
one without needing more local variables.

Reported-by: Julian Vetter <[email protected]>
Signed-off-by: Andrew Cooper <[email protected]>
---
CC: Andrew Cooper <[email protected]>
CC: Andrii Sultanov <[email protected]>
CC: Guillaume Thouvenin <[email protected]>
CC: Julian Vetter <[email protected]>
CC: Oleksii Kurochko <[email protected]>
---
 tools/ocaml/libs/xc/xenctrl_stubs.c | 23 ++++++++++++++---------
 1 file changed, 14 insertions(+), 9 deletions(-)

diff --git a/tools/ocaml/libs/xc/xenctrl_stubs.c b/tools/ocaml/libs/xc/xenctrl_stubs.c
index 7f6381cdd2fe..441e1d83cfec 100644
--- a/tools/ocaml/libs/xc/xenctrl_stubs.c
+++ b/tools/ocaml/libs/xc/xenctrl_stubs.c
@@ -414,7 +414,8 @@ CAMLprim value stub_xc_domain_shutdown(value xch_val, value domid, value reason)
 static value alloc_domaininfo(xc_domaininfo_t * info)
 {
 	CAMLparam0();
-	CAMLlocal5(result, tmp, arch_config, x86_arch_config, emul_list);
+	CAMLlocal4(result, tmp, arch_config, emul_list);
+	int tag = -1;
 	int i;
 
 	result = caml_alloc_tuple(17);
@@ -444,6 +445,9 @@ static value alloc_domaininfo(xc_domaininfo_t * info)
 	Store_field(result, 15, tmp);
 
 #if defined(__i386__) || defined(__x86_64__)
+
+	tag = 1; /* tag x86 */
+
 	/*
 	 * emulation_flags: x86_arch_emulation_flags list;
 	 */
@@ -452,16 +456,17 @@ static value alloc_domaininfo(xc_domaininfo_t * info)
 		(info->arch_config.emulation_flags);
 
 	/* xen_x86_arch_domainconfig */
-	x86_arch_config = caml_alloc_tuple(1);
-	Store_field(x86_arch_config, 0, emul_list);
+	arch_config = caml_alloc_tuple(1);
+	Field(arch_config, 0) = emul_list;
 
-	/* arch_config: arch_domainconfig */
-	arch_config = caml_alloc_small(1, 1);
-
-	Store_field(arch_config, 0, x86_arch_config);
-
-	Store_field(result, 16, arch_config);
 #endif
+	if (tag < 0)
+		caml_failwith("Unimplemented architecutre in alloc_domaininfo()");
+
+	/* arch_config: arch_domainconfig */
+	tmp = caml_alloc_small(1, tag);
+	Field(tmp, 0) = arch_config;
+	Field(result, 16) = tmp;
 
 	CAMLreturn(result);
 }
-- 
2.39.5