From 0c41dbf8af0c7e48a42ae55ef0b94e5335c40a7a Mon Sep 17 00:00:00 2001 From: Stephen Adams Date: Tue, 8 Aug 1995 15:31:05 +0000 Subject: [PATCH] Added WITH-TIMINGS, a general procedure timing device. --- v7/src/runtime/sysclk.scm | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) 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 -- 2.25.1