From: Taylor R Campbell <campbell@mumble.net>
Date: Sun, 6 Jan 2019 04:14:01 +0000 (+0000)
Subject: Dust off stack sampler.
X-Git-Tag: mit-scheme-pucked-10.1.10~6^2~18
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=de3dd56418b9e124aa9a51e4bd6bbcc6ba30aee7;p=mit-scheme.git

Dust off stack sampler.

Use of compiled-code-address? will be needed by the
riastrah-20181220-closentry{...} branch.
---

diff --git a/src/runtime/stack-sample.scm b/src/runtime/stack-sample.scm
index ebe350bbe..834f4469f 100644
--- a/src/runtime/stack-sample.scm
+++ b/src/runtime/stack-sample.scm
@@ -78,9 +78,6 @@
 
 ;;;; Miscellaneous Kludgerosity
 
-(define (compiled-entry? object)
-  (object-type? (ucode-type compiled-entry) object))
-
 (define event-return-address 'uninitialized)
 
 (define (initialize-package!)
@@ -181,8 +178,8 @@
          (if (eq? stack-frame-type/compiled-return-address
                   (stack-frame/type stack-frame))
              (parameterize ((stack-sampling-return-address
-			     (stack-frame/return-address stack-frame)))
-	       (thunk))
+                             (stack-frame/return-address stack-frame)))
+               (thunk))
              (thunk)))))))
 
 ;;;; Profile Data
@@ -231,7 +228,7 @@
           (else (find-subproblem stack-frame)))))
 
 (define (find-subproblem stack-frame)
-  (if (compiled-entry? (stack-frame/return-address stack-frame))
+  (if (compiled-code-address? (stack-frame/return-address stack-frame))
       stack-frame
       (find-next-subproblem stack-frame)))
 
@@ -254,7 +251,7 @@
 
 (define (intern-entry profile stack-frame)
   (let ((return-address (stack-frame/return-address stack-frame)))
-    (if (compiled-entry? return-address)
+    (if (compiled-code-address? return-address)
         (let ((return-address
                (if (compiled-closure? return-address)
                    (compiled-closure->entry return-address)
@@ -289,7 +286,7 @@
   (let ((entries (hash-table-values (profile.entries profile))))
     (define (sortem entry.count)
       (sort (remove (lambda (e) (zero? (entry.count e)))
-		    entries)
+                    entries)
             (lambda (a b) (< (entry.count a) (entry.count b)))))
     (let ((sampled (sortem entry.sampled-count))
           (waiting (sortem entry.waiting-count)))
@@ -397,9 +394,9 @@
 (define (profile-pp expression output-port)
   ;; Random parametrization.
   (parameterize ((param:printer-list-breadth-limit 5)
-		 (param:printer-list-depth-limit 3)
-		 (param:printer-string-length-limit 40)
-		 (param:print-primitives-by-name? #t)
-		 (param:pp-save-vertical-space? #t)
-		 (param:pp-default-as-code? #t))
+                 (param:printer-list-depth-limit 3)
+                 (param:printer-string-length-limit 40)
+                 (param:print-primitives-by-name? #t)
+                 (param:pp-save-vertical-space? #t)
+                 (param:pp-default-as-code? #t))
     (pp expression output-port)))
\ No newline at end of file