diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/eval-helpers.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/eval-helpers-and-pref-init.rkt similarity index 95% rename from pkgs/drracket-pkgs/drracket/drracket/private/eval-helpers.rkt rename to pkgs/drracket-pkgs/drracket/drracket/private/eval-helpers-and-pref-init.rkt index 75b66eedb0..09b56cffa7 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/eval-helpers.rkt +++ b/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 diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/eval.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/eval.rkt index 1f260acd63..abf47f1abd 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/eval.rkt +++ b/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) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/expanding-place.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/expanding-place.rkt index 37ada93f03..5701079fa8 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/expanding-place.rkt +++ b/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 - ;; constant is used back in the drracket place - "Expansion thread terminated unexpectedly" + ;; note: this message is not used directly, a string + ;; 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: diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/main.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/main.rkt index beabcef699..5da5c7fc2f 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/main.rkt +++ b/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) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/module-browser.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/module-browser.rkt index e961270429..24a6cb1326 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/module-browser.rkt +++ b/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 diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/module-language.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/module-language.rkt index 1d724dbd03..ffa369801b 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/module-language.rkt +++ b/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) - (list (exn-info sc-abnormal-termination '() '() #f)) + (if (equal? (vector-ref res 0) 'abnormal-termination) + (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))) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/syncheck/gui.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/syncheck/gui.rkt index fd61ba0822..66b8aada68 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/syncheck/gui.rkt +++ b/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" diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/syncheck/online-comp.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/syncheck/online-comp.rkt index da3df1f7eb..04a1c13537 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/syncheck/online-comp.rkt +++ b/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" diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/unit.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/unit.rkt index 6a186b8933..84e55b243f 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/unit.rkt +++ b/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"