From db1d1916b5ce1cb6d673292e48d4f2522b6152e0 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 23 Apr 2020 15:25:55 -0600
Subject: [PATCH] cs: fix a semi-leak for places

The most recently created place's data could be retained
after the place terminated.
---
 .../tests/racket/core-tests.rktl              |  2 +-
 racket/src/cs/main.sps                        |  5 ++++-
 racket/src/cs/rumble/memory.ss                |  3 ++-
 racket/src/thread/schedule.rkt                | 19 ++++++++++++-------
 4 files changed, 19 insertions(+), 10 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/core-tests.rktl b/pkgs/racket-test-core/tests/racket/core-tests.rktl
index 9d09d3edbf..46ce49ffba 100644
--- a/pkgs/racket-test-core/tests/racket/core-tests.rktl
+++ b/pkgs/racket-test-core/tests/racket/core-tests.rktl
@@ -17,7 +17,7 @@
 (load-relative "stxparam.rktl")
 (load-relative "number.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-derived.rktl")
 (load-relative "thread.rktl")
diff --git a/racket/src/cs/main.sps b/racket/src/cs/main.sps
index 4602497d25..ba8765c553 100644
--- a/racket/src/cs/main.sps
+++ b/racket/src/cs/main.sps
@@ -722,7 +722,7 @@
                (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!)
      (current-command-line-arguments remaining-command-line-arguments)
@@ -831,6 +831,9 @@
           (dump-memory-stats)
           (apply orig args)))))
 
+   (when (getenv "PLT_MAX_COMPACT_GC")
+     (in-place-minimum-generation 254))
+
    (when version?
      (display (banner)))
    (call/cc ; Chez Scheme's `call/cc`, used here to escape from the Racket-thread engine loop
diff --git a/racket/src/cs/rumble/memory.ss b/racket/src/cs/rumble/memory.ss
index 77c497132a..35b19c3575 100644
--- a/racket/src/cs/rumble/memory.ss
+++ b/racket/src/cs/rumble/memory.ss
@@ -357,7 +357,8 @@
                                             (cond
                                              [(zero? len) (void)]
                                              [(not o) (set-box! prev-trace (reverse accum))]
-                                             [(#%memq o (unbox prev-trace))
+                                             [(and (not (null? o))
+                                                   (#%memq o (unbox prev-trace)))
                                               => (lambda (l)
                                                    (#%printf " <- DITTO\n")
                                                    (set-box! prev-trace (append (reverse accum) l)))]
diff --git a/racket/src/thread/schedule.rkt b/racket/src/thread/schedule.rkt
index 96092e6c21..dd4c55c8c0 100644
--- a/racket/src/thread/schedule.rkt
+++ b/racket/src/thread/schedule.rkt
@@ -31,12 +31,10 @@
 
 ;; Initializes the thread system:
 (define (call-in-main-thread thunk)
-  (make-initial-thread (lambda ()
-                         (set-place-host-roots! initial-place (host:current-place-roots))
-                         (thunk)))
-  (call-with-engine-completion
-   (lambda (done)
-     (poll-and-select-thread! 0))))
+  (call-in-new-main-thread
+   (lambda ()
+     (set-place-host-roots! initial-place (host:current-place-roots))
+     (thunk))))
 
 ;; Initializes the thread system in a new place:
 (define (call-in-another-main-thread c thunk)
@@ -46,7 +44,14 @@
   (init-future-place!)
   (init-schedule-counters!)
   (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))))
 
 ;; ----------------------------------------