From 9ab5ba0fbc0cd32dcf8fbd918459ecf36b62bb18 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 11 May 2020 09:45:52 -0600
Subject: [PATCH] cs: fix interaction of places and 'GC log receivers

Related to #3174
---
 .../tests/racket/place-gc-logger.rkt          | 25 +++++++++++++++++
 racket/src/thread/pre-poll.rkt                | 28 +++++++++++--------
 2 files changed, 41 insertions(+), 12 deletions(-)
 create mode 100644 pkgs/racket-test/tests/racket/place-gc-logger.rkt

diff --git a/pkgs/racket-test/tests/racket/place-gc-logger.rkt b/pkgs/racket-test/tests/racket/place-gc-logger.rkt
new file mode 100644
index 0000000000..24d3805f1c
--- /dev/null
+++ b/pkgs/racket-test/tests/racket/place-gc-logger.rkt
@@ -0,0 +1,25 @@
+#lang racket/base
+(require racket/place)
+
+(define (churn n)
+  (let loop ([l (cons "" 0)])
+    (if (equal? (cdr l) n)
+        (string-length (car l))
+        (loop (cons (make-string 512 #\x)
+                    (add1 (cdr l)))))))
+
+(define (go)
+  (place pch
+         (churn 100000)))
+
+(module+ main
+  (go)
+  (define receiver
+    (make-log-receiver (current-logger) 'debug 'GC))
+  (void
+   (thread
+    (lambda ()
+      (let loop ()
+        (sync receiver)
+        (loop)))))
+  (churn 100000))
diff --git a/racket/src/thread/pre-poll.rkt b/racket/src/thread/pre-poll.rkt
index 23b894e300..066b85de19 100644
--- a/racket/src/thread/pre-poll.rkt
+++ b/racket/src/thread/pre-poll.rkt
@@ -1,26 +1,30 @@
 #lang racket/base
 (require "atomic.rkt"
-         "host.rkt")
+         "host.rkt"
+         "place-object.rkt")
 
 (provide unsafe-add-pre-poll-callback!
          call-pre-poll-external-callbacks)
 
+;; Callbacks for the original place only:
 (define pre-poll-callbacks null)
 
-;; called in atomic mode in an arbitrary host thread, but
+;; Called in atomic mode in an arbitrary host thread, but
 ;; with all other host threads paused; the given procedure
-;; will be called in atomic mode, possibly in the schduler
+;; will be called in atomic mode, possibly in the schduler,
+;; in the original place
 (define (unsafe-add-pre-poll-callback! proc)
   (set! pre-poll-callbacks (cons proc pre-poll-callbacks)))
 
 ;; in atomic mode
 (define (call-pre-poll-external-callbacks)
-  (unless (null? pre-poll-callbacks)
-    ;; disable interrupts to avoid a case with `unsafe-add-pre-poll-callback!`
-    (host:disable-interrupts)
-    (define l pre-poll-callbacks)
-    (set! pre-poll-callbacks null)
-    (host:enable-interrupts)
-    ;; Call the callbacks
-    (for ([cb (in-list (reverse l))])
-      (cb))))
+  (when (eq? current-place initial-place)
+    (unless (null? pre-poll-callbacks)
+      ;; disable interrupts to avoid a case with `unsafe-add-pre-poll-callback!`
+      (host:disable-interrupts)
+      (define l pre-poll-callbacks)
+      (set! pre-poll-callbacks null)
+      (host:enable-interrupts)
+      ;; Call the callbacks
+      (for ([cb (in-list (reverse l))])
+        (cb)))))