cs: fix a semi-leak for places

The most recently created place's data could be retained
after the place terminated.
This commit is contained in:
Matthew Flatt 2020-04-23 15:25:55 -06:00
parent f5a4180803
commit db1d1916b5
4 changed files with 19 additions and 10 deletions

View File

@ -17,7 +17,7 @@
(load-relative "stxparam.rktl") (load-relative "stxparam.rktl")
(load-relative "number.rktl") (load-relative "number.rktl")
(load-relative "unsafe.rktl") (load-relative "unsafe.rktl")
(load-relative "object.rktl") (load-in-sandbox "object.rktl") ; sandbox usefully avoids heap growth here
(load-relative "struct.rktl") (load-relative "struct.rktl")
(load-relative "struct-derived.rktl") (load-relative "struct-derived.rktl")
(load-relative "thread.rktl") (load-relative "thread.rktl")

View File

@ -722,7 +722,7 @@
(parse-logging-spec "syslog" spec "in PLTSYSLOG environment variable" #f) (parse-logging-spec "syslog" spec "in PLTSYSLOG environment variable" #f)
'())))) '()))))
(define gcs-on-exit? (and (getenv "PLT_GCS_ON_EXIT"))) (define gcs-on-exit? (and (getenv "PLT_GCS_ON_EXIT") #t))
(define (initialize-place!) (define (initialize-place!)
(current-command-line-arguments remaining-command-line-arguments) (current-command-line-arguments remaining-command-line-arguments)
@ -831,6 +831,9 @@
(dump-memory-stats) (dump-memory-stats)
(apply orig args))))) (apply orig args)))))
(when (getenv "PLT_MAX_COMPACT_GC")
(in-place-minimum-generation 254))
(when version? (when version?
(display (banner))) (display (banner)))
(call/cc ; Chez Scheme's `call/cc`, used here to escape from the Racket-thread engine loop (call/cc ; Chez Scheme's `call/cc`, used here to escape from the Racket-thread engine loop

View File

@ -357,7 +357,8 @@
(cond (cond
[(zero? len) (void)] [(zero? len) (void)]
[(not o) (set-box! prev-trace (reverse accum))] [(not o) (set-box! prev-trace (reverse accum))]
[(#%memq o (unbox prev-trace)) [(and (not (null? o))
(#%memq o (unbox prev-trace)))
=> (lambda (l) => (lambda (l)
(#%printf " <- DITTO\n") (#%printf " <- DITTO\n")
(set-box! prev-trace (append (reverse accum) l)))] (set-box! prev-trace (append (reverse accum) l)))]

View File

@ -31,12 +31,10 @@
;; Initializes the thread system: ;; Initializes the thread system:
(define (call-in-main-thread thunk) (define (call-in-main-thread thunk)
(make-initial-thread (lambda () (call-in-new-main-thread
(lambda ()
(set-place-host-roots! initial-place (host:current-place-roots)) (set-place-host-roots! initial-place (host:current-place-roots))
(thunk))) (thunk))))
(call-with-engine-completion
(lambda (done)
(poll-and-select-thread! 0))))
;; Initializes the thread system in a new place: ;; Initializes the thread system in a new place:
(define (call-in-another-main-thread c thunk) (define (call-in-another-main-thread c thunk)
@ -46,7 +44,14 @@
(init-future-place!) (init-future-place!)
(init-schedule-counters!) (init-schedule-counters!)
(init-sync-place!) (init-sync-place!)
(call-in-main-thread thunk)) (call-in-new-main-thread thunk))
;; Finish initializing the thread system within a place:
(define (call-in-new-main-thread thunk)
(make-initial-thread thunk)
(call-with-engine-completion
(lambda (done)
(poll-and-select-thread! 0))))
;; ---------------------------------------- ;; ----------------------------------------