~ chicken-core (chicken-5) df10eb66dc22a1538bdab4ceafd3f15812c18842
commit df10eb66dc22a1538bdab4ceafd3f15812c18842
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Sun Jun 25 10:22:01 2023 +0200
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Sun Jun 25 10:22:01 2023 +0200
Fetch line number from info in evaluator before compiling applications
Emitting trace information should be as cheap as possible, it is
called many times during a program's execution (upon every procedure
application). The get-line-number call would slow things down by a
factor of almost 2. Instead, retrieve the line number at closure
compilation time and pass it directly to emit-trace-info.
diff --git a/eval.scm b/eval.scm
index 9a69e051..7fa72028 100644
--- a/eval.scm
+++ b/eval.scm
@@ -109,11 +109,11 @@
((eq? x (##sys#slot lst 0)) i)
(else (loop (##sys#slot lst 1) (fx+ i 1))) ) ) )
- (define (emit-trace-info tf info cntr e v)
+ (define (emit-trace-info tf ln info cntr e v)
(when tf
(##core#inline
"C_emit_trace_info"
- (or (get-line-number info) "<eval>")
+ ln
info
(##sys#make-structure 'frameinfo cntr e v)
(thread-id ##sys#current-thread) ) ) )
@@ -689,37 +689,38 @@
(compile (##sys#slot x 0) e #f tf cntr #f)))
(args (##sys#slot x 1))
(argc (checked-length args))
- (info x) )
+ (info x)
+ (ln (or (get-line-number info) "<eval>")))
(case argc
((#f) (##sys#syntax-error/context "malformed expression" x))
((0) (lambda (v)
- (emit-trace-info tf info cntr e v)
+ (emit-trace-info tf ln info cntr e v)
((##core#app fn v))))
((1) (let ((a1 (compile (##sys#slot args 0) e #f tf cntr #f)))
(lambda (v)
- (emit-trace-info tf info cntr e v)
+ (emit-trace-info tf ln info cntr e v)
((##core#app fn v) (##core#app a1 v))) ) )
((2) (let* ((a1 (compile (##sys#slot args 0) e #f tf cntr #f))
(a2 (compile (##core#inline "C_u_i_list_ref" args 1) e #f tf cntr #f)) )
(lambda (v)
- (emit-trace-info tf info cntr e v)
+ (emit-trace-info tf ln info cntr e v)
((##core#app fn v) (##core#app a1 v) (##core#app a2 v))) ) )
((3) (let* ((a1 (compile (##sys#slot args 0) e #f tf cntr #f))
(a2 (compile (##core#inline "C_u_i_list_ref" args 1) e #f tf cntr #f))
(a3 (compile (##core#inline "C_u_i_list_ref" args 2) e #f tf cntr #f)) )
(lambda (v)
- (emit-trace-info tf info cntr e v)
+ (emit-trace-info tf ln info cntr e v)
((##core#app fn v) (##core#app a1 v) (##core#app a2 v) (##core#app a3 v))) ) )
((4) (let* ((a1 (compile (##sys#slot args 0) e #f tf cntr #f))
(a2 (compile (##core#inline "C_u_i_list_ref" args 1) e #f tf cntr #f))
(a3 (compile (##core#inline "C_u_i_list_ref" args 2) e #f tf cntr #f))
(a4 (compile (##core#inline "C_u_i_list_ref" args 3) e #f tf cntr #f)) )
(lambda (v)
- (emit-trace-info tf info cntr e v)
+ (emit-trace-info tf ln info cntr e v)
((##core#app fn v) (##core#app a1 v) (##core#app a2 v) (##core#app a3 v) (##core#app a4 v))) ) )
(else (let ((as (##sys#map (lambda (a) (compile a e #f tf cntr #f)) args)))
(lambda (v)
- (emit-trace-info tf info cntr e v)
+ (emit-trace-info tf ln info cntr e v)
(apply (##core#app fn v) (##sys#map (lambda (a) (##core#app a v)) as))) ) ) ) ) )
(compile exp env #f (fx> (##sys#eval-debug-level) 0) cntr tl?) ) ) )
Trap