From 78b2e47541bcbb591c7a18df9b9292e47e58923c Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 21 Dec 2010 18:45:36 -0700
Subject: [PATCH] fix more try-atomic problems

---
 collects/ffi/unsafe/try-atomic.rkt       | 16 ++++++++++------
 collects/mred/private/wx/win32/frame.rkt |  3 ++-
 src/racket/src/thread.c                  |  4 ++++
 3 files changed, 16 insertions(+), 7 deletions(-)

diff --git a/collects/ffi/unsafe/try-atomic.rkt b/collects/ffi/unsafe/try-atomic.rkt
index 6f976a645a..00a22c46f2 100644
--- a/collects/ffi/unsafe/try-atomic.rkt
+++ b/collects/ffi/unsafe/try-atomic.rkt
@@ -15,10 +15,13 @@
 (define scheme_restore_on_atomic_timeout 
   (get-ffi-obj 'scheme_set_on_atomic_timeout #f (_fun _pointer -> _pointer)))
 
-(define freezer-box (make-parameter #f))
+(define freezer-box-key (gensym))
 (define freeze-tag (make-continuation-prompt-tag))
 (define force-timeout (make-parameter #f))
 
+(define (freezer-box)
+  (continuation-mark-set-first #f freezer-box-key))
+
 ;; Runs `thunk' atomically, but cooperates with 
 ;; `try-atomic' to continue a frozen
 ;; computation in non-atomic mode.
@@ -36,13 +39,14 @@
                     ;; Start with an empty list of things to finish:
                     null))])
     (begin0
-     (parameterize ([freezer-box b])
+     (with-continuation-mark freezer-box-key b
        ;; In atomic mode (but not using call-as-atomic, because we
        ;; don't want to change the exception handler, etc.)
-       (start-atomic)
-       (begin0 
-        (thunk)
-        (end-atomic)))
+       (begin
+         (start-atomic)
+         (begin0 
+          (thunk)
+          (end-atomic))))
      ;; Retries out of atomic mode:
      (let ([l (unbox b)])
        (for ([k (in-list (reverse l))])
diff --git a/collects/mred/private/wx/win32/frame.rkt b/collects/mred/private/wx/win32/frame.rkt
index 5ebf30e677..c6c0a5296e 100644
--- a/collects/mred/private/wx/win32/frame.rkt
+++ b/collects/mred/private/wx/win32/frame.rkt
@@ -210,7 +210,8 @@
      [(= msg WM_CLOSE)
       (queue-window-event this (lambda () 
 				 (when (on-close)
-				   (direct-show #f))))
+                                   (atomically
+                                    (direct-show #f)))))
       0]
      [(and (= msg WM_SIZE)
            (not (= wParam SIZE_MINIMIZED)))
diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c
index ad0cb3cb30..14e20b8768 100644
--- a/src/racket/src/thread.c
+++ b/src/racket/src/thread.c
@@ -4634,7 +4634,11 @@ int scheme_wait_until_suspend_ok(void)
 
   while (do_atomic && scheme_on_atomic_timeout) {
     did = 1;
+    if (atomic_timeout_auto_suspend)
+      atomic_timeout_auto_suspend++;
     call_on_atomic_timeout(1);
+    if (atomic_timeout_auto_suspend > 1)
+      --atomic_timeout_auto_suspend;
   }
 
   return did;