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

nice memory printout

Browse Source 
svn: r12052
This commit is contained in:
Eli Barzilay 2008-10-17 08:36:29 +00:00
parent c1d1405150
commit 33bfa42df4
1 changed files with 38 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/handin-server/main.ss
View File

@ -546,7 +546,14 @@
(define session-channel (make-channel)) (define session-channel (make-channel))
(define timeout #f) (define timeout #f)
(define status-box (box #f)) (define status-box (box #f))
(define (watch-loop timed-out?) (define (mem m)
(let loop ([m m] [q 'B] [qs '(KB MB GB TB)])
(if (and (>= m 1024) (pair? qs))
(loop (round (/ m 1024)) (car qs) (cdr qs))
(format "~a~a" m q))))
(define (watch-loop)
(define session-thread (channel-get session-channel))
(let loop ([timed-out? #f])
(cond [(sync/timeout 3 session-thread) (cond [(sync/timeout 3 session-thread)
(let* ([status (unbox status-box)] (let* ([status (unbox status-box)]
[status (if status (format " while ~a" status) "")]) [status (if status (format " while ~a" status) "")])
@ -566,15 +573,15 @@
;; message, instead of relying on a timeout at the ;; message, instead of relying on a timeout at the
;; run-server level ;; run-server level
(custodian-shutdown-all session-cust) (custodian-shutdown-all session-cust)
(watch-loop #t)] (loop #t)]
[else (collect-garbage) [else (collect-garbage)
(log-line "running ~a ~a" (log-line "running ~a ~a"
(current-memory-use session-cust) (mem (current-memory-use session-cust))
(if no-limit-warning? (if no-limit-warning?
"(total)" "(total)"
(list (current-memory-use orig-custodian) (list (mem (current-memory-use orig-custodian))
(current-memory-use)))) (mem (current-memory-use)))))
(watch-loop #f)])) (loop #f)])))
(define (timeout-control msg) (define (timeout-control msg)
(if (rational? msg) (if (rational? msg)
(set! timeout (+ (current-inexact-milliseconds) (* 1000 msg))) (set! timeout (+ (current-inexact-milliseconds) (* 1000 msg)))
@ -592,12 +599,8 @@
"not supported by MrEd"))]) "not supported by MrEd"))])
(custodian-limit-memory (custodian-limit-memory
session-cust (get-conf 'session-memory-limit) session-cust))) session-cust (get-conf 'session-memory-limit) session-cust)))
(let ([watcher (let ([watcher (parameterize ([current-custodian orig-custodian])
(parameterize ([current-custodian orig-custodian]) (thread watch-loop))])
(thread
(lambda ()
(let ([session-thread (channel-get session-channel)])
(watch-loop #f)))))])
;; Run proc in a thread under session-cust: ;; Run proc in a thread under session-cust:
(let ([session-thread (let ([session-thread
(parameterize ([current-custodian session-cust] (parameterize ([current-custodian session-cust]