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

This commit is contained in:
Robby Findler 2014-09-12 17:13:39 -05:00
parent c05bd45dae
commit d495f74648
9 changed files with 37 additions and 18 deletions

View File

@ -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

View File

@ -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)

View File

@ -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:

View File

@ -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)

View File

@ -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

View File

@ -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)))

View File

@ -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"

View File

@ -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"

View File

@ -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"