Review fixes: registration key, thread-locals, debug flag timing
- Register a fn under the name Chez actually reports for its frame, not the def name: a named fn literal whose name differs from the def (def foo (fn bar …)) is framed as 'bar', and an anonymous fn def (def foo (fn …)) as jv$ns$foo. Both previously registered under the def name and so never appeared in traces. - rdr-source-file / rdr-pos-cursor are thread parameters, so concurrent compiles (futures, core.async) don't clobber each other's file/line attribution. - Read JOLT_DEBUG_FRAMES at call time: a built binary evaluates top-level forms at heap-build time, where a load-time getenv is always unset. Re-mint (backend + reader); prelude byte-identical, selfhost holds.
This commit is contained in:
Yogthos
parent
8fd5cf9f68
commit
8d7008b232
4 changed files with 18 additions and 12 deletions
|
|
@ -333,7 +333,7 @@
|
|||
;; bound rdr-source-file. read-string leaves the file unset. The analyzer reads
|
||||
;; this back via jolt.host/form-position to stamp :pos on call nodes; macros and
|
||||
;; (meta (read-string "(…)")) see it too.
|
||||
(define rdr-source-file (make-parameter #f))
|
||||
(define rdr-source-file (make-thread-parameter #f))
|
||||
(define rdr-kw-line (keyword #f "line"))
|
||||
(define rdr-kw-column (keyword #f "column"))
|
||||
(define rdr-kw-file (keyword #f "file"))
|
||||
|
|
@ -341,7 +341,7 @@
|
|||
;; Forms are read left-to-right, so the indices queried are non-decreasing within
|
||||
;; one source string — keep a cursor and count newlines only over the delta
|
||||
;; (O(n) total, not O(n^2)). A different string or a backward index resets it.
|
||||
(define rdr-pos-cursor (make-parameter #f)) ; #f | (vector s i line col)
|
||||
(define rdr-pos-cursor (make-thread-parameter #f)) ; #f | (vector s i line col)
|
||||
(define (rdr-line-col-at s i)
|
||||
(let* ((cur (rdr-pos-cursor))
|
||||
(reuse (and (vector? cur) (eq? (vector-ref cur 0) s)
|
||||
|
|
|
|||
|
|
@ -247,7 +247,7 @@
|
|||
(guard (e (#t #f))
|
||||
(def-var! "jolt.backend-scheme" "dl-opt-out?" (letrec ((dl-opt-out? (lambda (m) (let fnrec7138 ((m m)) (let* ((or__26__auto (jolt-get m (keyword #f "dynamic")))) (if (jolt-truthy? or__26__auto) or__26__auto (jolt-get m (keyword #f "redef")))))))) dl-opt-out?)))
|
||||
(guard (e (#t #f))
|
||||
(def-var! "jolt.backend-scheme" "emit-top-form" (letrec ((emit-top-form (lambda (node) (let fnrec7139 ((node node)) (if (jolt-not (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.backend-scheme" "direct-link?"))) (jolt-invoke (var-deref "jolt.backend-scheme" "emit") node) (if (jolt= (keyword #f "do") (jolt-get node (keyword #f "op"))) (let* ((_a$7140 (var-deref "clojure.core" "str")) (_a$7141 "(begin ") (_a$7142 (jolt-invoke (var-deref "clojure.string" "join") " " (jolt-map emit-top-form (jolt-get node (keyword #f "statements"))))) (_a$7143 (if (jolt-empty? (jolt-get node (keyword #f "statements"))) "" " ")) (_a$7144 (jolt-invoke emit-top-form (jolt-get node (keyword #f "ret")))) (_a$7145 ")")) (jolt-invoke _a$7140 _a$7141 _a$7142 _a$7143 _a$7144 _a$7145)) (if (jolt-truthy? (let* ((and__25__auto (jolt= (keyword #f "def") (jolt-get node (keyword #f "op"))))) (if (jolt-truthy? and__25__auto) (let* ((and__25__auto (jolt-not (jolt-get node (keyword #f "no-init"))))) (if (jolt-truthy? and__25__auto) (jolt-not (jolt-invoke (var-deref "jolt.backend-scheme" "dl-opt-out?") (jolt-get node (keyword #f "meta")))) and__25__auto)) and__25__auto))) (let* ((ns (jolt-get node (keyword #f "ns"))) (nm (jolt-get node (keyword #f "name"))) (b (jolt-invoke (var-deref "jolt.backend-scheme" "dl-name") ns nm)) (fn? (jolt= (keyword #f "fn") (jolt-get (jolt-get node (keyword #f "init")) (keyword #f "op")))) (pos (jolt-get node (keyword #f "pos"))) (reg (if (jolt-truthy? (let* ((and__25__auto fn?)) (if (jolt-truthy? and__25__auto) pos and__25__auto))) (let* ((_a$7146 (var-deref "clojure.core" "str")) (_a$7147 " (jolt-register-source! ") (_a$7148 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-invoke (var-deref "jolt.backend-scheme" "munge-name") nm))) (_a$7149 " ") (_a$7150 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") ns)) (_a$7151 " ") (_a$7152 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") nm)) (_a$7153 " ") (_a$7154 (if (jolt-truthy? (jolt-get pos (keyword #f "file"))) (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get pos (keyword #f "file"))) "jolt-nil")) (_a$7155 " ") (_a$7156 (let* ((or__26__auto (jolt-get pos (keyword #f "line")))) (if (jolt-truthy? or__26__auto) or__26__auto 0))) (_a$7157 ")")) (jolt-invoke _a$7146 _a$7147 _a$7148 _a$7149 _a$7150 _a$7151 _a$7152 _a$7153 _a$7154 _a$7155 _a$7156 _a$7157)) jolt-nil))) (begin (jolt-invoke (var-deref "clojure.core" "swap!") (var-deref "jolt.backend-scheme" "direct-link-defined") jolt-conj (jolt-invoke (var-deref "jolt.backend-scheme" "dl-fqn") ns nm)) (if (jolt-truthy? fn?) (jolt-invoke (var-deref "clojure.core" "swap!") (var-deref "jolt.backend-scheme" "direct-link-fns") jolt-conj (jolt-invoke (var-deref "jolt.backend-scheme" "dl-fqn") ns nm)) jolt-nil) (let* ((init (jolt-invoke (var-deref "jolt.backend-scheme" "emit") (jolt-get node (keyword #f "init"))))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.backend-scheme" "jmeta-nonempty?") (jolt-get node (keyword #f "meta")))) (let* ((_a$7158 (var-deref "clojure.core" "str")) (_a$7159 "(begin (define ") (_a$7160 b) (_a$7161 " ") (_a$7162 init) (_a$7163 ") (def-var-with-meta! ") (_a$7164 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") ns)) (_a$7165 " ") (_a$7166 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") nm)) (_a$7167 " ") (_a$7168 b) (_a$7169 " ") (_a$7170 (jolt-invoke (var-deref "jolt.backend-scheme" "emit-def-meta") node)) (_a$7171 ")") (_a$7172 (let* ((or__26__auto reg)) (if (jolt-truthy? or__26__auto) or__26__auto ""))) (_a$7173 ")")) (jolt-invoke _a$7158 _a$7159 _a$7160 _a$7161 _a$7162 _a$7163 _a$7164 _a$7165 _a$7166 _a$7167 _a$7168 _a$7169 _a$7170 _a$7171 _a$7172 _a$7173)) (let* ((_a$7174 (var-deref "clojure.core" "str")) (_a$7175 "(begin (define ") (_a$7176 b) (_a$7177 " ") (_a$7178 init) (_a$7179 ") (def-var! ") (_a$7180 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") ns)) (_a$7181 " ") (_a$7182 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") nm)) (_a$7183 " ") (_a$7184 b) (_a$7185 ")") (_a$7186 (let* ((or__26__auto reg)) (if (jolt-truthy? or__26__auto) or__26__auto ""))) (_a$7187 ")")) (jolt-invoke _a$7174 _a$7175 _a$7176 _a$7177 _a$7178 _a$7179 _a$7180 _a$7181 _a$7182 _a$7183 _a$7184 _a$7185 _a$7186 _a$7187)))))) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit") node) jolt-nil)))))))) emit-top-form)))
|
||||
(def-var! "jolt.backend-scheme" "emit-top-form" (letrec ((emit-top-form (lambda (node) (let fnrec7139 ((node node)) (if (jolt-not (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.backend-scheme" "direct-link?"))) (jolt-invoke (var-deref "jolt.backend-scheme" "emit") node) (if (jolt= (keyword #f "do") (jolt-get node (keyword #f "op"))) (let* ((_a$7140 (var-deref "clojure.core" "str")) (_a$7141 "(begin ") (_a$7142 (jolt-invoke (var-deref "clojure.string" "join") " " (jolt-map emit-top-form (jolt-get node (keyword #f "statements"))))) (_a$7143 (if (jolt-empty? (jolt-get node (keyword #f "statements"))) "" " ")) (_a$7144 (jolt-invoke emit-top-form (jolt-get node (keyword #f "ret")))) (_a$7145 ")")) (jolt-invoke _a$7140 _a$7141 _a$7142 _a$7143 _a$7144 _a$7145)) (if (jolt-truthy? (let* ((and__25__auto (jolt= (keyword #f "def") (jolt-get node (keyword #f "op"))))) (if (jolt-truthy? and__25__auto) (let* ((and__25__auto (jolt-not (jolt-get node (keyword #f "no-init"))))) (if (jolt-truthy? and__25__auto) (jolt-not (jolt-invoke (var-deref "jolt.backend-scheme" "dl-opt-out?") (jolt-get node (keyword #f "meta")))) and__25__auto)) and__25__auto))) (let* ((ns (jolt-get node (keyword #f "ns"))) (nm (jolt-get node (keyword #f "name"))) (b (jolt-invoke (var-deref "jolt.backend-scheme" "dl-name") ns nm)) (fn? (jolt= (keyword #f "fn") (jolt-get (jolt-get node (keyword #f "init")) (keyword #f "op")))) (pos (jolt-get node (keyword #f "pos"))) (frame-name (if (jolt-truthy? fn?) (let* ((temp__16__auto (jolt-get (jolt-get node (keyword #f "init")) (keyword #f "name")))) (if (jolt-truthy? temp__16__auto) (let* ((fnm temp__16__auto)) (jolt-invoke (var-deref "jolt.backend-scheme" "munge-name") fnm)) b)) jolt-nil)) (reg (if (jolt-truthy? (let* ((and__25__auto fn?)) (if (jolt-truthy? and__25__auto) pos and__25__auto))) (let* ((_a$7146 (var-deref "clojure.core" "str")) (_a$7147 " (jolt-register-source! ") (_a$7148 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") frame-name)) (_a$7149 " ") (_a$7150 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") ns)) (_a$7151 " ") (_a$7152 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") nm)) (_a$7153 " ") (_a$7154 (if (jolt-truthy? (jolt-get pos (keyword #f "file"))) (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get pos (keyword #f "file"))) "jolt-nil")) (_a$7155 " ") (_a$7156 (let* ((or__26__auto (jolt-get pos (keyword #f "line")))) (if (jolt-truthy? or__26__auto) or__26__auto 0))) (_a$7157 ")")) (jolt-invoke _a$7146 _a$7147 _a$7148 _a$7149 _a$7150 _a$7151 _a$7152 _a$7153 _a$7154 _a$7155 _a$7156 _a$7157)) jolt-nil))) (begin (jolt-invoke (var-deref "clojure.core" "swap!") (var-deref "jolt.backend-scheme" "direct-link-defined") jolt-conj (jolt-invoke (var-deref "jolt.backend-scheme" "dl-fqn") ns nm)) (if (jolt-truthy? fn?) (jolt-invoke (var-deref "clojure.core" "swap!") (var-deref "jolt.backend-scheme" "direct-link-fns") jolt-conj (jolt-invoke (var-deref "jolt.backend-scheme" "dl-fqn") ns nm)) jolt-nil) (let* ((init (jolt-invoke (var-deref "jolt.backend-scheme" "emit") (jolt-get node (keyword #f "init"))))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.backend-scheme" "jmeta-nonempty?") (jolt-get node (keyword #f "meta")))) (let* ((_a$7158 (var-deref "clojure.core" "str")) (_a$7159 "(begin (define ") (_a$7160 b) (_a$7161 " ") (_a$7162 init) (_a$7163 ") (def-var-with-meta! ") (_a$7164 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") ns)) (_a$7165 " ") (_a$7166 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") nm)) (_a$7167 " ") (_a$7168 b) (_a$7169 " ") (_a$7170 (jolt-invoke (var-deref "jolt.backend-scheme" "emit-def-meta") node)) (_a$7171 ")") (_a$7172 (let* ((or__26__auto reg)) (if (jolt-truthy? or__26__auto) or__26__auto ""))) (_a$7173 ")")) (jolt-invoke _a$7158 _a$7159 _a$7160 _a$7161 _a$7162 _a$7163 _a$7164 _a$7165 _a$7166 _a$7167 _a$7168 _a$7169 _a$7170 _a$7171 _a$7172 _a$7173)) (let* ((_a$7174 (var-deref "clojure.core" "str")) (_a$7175 "(begin (define ") (_a$7176 b) (_a$7177 " ") (_a$7178 init) (_a$7179 ") (def-var! ") (_a$7180 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") ns)) (_a$7181 " ") (_a$7182 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") nm)) (_a$7183 " ") (_a$7184 b) (_a$7185 ")") (_a$7186 (let* ((or__26__auto reg)) (if (jolt-truthy? or__26__auto) or__26__auto ""))) (_a$7187 ")")) (jolt-invoke _a$7174 _a$7175 _a$7176 _a$7177 _a$7178 _a$7179 _a$7180 _a$7181 _a$7182 _a$7183 _a$7184 _a$7185 _a$7186 _a$7187)))))) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit") node) jolt-nil)))))))) emit-top-form)))
|
||||
(guard (e (#t #f))
|
||||
(def-var-with-meta! "jolt.passes.fold" "foldable" (let* ((_o$7188 "+") (_o$7189 jolt-add) (_o$7190 "-") (_o$7191 jolt-sub) (_o$7192 "*") (_o$7193 jolt-mul) (_o$7194 "/") (_o$7195 jolt-div) (_o$7196 "<") (_o$7197 <) (_o$7198 ">") (_o$7199 >) (_o$7200 "<=") (_o$7201 <=) (_o$7202 ">=") (_o$7203 >=) (_o$7204 "=") (_o$7205 jolt=) (_o$7206 "inc") (_o$7207 jolt-inc) (_o$7208 "dec") (_o$7209 jolt-dec) (_o$7210 "mod") (_o$7211 modulo) (_o$7212 "rem") (_o$7213 remainder) (_o$7214 "quot") (_o$7215 quotient) (_o$7216 "bit-and") (_o$7217 (var-deref "clojure.core" "__bit-and")) (_o$7218 "bit-or") (_o$7219 (var-deref "clojure.core" "__bit-or")) (_o$7220 "bit-xor") (_o$7221 (var-deref "clojure.core" "__bit-xor"))) (jolt-hash-map _o$7188 _o$7189 _o$7190 _o$7191 _o$7192 _o$7193 _o$7194 _o$7195 _o$7196 _o$7197 _o$7198 _o$7199 _o$7200 _o$7201 _o$7202 _o$7203 _o$7204 _o$7205 _o$7206 _o$7207 _o$7208 _o$7209 _o$7210 _o$7211 _o$7212 _o$7213 _o$7214 _o$7215 _o$7216 _o$7217 _o$7218 _o$7219 _o$7220 _o$7221)) (let* ((_o$7222 (keyword #f "private")) (_o$7223 #t)) (jolt-hash-map _o$7222 _o$7223))))
|
||||
(guard (e (#t #f))
|
||||
|
|
|
|||
|
|
@ -57,19 +57,21 @@
|
|||
;; (frame-name . record) pairs, where record is #(ns name file line) or the symbol
|
||||
;; 'ambiguous. Unmapped frames (host spine, anonymous lambdas) are skipped; raw
|
||||
;; depth is capped.
|
||||
(define srcreg-debug? (getenv "JOLT_DEBUG_FRAMES"))
|
||||
(define (jolt-frame-records k)
|
||||
(guard (e (#t '()))
|
||||
;; 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.
|
||||
(let ((debug? (getenv "JOLT_DEBUG_FRAMES")))
|
||||
(guard (e (#t '()))
|
||||
(let loop ((io (inspect/object k)) (n 0) (acc '()))
|
||||
(if (or (not io) (fx>=? n 400))
|
||||
(reverse acc)
|
||||
(let* ((nm (srcreg-frame-name io))
|
||||
(src (and nm (hashtable-ref source-registry nm #f))))
|
||||
(when (and srcreg-debug? nm)
|
||||
(when (and debug? nm)
|
||||
(display (string-append " [frame] " nm (if src " *MAPPED*" "") "\n")
|
||||
(current-error-port)))
|
||||
(loop (guard (e (#t #f)) (io 'link)) (fx+ n 1)
|
||||
(if src (cons (cons nm src) acc) acc)))))))
|
||||
(if src (cons (cons nm src) acc) acc))))))))
|
||||
|
||||
;; Multi-line backtrace for an uncaught value — " ns/name (file:line)" for a
|
||||
;; mapped frame, the bare frame name for an ambiguous one — or #f when no jolt
|
||||
|
|
|
|||
|
|
@ -676,13 +676,17 @@
|
|||
(and (= :def (:op node)) (not (:no-init node)) (not (dl-opt-out? (:meta node))))
|
||||
(let [ns (:ns node) nm (:name node) b (dl-name ns nm)
|
||||
fn? (= :fn (:op (:init node)))
|
||||
;; A named fn def gets a source-registry entry so a native backtrace can
|
||||
;; map its frame to ns/name (file:line). Chez names a frame by the fn's
|
||||
;; SHORT self-binding (emit-fn's letrec name = munge-name), not jv$ns$name,
|
||||
;; so register under that. Non-fn defs are not procedures.
|
||||
;; A fn def gets a source-registry entry so a native backtrace can map its
|
||||
;; frame to ns/name (file:line). Chez names the frame by whatever emit-fn
|
||||
;; binds the lambda to: a NAMED fn (defn, or (fn foo …)) gets a letrec
|
||||
;; self-binding = munge-name of the fn's own name; an ANONYMOUS fn def has
|
||||
;; no letrec, so the lambda sits directly under (define jv$ns$name …) and
|
||||
;; takes that name. Register under whichever Chez will report.
|
||||
pos (:pos node)
|
||||
frame-name (when fn?
|
||||
(if-let [fnm (:name (:init node))] (munge-name fnm) b))
|
||||
reg (when (and fn? pos)
|
||||
(str " (jolt-register-source! " (chez-str-lit (munge-name nm)) " "
|
||||
(str " (jolt-register-source! " (chez-str-lit frame-name) " "
|
||||
(chez-str-lit ns) " " (chez-str-lit nm) " "
|
||||
(if (get pos :file) (chez-str-lit (get pos :file)) "jolt-nil") " "
|
||||
(or (get pos :line) 0) ")"))]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue