adjust drracket's online expansion to terminate out-of-memory expansion attempts

pkgs/drracket-pkgs/drracket/drracket/private/eval-helpers-and-pref-init.rkt

@@ -7,6 +7,7 @@
          setup/dirs
          planet/config
          pkg/lib
+         framework/preferences
          (prefix-in *** '#%foreign) ;; just to make sure it is here
          )
 
@@ -16,6 +17,12 @@
          transform-module
          get-init-dir)
 
+(preferences:set-default 'drracket:child-only-memory-limit
+                         (* 1024 1024 128)
+                         (λ (x) (or (not x)
+                                    (and (exact-integer? x)
+                                         (x . >= . (* 1024 1024 8))))))
+
 ;; get-init-dir : (or/c path? #f) -> path?
 ;; returns the initial directory for a program
 ;; that is saved in 'path/f' (with #f indicating

pkgs/drracket-pkgs/drracket/drracket/private/eval.rkt

@@ -6,7 +6,7 @@
            racket/class
            syntax/toplevel
            framework
-           "eval-helpers.rkt"
+           "eval-helpers-and-pref-init.rkt"
            "local-member-names.rkt"
            drracket/private/drsig)
   

pkgs/drracket-pkgs/drracket/drracket/private/expanding-place.rkt

@@ -2,8 +2,9 @@
 (require racket/place
          racket/port
          racket/list
-         "eval-helpers.rkt"
+         "eval-helpers-and-pref-init.rkt"
          compiler/cm
+         framework/preferences
          syntax/readerr)
 (provide start)
 
@@ -93,7 +94,15 @@
 (struct exn:access exn:fail ())
 
 (define (new-job program-as-string path response-pc settings pc-status-expanding-place)
-  (define cust (make-custodian))
+  (define custodian-limit
+    (and (custodian-memory-accounting-available?)
+         (preferences:get 'drracket:child-only-memory-limit)))
+  (define cust-parent (make-custodian))
+  (define cust (parameterize ([current-custodian cust-parent])
+                 (make-custodian)))
+  (when custodian-limit
+    (custodian-limit-memory cust-parent custodian-limit cust-parent))
+  (define memory-killed-cust-box (make-custodian-box cust-parent #t))
   (define exn-chan (make-channel))
   (define extra-exns-chan (make-channel))
   (define result-chan (make-channel))
@@ -258,9 +267,12 @@
            (place-channel-put 
             response-pc
             (vector 'abnormal-termination 
-                    ;; note: this message is actually ignored: a string 
+                    ;; note: this message is not used directly, a string 
-                    ;; constant is used back in the drracket place
+                    ;; constant is used back in the drracket place; but
+                    ;; this is checked to see if it was an out of memory error
+                    (if (custodian-box-value memory-killed-cust-box)
                         "Expansion thread terminated unexpectedly"
+                        "Expansion thread terminated unexpectedly (out of memory)")
                     '()
                     
                     ;; give up on dep paths in this case:

pkgs/drracket-pkgs/drracket/drracket/private/main.rkt

@@ -131,11 +131,6 @@
                          (listof (cons/c 'lib (listof string?))))
 (drr:set-default 'drracket:defs/ints-horizontal #f boolean?)
 
-(drr:set-default 'drracket:child-only-memory-limit (* 1024 1024 128)
-                         (λ (x) (or (boolean? x)
-                                    (exact-integer? x)
-                                    (x . >= . (* 1024 1024 8)))))
-
 (drr:set-default 'drracket:recent-language-names 
                          null 
                          (λ (x) 

pkgs/drracket-pkgs/drracket/drracket/private/module-browser.rkt

@@ -11,7 +11,7 @@
          string-constants
          mrlib/graph
          drracket/private/drsig
-         "eval-helpers.rkt"
+         "eval-helpers-and-pref-init.rkt"
          racket/unit
          racket/async-channel
          racket/match

pkgs/drracket-pkgs/drracket/drracket/private/module-language.rkt

@@ -23,7 +23,7 @@
          "tooltip.rkt"
          drracket/private/drsig
          "rep.rkt"
-         "eval-helpers.rkt"
+         "eval-helpers-and-pref-init.rkt"
          "local-member-names.rkt"
          "rectangle-intersect.rkt"
          pkg/lib
@@ -79,6 +79,8 @@
 (define sc-only-raw-text-files-supported 
   (string-constant online-expansion-only-raw-text-files-supported))
 (define sc-abnormal-termination (string-constant online-expansion-abnormal-termination))
+(define sc-abnormal-termination-out-of-memory 
+  (string-constant online-expansion-abnormal-termination-out-of-memory))
 (define sc-jump-to-error (string-constant jump-to-error))
 (define sc-finished-successfully (string-constant online-expansion-finished-successfully))
 
@@ -2192,8 +2194,11 @@
          (line-of-interest)
          (send running-tab set-oc-status
                (clean (vector-ref res 0)
-                      (if (eq? (vector-ref res 0) 'abnormal-termination)
+                      (if (equal? (vector-ref res 0) 'abnormal-termination)
-                          (list (exn-info sc-abnormal-termination '() '() #f))
+                          (list (exn-info (if (regexp-match #rx"memory" (vector-ref res 1))
+                                              sc-abnormal-termination-out-of-memory
+                                              sc-abnormal-termination)
+                                          '() '() #f))
                           (vector-ref res 1))))
          (send running-tab set-dep-paths (list->set (vector-ref res 2)) #t)])
       (oc-maybe-start-something)))

pkgs/drracket-pkgs/drracket/drracket/private/syncheck/gui.rkt

@@ -40,7 +40,7 @@ If the namespace does not, they are colored the unbound color.
          (for-syntax racket/base)
          (only-in ffi/unsafe register-finalizer)
          "../../syncheck-drracket-button.rkt"
-         "../../private/eval-helpers.rkt"
+         "../../private/eval-helpers-and-pref-init.rkt"
          "intf.rkt"
          "local-member-names.rkt"
          "colors.rkt"

pkgs/drracket-pkgs/drracket/drracket/private/syncheck/online-comp.rkt

@@ -4,7 +4,7 @@
          racket/match
          racket/contract
          (for-syntax racket/base)
-         "../../private/eval-helpers.rkt"
+         "../../private/eval-helpers-and-pref-init.rkt"
          "traversals.rkt"
          "local-member-names.rkt"
          "intf.rkt"

pkgs/drracket-pkgs/drracket/drracket/private/unit.rkt

@@ -25,7 +25,7 @@
          "insert-large-letters.rkt"
          "get-defs.rkt"
          "local-member-names.rkt"
-         "eval-helpers.rkt"
+         "eval-helpers-and-pref-init.rkt"
          "parse-logger-args.rkt"
          "get-module-path.rkt"
          "named-undefined.rkt"