summaryrefslogtreecommitdiff
path: root/module/system
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-07-25 18:26:37 +0200
committerAndy Wingo <wingo@pobox.com>2011-07-25 18:26:37 +0200
commitab4bc85398a14b62b58694bab83c63be286b2fd5 (patch)
tree84bfe7b0b6064016bcfadb76ec95d07410654fe8 /module/system
parentf29c300507da21a667f5b82e75300f8009eab9cc (diff)
parentf4b7d918eff9770f09893b023fd834f5c0bc33d1 (diff)
downloadguile-ab4bc85398a14b62b58694bab83c63be286b2fd5.tar.gz
Merge remote-tracking branch 'origin/stable-2.0'
Conflicts: GUILE-VERSION test-suite/tests/srfi-4.test
Diffstat (limited to 'module/system')
-rw-r--r--module/system/base/compile.scm14
-rw-r--r--module/system/repl/command.scm22
2 files changed, 21 insertions, 15 deletions
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 1b6e73f32..943999040 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -103,6 +103,16 @@
;;;
;;; See also boot-9.scm:load.
(define (compiled-file-name file)
+ ;; FIXME: would probably be better just to append SHA1(canon-path)
+ ;; to the %compile-fallback-path, to avoid deep directory stats.
+ (define (canonical->suffix canon)
+ (cond
+ ((string-prefix? "/" canon) canon)
+ ((and (> (string-length canon) 2)
+ (eqv? (string-ref canon 1) #\:))
+ ;; Paths like C:... transform to /C...
+ (string-append "/" (substring canon 0 1) (substring canon 2)))
+ (else canon)))
(define (compiled-extension)
(cond ((or (null? %load-compiled-extensions)
(string-null? (car %load-compiled-extensions)))
@@ -113,9 +123,7 @@
(and %compile-fallback-path
(let ((f (string-append
%compile-fallback-path
- ;; no need for '/' separator here, canonicalize-path
- ;; will give us an absolute path
- (canonicalize-path file)
+ (canonical->suffix (canonicalize-path file))
(compiled-extension))))
(and (false-if-exception (ensure-writable-dir (dirname f)))
f))))
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 109b533f8..a2f2a6f84 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -485,21 +485,19 @@ Disassemble a file."
"time EXP
Time execution."
(let* ((gc-start (gc-run-time))
- (tms-start (times))
+ (real-start (get-internal-real-time))
+ (run-start (get-internal-run-time))
(result (repl-eval repl (repl-parse repl form)))
- (tms-end (times))
+ (run-end (get-internal-run-time))
+ (real-end (get-internal-real-time))
(gc-end (gc-run-time)))
- (define (get proc start end)
- (exact->inexact (/ (- (proc end) (proc start)) internal-time-units-per-second)))
+ (define (diff start end)
+ (/ (- end start) 1.0 internal-time-units-per-second))
(repl-print repl result)
- (display "clock utime stime cutime cstime gctime\n")
- (format #t "~5,2F ~5,2F ~5,2F ~6,2F ~6,2F ~6,2F\n"
- (get tms:clock tms-start tms-end)
- (get tms:utime tms-start tms-end)
- (get tms:stime tms-start tms-end)
- (get tms:cutime tms-start tms-end)
- (get tms:cstime tms-start tms-end)
- (get identity gc-start gc-end))
+ (format #t ";; ~,6Fs real time, ~,6Fs run time. ~,6Fs spent in GC.\n"
+ (diff real-start real-end)
+ (diff run-start run-end)
+ (diff gc-start gc-end))
result))
(define-meta-command (profile repl (form) . opts)