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

made memory limits be on by default and improved 'killed' dialog to turn up the limits

Browse Source 
svn: r8424
This commit is contained in:
Robby Findler 2008-01-26 14:37:55 +00:00
parent 765a40a2ea
commit 288fb78029
3 changed files with 47 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -71,7 +71,7 @@
(number? (car x))
(number? (cdr x))))))
(preferences:set-default 'drscheme:limit-memory #f
(preferences:set-default 'drscheme:limit-memory (* 1024 1024 128)
(λ (x) (or (boolean? x)
(integer? x)
(x . >= . (* 1024 1024 100)))))

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

@ -532,25 +532,6 @@ TODO
(make-object image-snip% bitmap)
(make-object string-snip% "[err]"))))
(define (no-user-evaluation-message frame exit-code memory-killed?)
(message-box
(string-constant evaluation-terminated)
(string-append
(string-constant evaluation-terminated-explanation)
(if exit-code
(string-append
"\n\n"
(if (zero? exit-code)
(string-constant exited-successfully)
(format (string-constant exited-with-error-code) exit-code)))
"")
(if memory-killed?
(string-append
"\n\n"
(string-constant program-ran-out-of-memory))
""))
frame))
;; insert/delta : (instanceof text%) (union snip string) (listof style-delta%) *-> (values number number)
;; inserts the string/stnip into the text at the end and changes the
;; style of the newly inserted text based on the style deltas.
@ -970,6 +951,38 @@ TODO
(not (thread-running? memory-killed-thread))))))
(field (need-interaction-cleanup? #f))
(define/private (no-user-evaluation-message frame exit-code memory-killed?)
(let* ([new-limit (and custodian-limit (+ (* 1024 1024 128) custodian-limit))]
[ans (message-box/custom
(string-constant evaluation-terminated)
(string-append
(string-constant evaluation-terminated-explanation)
(if exit-code
(string-append
"\n\n"
(if (zero? exit-code)
(string-constant exited-successfully)
(format (string-constant exited-with-error-code) exit-code)))
"")
(if memory-killed?
(string-append
"\n\n"
(string-constant program-ran-out-of-memory))
""))
(string-constant ok)
#f
(and memory-killed?
new-limit
(format "Increase memory limit to ~a megabytes"
(floor (/ new-limit 1024 1024))))
frame
'(default=1 stop)
)])
(when (equal? ans 3)
(set-custodian-limit new-limit)
(preferences:set 'drscheme:limit-memory new-limit))
(void)))
(define/private (cleanup-interaction) ; =Kernel=, =Handler=
(set! need-interaction-cleanup? #f)
(begin-edit-sequence)

14
collects/mred/private/editor.ss
View File

@ -81,6 +81,20 @@
set-modified set-filename
get-file put-file
get-max-undo-history)
(rename-super [super-on-char on-char])
(define time 0)
(define count 0)
(override* [on-char
(λ (evt)
(let-values ([(results cpu real gc)
(time-apply (λ () (super-on-char evt)) '())])
(set! time (+ real time))
(set! count (+ count 1))
(when (= count 20)
(printf "time ~s\n" time)
(set! count 0)
(set! time 0))
(apply values results)))])
(define canvases null)
(define active-canvas #f)
(define auto-set-wrap? #f)