From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Tue, 8 Aug 1995 15:31:05 +0000 (+0000)
Subject: Added WITH-TIMINGS, a general procedure timing device.
X-Git-Tag: 20090517-FFI~6055
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=0c41dbf8af0c7e48a42ae55ef0b94e5335c40a7a;p=mit-scheme.git

Added WITH-TIMINGS, a general procedure timing device.
---

diff --git a/v7/src/runtime/sysclk.scm b/v7/src/runtime/sysclk.scm
index 45397af78..10e7473a5 100644
--- a/v7/src/runtime/sysclk.scm
+++ b/v7/src/runtime/sysclk.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/sysclk.scm,v 14.2 1989/11/28 01:28:19 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/sysclk.scm,v 14.3 1995/08/08 15:31:05 adams Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -78,4 +78,20 @@ MIT in each case. |#
   (/ (exact->inexact ticks) 1000))
 
 (define (internal-time/seconds->ticks seconds)
-  (round->exact (* seconds 1000)))
\ No newline at end of file
+  (round->exact (* seconds 1000)))
+
+(define (with-timings thunk receiver)
+  (let ((process-start  (process-time-clock))
+	(gc-time-start  non-runtime)
+	(real-start     (real-time-clock)))
+    (let ((value (thunk)))
+      (let ((process-end  (process-time-clock))
+	    (gc-time-end  non-runtime)
+	    (real-end     (real-time-clock)))
+	(let ((process-time (- process-end process-start))
+	      (gc-time      (- gc-time-end gc-time-start))
+	      (real-time    (- real-end real-start)))
+	  (receiver (- process-time gc-time)
+		    gc-time
+		    real-time)
+	  value)))))
\ No newline at end of file