Rework the backtrace handling

Try and improve the print-backtrace-and-exception/knots output, be
selective about the stack frames which are shown to try and produce
some useful output which reflects user code and hide the
&knots-exceptions.

This commit also introduces a bunch of tests scripts that produce
output from print-backtrace-and-exception/knots, to help test this
code in different situations.

tests/backtraces/call-with-cached-connection.scm

@@ -0,0 +1,18 @@
+(use-modules (knots) (fibers) (knots resource-pool) (knots web))
+
+(run-fibers
+ (lambda ()
+   (let ((cache (make-fixed-size-resource-pool
+                 (list (open-input-string "fake")))))
+     ;; FIRST BACKTRACE ENTRY: 1762:12    (with-exception-handler
+     (with-exception-handler
+         (lambda (e)
+           (print-backtrace-and-exception/knots e)
+           (primitive-exit 1))
+       (lambda ()
+         (call-with-cached-connection cache
+                                      (lambda (port)
+                                        (error "error from call-with-cached-connection"))  ; LAST BACKTRACE ENTRY HERE
+                                      #:close-connection-on-exception? #f)))))
+ #:hz 0 #:parallelism 1)
+

tests/backtraces/call-with-resource-from-pool.scm

@@ -0,0 +1,16 @@
+(use-modules (knots) (fibers) (knots resource-pool))
+
+(run-fibers
+ (lambda ()
+   (let ((pool (make-resource-pool (const 'resource) 1)))
+     ;; FIRST BACKTRACE ENTRY: 1762:12    (with-exception-handler
+     (with-exception-handler
+         (lambda (e)
+           (print-backtrace-and-exception/knots e)
+           (primitive-exit 1))
+       (lambda ()
+         (call-with-resource-from-pool pool
+                                       (lambda (resource)
+                                         (error "error from call-with-resource-from-pool")))))))  ; LAST BACKTRACE ENTRY HERE
+ #:hz 0 #:parallelism 1)
+

tests/backtraces/call-with-thread.scm

@@ -0,0 +1,14 @@
+(use-modules (knots) (knots thread-pool))
+
+(define thread-pool (make-fixed-size-thread-pool 1))
+
+;; FIRST BACKTRACE ENTRY: 1762:12    (with-exception-handler
+(with-exception-handler
+    (lambda (exn)
+      (print-backtrace-and-exception/knots exn)
+      (primitive-exit 1))
+  (lambda ()
+    (call-with-thread
+     thread-pool
+     (lambda ()
+       (error "error from call-with-thread")))))  ; LAST BACKTRACE ENTRY HERE

tests/backtraces/fibers-force.scm

@@ -0,0 +1,15 @@
+(use-modules (knots) (fibers) (knots promise))
+
+(run-fibers
+ (lambda ()
+   ;; FIRST BACKTRACE ENTRY: 1762:12    (with-exception-handler
+   (with-exception-handler
+       (lambda (e)
+         (print-backtrace-and-exception/knots e)
+         (primitive-exit 1))
+     (lambda ()
+       (fibers-force
+        (fibers-delay
+         (lambda ()
+           (error "error from fibers-force"))))))) ; LAST BACKTRACE ENTRY HERE
+ #:hz 0 #:parallelism 1)

tests/backtraces/fibers-map.scm

@@ -0,0 +1,20 @@
+(use-modules (knots) (fibers) (knots parallelism))
+
+(run-fibers
+ (lambda ()
+   (with-exception-handler
+       (lambda _
+         ;; To avoid the test hanging if there's an exception
+         (primitive-exit 1))
+     (lambda ()
+       ;; FIRST BACKTRACE ENTRY: 1762:12    (with-exception-handler
+       (with-exception-handler
+           (lambda (e)
+             (print-backtrace-and-exception/knots e)
+             (primitive-exit 1))
+         (lambda ()
+           (fibers-map
+            (lambda (x)
+              (error "error from fibers-map"))  ; LAST BACKTRACE ENTRY HERE
+            '(1)))))))
+ #:hz 0 #:parallelism 1)

tests/backtraces/guile-error-deep-in-thread.scm

@@ -0,0 +1,19 @@
+(use-modules (knots))
+
+(define (do-sort)
+  (begin
+    (sort '(1 2 3)
+          (lambda _
+            (+ 1 'a)))         ; LAST BACKTRACE ENTRY HERE
+    'unreachable))
+
+;; FIRST BACKTRACE ENTRY: 1762:12    (with-exception-handler
+(with-exception-handler
+    (lambda (exn)
+      (print-backtrace-and-exception/knots exn)
+      (primitive-exit 1))
+  (lambda ()
+    (call-with-temporary-thread
+     (lambda ()
+       (do-sort)
+       'done))))

tests/backtraces/guile-error-in-thread.scm

@@ -0,0 +1,11 @@
+(use-modules (knots))
+
+;; FIRST BACKTRACE ENTRY: 1762:12    (with-exception-handler
+(with-exception-handler
+    (lambda (exn)
+      (print-backtrace-and-exception/knots exn)
+      (primitive-exit 1))
+  (lambda ()
+    (call-with-temporary-thread
+     (lambda ()
+       (+ 1 'a)))))           ; LAST BACKTRACE ENTRY HERE

tests/backtraces/nested-parallelism.scm

@@ -0,0 +1,40 @@
+(use-modules (knots) (fibers) (knots parallelism))
+
+;; Deep call chain within the innermost fiber.  Each function calls the next
+;; via `begin', placing the call in non-tail position so Guile's TCO does not
+;; collapse the frames; all four frames survive and appear in the backtrace.
+(define (deeply-nested x)
+  (error "deeply nested error" x))  ; LAST BACKTRACE ENTRY HERE
+
+(define (three-deep x)
+  (fibers-map deeply-nested (list x)))
+
+(define (two-deep x)
+  (fibers-map three-deep (list x)))
+
+(define (one-deep x)
+  (fibers-map two-deep (list x)))
+
+;; process-batch runs inside one fiber and dispatches the deep call chain into
+;; a nested fiber via a second fibers-map, creating two fiber boundaries.
+(define (process-batch items)
+  (begin
+    (fibers-map one-deep (list items))
+    'unreachable))
+
+(define (run-work)
+  (begin
+    (fibers-map process-batch '(1))
+    'unreachable))
+
+(define result
+  (run-fibers
+   (lambda ()
+     ;; FIRST BACKTRACE ENTRY: 1762:12    (with-exception-handler
+     (with-exception-handler
+         (lambda (e)
+           (print-backtrace-and-exception/knots e)
+           (primitive-exit 1))
+       run-work))
+   #:hz 0 #:parallelism 1))
+

tests/backtraces/plain-exception.scm

@@ -0,0 +1,10 @@
+(use-modules (knots))
+
+;; FIRST BACKTRACE ENTRY: 1762:12    (with-exception-handler
+
+(with-exception-handler
+    (lambda (exn)
+      (print-backtrace-and-exception/knots exn)
+      (primitive-exit 1))
+  (lambda ()
+    (error "plain error message")))     ; LAST BACKTRACE ENTRY HERE

tests/backtraces/stack-situation-fibers.scm

@@ -0,0 +1,19 @@
+(use-modules (knots)
+             (knots backtraces)
+             (fibers)
+             (system repl debug))
+
+(run-fibers
+ (lambda ()
+   (with-exception-handler
+       (lambda (exn)
+         (let ((stack (make-stack #t)))
+           (print-backtrace-and-exception/knots exn)
+           (simple-format/knots #t
+                                "situation: ~A\n"
+                                (classify-stack-situation
+                                 (stack->vector stack))))
+         (primitive-exit 0))
+     (lambda ()
+       (error "test"))))
+ #:hz 0 #:parallelism 1)

tests/backtraces/stack-situation-script.scm

@@ -0,0 +1,15 @@
+(use-modules (knots)
+             (knots backtraces)
+             (system repl debug))
+
+(with-exception-handler
+    (lambda (exn)
+      (let ((stack (make-stack #t)))
+        (print-backtrace-and-exception/knots exn)
+        (simple-format/knots #t
+                             "situation: ~A\n"
+                             (classify-stack-situation
+                              (stack->vector stack))))
+      (primitive-exit 0))
+  (lambda ()
+    (error "test")))

tests/backtraces/stack-situation-unknown.scm

@@ -0,0 +1,17 @@
+(use-modules (knots)
+             (knots backtraces)
+             (fibers)
+             (system repl debug))
+
+(start-stack
+ #t
+ (with-exception-handler
+     (lambda (exn)
+       (let* ((stack (make-stack #t))
+              (stack-classification
+               (classify-stack-situation (stack->vector stack))))
+         (print-backtrace-and-exception/knots exn)
+         (simple-format/knots #t "situation: ~A\n" stack-classification)
+         (primitive-exit 0)))
+   (lambda ()
+     (error "test"))))

tests/backtraces/temporary-thread.scm

@@ -0,0 +1,11 @@
+(use-modules (knots))
+
+;; FIRST BACKTRACE ENTRY: 1762:12    (with-exception-handler
+(with-exception-handler
+    (lambda (exn)
+      (print-backtrace-and-exception/knots exn)
+      (primitive-exit 1))
+  (lambda ()
+    (call-with-temporary-thread
+     (lambda ()
+       (error "error from temporary thread")))))  ; LAST BACKTRACE ENTRY HERE

tests/backtraces/triple-with-exception-handler.scm

@@ -0,0 +1,16 @@
+(use-modules (knots))
+
+;; FIRST BACKTRACE ENTRY: 1762:12    (with-exception-handler
+
+(with-exception-handler
+    (lambda _ #f)
+  (lambda ()
+    (with-exception-handler
+        (lambda _ #f)
+      (lambda ()
+        (with-exception-handler
+            (lambda (exn)
+              (print-backtrace-and-exception/knots exn)
+              (primitive-exit 1))
+          (lambda ()
+            (error "plain error message"))))))) ; LAST BACKTRACE ENTRY HERE

tests/backtraces/vhash-fold-in-thread.scm

@@ -0,0 +1,26 @@
+(use-modules (knots) (ice-9 vlist))
+
+;; LAST BACKTRACE ENTRY: 257:2
+
+(define (do-fold)
+  (begin
+    (vhash-fold
+     (lambda (key value result)
+       ;; Shouldn't be reached
+       #f)
+     0
+     ;; The aim here is to pass in #f for the vlist, and cause an
+     ;; exception within the (ice-9 vlist) module
+     #f)
+    'done))
+
+;; FIRST BACKTRACE ENTRY: 1762:12    (with-exception-handler
+(with-exception-handler
+    (lambda (exn)
+      (print-backtrace-and-exception/knots exn)
+      (primitive-exit 1))
+  (lambda ()
+    (call-with-temporary-thread
+     (lambda ()
+       (do-fold)
+       'done))))

tests/backtraces/vhash-fold.scm

@@ -0,0 +1,24 @@
+(use-modules (knots) (ice-9 vlist))
+
+;; LAST BACKTRACE ENTRY: 257:2
+
+(define (do-fold)
+  (begin
+    (vhash-fold
+     (lambda (key value result)
+       ;; Shouldn't be reached
+       #f)
+     0
+     ;; The aim here is to pass in #f for the vlist, and cause an
+     ;; exception within the (ice-9 vlist) module
+     #f)
+    'done))
+
+;; FIRST BACKTRACE ENTRY: 1762:12    (with-exception-handler
+(with-exception-handler
+    (lambda (exn)
+      (print-backtrace-and-exception/knots exn)
+      (primitive-exit 1))
+  (lambda ()
+    (do-fold)
+    'done))

tests/backtraces/wrapped-exception.scm

@@ -0,0 +1,16 @@
+(use-modules (knots))
+
+;; FIRST BACKTRACE ENTRY: 1762:12    (with-exception-handler
+(with-exception-handler
+    (lambda (exn)
+      (print-backtrace-and-exception/knots exn)
+      (primitive-exit 1))
+  (lambda ()
+    (with-exception-handler
+        (lambda (exn)
+          (raise-exception
+           (make-exception
+            exn
+            (make-knots-exception (make-stack #t)))))
+      (lambda ()
+        (error "wrapped error message"))))) ; LAST BACKTRACE ENTRY HERE