I take it back. I TAKE IT BACK.
svn: r12054
This commit is contained in:
Stevie Strickland
commit
6e05d745ae
|
|
@ -546,35 +546,42 @@
|
|||
(define session-channel (make-channel))
|
||||
(define timeout #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 (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)
|
||||
(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)
|
||||
(loop #t)]
|
||||
[else (collect-garbage)
|
||||
(log-line "running ~a ~a"
|
||||
(mem (current-memory-use session-cust))
|
||||
(if no-limit-warning?
|
||||
"(total)"
|
||||
(list (mem (current-memory-use orig-custodian))
|
||||
(mem (current-memory-use)))))
|
||||
(loop #f)])))
|
||||
(define (timeout-control msg)
|
||||
(if (rational? msg)
|
||||
(set! timeout (+ (current-inexact-milliseconds) (* 1000 msg)))
|
||||
|
|
@ -592,12 +599,8 @@
|
|||
"not supported by MrEd"))])
|
||||
(custodian-limit-memory
|
||||
session-cust (get-conf 'session-memory-limit) session-cust)))
|
||||
(let ([watcher
|
||||
(parameterize ([current-custodian orig-custodian])
|
||||
(thread
|
||||
(lambda ()
|
||||
(let ([session-thread (channel-get session-channel)])
|
||||
(watch-loop #f)))))])
|
||||
(let ([watcher (parameterize ([current-custodian orig-custodian])
|
||||
(thread watch-loop))])
|
||||
;; Run proc in a thread under session-cust:
|
||||
(let ([session-thread
|
||||
(parameterize ([current-custodian session-cust]
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
#lang scheme/base (provide stamp) (define stamp "16oct2008")
|
||||
#lang scheme/base (provide stamp) (define stamp "17oct2008")
|
||||
|
|
|
|||
|
|
@ -206,8 +206,7 @@ case-sensitively.
|
|||
[start-pos exact-nonnegative-integer? 0]
|
||||
[end-pos (or/c exact-nonnegative-integer? #f) #f]
|
||||
[output-port (or/c output-port? #f) #f])
|
||||
(or/c (listof (or/c (cons (or/c string? bytes?)
|
||||
(or/c string? bytes?))
|
||||
(or/c (listof (or/c (or/c string? bytes?)
|
||||
#f))
|
||||
#f)]{
|
||||
|
||||
|
|
@ -337,8 +336,7 @@ port).
|
|||
[start-pos exact-nonnegative-integer? 0]
|
||||
[end-pos (or/c exact-nonnegative-integer? #f) #f]
|
||||
[output-port (or/c output-port? #f) #f])
|
||||
(or/c (listof (or/c (cons (or/c string? bytes?)
|
||||
(or/c string? bytes?))
|
||||
(or/c (listof (or/c (or/c string? bytes?)
|
||||
#f))
|
||||
#f)]{
|
||||
|
||||
|
|
@ -358,8 +356,8 @@ fails.}
|
|||
[start-pos exact-nonnegative-integer? 0]
|
||||
[end-pos (or/c exact-nonnegative-integer? #f) #f]
|
||||
[output-port (or/c output-port? #f) #f])
|
||||
(or/c (listof (or/c (cons exact-nonnegative-integer?
|
||||
exact-nonnegative-integer?)
|
||||
(or/c (listof (or/c (cons/c exact-nonnegative-integer?
|
||||
exact-nonnegative-integer?)
|
||||
#f))
|
||||
#f)]{
|
||||
|
||||
|
|
@ -388,8 +386,8 @@ positions indicate the number of bytes that were read, including
|
|||
[input (or/c string? bytes? input-port?)]
|
||||
[start-pos exact-nonnegative-integer? 0]
|
||||
[end-pos (or/c exact-nonnegative-integer? #f) #f])
|
||||
(listof (cons exact-nonnegative-integer?
|
||||
exact-nonnegative-integer?))]{
|
||||
(listof (cons/c exact-nonnegative-integer?
|
||||
exact-nonnegative-integer?))]{
|
||||
|
||||
Like @scheme[regexp-match-positions], but returns multiple matches
|
||||
like @scheme[regexp-match*].
|
||||
|
|
@ -433,8 +431,7 @@ entire content of @scheme[input] matches @scheme[pattern].
|
|||
[start-pos exact-nonnegative-integer? 0]
|
||||
[end-pos (or/c exact-nonnegative-integer? #f) #f]
|
||||
[progress (or/c evt #f) #f])
|
||||
(or/c (listof (or/c (cons bytes? bytes?)
|
||||
#f))
|
||||
(or/c (listof (or/c bytes? #f))
|
||||
#f)]{
|
||||
|
||||
Like @scheme[regexp-match] on input ports, but only peeks bytes from
|
||||
|
|
@ -463,8 +460,8 @@ information if another process meanwhile reads from
|
|||
[start-pos exact-nonnegative-integer? 0]
|
||||
[end-pos (or/c exact-nonnegative-integer? #f) #f]
|
||||
[progress (or/c evt #f) #f])
|
||||
(or/c (listof (or/c (cons exact-nonnegative-integer?
|
||||
exact-nonnegative-integer?)
|
||||
(or/c (listof (or/c (cons/c exact-nonnegative-integer?
|
||||
exact-nonnegative-integer?)
|
||||
#f))
|
||||
#f)]{
|
||||
|
||||
|
|
@ -478,8 +475,7 @@ bytes from @scheme[input-port] instead of reading them, and with a
|
|||
[start-pos exact-nonnegative-integer? 0]
|
||||
[end-pos (or/c exact-nonnegative-integer? #f) #f]
|
||||
[progress (or/c evt #f) #f])
|
||||
(or/c (listof (or/c (cons bytes? bytes?)
|
||||
#f))
|
||||
(or/c (listof (or/c bytes? #f))
|
||||
#f)]{
|
||||
|
||||
Like @scheme[regexp-match-peek], but it attempts to match only bytes
|
||||
|
|
@ -493,8 +489,8 @@ match fails if not-yet-available characters might be used to match
|
|||
[start-pos exact-nonnegative-integer? 0]
|
||||
[end-pos (or/c exact-nonnegative-integer? #f) #f]
|
||||
[progress (or/c evt #f) #f])
|
||||
(or/c (listof (or/c (cons exact-nonnegative-integer?
|
||||
exact-nonnegative-integer?)
|
||||
(or/c (listof (or/c (cons/c exact-nonnegative-integer?
|
||||
exact-nonnegative-integer?)
|
||||
#f))
|
||||
#f)]{
|
||||
|
||||
|
|
@ -508,8 +504,8 @@ used to match @scheme[pattern].}
|
|||
[input input-port?]
|
||||
[start-pos exact-nonnegative-integer? 0]
|
||||
[end-pos (or/c exact-nonnegative-integer? #f) #f])
|
||||
(listof (cons exact-nonnegative-integer?
|
||||
exact-nonnegative-integer?))]{
|
||||
(listof (cons/c exact-nonnegative-integer?
|
||||
exact-nonnegative-integer?))]{
|
||||
|
||||
Like @scheme[regexp-match-peek-positions], but returns multiple matches like
|
||||
@scheme[regexp-match*].}
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user