From 33bfa42df4a452ae964fd348ec4adb1a42b27f95 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Fri, 17 Oct 2008 08:36:29 +0000
Subject: [PATCH] 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]