Change time reports to match compiler.

diff --git a/v7/src/sf/make.scm b/v7/src/sf/make.scm
index 1e7cff184079867ee88e9049e1d3838382abb192..e1eadd89e0bee824d7b06c0f4b76bc458eac242e 100644 (file)
--- a/v7/src/sf/make.scm
+++ b/v7/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 4.1 1988/03/25 20:50:11 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 4.2 1988/03/30 21:56:15 cph Rel $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -61,9 +61,12 @@ MIT in each case. |#
     (make-environment
       (define :name "SF")
       (define :version 4)
-      (define :modification 0)
+      (define :modification 2)
       (define :files)
 
+      (define :rcs-header              ;RCS sets up this string.
+       "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 4.2 1988/03/30 21:56:15 cph Rel $")
+
       (define :files-lists
        (list
         (cons system-global-environment

diff --git a/v7/src/sf/toplev.scm b/v7/src/sf/toplev.scm
index 58c8ae8892fcc68fffe5b11b6dcf40bc4c9a686b..b5d144800ca13a166c52dd1a4b4a9ce15736283d 100644 (file)
--- a/v7/src/sf/toplev.scm
+++ b/v7/src/sf/toplev.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/toplev.scm,v 3.6 1988/03/22 17:40:18 jrm Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/toplev.scm,v 3.7 1988/03/30 21:54:08 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -275,10 +275,10 @@ Currently only the 68000 implementation needs this."
          expression))))
 
 (define (integrate/kernel get-scode declarations)
-  (fluid-let ((previous-real-time      false)
-             (previous-process-time    false)
-             (previous-name            false)
-             (events                    '()))
+  (fluid-let ((previous-name false)
+             (previous-process-time false)
+             (previous-real-time false)
+             (events '()))
     (transmit-values
        (transmit-values
            (transmit-values
@@ -322,31 +322,37 @@ Currently only the 68000 implementation needs this."
   (return-2 (operations->external operations environment)
            (cgen/expression expression)))
 
-(define previous-real-time)
-(define previous-process-time)
 (define previous-name)
+(define previous-process-time)
+(define previous-real-time)
 (define events)
 
 (define (mark-phase this-name)
   (end-phase)
   (newline)
-  (write-string "    ")
+  (write-string "      ")
   (write-string this-name)
   (write-string "...")
   (set! previous-name this-name))
 
 (define (end-phase)
-  (let ((this-time (real-time-clock))
-       (this-process-time (runtime)))
-    (if previous-real-time
-       (let ((dt (- this-time previous-real-time))
-             (dpt (- this-process-time previous-process-time)))
-         (set! events (cons (cons previous-name dt) events))
-         (newline)
-         (write-string "    Time: ")
-         (write (floor (/ dt 1000.)))
-         (write-string " seconds (real); ")
-         (write dpt)
-         (write-string " seconds (process).")))
+  (let ((this-process-time (runtime))
+       (this-real-time (real-time-clock)))
+    (if previous-process-time
+       (let ((delta-process-time (- this-process-time previous-process-time)))
+         (set! events (cons (cons previous-name delta-process-time) events))
+         (time-report "      Time taken"
+                      delta-process-time
+                      (- this-real-time previous-real-time))))
     (set! previous-real-time this-time)
-    (set! previous-process-time this-process-time)))
\ No newline at end of file
+    (set! previous-process-time this-process-time)))
+
+;; Should match the compiler.  We'll merge the two at some point.
+(define (time-report prefix process-time real-time)
+  (newline)
+  (write-string prefix)
+  (write-string ": ")
+  (write (/ process-time 1000))
+  (write-string " (process time); ")
+  (write (/ real-time 1000))
+  (write-string " (real time)"))
\ No newline at end of file

diff --git a/v8/src/sf/toplev.scm b/v8/src/sf/toplev.scm
index 1f1553c91cc5a444c1dbba4e092d2edc56853d62..27a295e73001796318fad4055482e37652b42df8 100644 (file)
--- a/v8/src/sf/toplev.scm
+++ b/v8/src/sf/toplev.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/toplev.scm,v 3.6 1988/03/22 17:40:18 jrm Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/toplev.scm,v 3.7 1988/03/30 21:54:08 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -275,10 +275,10 @@ Currently only the 68000 implementation needs this."
          expression))))
 
 (define (integrate/kernel get-scode declarations)
-  (fluid-let ((previous-real-time      false)
-             (previous-process-time    false)
-             (previous-name            false)
-             (events                    '()))
+  (fluid-let ((previous-name false)
+             (previous-process-time false)
+             (previous-real-time false)
+             (events '()))
     (transmit-values
        (transmit-values
            (transmit-values
@@ -322,31 +322,37 @@ Currently only the 68000 implementation needs this."
   (return-2 (operations->external operations environment)
            (cgen/expression expression)))
 
-(define previous-real-time)
-(define previous-process-time)
 (define previous-name)
+(define previous-process-time)
+(define previous-real-time)
 (define events)
 
 (define (mark-phase this-name)
   (end-phase)
   (newline)
-  (write-string "    ")
+  (write-string "      ")
   (write-string this-name)
   (write-string "...")
   (set! previous-name this-name))
 
 (define (end-phase)
-  (let ((this-time (real-time-clock))
-       (this-process-time (runtime)))
-    (if previous-real-time
-       (let ((dt (- this-time previous-real-time))
-             (dpt (- this-process-time previous-process-time)))
-         (set! events (cons (cons previous-name dt) events))
-         (newline)
-         (write-string "    Time: ")
-         (write (floor (/ dt 1000.)))
-         (write-string " seconds (real); ")
-         (write dpt)
-         (write-string " seconds (process).")))
+  (let ((this-process-time (runtime))
+       (this-real-time (real-time-clock)))
+    (if previous-process-time
+       (let ((delta-process-time (- this-process-time previous-process-time)))
+         (set! events (cons (cons previous-name delta-process-time) events))
+         (time-report "      Time taken"
+                      delta-process-time
+                      (- this-real-time previous-real-time))))
     (set! previous-real-time this-time)
-    (set! previous-process-time this-process-time)))
\ No newline at end of file
+    (set! previous-process-time this-process-time)))
+
+;; Should match the compiler.  We'll merge the two at some point.
+(define (time-report prefix process-time real-time)
+  (newline)
+  (write-string prefix)
+  (write-string ": ")
+  (write (/ process-time 1000))
+  (write-string " (process time); ")
+  (write (/ real-time 1000))
+  (write-string " (real time)"))
\ No newline at end of file