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)))
(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
null

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

@ -896,6 +896,14 @@ TODO
(field (user-language-settings #f)
(user-teachpack-cache (preferences:get 'drscheme:teachpacks))
(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-namespace-box (make-weak-box #f))
(user-eventspace-main-thread #f)
@ -913,9 +921,9 @@ TODO
(define/public (get-user-thread) user-eventspace-main-thread)
(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-custodian-limit) custodian-limit)
(define/pubment (set-custodian-limit c) (set! custodian-limit c))
(field (in-evaluation? #f)
(should-collect-garbage? #f)
(ask-about-kill? #f))
(define/public (get-in-evaluation?) in-evaluation?)
@ -1033,9 +1041,6 @@ TODO
(send context reset-offer-kill)
(send context set-breakables (get-user-thread) (get-user-custodian))
(reset-pretty-print-width)
(when should-collect-garbage?
(set! should-collect-garbage? #f)
(collect-garbage))
(set! in-evaluation? #t)
(update-running #t)
(set! need-interaction-cleanup? #t)
@ -1140,7 +1145,8 @@ TODO
(set! user-language-settings (send definitions-text get-next-settings))
(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])
(make-eventspace))])
(set! user-eventspace-box (make-weak-box user-eventspace))
@ -1168,6 +1174,8 @@ TODO
(let ([drscheme-exit-handler
(λ (x)
(parameterize-break
#f
(let ([s (make-semaphore)])
(parameterize ([current-eventspace drs-eventspace])
(queue-callback
@ -1179,7 +1187,7 @@ TODO
0))
(semaphore-post s))))
(semaphore-wait s)
(custodian-shutdown-all user-custodian)))])
(custodian-shutdown-all user-custodian))))])
(exit-handler drscheme-exit-handler))
(initialize-parameters snip-classes))))
@ -1411,7 +1419,6 @@ TODO
(clear-box-input-port)
(clear-output-ports)
(set-allow-edits #t)
(set! should-collect-garbage? #t)
;; in case the last evaluation thread was killed, clean up some state.
(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)))))
(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)
(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 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))
(define/public (next-tab) (change-to-delta-tab +1))