Make number of topmost frames with expressions shown configurable.

(cherry picked from commit 40b38b004302f7f23024f0ea220e8bad3fa00688)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 95462cd62bd8d8a92b2d2bf353746fb88373b31f..7830e68afe0f85a51a1d8286afb64c8653d9ddbd 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -5851,7 +5851,7 @@ USA.
   (parent (runtime))
   (export ()
          stack-sampler:debug-internal-errors?
-         stack-sampler:show-expressions?
+         stack-sampler:topmost-expressions
          with-stack-sampling)
   (initialization (initialize-package!)))
 

diff --git a/src/runtime/stack-sample.scm b/src/runtime/stack-sample.scm
index 9594c21c24d10c99f610e292a4b80fff3351d665..04b864098d4358a93fc6da20520a6c6c80b65b1b 100644 (file)
--- a/src/runtime/stack-sample.scm
+++ b/src/runtime/stack-sample.scm
@@ -96,7 +96,7 @@
         (unblock-thread-events))))
 
 (define stack-sampler:debug-internal-errors? #f)
-(define stack-sampler:show-expressions? #t)
+(define stack-sampler:topmost-expressions 2)
 \f
 ;;;; Running with Stack Sampling
 
@@ -284,11 +284,12 @@
                 (let loop ((pframes pframes))
                   (let ((pframe (car pframes)))
                     (display-pframe pframe output-port)
-                    (if (pair? (cdr pframes))
-                        (loop (cdr pframes))
-                        (show-expression (pframe.expression pframe)
+                   (if (<= (length pframes) stack-sampler:topmost-expressions)
+                       (show-expression (pframe.expression pframe)
                                          (pframe.subexpression pframe)
-                                         output-port))))
+                                         output-port))
+                    (if (pair? (cdr pframes))
+                        (loop (cdr pframes)))))
                 (write count output-port)
                 (newline output-port)))
             (sort (hash-table->alist (profile.histogram profile))
@@ -296,6 +297,7 @@
                     (< (cdr a) (cdr b))))))
 
 (define (display-pframe pframe output-port)
+  (display "-> " output-port)
   (let ((environment-names (pframe.environment-names pframe)))
     (if (pair? environment-names)
         (show-environment-names environment-names output-port)