Commit | Line | Data |
---|---|---|
ea9c5dab | 1 | ;;; Repl commands |
17e90c5e | 2 | |
6f3b0cc2 | 3 | ;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc. |
17e90c5e | 4 | |
eb721799 AW |
5 | ;; This library is free software; you can redistribute it and/or |
6 | ;; modify it under the terms of the GNU Lesser General Public | |
7 | ;; License as published by the Free Software Foundation; either | |
8 | ;; version 3 of the License, or (at your option) any later version. | |
17e90c5e | 9 | ;; |
eb721799 | 10 | ;; This library is distributed in the hope that it will be useful, |
17e90c5e | 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
eb721799 AW |
12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
13 | ;; Lesser General Public License for more details. | |
17e90c5e | 14 | ;; |
eb721799 AW |
15 | ;; You should have received a copy of the GNU Lesser General Public |
16 | ;; License along with this library; if not, write to the Free Software | |
17 | ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA | |
18 | ;; 02110-1301 USA | |
17e90c5e KN |
19 | |
20 | ;;; Code: | |
21 | ||
22 | (define-module (system repl command) | |
8239263f | 23 | #:use-module (system base syntax) |
1a1a10d3 AW |
24 | #:use-module (system base pmatch) |
25 | #:use-module (system base compile) | |
26 | #:use-module (system repl common) | |
27 | #:use-module (system vm objcode) | |
28 | #:use-module (system vm program) | |
29 | #:use-module (system vm vm) | |
eb721799 | 30 | #:autoload (system base language) (lookup-language language-reader) |
7e9f9602 | 31 | #:autoload (system vm trace) (vm-trace) |
1a1a10d3 AW |
32 | #:autoload (system vm profile) (vm-profile) |
33 | #:use-module (ice-9 format) | |
34 | #:use-module (ice-9 session) | |
35 | #:use-module (ice-9 documentation) | |
36 | #:use-module (ice-9 and-let-star) | |
eb721799 | 37 | #:use-module (ice-9 rdelim) |
a6dc56a7 | 38 | #:use-module (statprof) |
1a1a10d3 | 39 | #:export (meta-command)) |
4bfb26f5 KN |
40 | |
41 | \f | |
42 | ;;; | |
8f5cfc81 | 43 | ;;; Meta command interface |
4bfb26f5 KN |
44 | ;;; |
45 | ||
46 | (define *command-table* | |
dca9a4d6 | 47 | '((help (help h) (show s) (apropos a) (describe d) (option o) (quit q)) |
db917b41 | 48 | (module (module m) (import i) (load l) (binding b)) |
4bfb26f5 KN |
49 | (language (language L)) |
50 | (compile (compile c) (compile-file cc) | |
51 | (disassemble x) (disassemble-file xx)) | |
52 | (profile (time t) (profile pr)) | |
01c0082f | 53 | (debug (trace tr)) |
f21dfea6 | 54 | (system (gc) (statistics stat)))) |
4bfb26f5 | 55 | |
dca9a4d6 AW |
56 | (define *show-table* |
57 | '((show (warranty w) (copying c) (version v)))) | |
58 | ||
4bfb26f5 KN |
59 | (define (group-name g) (car g)) |
60 | (define (group-commands g) (cdr g)) | |
61 | ||
62 | (define *command-module* (current-module)) | |
63 | (define (command-name c) (car c)) | |
64 | (define (command-abbrev c) (if (null? (cdr c)) #f (cadr c))) | |
65 | (define (command-procedure c) (module-ref *command-module* (command-name c))) | |
66 | (define (command-doc c) (procedure-documentation (command-procedure c))) | |
67 | ||
68 | (define (command-usage c) | |
69 | (let ((doc (command-doc c))) | |
70 | (substring doc 0 (string-index doc #\newline)))) | |
71 | ||
72 | (define (command-summary c) | |
73 | (let* ((doc (command-doc c)) | |
74 | (start (1+ (string-index doc #\newline)))) | |
75 | (cond ((string-index doc #\newline start) | |
76 | => (lambda (end) (substring doc start end))) | |
77 | (else (substring doc start))))) | |
78 | ||
79 | (define (lookup-group name) | |
80 | (assq name *command-table*)) | |
81 | ||
dca9a4d6 AW |
82 | (define* (lookup-command key #:optional (table *command-table*)) |
83 | (let loop ((groups table) (commands '())) | |
4bfb26f5 KN |
84 | (cond ((and (null? groups) (null? commands)) #f) |
85 | ((null? commands) | |
86 | (loop (cdr groups) (cdar groups))) | |
87 | ((memq key (car commands)) (car commands)) | |
88 | (else (loop groups (cdr commands)))))) | |
89 | ||
dca9a4d6 | 90 | (define* (display-group group #:optional (abbrev? #t)) |
4bfb26f5 KN |
91 | (format #t "~:(~A~) Commands [abbrev]:~2%" (group-name group)) |
92 | (for-each (lambda (c) | |
93 | (display-summary (command-usage c) | |
dca9a4d6 | 94 | (and abbrev? (command-abbrev c)) |
4bfb26f5 KN |
95 | (command-summary c))) |
96 | (group-commands group)) | |
97 | (newline)) | |
98 | ||
99 | (define (display-command command) | |
100 | (display "Usage: ") | |
101 | (display (command-doc command)) | |
102 | (newline)) | |
103 | ||
104 | (define (display-summary usage abbrev summary) | |
105 | (let ((abbrev (if abbrev (format #f "[,~A]" abbrev) ""))) | |
106 | (format #t " ,~24A ~8@A - ~A\n" usage abbrev summary))) | |
107 | ||
eb721799 AW |
108 | (define (read-datum repl) |
109 | (read)) | |
110 | ||
111 | (define read-line | |
112 | (let ((orig-read-line read-line)) | |
113 | (lambda (repl) | |
114 | (orig-read-line)))) | |
115 | ||
116 | (define (meta-command repl) | |
117 | (let ((command (read-datum repl))) | |
118 | (if (not (symbol? command)) | |
119 | (user-error "Meta-command not a symbol: ~s" command)) | |
120 | (let ((c (lookup-command command))) | |
121 | (if c | |
122 | ((command-procedure c) repl) | |
123 | (user-error "Unknown meta command: ~A" command))))) | |
124 | ||
125 | (define-syntax define-meta-command | |
126 | (syntax-rules () | |
127 | ((_ (name repl (expression0 ...) . datums) docstring b0 b1 ...) | |
128 | (define (name repl) | |
129 | docstring | |
130 | (let* ((expression0 | |
4b2afc62 AW |
131 | (repl-reader "" |
132 | (lambda args | |
133 | (let ((port (if (pair? args) | |
134 | (car args) | |
135 | (current-input-port)))) | |
136 | ((language-reader (repl-language repl)) | |
137 | port (current-module)))))) | |
eb721799 AW |
138 | ...) |
139 | (apply (lambda datums b0 b1 ...) | |
140 | (let ((port (open-input-string (read-line repl)))) | |
141 | (let lp ((out '())) | |
142 | (let ((x (read port))) | |
143 | (if (eof-object? x) | |
144 | (reverse out) | |
145 | (lp (cons x out)))))))))) | |
146 | ((_ (name repl . datums) docstring b0 b1 ...) | |
147 | (define-meta-command (name repl () . datums) | |
148 | docstring b0 b1 ...)))) | |
149 | ||
4bfb26f5 KN |
150 | |
151 | \f | |
152 | ;;; | |
153 | ;;; Help commands | |
154 | ;;; | |
155 | ||
eb721799 AW |
156 | (define-meta-command (help repl . args) |
157 | "help | |
158 | help GROUP | |
159 | help [-c] COMMAND | |
160 | ||
161 | Gives help on the meta-commands available at the REPL. | |
162 | ||
163 | With one argument, tries to look up the argument as a group name, giving | |
164 | help on that group if successful. Otherwise tries to look up the | |
165 | argument as a command, giving help on the command. | |
166 | ||
167 | If there is a command whose name is also a group name, use the ,help | |
168 | -c COMMAND form to give help on the command instead of the group. | |
169 | ||
8f5cfc81 | 170 | Without any argument, a list of help commands and command groups |
eb721799 | 171 | are displayed." |
e429de1e | 172 | (pmatch args |
4bfb26f5 KN |
173 | (() |
174 | (display-group (lookup-group 'help)) | |
175 | (display "Command Groups:\n\n") | |
176 | (display-summary "help all" #f "List all commands") | |
177 | (for-each (lambda (g) | |
178 | (let* ((name (symbol->string (group-name g))) | |
179 | (usage (string-append "help " name)) | |
180 | (header (string-append "List " name " commands"))) | |
181 | (display-summary usage #f header))) | |
182 | (cdr *command-table*)) | |
183 | (newline) | |
8f5cfc81 | 184 | (display "Type `,COMMAND -h' to show documentation of each command.") |
4bfb26f5 | 185 | (newline)) |
e429de1e | 186 | ((all) |
4bfb26f5 | 187 | (for-each display-group *command-table*)) |
e429de1e | 188 | ((,group) (guard (lookup-group group)) |
4bfb26f5 | 189 | (display-group (lookup-group group))) |
eb721799 AW |
190 | ((,command) (guard (lookup-command command)) |
191 | (display-command (lookup-command command))) | |
192 | ((-c ,command) (guard (lookup-command command)) | |
193 | (display-command (lookup-command command))) | |
194 | ((,command) | |
195 | (user-error "Unknown command or group: ~A" command)) | |
196 | ((-c ,command) | |
197 | (user-error "Unknown command: ~A" command)) | |
8f5cfc81 | 198 | (else |
eb721799 | 199 | (user-error "Bad arguments: ~A" args)))) |
4bfb26f5 | 200 | |
dca9a4d6 AW |
201 | (define-meta-command (show repl . args) |
202 | "show | |
203 | show TOPIC | |
204 | ||
205 | Gives information about Guile. | |
206 | ||
207 | With one argument, tries to show a particular piece of information; | |
208 | ||
209 | currently supported topics are `warranty' (or `w'), `copying' (or `c'), | |
210 | and `version' (or `v'). | |
211 | ||
212 | Without any argument, a list of topics is displayed." | |
213 | (pmatch args | |
214 | (() | |
215 | (display-group (car *show-table*) #f) | |
216 | (newline)) | |
217 | ((,topic) (guard (lookup-command topic *show-table*)) | |
218 | ((command-procedure (lookup-command topic *show-table*)) repl)) | |
219 | ((,command) | |
220 | (user-error "Unknown topic: ~A" command)) | |
221 | (else | |
222 | (user-error "Bad arguments: ~A" args)))) | |
223 | ||
224 | (define (warranty repl) | |
225 | "show warranty | |
226 | Details on the lack of warranty." | |
227 | (display *warranty*) | |
228 | (newline)) | |
229 | ||
230 | (define (copying repl) | |
231 | "show copying | |
232 | Show the LGPLv3." | |
233 | (display *copying*) | |
234 | (newline)) | |
235 | ||
236 | (define (version repl) | |
237 | "show version | |
238 | Version information." | |
239 | (display *version*) | |
240 | (newline)) | |
241 | ||
8f5cfc81 | 242 | (define guile:apropos apropos) |
eb721799 | 243 | (define-meta-command (apropos repl regexp) |
8f5cfc81 | 244 | "apropos REGEXP |
4bfb26f5 | 245 | Find bindings/modules/packages." |
8f5cfc81 | 246 | (guile:apropos (->string regexp))) |
4bfb26f5 | 247 | |
eb721799 | 248 | (define-meta-command (describe repl (form)) |
4bfb26f5 KN |
249 | "describe OBJ |
250 | Show description/documentation." | |
eb721799 | 251 | (display (object-documentation (repl-eval repl (repl-parse repl form)))) |
8f5cfc81 | 252 | (newline)) |
4bfb26f5 | 253 | |
eb721799 | 254 | (define-meta-command (option repl . args) |
8f5cfc81 | 255 | "option [KEY VALUE] |
4bfb26f5 | 256 | List/show/set options." |
e429de1e | 257 | (pmatch args |
f21dfea6 KN |
258 | (() |
259 | (for-each (lambda (key+val) | |
260 | (format #t "~A\t~A\n" (car key+val) (cdr key+val))) | |
ce0925e1 | 261 | (repl-options repl))) |
e429de1e | 262 | ((,key) |
f21dfea6 KN |
263 | (display (repl-option-ref repl key)) |
264 | (newline)) | |
e429de1e | 265 | ((,key ,val) |
7e9f9602 | 266 | (repl-option-set! repl key val)))) |
4bfb26f5 | 267 | |
eb721799 | 268 | (define-meta-command (quit repl) |
4bfb26f5 KN |
269 | "quit |
270 | Quit this session." | |
271 | (throw 'quit)) | |
272 | ||
273 | \f | |
274 | ;;; | |
275 | ;;; Module commands | |
276 | ;;; | |
277 | ||
eb721799 | 278 | (define-meta-command (module repl . args) |
4bfb26f5 KN |
279 | "module [MODULE] |
280 | Change modules / Show current module." | |
e429de1e | 281 | (pmatch args |
db917b41 | 282 | (() (puts (module-name (current-module)))) |
482015af AW |
283 | ((,mod-name) (guard (list? mod-name)) |
284 | (set-current-module (resolve-module mod-name))) | |
285 | (,mod-name (set-current-module (resolve-module mod-name))))) | |
4bfb26f5 | 286 | |
eb721799 | 287 | (define-meta-command (import repl . args) |
4bfb26f5 KN |
288 | "import [MODULE ...] |
289 | Import modules / List those imported." | |
9246a486 AW |
290 | (let () |
291 | (define (use name) | |
292 | (let ((mod (resolve-interface name))) | |
293 | (if mod | |
294 | (module-use! (current-module) mod) | |
295 | (user-error "No such module: ~A" name)))) | |
296 | (if (null? args) | |
297 | (for-each puts (map module-name (module-uses (current-module)))) | |
298 | (for-each use args)))) | |
4bfb26f5 | 299 | |
84012ef4 | 300 | (define guile:load load) |
eb721799 | 301 | (define-meta-command (load repl file . opts) |
8f5cfc81 KN |
302 | "load FILE |
303 | Load a file in the current module. | |
304 | ||
f21dfea6 | 305 | -f Load source file (see `compile')" |
84012ef4 LC |
306 | (let ((file (->string file))) |
307 | (if (memq #:f opts) | |
308 | (primitive-load file) | |
309 | (guile:load file)))) | |
4bfb26f5 | 310 | |
eb721799 | 311 | (define-meta-command (binding repl) |
8f5cfc81 | 312 | "binding |
4bfb26f5 | 313 | List current bindings." |
db917b41 AW |
314 | (module-for-each (lambda (k v) (format #t "~23A ~A\n" k v)) |
315 | (current-module))) | |
4bfb26f5 KN |
316 | |
317 | \f | |
318 | ;;; | |
319 | ;;; Language commands | |
320 | ;;; | |
321 | ||
eb721799 | 322 | (define-meta-command (language repl name) |
4bfb26f5 KN |
323 | "language LANGUAGE |
324 | Change languages." | |
dca9a4d6 AW |
325 | (let ((lang (lookup-language name)) |
326 | (cur (repl-language repl))) | |
4d75554d | 327 | (format #t "Happy hacking with ~a! To switch back, type `,L ~a'.\n" |
dca9a4d6 AW |
328 | (language-title lang) (language-name cur)) |
329 | (set! (repl-language repl) lang))) | |
4bfb26f5 KN |
330 | |
331 | \f | |
332 | ;;; | |
333 | ;;; Compile commands | |
334 | ;;; | |
335 | ||
eb721799 | 336 | (define-meta-command (compile repl (form) . opts) |
8f5cfc81 | 337 | "compile FORM |
4bfb26f5 KN |
338 | Generate compiled code. |
339 | ||
340 | -e Stop after expanding syntax/macro | |
341 | -t Stop after translating into GHIL | |
342 | -c Stop after generating GLIL | |
343 | ||
344 | -O Enable optimization | |
345 | -D Add debug information" | |
b0b180d5 | 346 | (let ((x (apply repl-compile repl (repl-parse repl form) opts))) |
81e002fc | 347 | (cond ((objcode? x) (guile:disassemble x)) |
b0b180d5 | 348 | (else (repl-print repl x))))) |
4bfb26f5 | 349 | |
f21dfea6 | 350 | (define guile:compile-file compile-file) |
eb721799 | 351 | (define-meta-command (compile-file repl file . opts) |
8f5cfc81 | 352 | "compile-file FILE |
4bfb26f5 | 353 | Compile a file." |
b0b180d5 | 354 | (guile:compile-file (->string file) #:opts opts)) |
4bfb26f5 | 355 | |
9bb8012d AW |
356 | (define (guile:disassemble x) |
357 | ((@ (language assembly disassemble) disassemble) x)) | |
358 | ||
eb721799 | 359 | (define-meta-command (disassemble repl (form)) |
4bfb26f5 KN |
360 | "disassemble PROGRAM |
361 | Disassemble a program." | |
eb721799 | 362 | (guile:disassemble (repl-eval repl (repl-parse repl form)))) |
4bfb26f5 | 363 | |
eb721799 | 364 | (define-meta-command (disassemble-file repl file) |
4bfb26f5 KN |
365 | "disassemble-file FILE |
366 | Disassemble a file." | |
9bb8012d | 367 | (guile:disassemble (load-objcode (->string file)))) |
4bfb26f5 KN |
368 | |
369 | \f | |
370 | ;;; | |
371 | ;;; Profile commands | |
372 | ;;; | |
373 | ||
eb721799 | 374 | (define-meta-command (time repl (form)) |
8f5cfc81 KN |
375 | "time FORM |
376 | Time execution." | |
e5f5113c | 377 | (let* ((gc-start (gc-run-time)) |
8f5cfc81 | 378 | (tms-start (times)) |
b0b180d5 | 379 | (result (repl-eval repl (repl-parse repl form))) |
8f5cfc81 | 380 | (tms-end (times)) |
e5f5113c | 381 | (gc-end (gc-run-time))) |
8f5cfc81 | 382 | (define (get proc start end) |
17d1b4bf | 383 | (exact->inexact (/ (- (proc end) (proc start)) internal-time-units-per-second))) |
8f5cfc81 KN |
384 | (repl-print repl result) |
385 | (display "clock utime stime cutime cstime gctime\n") | |
386 | (format #t "~5,2F ~5,2F ~5,2F ~6,2F ~6,2F ~6,2F\n" | |
387 | (get tms:clock tms-start tms-end) | |
388 | (get tms:utime tms-start tms-end) | |
389 | (get tms:stime tms-start tms-end) | |
390 | (get tms:cutime tms-start tms-end) | |
391 | (get tms:cstime tms-start tms-end) | |
392 | (get identity gc-start gc-end)) | |
393 | result)) | |
394 | ||
a6dc56a7 | 395 | (define-meta-command (profile repl (form) . opts) |
4bfb26f5 KN |
396 | "profile FORM |
397 | Profile execution." | |
a6dc56a7 | 398 | ;; FIXME opts |
01c0082f AW |
399 | (apply statprof |
400 | (make-program (repl-compile repl (repl-parse repl form))) | |
401 | opts)) | |
a6dc56a7 | 402 | |
4bfb26f5 KN |
403 | |
404 | \f | |
405 | ;;; | |
406 | ;;; Debug commands | |
407 | ;;; | |
408 | ||
01c0082f | 409 | (define-meta-command (trace repl (form) . opts) |
8f5cfc81 | 410 | "trace FORM |
737caee8 | 411 | Trace execution." |
7e9f9602 | 412 | ;; FIXME: doc options, or somehow deal with them better |
737caee8 | 413 | (apply vm-trace |
01c0082f | 414 | (the-vm) |
737caee8 | 415 | (make-program (repl-compile repl (repl-parse repl form))) |
b0b180d5 | 416 | opts)) |
4bfb26f5 | 417 | |
4bfb26f5 KN |
418 | |
419 | \f | |
420 | ;;; | |
421 | ;;; System commands | |
422 | ;;; | |
423 | ||
8f5cfc81 | 424 | (define guile:gc gc) |
eb721799 | 425 | (define-meta-command (gc repl) |
4bfb26f5 KN |
426 | "gc |
427 | Garbage collection." | |
8f5cfc81 | 428 | (guile:gc)) |
4bfb26f5 | 429 | |
eb721799 | 430 | (define-meta-command (statistics repl) |
4bfb26f5 KN |
431 | "statistics |
432 | Display statistics." | |
433 | (let ((this-tms (times)) | |
4bfb26f5 | 434 | (this-gcs (gc-stats)) |
ce0925e1 | 435 | (last-tms (repl-tm-stats repl)) |
ce0925e1 | 436 | (last-gcs (repl-gc-stats repl))) |
4bfb26f5 KN |
437 | ;; GC times |
438 | (let ((this-times (assq-ref this-gcs 'gc-times)) | |
439 | (last-times (assq-ref last-gcs 'gc-times))) | |
440 | (display-diff-stat "GC times:" #t this-times last-times "times") | |
441 | (newline)) | |
442 | ;; Memory size | |
443 | (let ((this-cells (assq-ref this-gcs 'cells-allocated)) | |
444 | (this-heap (assq-ref this-gcs 'cell-heap-size)) | |
445 | (this-bytes (assq-ref this-gcs 'bytes-malloced)) | |
446 | (this-malloc (assq-ref this-gcs 'gc-malloc-threshold))) | |
447 | (display-stat-title "Memory size:" "current" "limit") | |
448 | (display-stat "heap" #f this-cells this-heap "cells") | |
449 | (display-stat "malloc" #f this-bytes this-malloc "bytes") | |
450 | (newline)) | |
451 | ;; Cells collected | |
452 | (let ((this-marked (assq-ref this-gcs 'cells-marked)) | |
453 | (last-marked (assq-ref last-gcs 'cells-marked)) | |
454 | (this-swept (assq-ref this-gcs 'cells-swept)) | |
455 | (last-swept (assq-ref last-gcs 'cells-swept))) | |
456 | (display-stat-title "Cells collected:" "diff" "total") | |
457 | (display-diff-stat "marked" #f this-marked last-marked "cells") | |
458 | (display-diff-stat "swept" #f this-swept last-swept "cells") | |
459 | (newline)) | |
460 | ;; GC time taken | |
461 | (let ((this-mark (assq-ref this-gcs 'gc-mark-time-taken)) | |
462 | (last-mark (assq-ref last-gcs 'gc-mark-time-taken)) | |
4bfb26f5 KN |
463 | (this-total (assq-ref this-gcs 'gc-time-taken)) |
464 | (last-total (assq-ref last-gcs 'gc-time-taken))) | |
465 | (display-stat-title "GC time taken:" "diff" "total") | |
466 | (display-time-stat "mark" this-mark last-mark) | |
4bfb26f5 KN |
467 | (display-time-stat "total" this-total last-total) |
468 | (newline)) | |
469 | ;; Process time spent | |
470 | (let ((this-utime (tms:utime this-tms)) | |
471 | (last-utime (tms:utime last-tms)) | |
472 | (this-stime (tms:stime this-tms)) | |
473 | (last-stime (tms:stime last-tms)) | |
474 | (this-cutime (tms:cutime this-tms)) | |
475 | (last-cutime (tms:cutime last-tms)) | |
476 | (this-cstime (tms:cstime this-tms)) | |
477 | (last-cstime (tms:cstime last-tms))) | |
478 | (display-stat-title "Process time spent:" "diff" "total") | |
479 | (display-time-stat "user" this-utime last-utime) | |
480 | (display-time-stat "system" this-stime last-stime) | |
481 | (display-time-stat "child user" this-cutime last-cutime) | |
482 | (display-time-stat "child system" this-cstime last-cstime) | |
483 | (newline)) | |
4bfb26f5 KN |
484 | ;; Save statistics |
485 | ;; Save statistics | |
ce0925e1 | 486 | (set! (repl-tm-stats repl) this-tms) |
ce0925e1 | 487 | (set! (repl-gc-stats repl) this-gcs))) |
cb4cca12 KN |
488 | |
489 | (define (display-stat title flag field1 field2 unit) | |
490 | (let ((str (format #f "~~20~AA ~~10@A /~~10@A ~~A~~%" (if flag "" "@")))) | |
491 | (format #t str title field1 field2 unit))) | |
492 | ||
493 | (define (display-stat-title title field1 field2) | |
494 | (display-stat title #t field1 field2 "")) | |
495 | ||
496 | (define (display-diff-stat title flag this last unit) | |
497 | (display-stat title flag (- this last) this unit)) | |
498 | ||
499 | (define (display-time-stat title this last) | |
500 | (define (conv num) | |
b9d8ed05 | 501 | (format #f "~10,2F" (exact->inexact (/ num internal-time-units-per-second)))) |
cb4cca12 KN |
502 | (display-stat title #f (conv (- this last)) (conv this) "s")) |
503 | ||
504 | (define (display-mips-stat title this-time this-clock last-time last-clock) | |
505 | (define (mips time clock) | |
b9d8ed05 | 506 | (if (= time 0) "----" (format #f "~10,2F" (/ clock time 1000000.0)))) |
cb4cca12 KN |
507 | (display-stat title #f |
508 | (mips (- this-time last-time) (- this-clock last-clock)) | |
509 | (mips this-time this-clock) "mips")) |