Recover TCO-elided frames in uncaught-error stack traces

On the eval path nothing registers a source map, so jolt-backtrace-string
dropped every walkable frame and printed no trace at all. Keep any named,
non-plumbing continuation frame (rendered as a bare name when unmapped) so a
runtime error shows the surviving non-tail spine — "print what is available".

Add an opt-in tail-frame history behind JOLT_TRACE for the frames TCO erases.
Each compiled fn records itself on entry into a bounded ring-of-rings, MIT
Scheme's "history" shape: the outer ring holds one rib per non-tail subproblem,
each rib a small inner ring of the tail-calls made at that level. A tight tail
loop churns one rib instead of flushing the spine, so the non-tail caller
context survives and total space stays bounded. The reporter prefers this
history over the continuation when it's present, and resets it per top-level
form so an error's trace isn't padded with earlier REPL frames.

The emitter marks a tail call with (jolt-trace-mark! #t) so the runtime routes
the callee into the current rib vs a fresh one; a *tail?* dynamic var tracks
tail position (cleared by default, passed through if/do/let/loop/fn-body). It's
all gated on trace-frames?, which compile-eval turns on for JOLT_TRACE and
emit-image/`jolt build` force off — so non-trace emitted output is byte-identical
(prelude unchanged, seed re-minted), and a built binary carries no per-call cost.

docs/tools-deps.md

@@ -182,6 +182,20 @@ a root, transitively.
 - Source only; compiled `.class` files in a git dep are ignored.
 - git `:git/sha` must be a full SHA (`git fetch` can't resolve a short one).
 
+## Stack traces
+
+An uncaught error prints the message, the top-level source location, and — when
+frames are available — a `trace:` backtrace. In an AOT `jolt build --direct-link`
+binary the frames map to `ns/name (file:line)`; on the runtime eval path they are
+the surviving fn names. Tail-call optimization erases tail-called frames, so the
+default trace shows only the non-tail spine.
+
+Set `JOLT_TRACE=1` to opt into a fuller **tail-frame history**. Each compiled fn
+then records itself on entry into a bounded ring-of-rings buffer, so the trace
+recovers TCO-elided frames (including the immediate error site) while a tight tail
+loop stays bounded and its non-tail caller context is preserved. It costs a small
+per-call overhead, so it is off by default and never emitted into a built binary.
+
 ## Conformance
 
 The known-working libraries (see [libraries.md](libraries.md)) and the

host/chez/compile-eval.ss

@@ -110,6 +110,13 @@
 ;; older seed during the first re-mint pass.
 (let ((scv (var-deref "jolt.backend-scheme" "set-var-cache!")))
   (when (procedure? scv) (scv #t)))
+;; JOLT_TRACE opts into tail-frame history: the emitter prepends a frame-recording
+;; push to every runtime-compiled fn, and the ring buffer is allocated for this
+;; thread. Off by default, so a normal run emits and pays exactly as before.
+(when (getenv "JOLT_TRACE")
+  (let ((stf (var-deref "jolt.backend-scheme" "set-trace-frames!")))
+    (when (procedure? stf) (stf #t)))
+  (jolt-trace-enable!))
 
 ;; (with-meta sym m) -> sym, else x — an (ns ^:no-doc name …) yields the name with
 ;; reader metadata as a with-meta form; strip it to read the bare ns symbol.
@@ -235,6 +242,9 @@
      ;; record this form's source location first, so a compile- or run-time error
      ;; in it reports the right place.
      (jolt-enter-form! form)
+     ;; drop tail-frame history from earlier top-level forms, so an error's trace
+     ;; shows only this form's own call history (a no-op unless JOLT_TRACE is on).
+     (jolt-trace-reset!)
      (eval (read (open-input-string (jolt-analyze-emit-form form ns)))
            (interaction-environment)))))
 

host/chez/emit-image.ss

@@ -46,6 +46,10 @@
 ;; after it). Guarded for the first re-mint pass off an older seed.
 (let ((scv (var-deref "jolt.backend-scheme" "set-var-cache!")))
   (when (procedure? scv) (scv #f)))
+;; Tail-frame tracing off for the mint + `jolt build`: the seed must stay a
+;; byte-fixpoint, and a built app should carry no per-call trace overhead.
+(let ((stf (var-deref "jolt.backend-scheme" "set-trace-frames!")))
+  (when (procedure? stf) (stf #f)))
 (define (ei-compile-form ctx f optimize?)
   (let ((ir (jolt-ce-analyze ctx f)))
     (jolt-ce-emit-top (if optimize? (jolt-ce-run-passes ir ctx) ir))))

host/chez/rt.ss

@@ -60,6 +60,112 @@
 ;; stack trace (source-registry.ss). call/cc is paid only on a throw, never per
 ;; call; the captured k is walked, never invoked.
 (define jolt-throw-cont (make-thread-parameter #f))
+
+;; --- tail-frame history: a ring of rings (opt-in) ----------------------------
+;; TCO erases tail-called frames from the native continuation, so an uncaught
+;; error's backtrace shows only the surviving non-tail spine — the immediate error
+;; site is often a tail call and is missing. When tracing is enabled (JOLT_TRACE,
+;; wired in compile-eval.ss), each compiled fn records its frame-name on entry, and
+;; the reporter reads this history to recover TCO-elided frames.
+;;
+;; The store is MIT-Scheme's "history" shape — a ring of rings. The OUTER ring
+;; holds one RIB per non-tail subproblem (the real call spine); each rib's INNER
+;; ring holds the recent tail-calls made AT that subproblem. A non-tail entry
+;; advances the outer ring (a fresh rib); a tail entry rotates the current rib's
+;; inner ring. So a tight tail loop (mutual recursion, a non-recur self-tail-call)
+;; churns ONE rib's small inner ring instead of flushing the outer spine — the
+;; caller context that led into the loop survives. Both rings are fixed-size, so
+;; the whole history is bounded: a constant space factor, NOT a change to the
+;; asymptotic space TCO guarantees.
+;;
+;; Whether an entry is tail or non-tail is set by the CALLER: the emitter marks a
+;; tail call with (jolt-trace-mark! #t) right before it; a non-tail entry is the
+;; default. NOTE this is best-effort: a tail call routed through jolt-invoke to a
+;; target that has no entry prologue (a core/native fn, an anonymous fn held in a
+;; var) does not consume the mark, so a following non-tail frame can be mislabeled
+;; as a tail rotation — a cosmetic mis-grouping in the trace, never a wrong result.
+(define jolt-trace-outer-size 48)          ; ribs (non-tail spine depth kept)
+(define jolt-trace-inner-size 6)           ; tail-calls kept per subproblem
+;; A history: #(ribs-vector outer-head outer-count). A rib: #(name-vector head count).
+(define (jolt-make-rib) (vector (make-vector jolt-trace-inner-size #f) 0 0))
+(define (jolt-make-history)
+  (let ((ribs (make-vector jolt-trace-outer-size #f)))
+    (let loop ((i 0))
+      (when (fx<? i jolt-trace-outer-size)
+        (vector-set! ribs i (jolt-make-rib)) (loop (fx+ i 1))))
+    (vector ribs 0 0)))
+;; A global switch (all threads) plus a per-thread ring, lazily created on first
+;; use — so code run on a spawned thread (a future/agent) records into ITS OWN
+;; history, not the enabling thread's (make-thread-parameter hands a new thread the
+;; initial #f, so we can't rely on inheritance).
+(define jolt-trace-on? #f)
+(define jolt-trace-ring (make-thread-parameter #f))
+(define jolt-trace-tail? (make-thread-parameter #f))   ; caller-set, consumed per entry
+(define (jolt-trace-enable!) (set! jolt-trace-on? #t) (jolt-trace-ring (jolt-make-history)))
+;; this thread's ring, created on demand while tracing is on
+(define (jolt-trace-cur-ring)
+  (or (jolt-trace-ring)
+      (and jolt-trace-on? (let ((h (jolt-make-history))) (jolt-trace-ring h) h))))
+;; Drop accumulated history at a top-level boundary (compile-eval.ss calls this per
+;; top-level form) so an error's trace shows only the forms that led to it, not the
+;; frames of earlier, already-returned REPL/eval forms.
+(define (jolt-trace-reset!)
+  (when (jolt-trace-ring) (jolt-trace-ring (jolt-make-history)) (jolt-trace-tail? #f)))
+(define (jolt-trace-mark! t) (jolt-trace-tail? t))
+
+;; push name into a rib's inner ring
+(define (jolt-rib-push! rib name)
+  (let ((buf (vector-ref rib 0)) (i (vector-ref rib 1)) (cnt (vector-ref rib 2)))
+    (vector-set! buf i name)
+    (vector-set! rib 1 (fxmod (fx+ i 1) jolt-trace-inner-size))
+    (when (fx<? cnt jolt-trace-inner-size) (vector-set! rib 2 (fx+ cnt 1)))))
+;; a non-tail entry: advance the outer ring, reset the new rib, seed it with name
+(define (jolt-history-nontail! h name)
+  (let* ((ribs (vector-ref h 0)) (oh (vector-ref h 1)) (oc (vector-ref h 2))
+         (rib (vector-ref ribs oh)))
+    (vector-set! rib 1 0) (vector-set! rib 2 0)
+    (jolt-rib-push! rib name)
+    (vector-set! h 1 (fxmod (fx+ oh 1) jolt-trace-outer-size))
+    (when (fx<? oc jolt-trace-outer-size) (vector-set! h 2 (fx+ oc 1)))))
+;; a tail entry: rotate the CURRENT rib's inner ring (bootstrap a rib if none yet)
+(define (jolt-history-tail! h name)
+  (if (fx=? (vector-ref h 2) 0)
+      (jolt-history-nontail! h name)
+      (let* ((ribs (vector-ref h 0))
+             (cur (fxmod (fx+ (fx- (vector-ref h 1) 1) jolt-trace-outer-size)
+                         jolt-trace-outer-size)))
+        (jolt-rib-push! (vector-ref ribs cur) name))))
+;; Record a frame entry, routed by the caller's tail mark; then reset the mark so a
+;; subsequent entry reached WITHOUT a mark (e.g. via apply) defaults to non-tail.
+(define (jolt-trace-push! name)
+  (let ((h (jolt-trace-cur-ring)))
+    (when h
+      (if (jolt-trace-tail?) (jolt-history-tail! h name) (jolt-history-nontail! h name))
+      (jolt-trace-tail? #f)))
+  jolt-nil)
+
+;; a rib's inner names, most-recent (deepest) tail first
+(define (jolt-rib-names rib)
+  (let ((buf (vector-ref rib 0)) (head (vector-ref rib 1)) (cnt (vector-ref rib 2)))
+    (let loop ((k 1) (acc '()))
+      (if (fx>? k cnt)
+          (reverse acc)
+          (loop (fx+ k 1)
+                (cons (vector-ref buf (fxmod (fx+ (fx- head k) jolt-trace-inner-size)
+                                             jolt-trace-inner-size))
+                      acc))))))
+;; The whole history flattened to frame-names, most-recent (deepest) first:
+;; current rib's tail-history, then its non-tail caller's, and so on outward.
+(define (jolt-trace-snapshot)
+  (let ((h (jolt-trace-ring)))
+    (if (not h) '()
+        (let* ((ribs (vector-ref h 0)) (oh (vector-ref h 1)) (oc (vector-ref h 2)))
+          (let loop ((k 1) (acc '()))
+            (if (fx>? k oc)
+                (apply append (reverse acc))
+                (let ((idx (fxmod (fx+ (fx- oh k) jolt-trace-outer-size) jolt-trace-outer-size)))
+                  (loop (fx+ k 1) (cons (jolt-rib-names (vector-ref ribs idx)) acc)))))))))
+
 (define-condition-type &jolt-throw &condition
   make-jolt-throw-condition jolt-throw-condition?
   (value jolt-throw-condition-value))

host/chez/smoke.sh

@@ -30,6 +30,39 @@ check_loc() {
   fi
 }
 
+# An uncaught error's stack trace must name the runtime-eval'd fn frames that
+# survive TCO (the non-tail spine), even though the eval path registers no source
+# map — "print what is available". Asserts a substring appears under "  trace:".
+check_trace() {
+  err="$(bin/joltc -e "$1" 2>&1 >/dev/null)"
+  if printf '%s' "$err" | grep -q '  trace:' && printf '%s' "$err" | grep -q "$2"; then
+    pass=$((pass + 1))
+  else
+    echo "  FAIL (trace): $1"
+    echo "    want stderr trace to contain \`$2\`, got \`$err\`"
+    fails=$((fails + 1))
+  fi
+}
+
+# JOLT_TRACE opts into the tail-frame history (the ring of rings): every $2 (an
+# ERE) must match the "  trace:" block. Used to assert TCO-elided frames are
+# recovered and non-tail caller context survives a tail loop.
+check_trace_on() {
+  err="$(JOLT_TRACE=1 bin/joltc -e "$1" 2>&1 >/dev/null)"
+  ok=1
+  printf '%s' "$err" | grep -q '  trace:' || ok=0
+  shift
+  for want in "$@"; do
+    printf '%s' "$err" | grep -Eq "$want" || ok=0
+  done
+  if [ "$ok" = 1 ]; then
+    pass=$((pass + 1))
+  else
+    echo "  FAIL (trace-on): want [$*] in trace, got \`$err\`"
+    fails=$((fails + 1))
+  fi
+}
+
 check '(+ 1 2)' '3'
 check '(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 15)' '610'
 check '(->> (range 10) (filter even?) (map (fn [x] (* x x))) (reduce +))' '120'
@@ -60,6 +93,38 @@ check '(try (load-string "(+") (catch :default e (ex-message e)))' 'EOF while re
 check_loc '(throw (ex-info "boom" {}))' 'boom'
 check_loc '(do (+ 1 1) (/ 1 0))' '  at 1:'
 
+# Runtime-eval'd fns aren't source-mapped, but their native frame names survive on
+# the non-tail spine; the trace must show them. deepest/+ are tail calls (erased);
+# middle and outer wait on a non-tail (inc …) so their frames are live at the throw.
+trace_prog='(defn deepest [x] (+ x 1)) (defn middle [x] (inc (deepest x))) (defn outer [x] (inc (middle x))) (outer :nan)'
+check_trace "$trace_prog" 'middle'
+check_trace "$trace_prog" 'outer'
+
+# JOLT_TRACE (tail-frame history / ring of rings). An all-tail chain is entirely
+# TCO-erased from the continuation, but the history recovers every frame — incl.
+# `deepest`, the actual error site.
+check_trace_on '(defn deepest [x] (+ x 1)) (defn middle [x] (deepest x)) (defn outer [x] (middle x)) (outer :nan)' \
+  'deepest' 'middle' 'outer'
+# A tail loop (a<->b) under a NON-tail caller: the loop is confined to one rib's
+# bounded inner ring, so the caller context (`driver`, `top`) is NOT flushed out —
+# the point of the ring of rings.
+check_trace_on '(declare b) (defn a [n] (if (zero? n) (+ :x 1) (b (dec n)))) (defn b [n] (a n)) (defn driver [] (inc (a 6))) (defn top [] (inc (driver))) (top)' \
+  'driver' 'top'
+# A ^long/^double return hint wraps the body in a coercion, so the hinted fn's call
+# is NOT a tail call — its own frame is still live and must appear (not be elided).
+check_trace_on '(defn g [n] (+ :x n)) (defn ^long f [n] (g n)) (f 3)' 'f' 'g'
+# History is per top-level form: a later form's error trace shows its own frames
+# (h2/u2), not frames from an earlier, already-returned form (h1/u1).
+check_trace_on '(defn h1 [x] (inc x)) (defn u1 [] (inc (h1 5))) (u1) (defn h2 [x] (+ :x x)) (defn u2 [] (inc (h2 5))) (u2)' \
+  'h2' 'u2'
+err_stale="$(JOLT_TRACE=1 bin/joltc -e '(defn h1 [x] (inc x)) (defn u1 [] (inc (h1 5))) (u1) (defn h2 [x] (+ :x x)) (defn u2 [] (inc (h2 5))) (u2)' 2>&1 >/dev/null)"
+if printf '%s' "$err_stale" | grep -q 'h1'; then
+  echo "  FAIL (trace-on): stale frame h1 from an earlier form leaked into the trace"
+  fails=$((fails + 1))
+else
+  pass=$((pass + 1))
+fi
+
 # --help prints usage, and lists the nREPL server under its real flag name.
 help_out="$(bin/joltc --help 2>/dev/null)"
 if printf '%s' "$help_out" | grep -q -- '--nrepl-server'; then

host/chez/source-registry.ss

@@ -57,10 +57,36 @@
                       ((symbol? nm) (symbol->string nm))
                       (else #f)))))))
 
-;; Walk a continuation, returning the registered jolt frames (innermost first) as
+;; Frame names that are pure Chez / jolt-runtime plumbing — the eval boundary,
-;; (frame-name . record) pairs, where record is #(ns name file line) or the symbol
+;; the var-cell trampoline, continuation/winder internals. They carry no Clojure
-;; 'ambiguous. Unmapped frames (host spine, anonymous lambdas) are skipped; raw
+;; meaning, so an unmapped frame with one of these names is dropped from the trace
-;; depth is capped.
+;; (a MAPPED frame is always kept — a jolt fn that happens to share the name still
+;; resolves to its source). Any name Chez prefixes with `$` (system) or that jolt
+;; prefixes with `jolt-` (host runtime) is plumbing too.
+(define srcreg-plumbing-names
+  (let ((h (make-hashtable string-hash string=?)))
+    (for-each (lambda (s) (hashtable-set! h s #t))
+              '("dynamic-wind" "winder-dummy" "ksrc" "invoke" "apply"
+                "call-with-values" "call/cc" "call-with-current-continuation"
+                "raise" "raise-continuable" "with-exception-handler" "guard"
+                "eval" "compile" "interpret" "expand" "read" "load"
+                ;; host dispatch/coercion helpers (not `jolt-` prefixed) that carry
+                ;; no Clojure meaning in a trace
+                "record-method-dispatch" "protocol-resolve" "devirt-resolve"
+                "list->cseq" "host-static-call" "host-call"))
+    h))
+(define (srcreg-plumbing-name? nm)
+  (or (hashtable-ref srcreg-plumbing-names nm #f)
+      (and (fx>? (string-length nm) 0) (char=? (string-ref nm 0) #\$))
+      (and (fx>=? (string-length nm) 5) (string=? (substring nm 0 5) "jolt-"))))
+
+;; Walk a continuation, returning its frames (innermost first) as (frame-name .
+;; record) pairs. record is a source vector #(ns name file line) for a frame that
+;; maps to registered Clojure source, the symbol 'ambiguous for a short name shared
+;; across namespaces, or #f for an unmapped-but-named frame (the common case on the
+;; open-world eval path, where nothing is registered — the bare frame name is still
+;; a useful trace line). Plumbing frames (host spine, eval boundary) and unnamed
+;; frames are skipped; raw depth is capped.
 (define (jolt-frame-records k)
   ;; read the env at call time, not load time: a built binary runs top-level forms
   ;; at heap-build time, where this would always be unset.
@@ -70,39 +96,72 @@
       (if (or (not io) (fx>=? n 400))
           (reverse acc)
           (let* ((nm (srcreg-frame-name io))
-                 (src (and nm (hashtable-ref source-registry nm #f))))
+                 (src (and nm (hashtable-ref source-registry nm #f)))
+                 ;; keep a frame that maps, or any named frame that isn't plumbing
+                 (keep? (and nm (or src (not (srcreg-plumbing-name? nm))))))
             (when (and debug? nm)
-              (display (string-append "  [frame] " nm (if src " *MAPPED*" "") "\n")
+              (display (string-append "  [frame] " nm (if src " *MAPPED*"
+                                                          (if keep? "" " (skipped)")) "\n")
                        (current-error-port)))
             (loop (guard (e (#t #f)) (io 'link)) (fx+ n 1)
-                  (if src (cons (cons nm src) acc) acc))))))))
+                  (if keep? (cons (cons nm src) acc) acc))))))))
 
-;; Multi-line backtrace for an uncaught value — "  ns/name (file:line)" for a
+;; Render a list of (frame-name . record) pairs (innermost/deepest first) to a
-;; mapped frame, the bare frame name for an ambiguous one — or #f when no jolt
+;; backtrace string. record is a source vector #(ns name file line) -> "ns/name
-;; frame maps (the caller then prints just the top-level location). Capped to the
+;; (file:line)", or 'ambiguous / #f -> the bare frame name. A run of the same
-;; innermost frames.
+;; frame-name collapses to one "name (xN)" line (deep recursion, or a hot fn a
+;; loop re-enters), and the number of distinct lines is capped.
+(define (jolt-render-recs recs)
+  (let ((port (open-output-string)))
+    (let loop ((rs recs) (shown 0))
+      (if (or (null? rs) (fx>=? shown 30))
+          (get-output-string port)
+          (let* ((p (car rs)) (frame-name (car p)) (r (cdr p)))
+            ;; count a maximal run of the same frame-name
+            (let run ((tail (cdr rs)) (cnt 1))
+              (if (and (pair? tail) (string=? (car (car tail)) frame-name))
+                  (run (cdr tail) (fx+ cnt 1))
+                  (begin
+                    (put-string port "    ")
+                    (if (vector? r)
+                        (let ((ns (vector-ref r 0)) (nm (vector-ref r 1))
+                              (file (vector-ref r 2)) (line (vector-ref r 3)))
+                          (put-string port ns) (put-string port "/") (put-string port nm)
+                          (when (string? file)
+                            (put-string port " (") (put-string port file)
+                            (put-string port ":") (put-string port (number->string line))
+                            (put-string port ")")))
+                        (put-string port frame-name))   ; 'ambiguous / unmapped: bare name
+                    (when (fx>? cnt 1)
+                      (put-string port " (x") (put-string port (number->string cnt)) (put-string port ")"))
+                    (put-char port #\newline)
+                    (loop tail (fx+ shown 1))))))))))
+
+;; Multi-line backtrace for an uncaught value. Two sources, in preference order:
+;;   1. The tail-frame history ring (rt.ss), when JOLT_TRACE enabled it — an
+;;      execution history of the runtime-compiled fns entered before the throw,
+;;      INCLUDING ones TCO erased from the live continuation. Most-recent first.
+;;   2. Otherwise the live continuation (jolt-frame-records) — the accurate but
+;;      TCO-truncated non-tail spine.
+;; Each frame maps to "ns/name (file:line)" when registered, else its bare name.
+;; #f when neither source yields a frame (the caller then prints just the location).
 (define (jolt-backtrace-string v)
-  (let ((k (jolt-error-continuation v)))
+  (let* ((hist (jolt-trace-snapshot))
-    (and k
+         ;; a mapped frame is always kept; else drop plumbing (same rule as the
-         (let ((recs (jolt-frame-records k)))
+         ;; continuation path) so the two backtrace sources read consistently
-           (and (pair? recs)
+         (recs (let loop ((ns hist) (acc '()))
-                (let ((port (open-output-string)))
+                 (if (null? ns)
-                  (let loop ((rs recs) (shown 0))
+                     (reverse acc)
-                    (when (and (pair? rs) (fx<? shown 30))
+                     (let* ((nm (car ns)) (src (hashtable-ref source-registry nm #f)))
-                      (let* ((p (car rs)) (frame-name (car p)) (r (cdr p)))
+                       (loop (cdr ns)
-                        (put-string port "    ")
+                             (if (or src (not (srcreg-plumbing-name? nm)))
-                        (if (vector? r)
+                                 (cons (cons nm src) acc) acc)))))))
-                            (let ((ns (vector-ref r 0)) (nm (vector-ref r 1))
+    (if (pair? recs)
-                                  (file (vector-ref r 2)) (line (vector-ref r 3)))
+        (jolt-render-recs recs)
-                              (put-string port ns) (put-string port "/") (put-string port nm)
+        (let ((k (jolt-error-continuation v)))
-                              (when (string? file)
+          (and k
-                                (put-string port " (") (put-string port file)
+               (let ((recs (jolt-frame-records k)))
-                                (put-string port ":") (put-string port (number->string line))
+                 (and (pair? recs) (jolt-render-recs recs))))))))
-                                (put-string port ")")))
-                            (put-string port frame-name))   ; 'ambiguous: bare name
-                        (put-char port #\newline))
-                      (loop (cdr rs) (fx+ shown 1))))
-                  (get-output-string port)))))))
 
 ;; Render an uncaught jolt throw (any value, not just a Chez condition) to a port:
 ;; an ex-info shows its message + ex-data (+ a host cause); anything else is

jolt-core/jolt/backend_scheme.clj

@@ -172,6 +172,14 @@
 (def var-cache? (atom false))
 (defn set-var-cache! [on] (reset! var-cache? on))
 
+;; Opt-in tail-frame history (JOLT_TRACE): emit a (jolt-trace-push! "name") at the
+;; head of every named fn body, so an entry records the frame into the runtime ring
+;; buffer (rt.ss) and a TCO-elided frame still shows in an error's backtrace. OFF
+;; during the seed mint and `jolt build` (byte-determinism + no runtime cost);
+;; compile-eval.ss turns it on for runtime-eval'd user code when JOLT_TRACE is set.
+(def trace-frames? (atom false))
+(defn set-trace-frames! [on] (reset! trace-frames? on))
+
 ;; A direct-link Scheme binding name for a var. The fqn maps to a unique identifier
 ;; jv$<ns>$<name>; chars that break a Scheme identifier or the `$` separator are
 ;; escaped so distinct vars never collide.
@@ -191,6 +199,13 @@
 ;; recursion auto-restores them (no manual save/restore, no throw-leak).
 (def ^:dynamic *recur-target* nil)
 (def ^:dynamic *known-procs* #{})
+;; True while emitting a node in TAIL position. Only used, in trace mode, to mark a
+;; tail call so the runtime routes its callee into the current history rib instead
+;; of a new one (rt.ss). It never affects semantics — a wrong value only mislabels
+;; a debug trace line — so partial propagation is safe. `emit` (the wrapper below)
+;; clears it by default; the tail-transparent forms (fn body, if/do/let/loop) pass
+;; it to their tail child. Default false so a top-level form is treated non-tail.
+(def ^:dynamic *tail?* false)
 
 (def ^:private gensym-counter (atom 0))
 (defn- fresh-label [prefix] (str prefix (swap! gensym-counter inc)))
@@ -253,6 +268,17 @@
     (if (or (contains? scheme-reserved s) (contains? bare-native-names s)) (str "_" s) s)))
 
 (declare emit)
+(declare emit*)
+;; Ops that pass tail position through to a child (the child can itself be a tail
+;; call): if/do carry it to their tail branch/last form, let/loop to their body,
+;; and invoke reads it to decide whether the call is tail. Every other op's
+;; children are non-tail, so `emit` clears *tail?* before dispatching them — that
+;; way a stray true can't leak into, say, a call sitting in a vector literal.
+(def ^:private tail-transparent-ops #{:if :do :let :loop :invoke})
+(defn emit [node]
+  (if (and *tail?* (not (tail-transparent-ops (:op node))))
+    (binding [*tail?* false] (emit* node))
+    (emit* node)))
 
 ;; A Chez string literal. Every char outside printable ASCII becomes a
 ;; codepoint hex escape \x<cp>; ; the named escapes (\n \t \r \" \\) match what
@@ -413,9 +439,10 @@
 ;; letfn lowers to a :let flagged :letrec (mutually-recursive named local fns):
 ;; Scheme `letrec*` binds them so each sees its siblings. A plain let uses let*.
 (defn- emit-let [node]
-  (let [kw (if (:letrec node) "letrec*" "let*")]
+  (let [kw (if (:letrec node) "letrec*" "let*")
-    (str "(" kw " (" (str/join " " (map emit-binding (:bindings node))) ") "
+        ;; bindings are non-tail; the body inherits the let's tail position
-         (emit (:body node)) ")")))
+        binds (binding [*tail?* false] (str/join " " (mapv emit-binding (:bindings node))))]
+    (str "(" kw " (" binds ") " (emit (:body node)) ")")))
 
 (defn- emit-loop [node]
   (let [label (fresh-label "loop")
@@ -423,9 +450,10 @@
         names (map #(munge-name (nth % 0)) pairs)
         ;; inits evaluate in the OUTER scope (recur-target unchanged) and, like
         ;; Clojure loop/let, SEQUENTIALLY — wrap a let* around the named let.
-        inits (map #(emit (nth % 1)) pairs)
+        inits (binding [*tail?* false] (mapv #(emit (nth % 1)) pairs))
         seq-bs (str/join " " (map (fn [n i] (str "(" n " " i ")")) names inits))
         rebinds (str/join " " (map (fn [n] (str "(" n " " n ")")) names))
+        ;; the loop body inherits the loop's tail position
         body (binding [*recur-target* label] (emit (:body node)))]
     (str "(let* (" seq-bs ") (let " label " (" rebinds ") " body "))")))
 
@@ -486,7 +514,11 @@
         params (map munge-name orig)
         restp (when-let [r (:rest a)] (munge-name r))
         label (fresh-label "fnrec")
-        body (binding [*recur-target* label] (emit (:body a)))
+        ret (:ret-nhint a)
+        ;; the body is the fn's tail position — UNLESS a ^double/^long return hint
+        ;; wraps it in a coercion below, which puts the body back in non-tail.
+        body-tail? (not (or (= ret :double) (= ret :long)))
+        body (binding [*recur-target* label *tail?* body-tail?] (emit (:body a)))
         paramlist (cond
                     (and restp (empty? params)) restp
                     restp (str "(" (str/join " " params) " . " restp ")")
@@ -511,6 +543,16 @@
         self (when-let [nm (:name node)] (munge-name nm))
         clauses (binding [*known-procs* (if self (conj *known-procs* self) *known-procs*)]
                   (mapv emit-arity-clause arities))
+        ;; trace mode: record this frame on entry (before the body), so a frame
+        ;; the body then tail-calls away is still in the ring at throw time. A
+        ;; `recur` re-enters via the named-let, not the lambda, so a tight loop
+        ;; records once, not per iteration.
+        clauses (if (and @trace-frames? self)
+                  (mapv (fn [c] [(nth c 0)
+                                 (str "(begin (jolt-trace-push! " (chez-str-lit self) ") "
+                                      (nth c 1) ")")])
+                        clauses)
+                  clauses)
         lambda (if (= 1 (count clauses))
                  (let [c (first clauses)] (str "(lambda " (nth c 0) " " (nth c 1) ")"))
                  (str "(case-lambda "
@@ -573,8 +615,31 @@
             (= (nth shape i) kw) i
             :else (recur (inc i))))))
 
+;; A plain Scheme application: (callee op ...).
+(defn- plain-call [callee operand-strs]
+  (str "(" callee (if (seq operand-strs) (str " " (str/join " " operand-strs)) "") ")"))
+;; A tail call in trace mode. Force-bind the operands to temps FIRST (so any
+;; operand whose own evaluation records a trace entry runs before our mark), THEN
+;; set the tail mark, THEN apply — the callee's entry prologue consumes the mark
+;; with nothing in between, so it can't be clobbered. Still a tail call: the let*'s
+;; last form is the application, so TCO is preserved.
+(defn- tail-marked-call [callee operand-strs]
+  (let [tmps (mapv (fn [_] (fresh-label "_tt$")) operand-strs)
+        binds (str/join " " (map (fn [t a] (str "(" t " " a ")")) tmps operand-strs))]
+    (str "(let* (" binds ") (jolt-trace-mark! #t) " (plain-call callee tmps) ")")))
+;; Emit a call, tail-marked when we're in tail position and tracing is on; a plain
+;; application otherwise. The mark is consumed by the callee's entry prologue —
+;; direct calls (:local known-proc, direct-link) always have one; a jolt-invoke
+;; call usually reaches one but not always (see the best-effort note in rt.ss).
+(defn- emit-call [tail? callee operand-strs]
+  (if (and @trace-frames? tail?)
+    (tail-marked-call callee operand-strs)
+    (plain-call callee operand-strs)))
+
 (defn- emit-invoke [node]
-  (let [fnode (:fn node)
+  (let [tail? *tail?*]           ; capture: children below emit non-tail
+   (binding [*tail?* false]
+    (let [fnode (:fn node)
         arg-nodes (:args node)
         args (mapv emit arg-nodes)
         nop (native-op fnode (count args))
@@ -586,8 +651,7 @@
         ;; order [callee & args] together when ordering is observable.
         invoke (fn []
                  (ordered-call (cons fnode arg-nodes) (cons (emit fnode) args)
-                               (fn [[f & as]]
+                               (fn [operands] (emit-call tail? "jolt-invoke" operands))))]
-                                 (str "(jolt-invoke " f (if (seq as) (str " " (str/join " " as)) "") ")"))))]
     (cond
       ;; devirtualized protocol call: the inference proved the receiver (arg 0) is
       ;; one record type, so resolve the impl by that static tag instead of routing
@@ -662,8 +726,7 @@
       ;; holds an arbitrary IFn -> dynamic dispatch.
       (= :local (:op fnode))
       (if (*known-procs* (munge-name (:name fnode)))
-        (order-args (fn [as] (str "(" (munge-name (:name fnode))
+        (order-args (fn [as] (emit-call tail? (munge-name (:name fnode)) as)))
-                                  (if (seq as) (str " " (str/join " " as)) "") ")")))
         (invoke))
       ;; closed-world direct call: the callee var is an app fn def already emitted
       ;; with a Scheme binding — apply it directly, no var lookup, no jolt-invoke.
@@ -672,8 +735,7 @@
       ;; below (which still uses the direct binding as the invoke target).
       (and (= :var (:op fnode)) (direct-linkable? (:ns fnode) (:name fnode))
            (direct-link-fn? (:ns fnode) (:name fnode)))
-      (order-args (fn [as] (str "(" (dl-name (:ns fnode) (:name fnode))
+      (order-args (fn [as] (emit-call tail? (dl-name (:ns fnode) (:name fnode)) as)))
-                                (if (seq as) (str " " (str/join " " as)) "") ")")))
       ;; a late-bound :var call head can hold a procedure OR a non-applicable
       ;; value the RT dispatches (multimethod, keyword/coll IFn) — route via
       ;; jolt-invoke (transparent for a procedure).
@@ -681,7 +743,7 @@
       (invoke)
       ;; a computed callee can yield ANY IFn — route through jolt-invoke.
       :else
-      (invoke))))
+      (invoke))))))
 
 ;; try/catch/finally. throw raises a Chez condition wrapping the jolt value
 ;; (jolt-throw = Scheme `raise` of a &jolt-throw condition); catch lowers to
@@ -728,7 +790,7 @@
        (returns-scheme-bool? (:body node) bools'))
      :else false)))
 
-(defn emit [node]
+(defn emit* [node]
   (case (:op node)
     :const (emit-const (:val node))
     :local (munge-name (:name node))
@@ -776,11 +838,14 @@
     :host-new (str "(host-new " (chez-str-lit (:class node))
                    (let [args (map emit (:args node))]
                      (if (empty? args) "" (str " " (str/join " " args)))) ")")
+    ;; the test is non-tail; then/else inherit the if's tail position
     :if (let [test (:test node)
-              t (if (returns-scheme-bool? test) (emit test)
+              t (binding [*tail?* false]
-                    (str "(jolt-truthy? " (emit test) ")"))]
+                  (if (returns-scheme-bool? test) (emit test)
+                      (str "(jolt-truthy? " (emit test) ")")))]
           (str "(if " t " " (emit (:then node)) " " (emit (:else node)) ")"))
-    :do (str "(begin " (str/join " " (map emit (:statements node)))
+    ;; non-last statements are non-tail; the ret inherits the do's tail position
+    :do (str "(begin " (binding [*tail?* false] (str/join " " (mapv emit (:statements node))))
              (if (empty? (:statements node)) "" " ") (emit (:ret node)) ")")
     :invoke (emit-invoke node)
     ;; collection literals -> rt constructors (collections.ss). Elements are