From: Taylor R Campbell <campbell@mumble.net>
Date: Wed, 29 May 2019 16:14:43 +0000 (+0000)
Subject: Make number of topmost frames with expressions shown configurable.
X-Git-Tag: mit-scheme-pucked-10.1.11~6^2~12
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=40b38b004302f7f23024f0ea220e8bad3fa00688;p=mit-scheme.git

Make number of topmost frames with expressions shown configurable.
---

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index f3aca8325..145ed4b58 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -5961,7 +5961,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 9594c21c2..04b864098 100644
--- 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)
 
 ;;;; 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)