From c1d14051501ec2022170d22689f7e1e581c5b549 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Fri, 17 Oct 2008 07:50:18 +0000 Subject: [PATCH 1/3] Welcome to a new PLT day. svn: r12051 --- collects/repos-time-stamp/stamp.ss | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss index b53bd5b766..9dc8c1106a 100644 --- a/collects/repos-time-stamp/stamp.ss +++ b/collects/repos-time-stamp/stamp.ss @@ -1 +1 @@ -#lang scheme/base (provide stamp) (define stamp "16oct2008") +#lang scheme/base (provide stamp) (define stamp "17oct2008") From 33bfa42df4a452ae964fd348ec4adb1a42b27f95 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Fri, 17 Oct 2008 08:36:29 +0000 Subject: [PATCH 2/3] nice memory printout svn: r12052 --- collects/handin-server/main.ss | 73 ++++++++++++++++++---------------- 1 file changed, 38 insertions(+), 35 deletions(-) diff --git a/collects/handin-server/main.ss b/collects/handin-server/main.ss index 6c7e22c6f8..1bd32f3b5d 100644 --- a/collects/handin-server/main.ss +++ b/collects/handin-server/main.ss @@ -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] From 5e323e53b76aa3083afcb5d66a690187ebf2e9d7 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Fri, 17 Oct 2008 14:57:12 +0000 Subject: [PATCH 3/3] conract fixes (PR9840) svn: r12053 --- collects/scribblings/reference/regexps.scrbl | 32 +++++++++----------- 1 file changed, 14 insertions(+), 18 deletions(-) diff --git a/collects/scribblings/reference/regexps.scrbl b/collects/scribblings/reference/regexps.scrbl index f9aaeeb423..92885b8d0d 100644 --- a/collects/scribblings/reference/regexps.scrbl +++ b/collects/scribblings/reference/regexps.scrbl @@ -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*].}