Hi all,

I noticed that the interpreter got quite a bit slower due to fetching
the line number information for an expression when emitting info into
the trace buffer.  Attached is an additional patch to bring things back
to our original performance by pre-fetching the line number info and
passing it as an additional argument to emit-trace-info.

Patch has also been pushed to the line-numbers-in-csi branch.

Cheers,
Peter
From df10eb66dc22a1538bdab4ceafd3f15812c18842 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Sun, 25 Jun 2023 10:22:01 +0200
Subject: [PATCH] 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.
---
 eval.scm | 19 ++++++++++---------
 1 file changed, 10 insertions(+), 9 deletions(-)

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?) ) ) )
-- 
2.40.1

Attachment: signature.asc
Description: PGP signature

Reply via email to