suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

updated

Browse Source 
original commit: cd85b42f0726b05433790901d50bbc624b53d6f0
This commit is contained in:
Matthew Flatt 1998-02-13 18:23:35 +00:00
parent 4297a558de
commit 7652bc2267
1 changed files with 10 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/tests/mred/mem.ss
View File

@ -1,4 +1,6 @@
; run with mred -u -- -f mem.ss
(define source-dir (current-load-relative-directory)) (define source-dir (current-load-relative-directory))
(define num-times 12) (define num-times 12)
@ -46,9 +48,9 @@
(collect-garbage) (collect-garbage)
(collect-garbage) (collect-garbage)
(printf "Thread: ~s Cycle: ~s~n" id n) (printf "Thread: ~s Cycle: ~s~n" id n)
(dump-object-stats) ; (dump-object-stats)
(if (and dump-stats? (= id 1)) ; (if (and dump-stats? (= id 1))
(dump-memory-stats)) ; (dump-memory-stats))
(unless (zero? n) (unless (zero? n)
(let ([tag (cons id n)]) (let ([tag (cons id n)])
(let* ([f (if edit? (remember tag (make-object frame%)))] (let* ([f (if edit? (remember tag (make-object frame%)))]
@ -234,8 +236,8 @@
(still))) (still)))
(define mred:startup (define mred:startup
(let ([old-mred:startup mred:startup]) (lambda args
(lambda args ; (send mred:the-frame-group set-empty-callback (lambda () #t))
(send mred:the-frame-group set-empty-callback (lambda () #t)) (do-test)
(do-test) (make-object mred:console-frame%)))
(apply old-mred:startup args))))