[PATCH v2] tools/ocaml/xc: Fix xc_physinfo() bindings

[PATCH v2] tools/ocaml/xc: Fix xc_physinfo() bindings

[Andrew Cooper]

The original change doesn't compile on ARM:

  xenctrl_stubs.c: In function 'stub_xc_physinfo':
  xenctrl_stubs.c:821:16: error: unused variable 'arch_cap_flags_tag' [-Werror=unused-variable]
    821 |         int r, arch_cap_flags_tag;
        |                ^~~~~~~~~~~~~~~~~~
  cc1: all warnings being treated as errors

but it was buggy too.

First, it tried storing an int in a pointer slot, causing heap corruption.

Next, it is not legitimate to exclude arm32 in the toolstack as it explicitly
can operate an arm64 toolstack and build arm64 domains.  That in turn means
that you can't stash a C uint32_t in an OCaml int.

Rewrite the arch_capabilities handling from scratch.  Break it out into a
separate function, and make the construction of arch_physinfo_cap_flags common
to prevent other indirection bugs.

Reintroduce arm_physinfo_caps with the fields broken out.

Fixes: 56a7aaa16bfe ("tools: add physinfo arch_capabilities handling for Arm")
Signed-off-by: Andrew Cooper <andrew.cooper3@citrix.com>
Acked-by: Christian Lindig <christian.lindig@cloud.com>
---
CC: Christian Lindig <christian.lindig@citrix.com>
CC: Edwin Török <edwin.torok@cloud.com>
CC: Rob Hoes <Rob.Hoes@citrix.com>
CC: Luca Fancellu <luca.fancellu@arm.com>

v2:
 * CAMLreturn().

Tested on x86 locally.  Tested on arm64 with:
  https://gitlab.com/xen-project/people/andyhhp/xen/-/jobs/4447272476

and a tweaked form of my local ocaml smoke test for these kinds of things:

  # osmoke
  Xen version: 4.18-unstable
  Physinfo:
    threads_per_core 1
    SVE len: 0
  Starting GC.compact()
  Done

I didn't get this working for arm32, because that's all Yocto, but the arm64
test is good enough IMO.
---
 tools/ocaml/libs/xc/xenctrl.ml      |  7 +++-
 tools/ocaml/libs/xc/xenctrl.mli     |  7 +++-
 tools/ocaml/libs/xc/xenctrl_stubs.c | 52 ++++++++++++++++++++---------
 3 files changed, 48 insertions(+), 18 deletions(-)

diff --git a/tools/ocaml/libs/xc/xenctrl.ml b/tools/ocaml/libs/xc/xenctrl.ml
index bf23ca50bb15..d6c6eb73db44 100644
--- a/tools/ocaml/libs/xc/xenctrl.ml
+++ b/tools/ocaml/libs/xc/xenctrl.ml
@@ -128,10 +128,15 @@ type physinfo_cap_flag =
   | CAP_Gnttab_v1
   | CAP_Gnttab_v2
 
+type arm_physinfo_caps =
+  {
+    sve_vl: int;
+  }
+
 type x86_physinfo_cap_flag
 
 type arch_physinfo_cap_flags =
-  | ARM of int
+  | ARM of arm_physinfo_caps
   | X86 of x86_physinfo_cap_flag list
 
 type physinfo =
diff --git a/tools/ocaml/libs/xc/xenctrl.mli b/tools/ocaml/libs/xc/xenctrl.mli
index ed1e28ea30a0..3bfc16edba96 100644
--- a/tools/ocaml/libs/xc/xenctrl.mli
+++ b/tools/ocaml/libs/xc/xenctrl.mli
@@ -113,10 +113,15 @@ type physinfo_cap_flag =
   | CAP_Gnttab_v1
   | CAP_Gnttab_v2
 
+type arm_physinfo_caps =
+  {
+    sve_vl: int;
+  }
+
 type x86_physinfo_cap_flag
 
 type arch_physinfo_cap_flags =
-  | ARM of int
+  | ARM of arm_physinfo_caps
   | X86 of x86_physinfo_cap_flag list
 
 type physinfo = {
diff --git a/tools/ocaml/libs/xc/xenctrl_stubs.c b/tools/ocaml/libs/xc/xenctrl_stubs.c
index a03da31f6f2c..e4d9070f2d00 100644
--- a/tools/ocaml/libs/xc/xenctrl_stubs.c
+++ b/tools/ocaml/libs/xc/xenctrl_stubs.c
@@ -812,13 +812,46 @@ CAMLprim value stub_xc_send_debug_keys(value xch_val, value keys)
 	CAMLreturn(Val_unit);
 }
 
+CAMLprim value physinfo_arch_caps(const xc_physinfo_t *info)
+{
+	CAMLparam0();
+	CAMLlocal2(arch_cap_flags, arch_obj);
+	int tag = -1;
+
+#if defined(__arm__) || defined(__aarch64__)
+
+	tag = 0; /* tag ARM */
+
+	arch_obj = caml_alloc_tuple(1);
+
+	Store_field(arch_obj, 0,
+		    Val_int(MASK_EXTR(info->arch_capabilities,
+				      XEN_SYSCTL_PHYSCAP_ARM_SVE_MASK) * 128));
+
+#elif defined(__i386__) || defined(__x86_64__)
+
+	tag = 1; /* tag x86 */
+
+	arch_obj = Tag_cons;
+
+#endif
+
+	if ( tag < 0 )
+		caml_failwith("Unhandled architecture");
+
+	arch_cap_flags = caml_alloc_small(1, tag);
+	Store_field(arch_cap_flags, 0, arch_obj);
+
+	CAMLreturn(arch_cap_flags);
+}
+
 CAMLprim value stub_xc_physinfo(value xch_val)
 {
 	CAMLparam1(xch_val);
-	CAMLlocal4(physinfo, cap_list, arch_cap_flags, arch_cap_list);
+	CAMLlocal2(physinfo, cap_list);
 	xc_interface *xch = xch_of_val(xch_val);
 	xc_physinfo_t c_physinfo;
-	int r, arch_cap_flags_tag;
+	int r;
 
 	caml_enter_blocking_section();
 	r = xc_physinfo(xch, &c_physinfo);
@@ -846,20 +879,7 @@ CAMLprim value stub_xc_physinfo(value xch_val)
 	Store_field(physinfo, 7, caml_copy_nativeint(c_physinfo.scrub_pages));
 	Store_field(physinfo, 8, cap_list);
 	Store_field(physinfo, 9, Val_int(c_physinfo.max_cpu_id + 1));
-
-#if defined(__i386__) || defined(__x86_64__)
-	arch_cap_list = Tag_cons;
-
-	arch_cap_flags_tag = 1; /* tag x86 */
-
-	arch_cap_flags = caml_alloc_small(1, arch_cap_flags_tag);
-	Store_field(arch_cap_flags, 0, arch_cap_list);
-	Store_field(physinfo, 10, arch_cap_flags);
-#elif defined(__aarch64__)
-	Store_field(physinfo, 10, Val_int(c_physinfo.arch_capabilities));
-#else
-	caml_failwith("Unhandled architecture");
-#endif
+	Store_field(physinfo, 10, physinfo_arch_caps(&c_physinfo));
 
 	CAMLreturn(physinfo);
 }
-- 
2.30.2