suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added a memory limit option

Browse Source 
svn: r6027
This commit is contained in:
Robby Findler 2007-04-23 23:36:30 +00:00
parent 34568d5702
commit 93492c90b6
3 changed files with 88 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/drscheme/private/main.ss
View File

@ -58,6 +58,10 @@
(finder:default-filters))) (finder:default-filters)))
(application:current-app-name (string-constant drscheme)) (application:current-app-name (string-constant drscheme))
(preferences:set-default 'drscheme:limit-memory #f
(λ (x) (or (boolean? x)
(integer? x)
(x . >= . (* 1024 1024 100)))))
(preferences:set-default 'drscheme:recent-language-names (preferences:set-default 'drscheme:recent-language-names
null null

45
collects/drscheme/private/rep.ss
View File

@ -896,6 +896,14 @@ TODO
(field (user-language-settings #f) (field (user-language-settings #f)
(user-teachpack-cache (preferences:get 'drscheme:teachpacks)) (user-teachpack-cache (preferences:get 'drscheme:teachpacks))
(user-custodian #f) (user-custodian #f)
(custodian-limit (and (with-handlers ([exn:fail:unsupported? (λ (x) #f)])
(let ([c (make-custodian)])
(custodian-limit-memory
c
100
c))
#t)
(preferences:get 'drscheme:limit-memory)))
(user-eventspace-box (make-weak-box #f)) (user-eventspace-box (make-weak-box #f))
(user-namespace-box (make-weak-box #f)) (user-namespace-box (make-weak-box #f))
(user-eventspace-main-thread #f) (user-eventspace-main-thread #f)
@ -913,9 +921,9 @@ TODO
(define/public (get-user-thread) user-eventspace-main-thread) (define/public (get-user-thread) user-eventspace-main-thread)
(define/public (get-user-namespace) (weak-box-value user-namespace-box)) (define/public (get-user-namespace) (weak-box-value user-namespace-box))
(define/pubment (get-user-break-parameterization) user-break-parameterization) ;; final method (define/pubment (get-user-break-parameterization) user-break-parameterization) ;; final method
(define/pubment (get-custodian-limit) custodian-limit)
(define/pubment (set-custodian-limit c) (set! custodian-limit c))
(field (in-evaluation? #f) (field (in-evaluation? #f)
(should-collect-garbage? #f)
(ask-about-kill? #f)) (ask-about-kill? #f))
(define/public (get-in-evaluation?) in-evaluation?) (define/public (get-in-evaluation?) in-evaluation?)
@ -1033,9 +1041,6 @@ TODO
(send context reset-offer-kill) (send context reset-offer-kill)
(send context set-breakables (get-user-thread) (get-user-custodian)) (send context set-breakables (get-user-thread) (get-user-custodian))
(reset-pretty-print-width) (reset-pretty-print-width)
(when should-collect-garbage?
(set! should-collect-garbage? #f)
(collect-garbage))
(set! in-evaluation? #t) (set! in-evaluation? #t)
(update-running #t) (update-running #t)
(set! need-interaction-cleanup? #t) (set! need-interaction-cleanup? #t)
@ -1140,7 +1145,8 @@ TODO
(set! user-language-settings (send definitions-text get-next-settings)) (set! user-language-settings (send definitions-text get-next-settings))
(set! user-custodian (make-custodian)) (set! user-custodian (make-custodian))
; (custodian-limit-memory user-custodian 10000000 user-custodian) (when custodian-limit
(custodian-limit-memory user-custodian custodian-limit user-custodian))
(let ([user-eventspace (parameterize ([current-custodian user-custodian]) (let ([user-eventspace (parameterize ([current-custodian user-custodian])
(make-eventspace))]) (make-eventspace))])
(set! user-eventspace-box (make-weak-box user-eventspace)) (set! user-eventspace-box (make-weak-box user-eventspace))
@ -1168,18 +1174,20 @@ TODO
(let ([drscheme-exit-handler (let ([drscheme-exit-handler
(λ (x) (λ (x)
(let ([s (make-semaphore)]) (parameterize-break
(parameterize ([current-eventspace drs-eventspace]) #f
(queue-callback (let ([s (make-semaphore)])
(λ () (parameterize ([current-eventspace drs-eventspace])
(set! user-exit-code (queue-callback
(if (and (integer? x) (λ ()
(<= 0 x 255)) (set! user-exit-code
x (if (and (integer? x)
0)) (<= 0 x 255))
(semaphore-post s)))) x
(semaphore-wait s) 0))
(custodian-shutdown-all user-custodian)))]) (semaphore-post s))))
(semaphore-wait s)
(custodian-shutdown-all user-custodian))))])
(exit-handler drscheme-exit-handler)) (exit-handler drscheme-exit-handler))
(initialize-parameters snip-classes)))) (initialize-parameters snip-classes))))
@ -1411,7 +1419,6 @@ TODO
(clear-box-input-port) (clear-box-input-port)
(clear-output-ports) (clear-output-ports)
(set-allow-edits #t) (set-allow-edits #t)
(set! should-collect-garbage? #t)
;; in case the last evaluation thread was killed, clean up some state. ;; in case the last evaluation thread was killed, clean up some state.
(lock #f) (lock #f)

59
collects/drscheme/private/unit.ss
View File

@ -1630,9 +1630,63 @@ module browser threading seems wrong.
(preferences:get 'framework:print-output-mode))))) (preferences:get 'framework:print-output-mode)))))
(super file-menu:between-print-and-close file-menu)) (super file-menu:between-print-and-close file-menu))
(define limit-memory-menu-item #f)
(define/override (edit-menu:between-find-and-preferences edit-menu) (define/override (edit-menu:between-find-and-preferences edit-menu)
(super edit-menu:between-find-and-preferences edit-menu) (super edit-menu:between-find-and-preferences edit-menu)
(add-modes-submenu edit-menu)) (add-modes-submenu edit-menu)
(when (with-handlers ([exn:fail:unsupported? (λ (x) #f)])
(let ([c (make-custodian)])
(custodian-limit-memory
c
100
c))
#t)
(set! limit-memory-menu-item
(new menu-item%
[label ""]
[parent edit-menu]
[callback
(λ (item b)
(let ([current-limit (send interactions-text get-custodian-limit)])
(cond
[current-limit
(preferences:set 'drscheme:limit-memory #f)
(send interactions-text set-custodian-limit #f)]
[else
(let ([num-str
(get-text-from-user
(string-constant drscheme)
(string-append
"Please choose a limit, in megabytes\n"
"The limit will take effect on the next Run of the program.")
this
(format "~a" (* 1/2 1024)))])
(when num-str
(let ([num (string->number num-str)])
(cond
[(and num
(integer? num)
(num . >= . 100))
(preferences:set 'drscheme:limit-memory (* 1024 1024 num))
(send interactions-text set-custodian-limit (* 1024 1024 num))]
[else
(message-box (string-constant drscheme)
"Expected a positive integer (as a series of digits without commas) that is greater than 100"
this)]))))])
(update-limit-memory-menu-item-label
(send interactions-text get-custodian-limit))))])))
(update-limit-memory-menu-item-label (preferences:get 'drscheme:limit-memory)))
(define/private (update-limit-memory-menu-item-label limit)
(when limit-memory-menu-item
(send limit-memory-menu-item set-label
(if limit
(format "Disable memory limit (currently ~a megabytes)"
(floor (/ limit 1024 1024)))
"Limit memory..."))))
; ;
@ -2227,6 +2281,9 @@ module browser threading seems wrong.
(send from-defs set-delegate #f) (send from-defs set-delegate #f)
(send to-defs set-delegate delegate))) (send to-defs set-delegate delegate)))
(update-limit-memory-menu-item-label
(send interactions-text get-custodian-limit))
(inner (void) on-tab-change from-tab to-tab)) (inner (void) on-tab-change from-tab to-tab))
(define/public (next-tab) (change-to-delta-tab +1)) (define/public (next-tab) (change-to-delta-tab +1))