Display Windows NTSTATUS exit codes in hex

On Windows, "negative" exit codes are probably NTSTATUS values. For
example, if a program accesses an invalid memory location, Unix sends
a SIGSEGV signal which, if unhandled, will terminate the
process (setting some kind of non-zero exit code - for example, Linux
sets the exit code to 128 + signal number to give a fairly memorable
139). In the equivalent scenario, Windows throws an
EXCEPTION_ACCESS_VIOLATION which, if handled by the default exception
handler, will terminate the process with exit code
STATUS_ACCESS_VIOLATION. These codes are large negative numbers, which
are not terribly memorable in decimal, so for negative exit codes we
instead display them in hexadecimal as 0xc0000005 is slightly more
memorable than -1073741819.

Author: MisterDA

bin/admin.ml

@@ -64,7 +64,7 @@ let show () cap_path terse pool worker =
 
 let check_exit_status = function
   | Unix.WEXITED 0 -> ()
-  | Unix.WEXITED x -> Fmt.failwith "Sub-process failed with exit code %d" x
+  | Unix.WEXITED x -> Fmt.failwith "Sub-process failed with exit code %a" Logging.pp_exit_status x
   | Unix.WSIGNALED x -> Fmt.failwith "Sub-process failed with signal %a" Fmt.Dump.signal x
   | Unix.WSTOPPED x -> Fmt.failwith "Sub-process stopped with signal %a" Fmt.Dump.signal x
 

bin/logging.ml

@@ -1,3 +1,9 @@
+let pp_exit_status f n =
+  if Sys.win32 && n < 0 then
+    Fmt.pf f "0x%08lx" (Int32.of_int n)
+  else
+    Fmt.int f n
+
 let pp_timestamp f x =
   let open Unix in
   let tm = localtime x in

bin/worker.ml

@@ -14,7 +14,7 @@ let or_die = function
 
 let check_exit_status = function
   | Unix.WEXITED 0 -> ()
-  | Unix.WEXITED x -> Fmt.failwith "Sub-process failed with exit code %d" x
+  | Unix.WEXITED x -> Fmt.failwith "Sub-process failed with exit code %a" Logging.pp_exit_status x
   | Unix.WSIGNALED x -> Fmt.failwith "Sub-process failed with signal %a" Fmt.Dump.signal x
   | Unix.WSTOPPED x -> Fmt.failwith "Sub-process stopped with signal %a" Fmt.Dump.signal x
 

worker/process.ml

@@ -41,9 +41,15 @@ let exec ~label ~log ~switch ?env ?(stdin="") ?(stderr=`FD_copy Unix.stdout) ?(i
   | Unix.WSIGNALED x -> Fmt.error_msg "%s failed with signal %a" label Fmt.Dump.signal x
   | Unix.WSTOPPED x -> Fmt.error_msg "%s stopped with signal %a" label Fmt.Dump.signal x
 
+let pp_exit_status f n =
+  if Sys.win32 && n < 0 then
+    Fmt.pf f "0x%08lx" (Int32.of_int n)
+  else
+    Fmt.int f n
+
 let check_call ~label ~log ~switch ?env ?stdin ?stderr ?is_success cmd =
   exec ~label ~log ~switch ?env ?stdin ?stderr ?is_success cmd >|= function
   | Ok () -> Ok ()
   | Error `Cancelled -> Error `Cancelled
-  | Error (`Exit_code n) -> Fmt.error_msg "%s failed with exit-code %d" label n
+  | Error (`Exit_code n) -> Fmt.error_msg "%s failed with exit-code %a" label pp_exit_status n
   | Error (`Msg _) as e -> e