~ chicken-core (chicken-5) af40e01b20b4949c8da325843d0651c49e618389
commit af40e01b20b4949c8da325843d0651c49e618389
Author: felix <bunny351@gmail.com>
AuthorDate: Tue May 4 08:52:32 2010 +0200
Commit: felix <bunny351@gmail.com>
CommitDate: Tue May 4 08:52:32 2010 +0200
time macro writes to stdout, moved ##sys#display-times into library unit, compresses output of time macro a little
diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index 3ee16eea..56fc6563 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -128,9 +128,10 @@
(##sys#start-timer)
(##sys#call-with-values
(##core#lambda () ,@(cdr form))
- (##core#lambda ,rvar
- (##sys#display-times (##sys#stop-timer))
- (##sys#apply ##sys#values ,rvar) ) ) ) ) ) ) )
+ (##core#lambda
+ ,rvar
+ (##sys#display-times (##sys#stop-timer))
+ (##sys#apply ##sys#values ,rvar) ) ) ) ) ) ) )
(##sys#extend-macro-environment
'declare '()
diff --git a/eval.scm b/eval.scm
index 1a901601..f1e1ebc3 100644
--- a/eval.scm
+++ b/eval.scm
@@ -1498,34 +1498,6 @@
(else (loop (##sys#slot paths 1))) ) ) ) ) ) )
-;;; Print timing information (support for "time" macro):
-
-(define ##sys#display-times
- (let* ((display display)
- (spaces
- (lambda (n)
- (do ((i n (fx- i 1)))
- ((fx<= i 0))
- (display #\space) ) ) )
- (display-rj
- (lambda (x w)
- (let* ((xs (if (zero? x) "0" (number->string x)))
- (xslen (##core#inline "C_block_size" xs)) )
- (spaces (fx- w xslen))
- (display xs) ) ) ) )
- (lambda (info)
- (display-rj (##sys#slot info 0) 8)
- (display " seconds elapsed\n")
- (display-rj (##sys#slot info 1) 8)
- (display " seconds in (major) GC\n")
- (display-rj (##sys#slot info 2) 8)
- (display " mutations\n")
- (display-rj (##sys#slot info 3) 8)
- (display " minor GCs\n")
- (display-rj (##sys#slot info 4) 8)
- (display " major GCs\n") ) ) )
-
-
;;; SRFI-0 support code:
(set! ##sys#features
diff --git a/library.scm b/library.scm
index c2137a8e..40879434 100644
--- a/library.scm
+++ b/library.scm
@@ -246,7 +246,11 @@ EOF
(define ##sys#decode-seconds (##core#primitive "C_decode_seconds"))
(define get-environment-variable (##core#primitive "C_get_environment_variable"))
(define getenv get-environment-variable) ; DEPRECATED
-(define (##sys#start-timer) (##core#inline "C_start_timer"))
+
+(define (##sys#start-timer)
+ (##sys#gc #t)
+ (##core#inline "C_start_timer"))
+
(define ##sys#stop-timer (##core#primitive "C_stop_timer"))
(define (##sys#immediate? x) (not (##core#inline "C_blockp" x)))
(define (##sys#message str) (##core#inline "C_message" str))
@@ -4624,3 +4628,22 @@ EOF
(if (memq prop props)
(values prop (##sys#slot tl 0) nxt)
(loop nxt) ) ) ) ) )
+
+
+;;; Print timing information (support for "time" macro):
+
+(define (##sys#display-times info)
+ (define (pstr str) (##sys#print str #f ##sys#standard-error))
+ (define (pnum num)
+ (##sys#print (if (zero? num) "0" (##sys#number->string num)) #f ##sys#standard-error))
+ (##sys#flush-output ##sys#standard-output)
+ (pnum (##sys#slot info 0))
+ (pstr "s elapsed, ")
+ (pnum (##sys#slot info 1))
+ (pstr "s (major) GC, ")
+ (pnum (##sys#slot info 2))
+ (pstr " mutations, GCs: ")
+ (pnum (##sys#slot info 3))
+ (pstr " minor, ")
+ (pnum (##sys#slot info 4))
+ (pstr " major\n") )
Trap