From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Wed, 20 Jul 2011 15:29:34 +0000 (-0700)
Subject: Reformat trace messages a wee bit.
X-Git-Tag: mit-scheme-pucked-9.2.12~681
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=791d0383f5fd97012313b8cc90a88145b2554048;p=mit-scheme.git

Reformat trace messages a wee bit.
---

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 9175a8d02..8c6bce041 100644
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -246,6 +246,7 @@ USA.
   (without-interrupts %suspend-current-thread))
 
 (define (%suspend-current-thread)
+  (%trace ";%suspend-current-thread: "first-running-thread"\n")
   (call-with-current-thread #f
     (lambda (thread)
       (let ((fp-env (flo:environment))
@@ -299,7 +300,7 @@ USA.
   ;; Preserve the floating-point environment here to guarantee that the
   ;; thread timer won't raise or clear exceptions (particularly the
   ;; inexact result exception) that the interrupted thread cares about.
-  (%trace ";Thread timer: interrupt in "first-running-thread"\n")
+  (%trace ";thread-timer: interrupt in "first-running-thread"\n")
   (let ((fp-env (flo:environment)))
     (flo:set-environment! (flo:default-environment))
     (set! next-scheduled-timeout #f)
@@ -307,20 +308,19 @@ USA.
     (deliver-timer-events)
     (maybe-signal-io-thread-events)
     (let ((thread first-running-thread))
-      (%trace ";Thread timer: first runnable: "thread".\n")
       (cond ((not thread)
 	     (%maybe-toggle-thread-timer)
-	     (%trace ";Thread timer: continuing with timer set for "
-		    next-scheduled-timeout".\n"))
+	     (%trace ";thread-timer: continuing with timer set for "
+		     next-scheduled-timeout"\n"))
 	    ((thread/continuation thread)
-	     (%trace ";Thread timer: switching to "thread".\n")
+	     (%trace ";thread-timer: switching to "thread"\n")
 	     (run-thread thread))
 	    ((not (eq? 'RUNNING-WITHOUT-PREEMPTION
 		       (thread/execution-state thread)))
-	     (%trace ";Thread timer: yielding to "(thread/next thread)".\n")
+	     (%trace ";thread-timer: yielding "thread" to "(thread/next thread)"\n")
 	     (yield-thread thread fp-env))
 	    (else
-	     (%trace ";Thread timer: continuing with "thread".\n")
+	     (%trace ";thread-timer: continuing with "thread"\n")
 	     (flo:set-environment! fp-env)
 	     (%resume-current-thread thread))))))
 
@@ -343,6 +343,7 @@ USA.
 
 (define (yield-thread thread #!optional fp-env)
   (let ((next (thread/next thread)))
+    (%trace ";yield-thread: "thread" yields to "next"\n")
     (if (not next)
 	(begin
 	  (if (not (default-object? fp-env))
@@ -359,11 +360,11 @@ USA.
 	   (set-thread/next! last-running-thread thread)
 	   (set! last-running-thread thread)
 	   (set! first-running-thread next)
-	   (%trace ";yield-thread: "thread" yields to "next"\n")
 	   (run-thread next))))))
 
 (define (exit-current-thread value)
   (let ((thread (current-thread)))
+    (%trace ";exit-current-thread: "thread" with "value"\n")
     (set-interrupt-enables! interrupt-mask/gc-ok)
     (set-thread/block-events?! thread #t)
     (ring/discard-all (thread/pending-events thread))
@@ -514,10 +515,12 @@ USA.
 				  '#(READ)))))
 
 (define (maybe-signal-io-thread-events)
+  (%trace ";maybe-signal-io-thread-events")
   (if io-registrations
       (let ((result (test-select-registry io-registry #f)))
-	(%trace "maybe-signal-io-thread-events: "result" "io-registry"\n")
-	(signal-select-result result))))
+	(%trace " => "(and result (vector-ref result 0))"\n")
+	(signal-select-result result))
+      (%trace " => 0\n")))
 
 (define (block-on-io-descriptor descriptor mode)
   (without-interrupts
@@ -1018,6 +1021,7 @@ USA.
   (dynamic-wind %stop-thread-timer thunk %maybe-toggle-thread-timer))
 
 (define (%maybe-toggle-thread-timer #!optional consider-non-timers?)
+  (%trace ";%maybe-toggle-thread-timer "consider-non-timers?"\n")
   (let ((now (real-time-clock)))
     (let ((start
 	   (lambda (time)