Add a test for ocaml#11031

testsuite/tests/frame-pointers/exception_handler.ml

@@ -0,0 +1,66 @@
+(* TEST
+ modules = "fp_backtrace.c"
+ * frame_pointers
+ ** arch_amd64
+ *** native
+*)
+
+(* https://github.com/ocaml/ocaml/pull/11031 *)
+external fp_backtrace : unit -> unit = "fp_backtrace" [@@noalloc]
+
+exception Exn1
+exception Exn2
+
+(* We want to be sure to use some stack space so that rbp is shifted,
+* preventing inlining seems enough *)
+let[@inline never] raiser i =
+  match i with
+  | 1 -> raise Exn1
+  | 2 -> raise Exn2
+  | _ -> 42 (* shouldn't happen *)
+
+let[@inline never][@local never] f x = x
+
+(* This give us a chance to overwrite the memory address pointed by rbp if it
+* is still within 'raiser' stack frame.
+* Technically we don't need to overwrite it but by doing so we avoid some
+* infinite loop while walking the stack. *)
+let[@inline never] handler () =
+  (* Force spilling of x0, x1, x2 *)
+  let x0 = Sys.opaque_identity 0x6f56df77 (* 0xdeadbeef *) in
+  let x1 = Sys.opaque_identity 0x6f56df77 (* 0xdeadbeef *) in
+  let x2 = Sys.opaque_identity 0x6f56df77 (* 0xdeadbeef *) in
+  let _ = f x0 in
+  let _ = f x1 in
+  let _ = f x2 in
+  let _ = Sys.opaque_identity x0 in
+  let _ = Sys.opaque_identity x1 in
+  let _ = Sys.opaque_identity x2 in
+  fp_backtrace ()
+
+let[@inline never] nested i =
+  begin
+    try
+      try ignore (raiser i) with Exn1 -> handler ()
+    with
+    | Exn2 -> handler ()
+  end;
+  i
+
+(* Check that we haven't broken anything by raising directly from this
+* function, it doesn't require rbp to be adjusted *)
+let[@inline never] bare i =
+  begin
+    try
+      try (if i == 1 then raise Exn1 else raise Exn2) with
+      | Exn1 -> handler ()
+    with
+    | Exn2 -> handler ()
+  end;
+  i
+
+let () =
+  ignore (bare 1);
+  ignore (bare 2);
+  ignore (nested 1);
+  ignore (nested 2)

testsuite/tests/frame-pointers/exception_handler.reference

@@ -0,0 +1,32 @@
+fp_backtrace
+camlException_handler__handler
+camlException_handler__bare
+camlException_handler__entry
+caml_program
+caml_start_program
+caml_main
+main
+fp_backtrace
+camlException_handler__handler
+camlException_handler__bare
+camlException_handler__entry
+caml_program
+caml_start_program
+caml_main
+main
+fp_backtrace
+camlException_handler__handler
+camlException_handler__nested
+camlException_handler__entry
+caml_program
+caml_start_program
+caml_main
+main
+fp_backtrace
+camlException_handler__handler
+camlException_handler__nested
+camlException_handler__entry
+caml_program
+caml_start_program
+caml_main
+main

testsuite/tests/frame-pointers/exception_handler.run

@@ -0,0 +1,3 @@
+#!/bin/sh
+(${program} 2>&1 || true) | \
+  ${test_source_directory}/filter-locations.sh > ${output}

testsuite/tests/frame-pointers/filter-locations.sh

@@ -0,0 +1,10 @@
+#!/bin/sh
+
+set -eu
+
+# https://stackoverflow.com/questions/29613304/is-it-possible-to-escape-regex-metacharacters-reliably-with-sed/29626460#29626460
+program_escaped=$(sed 's/[^^\\]/[&]/g; s/\^/\\^/g; s/\\/\\\\/g' <<<"${program}")
+sed_regex1="s/${program_escaped}(\(.*\)+0x[[:xdigit:]]*)[0x[[:xdigit:]]*]/\1/p"
+sed_regex2='s/^\(.*\)_[[:digit:]]*$/\1/'
+
+sed -n -e "${sed_regex1}" | sed -e "${sed_regex2}"

testsuite/tests/frame-pointers/fp_backtrace.c

@@ -0,0 +1,117 @@
+#include <execinfo.h>
+#include <unistd.h>
+#include <setjmp.h>
+#include <signal.h>
+#include <stdio.h>
+
+#define ARRSIZE(a)  (sizeof(a) / sizeof(*(a)))
+
+typedef struct frame_info
+{
+  struct frame_info*  prev;     /* rbp */
+  void*               retaddr;  /* rip */
+} frame_info;
+
+jmp_buf resume_buf;
+
+
+static void signal_handler(int /* signum */)
+{
+  /* Should be safe to be called from a signal handler.
+   * See 21.2.1 "Performing a nonlocal goto from a signal hanlder" from
+   * The Linux Programming Interface, Michael Kerrisk */
+  siglongjmp(resume_buf, 1);
+}
+
+static int install_signal_handlers(const int signals[], struct sigaction
+    handlers[], int count)
+{
+  for (int i = 0; i < count; i++) {
+    struct sigaction action = { 0 };
+    action.sa_handler = signal_handler;
+    sigemptyset(&action.sa_mask);
+    action.sa_flags = 0;
+
+    if (sigaction(signals[i], &action, &handlers[i]) != 0) {
+      perror("sigaction");
+      return -1;
+    }
+  }
+  return 0;
+}
+
+static int restore_signal_handlers(const int signals[], struct sigaction
+    handlers[], int count)
+{
+  for (int i = 0; i < count; i++) {
+    if (sigaction(signals[i], &handlers[i], NULL) != 0) {
+      perror("sigaction");
+      return -1;
+    }
+  }
+  return 0;
+}
+
+static int safe_read(const struct frame_info* fi, struct frame_info** prev,
+    void** retaddr)
+{
+  /* Signals to ignore while attempting to read frame_info members */
+  const int signals[] = { SIGSEGV, SIGBUS };
+  /* Store original signal handers */
+  struct sigaction handlers[ARRSIZE(signals)] = { 0 };
+  int ret = 0;
+
+  if (install_signal_handlers(signals, handlers, ARRSIZE(signals)) != 0)
+    return -1;
+
+  if (!sigsetjmp(resume_buf, 1)) {
+    *prev = fi->prev;
+    *retaddr = fi->retaddr;
+  } else {
+    ret = -1;
+  }
+
+  if (restore_signal_handlers(signals, handlers, ARRSIZE(signals)) != 0)
+    return -1;
+
+  return ret;
+}
+
+static void print_location(void* rip)
+{
+  if (!rip)
+    return;
+
+  /* This requires the binary to be linked with '-rdynamic' */
+  backtrace_symbols_fd(&rip, 1, STDOUT_FILENO);
+}
+
+void fp_backtrace(void)
+{
+  struct frame_info *fi;
+  struct frame_info* prev;
+  void* retaddr;
+  void* rip;
+
+  /* Print our current function by loading rip */
+  asm ("leaq 0(%%rip), %%rax\n"
+      "movq %%rax, %[rip]\n"
+      : [rip] "=rm" (rip) : /* no input */ : "rax");
+  print_location(rip);
+
+  /* Initialize [fi] from rbp register */
+  asm ("movq %%rbp, %[fi]\n" : [fi] "=rm" (fi));
+
+  for (; fi; fi = prev) {
+    if (safe_read(fi, &prev, &retaddr) != 0)
+      return;
+
+    print_location(retaddr);
+
+    /* Detect the simplest kind of infinite loop */
+    if (fi == prev) {
+      printf("fp_backtrace: loop detected\n");
+      return;
+    }
+  }
+}