From 896bbfaabb5af38f42ac944f8eb2ebf0fada0fc9 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Wed, 30 Jun 2010 19:28:31 -0500
Subject: [PATCH] Adding support to do memory profiling of drr startup that
 drdr can track.

---
 collects/drracket/syncheck.rkt                | 10 +++++-
 collects/scribblings/drracket/extending.scrbl | 12 ++++++-
 collects/tests/drracket/memory-log.rkt        | 36 ++++++++++++++-----
 3 files changed, 48 insertions(+), 10 deletions(-)

diff --git a/collects/drracket/syncheck.rkt b/collects/drracket/syncheck.rkt
index 4d66b4b097..1dc08c32d3 100644
--- a/collects/drracket/syncheck.rkt
+++ b/collects/drracket/syncheck.rkt
@@ -106,7 +106,15 @@ If the namespace does not, they are colored the unbound color.
     (define (printf . args) (apply fprintf o args))
     
     
-    (define xref (delay/idle (load-collections-xref)))
+    (define xref (if (getenv "PLTDRXREFDELAY")
+                     (begin
+                       (printf "PLTDRXREFDELAY: using plain delay\n")
+                       (delay (begin
+                                (printf "PLTDRXREFDELAY: loading xref\n")
+                                (begin0
+                                  (load-collections-xref)
+                                  (printf "PLTDRXREFDELAY: loaded xref\n")))))
+                     (delay/idle (load-collections-xref))))
     (define (get-xref) (force xref))
     
     
diff --git a/collects/scribblings/drracket/extending.scrbl b/collects/scribblings/drracket/extending.scrbl
index 97d53e01ff..20814a541a 100644
--- a/collects/scribblings/drracket/extending.scrbl
+++ b/collects/scribblings/drracket/extending.scrbl
@@ -1,6 +1,7 @@
 #lang scribble/doc
 @(require "common.ss"
-          (for-label compiler/cm))
+          (for-label compiler/cm
+                     racket/promise))
 
 @title[#:tag "extending-drracket"]{Extending DrRacket}
 
@@ -163,4 +164,13 @@ Several environment variables can affect DrRacket's behavior:
        @exec{setup-plt} with the @Flag{c} flag, set the environment
        variable, and then run @exec{setup-plt} again.}
 
+ @item{@indexed-envvar{PLTDRXREFDELAY} : When this environment variable
+        is set, DrRacket uses an ordinary @scheme[delay] (instead of
+        @scheme[delay/idle]) delay the computation of the searching
+        indicies. This means that Check Syntax will start more slowly
+        the first time, but that the startup performance is more
+        predictable. In addition, when the environment variable is
+        set, DrRacket will print out that it is set, and will print
+        when the index is started loading and when it finishes loading.}
+
 ]
diff --git a/collects/tests/drracket/memory-log.rkt b/collects/tests/drracket/memory-log.rkt
index 4df104ee2f..482c5ebb1d 100644
--- a/collects/tests/drracket/memory-log.rkt
+++ b/collects/tests/drracket/memory-log.rkt
@@ -1,6 +1,8 @@
 #lang racket/base
 (require "drracket-test-util.rkt"
-         racket/gui/base)
+         racket/gui/base
+         racket/class
+         framework/test)
 
 ;; mem-cnt returns the amount of memory used, iterating (collect-garbage)
 ;; until the delta is less than 10k or we've done it 20 times.
@@ -17,12 +19,30 @@
         [else
          (loop new-cmu (- n 1))]))))
     
+(void (putenv "PLTDRXREFDELAY" "yes"))
+
+(define (wait-and-print)
+  (let ([s (make-semaphore 0)])
+    ;; let two rounds of pending events be handled. 
+    (queue-callback (λ () (queue-callback  (λ () (semaphore-post s)) #f)) #f)
+    (yield s)
+    
+    ;; print out memory use in a fake form to be tracked by drdr
+    (let ([n (mem-cnt)])
+      (printf "cpu time: ~a real time: ~a gc time: ~a\n"
+              n n n))))
+
+(printf "The printouts below are designed to trick drdr into graphing them;\nthey aren't times, but memory usage.\n")
 (fire-up-drscheme-and-run-tests 
  (λ ()
-   (let ([drscheme-frame (wait-for-drscheme-frame)]
-         [s (make-semaphore 0)])
-     (queue-callback (λ () (queue-callback  (λ () (semaphore-post s)) #f)) #f)
-     (yield s) ;; let two rounds of pending events be handled. 
-     (let ([n (mem-cnt)])
-       (printf "cpu time: ~a real time: ~a gc time: ~a\n"
-               n n n)))))
+   (let ([drs-frame (wait-for-drscheme-frame)])
+     
+     (wait-and-print)
+     
+     (send (send drs-frame get-definitions-text) insert "#lang racket/base\n+")
+     (set-module-language!)
+     (test:run-one (lambda () (send (send drs-frame syncheck:get-button) command)))
+     (wait-for-computation drs-frame)
+     
+     (wait-and-print))))     
+