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

reorganize code a little

Browse Source 
svn: r12049
This commit is contained in:
Eli Barzilay 2008-10-17 01:36:14 +00:00
parent 614b8757de
commit ec506bc5e3
1 changed files with 68 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -542,10 +542,39 @@
((current-timeout-control) msg)) ((current-timeout-control) msg))
(define (with-watcher w proc) (define (with-watcher w proc)
(let ([session-cust (make-custodian)] (define session-cust (make-custodian))
[session-channel (make-channel)] (define session-channel (make-channel))
[timeout #f] (define timeout #f)
[status-box (box #f)]) (define status-box (box #f))
(define (watch-loop timed-out?)
(cond [(sync/timeout 3 session-thread)
(let* ([status (unbox status-box)]
[status (if status (format " while ~a" status) "")])
(log-line "session killed ~a~a"
(if timed-out? "(timeout) " "(memory)")
status)
(write+flush
w (format "handin terminated due to ~a ~a~a"
(if timed-out? "time limit" "excessive memory use")
"(program doesn't terminate?)"
status))
(close-output-port w)
(channel-put session-channel 'done))]
[(let ([t timeout]) ; grab value to avoid races
(and t ((current-inexact-milliseconds) . > . t)))
;; Shutdown here to get the handin-terminated error
;; message, instead of relying on a timeout at the
;; run-server level
(custodian-shutdown-all session-cust)
(watch-loop #t)]
[else (collect-garbage)
(log-line "running ~a ~a"
(current-memory-use session-cust)
(if no-limit-warning?
"(total)"
(list (current-memory-use orig-custodian)
(current-memory-use))))
(watch-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)))
@ -559,47 +588,16 @@
(with-handlers ([exn:fail:unsupported? (with-handlers ([exn:fail:unsupported?
(lambda (x) (lambda (x)
(set! no-limit-warning? #t) (set! no-limit-warning? #t)
(log-line "WARNING: per-session memory limit not supported by MrEd"))]) (log-line "WARNING: per-session memory limit ~a"
(custodian-limit-memory session-cust "not supported by MrEd"))])
(get-conf 'session-memory-limit) (custodian-limit-memory
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 (thread
(lambda () (lambda ()
(let ([session-thread (channel-get session-channel)]) (let ([session-thread (channel-get session-channel)])
(let loop ([timed-out? #f]) (watch-loop #f)))))])
(cond
[(sync/timeout 3 session-thread)
(let* ([status (unbox status-box)]
[status (if status
(format " while ~a" status)
"")])
(log-line "session killed ~a~a"
(if timed-out? "(timeout) " "(memory)")
status)
(write+flush
w (format "handin terminated due to ~a (program doesn't terminate?)~a"
(if timed-out? "time limit" "excessive memory use")
status))
(close-output-port w)
(channel-put session-channel 'done))]
[(let ([t timeout]) ; grab value to avoid races
(and t ((current-inexact-milliseconds) . > . t)))
;; Shutdown here to get the handin-terminated error
;; message, instead of relying on a timeout at the
;; run-server level
(custodian-shutdown-all session-cust)
(loop #t)]
[else
(collect-garbage)
(log-line "running ~a ~a"
(current-memory-use session-cust)
(if no-limit-warning?
"(total)"
(list (current-memory-use orig-custodian)
(current-memory-use))))
(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]
@ -613,7 +611,7 @@
(channel-put session-channel 'done-normal))))]) (channel-put session-channel 'done-normal))))])
(channel-put session-channel session-thread) (channel-put session-channel session-thread)
;; Wait until the proc is done or killed (and kill is reported): ;; Wait until the proc is done or killed (and kill is reported):
(channel-get session-channel))))) (channel-get session-channel))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;