From f347fe299aafe7b0011961829daab43f13774e98 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 8 Jan 2021 12:04:18 -0700
Subject: [PATCH] cs & io: fix atomic-mode step in `sync/enable-break`

---
 racket/src/cs/schemified/thread.scm | 15 +++++++++------
 racket/src/thread/atomic.rkt        | 13 ++++++++-----
 racket/src/thread/place.rkt         |  1 +
 racket/src/thread/thread.rkt        | 14 +++++++-------
 4 files changed, 25 insertions(+), 18 deletions(-)

diff --git a/racket/src/cs/schemified/thread.scm b/racket/src/cs/schemified/thread.scm
index d02977fd23..02805a4cc7 100644
--- a/racket/src/cs/schemified/thread.scm
+++ b/racket/src/cs/schemified/thread.scm
@@ -7978,12 +7978,15 @@
            (hasheq ignore_0 #t bc_0 #t)))))))
 (define thread-remove-ignored-break-cell!
   (lambda (t_0 bc_0)
-    (if (thread-ignore-break-cell? t_0 bc_0)
-      (let ((ignore_0 (thread-ignore-break-cells t_0)))
-        (set-thread-ignore-break-cells!
-         t_0
-         (if (eq? ignore_0 bc_0) #f (hash-remove ignore_0 bc_0))))
-      (void))))
+    (begin
+      (start-atomic)
+      (if (thread-ignore-break-cell? t_0 bc_0)
+        (let ((ignore_0 (thread-ignore-break-cells t_0)))
+          (set-thread-ignore-break-cells!
+           t_0
+           (if (eq? ignore_0 bc_0) #f (hash-remove ignore_0 bc_0))))
+        (void))
+      (end-atomic))))
 (define enqueue-mail!
   (lambda (thd_0 v_0) (queue-add! (thread-mailbox thd_0) v_0)))
 (define dequeue-mail!
diff --git a/racket/src/thread/atomic.rkt b/racket/src/thread/atomic.rkt
index db3b1625a6..313c33fdfa 100644
--- a/racket/src/thread/atomic.rkt
+++ b/racket/src/thread/atomic.rkt
@@ -4,7 +4,8 @@
          "place-local.rkt"
          "internal-error.rkt"
          "parameter.rkt"
-         "debug.rkt")
+         "debug.rkt"
+         (for-syntax racket/base))
 
 (provide atomically
          current-atomic
@@ -145,10 +146,12 @@
       (internal-error "not implicitly in atomic mode?"))
     (current-implicit-atomic #f))
 
-  (define-syntax-rule (assert-atomic-mode)
-    (unless (or (current-implicit-atomic)
-                (positive? (current-atomic)))
-      (internal-error "should be in atomic mode")))]
+  (define-syntax (assert-atomic-mode stx)
+    (syntax-case stx ()
+      [(_)
+       #`(unless (or (current-implicit-atomic)
+                     (positive? (current-atomic)))
+           (internal-error #,(format "should be in atomic mode: ~s" stx)))]))]
  #:off
  [(define-syntax-rule (start-implicit-atomic-mode) (begin))
   (define-syntax-rule (end-implicit-atomic-mode) (begin))
diff --git a/racket/src/thread/place.rkt b/racket/src/thread/place.rkt
index e478e5dc1a..b16b9af7f3 100644
--- a/racket/src/thread/place.rkt
+++ b/racket/src/thread/place.rkt
@@ -90,6 +90,7 @@
   (define host-thread
     (host:fork-place
      (lambda ()
+       (start-implicit-atomic-mode)
        (call-in-another-main-thread
         orig-cust
         (lambda ()
diff --git a/racket/src/thread/thread.rkt b/racket/src/thread/thread.rkt
index 433cd95996..a11e441324 100644
--- a/racket/src/thread/thread.rkt
+++ b/racket/src/thread/thread.rkt
@@ -890,14 +890,14 @@
                                          ;; Convert to set
                                          (hasheq ignore #t bc #t)]))))
 
-;; in atomic mode
 (define (thread-remove-ignored-break-cell! t bc)
-  (assert-atomic-mode)
-  (when (thread-ignore-break-cell? t bc)
-    (let ([ignore (thread-ignore-break-cells t)])
-      (set-thread-ignore-break-cells! t (cond
-                                          [(eq? ignore bc) #f]
-                                          [else (hash-remove ignore bc)])))))
+  (atomically
+   (when (thread-ignore-break-cell? t bc)
+     (let ([ignore (thread-ignore-break-cells t)])
+       (set-thread-ignore-break-cells! t (cond
+                                           [(eq? ignore bc) #f]
+                                           [else (hash-remove ignore bc)]))))
+   (void)))
 
 ;; ----------------------------------------
 ;; Thread mailboxes