diff --git a/collects/mred/private/lock.rkt b/collects/mred/private/lock.rkt
index 2169434780..7d50f669ba 100644
--- a/collects/mred/private/lock.rkt
+++ b/collects/mred/private/lock.rkt
@@ -1,19 +1,69 @@
-(module lock mzscheme
-  (require racket/draw/lock)
-  (provide as-entry
-           as-exit
-           entry-point
-           (protect mk-param))
+#lang racket/base
+(require (for-syntax racket/base)
+         ffi/unsafe/atomic)
 
-  (define-syntax mk-param
-    (lambda (stx)
-      (syntax-case stx ()
-	[(_ val filter check force-redraw)
-	 (syntax
-	  (case-lambda
-	   [() val]
-	   [(v) (check v)
-	    (let ([v2 (filter v)])
-	      (unless (eq? v2 val)
-		(set! val v2)
-		(force-redraw)))]))]))))
+(provide (protect-out as-entry    ;; alias for call-as-atomic
+                      as-exit     ;; alias for call-as-nonatomic
+                      atomically  ;; assumes no exceptions!
+                      entry-point ;; converts a proc body to use as-entry
+                      mk-param))  ;; parameter pattern --- out of place here
+
+;; We need atomic mode for a couple of reasons:
+;;
+;; * We may need to bracket some (trusted) operations so that the
+;;   queue thread doesn't poll for events during the operation.
+;;   The `atomically' form is ok for that if no exceptions will
+;;   be raised. Otherwise, use the more heavyweight `as-entry'.
+;;
+;; * The scheme/gui classes have internal-consistency requirements.
+;;   When the user creates an object or calls a method, or when the
+;;   system invokes a callback, many steps may be required to
+;;   initialize or reset fields to maintain invariants. To ensure that
+;;   other threads do not call methods during a time when invariants
+;;   do not hold, we force all of the following code to be executed in
+;;   a single threaded manner, and we temporarily disable breaks.
+;;   The `as-entry' form or `entry-point' wrapper is normally used for
+;;   that case.
+;;
+;; If an exception is raised within an `enter'ed area, control is
+;; moved back outside by the exception handler, and then the exception
+;; is re-raised. The user can't tell that the exception was caught an
+;; re-raised. But without the catch-and-reraise, the user's exception
+;; handler might try to use GUI elements from a different thread, or
+;; other such things, leading to deadlock.
+
+(define as-entry call-as-atomic)
+
+(define as-exit call-as-nonatomic)
+
+(define-syntax entry-point 
+  (lambda (stx)
+    (syntax-case stx (lambda #%plain-lambda case-lambda)
+      [(_ (lambda args body1 body ...))
+       (syntax (lambda args (as-entry (lambda () body1 body ...))))]
+      [(_ (#%plain-lambda args body1 body ...))
+       (syntax (#%plain-lambda args (as-entry (lambda () body1 body ...))))]
+      [(_ (case-lambda [vars body1 body ...] ...))
+       (syntax (case-lambda 
+                [vars (as-entry (lambda () body1 body ...))]
+                ...))])))
+
+(define-syntax-rule (atomically expr ...)
+  (begin
+    (start-atomic) 
+    (begin0 (let () expr ...)
+            (end-atomic))))
+
+;; Parameter-method pattern. (Why is this in the "lock" library?)
+(define-syntax mk-param
+  (lambda (stx)
+    (syntax-case stx ()
+      [(_ val filter check force-redraw)
+       (syntax
+        (case-lambda
+         [() val]
+         [(v) (check v)
+          (let ([v2 (filter v)])
+            (unless (eq? v2 val)
+              (set! val v2)
+              (force-redraw)))]))])))
diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt
index 3faad655bb..1c4467a1b5 100644
--- a/collects/mred/private/wx/cocoa/canvas.rkt
+++ b/collects/mred/private/wx/cocoa/canvas.rkt
@@ -235,6 +235,7 @@
       (queue-paint))
 
     (define/public (queue-backing-flush)
+      ;; called atomically (not expecting exceptions)
       (tellv content-cocoa setNeedsDisplay: #:type _BOOL #t))
 
     (define/override (get-cocoa-content) content-cocoa)
diff --git a/collects/mred/private/wx/cocoa/dc.rkt b/collects/mred/private/wx/cocoa/dc.rkt
index bfe3c8c90f..2dab797fe1 100644
--- a/collects/mred/private/wx/cocoa/dc.rkt
+++ b/collects/mred/private/wx/cocoa/dc.rkt
@@ -50,27 +50,26 @@
         (values (unbox xb) (unbox yb))))
 
     (define/override (queue-backing-flush)
+      ;; called atomically (not expecting exceptions)
       (send canvas queue-backing-flush))
 
     (define suspend-count 0)
     (define req #f)
 
     (define/override (suspend-flush) 
-      (as-entry
-       (lambda ()
-         (when (zero? suspend-count)
-           (set! req (request-flush-delay (send canvas get-cocoa-window))))
-         (set! suspend-count (add1 suspend-count))
-         (super suspend-flush))))
+      (atomically
+       (when (zero? suspend-count)
+         (set! req (request-flush-delay (send canvas get-cocoa-window))))
+       (set! suspend-count (add1 suspend-count))
+       (super suspend-flush)))
 
     (define/override (resume-flush) 
-      (as-entry
-       (lambda ()
-         (set! suspend-count (sub1 suspend-count))
-         (when (and (zero? suspend-count) req)
-           (cancel-flush-delay req)
-           (set! req #f))
-         (super resume-flush))))))
+      (atomically
+       (set! suspend-count (sub1 suspend-count))
+       (when (and (zero? suspend-count) req)
+         (cancel-flush-delay req)
+         (set! req #f))
+       (super resume-flush)))))
 
 (define (do-backing-flush canvas dc ctx dx dy)
   (tellv ctx saveGraphicsState)
diff --git a/collects/mred/private/wx/cocoa/dialog.rkt b/collects/mred/private/wx/cocoa/dialog.rkt
index 9ebc246fb0..2e69662900 100644
--- a/collects/mred/private/wx/cocoa/dialog.rkt
+++ b/collects/mred/private/wx/cocoa/dialog.rkt
@@ -14,11 +14,10 @@
 
   (define/override (direct-show on?)
     (unless on?
-      (as-entry
-       (lambda ()
-         (when close-sema
-           (semaphore-post close-sema)
-           (set! close-sema #f)))))
+      (atomically
+       (when close-sema
+         (semaphore-post close-sema)
+         (set! close-sema #f))))
     (super direct-show on?))
 
   ;; #t result avoids children sheets
@@ -26,11 +25,10 @@
 
   (define/override (show on?)
     (if on?
-        (let ([s (as-entry
-                  (lambda ()
-                    (let ([s (or close-sema (make-semaphore))])
-                      (unless close-sema (set! close-sema s))
-                      s)))])
+        (let ([s (atomically
+                  (let ([s (or close-sema (make-semaphore))])
+                    (unless close-sema (set! close-sema s))
+                    s))])
           (super show on?)
           (yield s)
           (void))
diff --git a/collects/mred/private/wx/cocoa/image.rkt b/collects/mred/private/wx/cocoa/image.rkt
index 4d4de0bdcd..f95cf7d10b 100644
--- a/collects/mred/private/wx/cocoa/image.rkt
+++ b/collects/mred/private/wx/cocoa/image.rkt
@@ -60,26 +60,25 @@
     (let ([mask (send bm get-loaded-mask)])
       (when mask
         (send mask get-argb-pixels 0 0 w h str #t)))
-    (as-entry
-     (lambda ()
-       (let ([rgba (scheme_make_sized_byte_string (malloc (* w h 4) 'raw) (* w h 4) 0)])
-         (memcpy rgba str (sub1 (* w h 4)))
-         (let* ([cs (CGColorSpaceCreateDeviceRGB)]
-                [provider (CGDataProviderCreateWithData #f rgba (* w h 4) free-it)]
-                [image (CGImageCreate w
-                                      h
-                                      8
-                                      32
-                                      (* 4 w)
-                                      cs
-                                      (bitwise-ior kCGImageAlphaFirst
-                                                   kCGBitmapByteOrder32Big)
-                                      provider ; frees `rgba'
-                                      #f
-                                      #f
-                                      0)])
-           (CGDataProviderRelease provider)
-           (CGColorSpaceRelease cs)
-           (tell (tell NSImage alloc) 
-                 initWithCGImage: #:type _CGImageRef image
-                 size: #:type _NSSize (make-NSSize w h))))))))
+    (atomically
+     (let ([rgba (scheme_make_sized_byte_string (malloc (* w h 4) 'raw) (* w h 4) 0)])
+       (memcpy rgba str (sub1 (* w h 4)))
+       (let* ([cs (CGColorSpaceCreateDeviceRGB)]
+              [provider (CGDataProviderCreateWithData #f rgba (* w h 4) free-it)]
+              [image (CGImageCreate w
+                                    h
+                                    8
+                                    32
+                                    (* 4 w)
+                                    cs
+                                    (bitwise-ior kCGImageAlphaFirst
+                                                 kCGBitmapByteOrder32Big)
+                                    provider ; frees `rgba'
+                                    #f
+                                    #f
+                                    0)])
+         (CGDataProviderRelease provider)
+         (CGColorSpaceRelease cs)
+         (tell (tell NSImage alloc) 
+               initWithCGImage: #:type _CGImageRef image
+               size: #:type _NSSize (make-NSSize w h)))))))
diff --git a/collects/mred/private/wx/cocoa/list-box.rkt b/collects/mred/private/wx/cocoa/list-box.rkt
index 434ef4b8f9..5495e8b313 100644
--- a/collects/mred/private/wx/cocoa/list-box.rkt
+++ b/collects/mred/private/wx/cocoa/list-box.rkt
@@ -106,16 +106,15 @@
   (define/public (get-selection)
     (tell #:type _NSInteger content-cocoa selectedRow))
   (define/public (get-selections)
-    (as-entry
-     (lambda ()
-       (with-autorelease
-        (let ([v (tell content-cocoa selectedRowIndexes)])
-          (begin0
-           (let loop ([i (tell #:type _NSInteger v firstIndex)])
-             (cond
-              [(= i NSNotFound) null]
-              [else (cons i (loop (tell #:type _NSInteger v 
-                                        indexGreaterThanIndex: #:type _NSInteger i)))]))))))))
+    (atomically
+     (with-autorelease
+      (let ([v (tell content-cocoa selectedRowIndexes)])
+        (begin0
+         (let loop ([i (tell #:type _NSInteger v firstIndex)])
+           (cond
+            [(= i NSNotFound) null]
+            [else (cons i (loop (tell #:type _NSInteger v 
+                                      indexGreaterThanIndex: #:type _NSInteger i)))])))))))
     
   (define/private (visible-range)
     (tell #:type _NSRange content-cocoa 
@@ -158,13 +157,12 @@
 
   (define/public (select i [on? #t] [extend? #t])
     (if on?
-        (as-entry
-         (lambda ()
-           (with-autorelease
-            (let ([index (tell (tell NSIndexSet alloc) initWithIndex: #:type _NSUInteger i)])
-              (tellv content-cocoa 
-                     selectRowIndexes: index
-                     byExtendingSelection: #:type _BOOL extend?)))))
+        (atomically
+         (with-autorelease
+          (let ([index (tell (tell NSIndexSet alloc) initWithIndex: #:type _NSUInteger i)])
+            (tellv content-cocoa 
+                   selectRowIndexes: index
+                   byExtendingSelection: #:type _BOOL extend?))))
         (tellv content-cocoa deselectRow: #:type _NSInteger i)))
   (define/public (set-selection i)
     (select i #t #f))
diff --git a/collects/mred/private/wx/cocoa/procs.rkt b/collects/mred/private/wx/cocoa/procs.rkt
index 3d7e2c10c5..f66c2ddd73 100644
--- a/collects/mred/private/wx/cocoa/procs.rkt
+++ b/collects/mred/private/wx/cocoa/procs.rkt
@@ -114,9 +114,9 @@
   (tellv NSCursor setHiddenUntilMouseMoves: #:type _BOOL #t))
 
 (define busy-count 0)
-(define (end-busy-cursor) (as-entry (lambda () (set! busy-count (add1 busy-count)))))
+(define (end-busy-cursor) (atomically (set! busy-count (add1 busy-count))))
 (define (is-busy?) (positive? busy-count))
-(define (begin-busy-cursor) (as-entry (lambda () (set! busy-count (sub1 busy-count)))))
+(define (begin-busy-cursor) (atomically (set! busy-count (sub1 busy-count))))
 
 (define (get-display-depth) 32)
 (define-unimplemented is-color-display?)
diff --git a/collects/mred/private/wx/cocoa/queue.rkt b/collects/mred/private/wx/cocoa/queue.rkt
index d22745d908..9d2f881349 100644
--- a/collects/mred/private/wx/cocoa/queue.rkt
+++ b/collects/mred/private/wx/cocoa/queue.rkt
@@ -245,7 +245,7 @@
   (thread (lambda ()
             (let loop ()
               (sync queue-evt)
-              (as-entry dispatch-all-ready)
+              (atomically (dispatch-all-ready))
               (loop)))))
 
 (set-check-queue!
diff --git a/collects/mred/private/wx/cocoa/window.rkt b/collects/mred/private/wx/cocoa/window.rkt
index 9361147c42..79300e5067 100644
--- a/collects/mred/private/wx/cocoa/window.rkt
+++ b/collects/mred/private/wx/cocoa/window.rkt
@@ -412,28 +412,26 @@
 (define depth 0)
 
 (define (request-flush-delay cocoa-win)
-  (as-entry
-   (lambda ()
-     (let ([req (box cocoa-win)])
-       (set! depth (add1 depth))
-       (tellv cocoa-win disableFlushWindow)
-       (add-event-boundary-sometimes-callback! 
-        req
-        (lambda (v) 
-          ;; in atomic mode
-          (when (unbox req) 
-            (set-box! req #f)
-            (set! depth (sub1 depth))
-            (tellv cocoa-win enableFlushWindow)
-            (tellv cocoa-win flushWindow))))
-       req))))
+  (atomically
+   (let ([req (box cocoa-win)])
+     (set! depth (add1 depth))
+     (tellv cocoa-win disableFlushWindow)
+     (add-event-boundary-sometimes-callback! 
+      req
+      (lambda (v) 
+        ;; in atomic mode
+        (when (unbox req) 
+          (set-box! req #f)
+          (set! depth (sub1 depth))
+          (tellv cocoa-win enableFlushWindow)
+          (tellv cocoa-win flushWindow))))
+     req)))
 
 (define (cancel-flush-delay req)
-  (as-entry
-   (lambda ()
-     (let ([cocoa-win (unbox req)])
-       (when cocoa-win
-         (set-box! req #f)
-         (set! depth (sub1 depth))
-         (tellv cocoa-win enableFlushWindow)
-         (remove-event-boundary-callback! req))))))
+  (atomically
+   (let ([cocoa-win (unbox req)])
+     (when cocoa-win
+       (set-box! req #f)
+       (set! depth (sub1 depth))
+       (tellv cocoa-win enableFlushWindow)
+       (remove-event-boundary-callback! req)))))
diff --git a/collects/mred/private/wx/common/backing-dc.rkt b/collects/mred/private/wx/common/backing-dc.rkt
index 73fdfd5ca0..7280e68d7f 100644
--- a/collects/mred/private/wx/common/backing-dc.rkt
+++ b/collects/mred/private/wx/common/backing-dc.rkt
@@ -41,7 +41,7 @@
 
     ;; override this method to set up a callback to
     ;;  `on-backing-flush' when the backing store can be rendered
-    ;;  to the screen
+    ;;  to the screen; called atomically (expecting no exceptions)
     (define/public (queue-backing-flush)
       (void))
 
@@ -102,18 +102,13 @@
     (define flush-suspends 0)
 
     (define/override (suspend-flush) 
-      (as-entry
-       (lambda ()
-         ;; if not suspended currently, sleep to encourage any
-         ;; existing flush requests to complete
-         (when (zero? flush-suspends) (sleep))
-         (set! flush-suspends (add1 flush-suspends)))))
+      (atomically
+       (set! flush-suspends (add1 flush-suspends))))
     (define/override (resume-flush)  
-      (as-entry
-       (lambda ()
-         (set! flush-suspends (sub1 flush-suspends))
-         (when (zero? flush-suspends)
-           (queue-backing-flush)))))))
+      (atomically 
+       (set! flush-suspends (sub1 flush-suspends))
+       (when (zero? flush-suspends)
+         (queue-backing-flush))))))
 
 (define (get-backing-bitmap w h)
   (make-object bitmap% w h #f #t))
diff --git a/collects/mred/private/wx/common/timer.rkt b/collects/mred/private/wx/common/timer.rkt
index 79e27f636f..2f6301fd78 100644
--- a/collects/mred/private/wx/common/timer.rkt
+++ b/collects/mred/private/wx/common/timer.rkt
@@ -16,10 +16,10 @@
   (define current-once? (and just-once? #t))
   (define cb #f)
   (def/public (interval) current-interval)
-  (def/public (start [(integer-in 0 1000000000) msec] [any? [once? #f]])
+  (define/private (do-start msec once?)
     (as-entry
      (lambda ()
-       (stop)
+       (do-stop)
        (set! current-interval msec)
        (set! current-once? (and once? #t))
        (letrec ([new-cb
@@ -31,17 +31,19 @@
                                            (lambda ()
                                              (unless once?
                                                (when (eq? cb new-cb)
-                                                 (start msec #f))))))))])
+                                                 (do-start msec #f))))))))])
          (set! cb new-cb)
          (add-timer-callback new-cb)))))
-  (def/public (stop)
+  (def/public (start [(integer-in 0 1000000000) msec] [any? [once? #f]])
+    (do-start msec once?))
+  (define/private (do-stop)
     (as-entry
      (lambda ()
        (when cb
          (remove-timer-callback cb)
          (set! cb #f)))))
+  (def/public (stop) (do-stop))
   (def/public (notify) (notify-cb) (void))
   (super-new)
   (when ival
     (start ival just-once?)))
-
diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt
index cf625f6e53..863654ae94 100644
--- a/collects/mred/private/wx/gtk/canvas.rkt
+++ b/collects/mred/private/wx/gtk/canvas.rkt
@@ -47,17 +47,16 @@
   #:fail (lambda ()
 	   ;; This by-hand version doesn't produce quite the same notifications.
 	   (lambda (gtk value lower upper step-inc page-inc page-size)
-	     (as-entry
-	      (lambda ()
-		(g_object_freeze_notify gtk)
-		(g_object_set_double gtk "lower" lower)
-		(g_object_set_double gtk "upper" upper)
-		(g_object_set_double gtk "step-increment" step-inc)
-		(g_object_set_double gtk "page-increment" page-inc)
-		(g_object_set_double gtk "page-size" page-size)
-		(let ([value (max lower (min value (- upper page-size)))])
-		  (gtk_adjustment_set_value gtk value))
-		(g_object_thaw_notify gtk))))))
+	     (atomically
+              (g_object_freeze_notify gtk)
+              (g_object_set_double gtk "lower" lower)
+              (g_object_set_double gtk "upper" upper)
+              (g_object_set_double gtk "step-increment" step-inc)
+              (g_object_set_double gtk "page-increment" page-inc)
+              (g_object_set_double gtk "page-size" page-size)
+              (let ([value (max lower (min value (- upper page-size)))])
+                (gtk_adjustment_set_value gtk value))
+              (g_object_thaw_notify gtk)))))
 (define-gtk gtk_adjustment_get_value (_fun _GtkAdjustment -> _double*))
 (define-gtk gtk_adjustment_set_value (_fun _GtkAdjustment _double* -> _void))
 (define-gtk gtk_adjustment_get_upper (_fun _GtkAdjustment -> _double*)
@@ -348,6 +347,7 @@
       (queue-paint))
 
     (define/public (queue-backing-flush)
+      ;; called atomically (not expecting exceptions)
       (gtk_widget_queue_draw client-gtk))
     
     (define/override (reset-child-dcs)
diff --git a/collects/mred/private/wx/gtk/check-box.rkt b/collects/mred/private/wx/gtk/check-box.rkt
index d9ff0f5646..f8eede1018 100644
--- a/collects/mred/private/wx/gtk/check-box.rkt
+++ b/collects/mred/private/wx/gtk/check-box.rkt
@@ -24,11 +24,10 @@
   (inherit get-gtk)
 
   (define/public (set-value v)
-    (as-entry
-     (lambda ()
-       (set! no-clicked? #t)
-       (gtk_toggle_button_set_active (get-gtk) v)
-       (set! no-clicked? #f))))
+    (atomically
+     (set! no-clicked? #t)
+     (gtk_toggle_button_set_active (get-gtk) v)
+     (set! no-clicked? #f)))
 
   (define no-clicked? #f)
   (define/override (queue-clicked)
diff --git a/collects/mred/private/wx/gtk/choice.rkt b/collects/mred/private/wx/gtk/choice.rkt
index 3f1238e84e..7c30ae0cea 100644
--- a/collects/mred/private/wx/gtk/choice.rkt
+++ b/collects/mred/private/wx/gtk/choice.rkt
@@ -71,29 +71,27 @@
       (queue-window-event this (lambda () (clicked)))))
 
   (define/public (set-selection i)
-    (as-entry
-     (lambda ()
-       (set! ignore-clicked? #t)
-       (gtk_combo_box_set_active gtk i)
-       (set! ignore-clicked? #f))))
+    (atomically
+     (set! ignore-clicked? #t)
+     (gtk_combo_box_set_active gtk i)
+     (set! ignore-clicked? #f)))
   (define/public (get-selection)
     (gtk_combo_box_get_active gtk))
   (define/public (number) count)
   (define/public (clear)
-    (as-entry
-     (lambda ()
-       (set! ignore-clicked? #t)
-       (for ([i (in-range count)])
-         (gtk_combo_box_remove_text gtk 0))
-       (set! count 0)
-       (set! ignore-clicked? #f))))
+    (atomically
+     (set! ignore-clicked? #t)
+     (for ([i (in-range count)])
+       (gtk_combo_box_remove_text gtk 0))
+     (set! count 0)
+     (set! ignore-clicked? #f)))
   (public [-append append])
   (define (-append l)
-    (as-entry
-     (lambda ()
-       (set! ignore-clicked? #t)
-       (set! count (add1 count))
-       (gtk_combo_box_append_text gtk l)
-       (when (= count 1)
-         (set-selection 0))
-       (set! ignore-clicked? #f)))))
+    (atomically
+     (set! ignore-clicked? #t)
+     (set! count (add1 count))
+     (gtk_combo_box_append_text gtk l)
+     (when (= count 1)
+       (set-selection 0))
+     (set! ignore-clicked? #f))))
+
diff --git a/collects/mred/private/wx/gtk/dc.rkt b/collects/mred/private/wx/gtk/dc.rkt
index 3b9f69a258..a4a812dccc 100644
--- a/collects/mred/private/wx/gtk/dc.rkt
+++ b/collects/mred/private/wx/gtk/dc.rkt
@@ -33,6 +33,7 @@
         (values (unbox xb) (unbox yb))))
 
     (define/override (queue-backing-flush)
+      ;; called atomically (not expecting exceptions)
       (send canvas queue-backing-flush))))
 
 (define (do-backing-flush canvas dc win)
diff --git a/collects/mred/private/wx/gtk/list-box.rkt b/collects/mred/private/wx/gtk/list-box.rkt
index 7e4f7f282e..f223482576 100644
--- a/collects/mred/private/wx/gtk/list-box.rkt
+++ b/collects/mred/private/wx/gtk/list-box.rkt
@@ -160,30 +160,28 @@
       (gtk_tree_path_free p)))
 
   (define/public (set choices)
-    (as-entry
-     (lambda ()
-       (set! ignore-click? #t)
-       (clear)
-       (set! items choices)
-       (set! data (map (lambda (x) (box #f)) choices))
-       (reset-content)
-       (set! ignore-click? #f))))
+    (atomically
+     (set! ignore-click? #t)
+     (clear)
+     (set! items choices)
+     (set! data (map (lambda (x) (box #f)) choices))
+     (reset-content)
+     (set! ignore-click? #f)))
 
   (define/public (get-selections)
-    (as-entry
-     (lambda ()
-       (let ([list (gtk_tree_selection_get_selected_rows selection #f)])
-         (if list
-             (let ([v null])
-               (g_list_foreach list 
-                               (lambda (t) 
-                                 (set! v (cons (ptr-ref (gtk_tree_path_get_indices t) _int)
-                                               v)))
-                               #f)
-               (g_list_foreach list gtk_tree_path_free #f)
-               (g_list_free list)
-               (reverse v))
-             null)))))
+    (atomically
+     (let ([list (gtk_tree_selection_get_selected_rows selection #f)])
+       (if list
+           (let ([v null])
+             (g_list_foreach list 
+                             (lambda (t) 
+                               (set! v (cons (ptr-ref (gtk_tree_path_get_indices t) _int)
+                                             v)))
+                             #f)
+             (g_list_foreach list gtk_tree_path_free #f)
+             (g_list_free list)
+             (reverse v))
+           null))))
   (define/public (get-selection)
     (let ([l (get-selections)])
       (if (null? l)
@@ -191,14 +189,13 @@
           (car l))))
 
   (define/private (get-visible-range)
-    (as-entry
-     (lambda ()
-       (let-values ([(sp ep) (gtk_tree_view_get_visible_range client-gtk)])
-         (begin0
-          (values (if sp (ptr-ref (gtk_tree_path_get_indices sp) _int) 0)
-                  (if ep (ptr-ref (gtk_tree_path_get_indices ep) _int) 0))
-          (when sp (gtk_tree_path_free sp))
-          (when ep (gtk_tree_path_free ep)))))))
+    (atomically
+     (let-values ([(sp ep) (gtk_tree_view_get_visible_range client-gtk)])
+       (begin0
+        (values (if sp (ptr-ref (gtk_tree_path_get_indices sp) _int) 0)
+                (if ep (ptr-ref (gtk_tree_path_get_indices ep) _int) 0))
+        (when sp (gtk_tree_path_free sp))
+        (when ep (gtk_tree_path_free ep))))))
 
   (define/public (get-first-item)
     (let-values ([(start end) (get-visible-range)])
@@ -219,18 +216,17 @@
        (gtk_tree_path_free p))))
 
   (define/public (select i [on? #t] [extend? #t])
-    (as-entry
-     (lambda ()
-       (set! ignore-click? #t)
-       (let ([p (gtk_tree_path_new_from_indices i -1)])
-         (if on?
-             (begin
-               (unless extend?
-                 (gtk_tree_selection_unselect_all selection))
-               (gtk_tree_selection_select_path selection p))
-             (gtk_tree_selection_unselect_path selection p))
-         (gtk_tree_path_free p))
-       (set! ignore-click? #f))))
+    (atomically
+     (set! ignore-click? #t)
+     (let ([p (gtk_tree_path_new_from_indices i -1)])
+       (if on?
+           (begin
+             (unless extend?
+               (gtk_tree_selection_unselect_all selection))
+             (gtk_tree_selection_select_path selection p))
+           (gtk_tree_selection_unselect_path selection p))
+       (gtk_tree_path_free p))
+     (set! ignore-click? #f)))
 
   (define/public (set-selection i)
     (select i #t #f))
@@ -248,15 +244,14 @@
 
   (public [append* append])
   (define (append* s [v #f])
-    (as-entry
-     (lambda ()
-       (set! ignore-click? #t)
-       (set! items (append items (list s)))
-       (set! data (append data (list (box v))))
-       (let ([iter (make-GtkTreeIter 0 #f #f #f)])
-         (gtk_list_store_append store iter #f)
-         (gtk_list_store_set store iter 0 s -1))
-       (maybe-init-select)
-       (set! ignore-click? #f))))
+    (atomically
+     (set! ignore-click? #t)
+     (set! items (append items (list s)))
+     (set! data (append data (list (box v))))
+     (let ([iter (make-GtkTreeIter 0 #f #f #f)])
+       (gtk_list_store_append store iter #f)
+       (gtk_list_store_set store iter 0 s -1))
+     (maybe-init-select)
+     (set! ignore-click? #f)))
 
-  (reset-content))
+  (atomically (reset-content)))
diff --git a/collects/mred/private/wx/gtk/pixbuf.rkt b/collects/mred/private/wx/gtk/pixbuf.rkt
index cfcbca4e79..1ccf381d70 100644
--- a/collects/mred/private/wx/gtk/pixbuf.rkt
+++ b/collects/mred/private/wx/gtk/pixbuf.rkt
@@ -39,18 +39,17 @@
     (let ([mask (send bm get-loaded-mask)])
       (when mask
         (send mask get-argb-pixels 0 0 w h str #t)))
-    (as-entry
-     (lambda ()
-       (let ([rgba (scheme_make_sized_byte_string (malloc (* w h 4) 'raw) (* w h 4) 0)])
-         (memcpy rgba (ptr-add str 1) (sub1 (* w h 4)))
-         (for ([i (in-range 0 (* w h 4) 4)])
-           (bytes-set! rgba (+ i 3) (bytes-ref str i)))
-         (gdk_pixbuf_new_from_data rgba
-                                   0
-                                   #t
-                                   8
-                                   w
-                                   h
-                                   (* w 4)
-                                   free-it
-                                   #f))))))
+    (atomically
+     (let ([rgba (scheme_make_sized_byte_string (malloc (* w h 4) 'raw) (* w h 4) 0)])
+       (memcpy rgba (ptr-add str 1) (sub1 (* w h 4)))
+       (for ([i (in-range 0 (* w h 4) 4)])
+         (bytes-set! rgba (+ i 3) (bytes-ref str i)))
+       (gdk_pixbuf_new_from_data rgba
+                                 0
+                                 #t
+                                 8
+                                 w
+                                 h
+                                 (* w 4)
+                                 free-it
+                                 #f)))))
diff --git a/collects/mred/private/wx/gtk/procs.rkt b/collects/mred/private/wx/gtk/procs.rkt
index 8753291b9c..32639281f8 100644
--- a/collects/mred/private/wx/gtk/procs.rkt
+++ b/collects/mred/private/wx/gtk/procs.rkt
@@ -120,9 +120,9 @@
 (define (hide-cursor) (void))
 
 (define busy-count 0)
-(define (end-busy-cursor) (as-entry (lambda () (set! busy-count (add1 busy-count)))))
+(define (end-busy-cursor) (atomically (set! busy-count (add1 busy-count))))
 (define (is-busy?) (positive? busy-count))
-(define (begin-busy-cursor) (as-entry (lambda () (set! busy-count (sub1 busy-count)))))
+(define (begin-busy-cursor) (atomically (set! busy-count (sub1 busy-count))))
 
 (define-unimplemented is-color-display?)
 
diff --git a/collects/mred/private/wx/gtk/queue.rkt b/collects/mred/private/wx/gtk/queue.rkt
index 7f63390665..bc6d8c35af 100644
--- a/collects/mred/private/wx/gtk/queue.rkt
+++ b/collects/mred/private/wx/gtk/queue.rkt
@@ -3,7 +3,7 @@
          ffi/unsafe
          "utils.rkt"
          "types.rkt"
-         racket/draw/lock
+         "../../lock.rkt"
          "../common/queue.rkt"
          "../common/freeze.rkt"
          "const.rkt")
@@ -131,5 +131,5 @@
   (thread (lambda ()
             (let loop ()
               (sync queue-evt)
-              (as-entry dispatch-all-ready)
+              (atomically (dispatch-all-ready))
               (loop)))))
diff --git a/collects/mred/private/wx/gtk/radio-box.rkt b/collects/mred/private/wx/gtk/radio-box.rkt
index e1c2087931..2f19912fc5 100644
--- a/collects/mred/private/wx/gtk/radio-box.rkt
+++ b/collects/mred/private/wx/gtk/radio-box.rkt
@@ -102,17 +102,16 @@
   (define/override (set-focus)
     (button-focus (max 0 (set-selection))))
   (define/public (set-selection i)
-    (as-entry
-     (lambda ()
-       (set! no-clicked? #t)
-       (if (= i -1)
-           (when (pair? radio-gtks)
-             (unless dummy-gtk 
-               (set! dummy-gtk (gtk_radio_button_new
-                                (gtk_radio_button_get_group (car radio-gtks)))))
-             (gtk_toggle_button_set_active dummy-gtk #t))
-           (gtk_toggle_button_set_active (list-ref radio-gtks i) #t))
-       (set! no-clicked? #f))))
+    (atomically
+     (set! no-clicked? #t)
+     (if (= i -1)
+         (when (pair? radio-gtks)
+           (unless dummy-gtk 
+             (set! dummy-gtk (gtk_radio_button_new
+                              (gtk_radio_button_get_group (car radio-gtks)))))
+           (gtk_toggle_button_set_active dummy-gtk #t))
+         (gtk_toggle_button_set_active (list-ref radio-gtks i) #t))
+     (set! no-clicked? #f)))
 
   (define/public (get-selection)
     (or (for/or ([radio-gtk (in-list radio-gtks)]
diff --git a/collects/mred/private/wx/gtk/slider.rkt b/collects/mred/private/wx/gtk/slider.rkt
index d2280ef35f..48a0098d3a 100644
--- a/collects/mred/private/wx/gtk/slider.rkt
+++ b/collects/mred/private/wx/gtk/slider.rkt
@@ -68,10 +68,9 @@
                              [time-stamp (current-milliseconds)]))))))
 
   (define/public (set-value v)
-    (as-entry
-     (lambda ()
-       (set! ignore-click? #t)
-       (gtk_range_set_value gtk v)
-       (set! ignore-click? #f))))
+    (atomically
+     (set! ignore-click? #t)
+     (gtk_range_set_value gtk v)
+     (set! ignore-click? #f)))
   (define/public (get-value)
     (inexact->exact (floor (gtk_range_get_value gtk)))))
diff --git a/collects/mred/private/wx/gtk/window.rkt b/collects/mred/private/wx/gtk/window.rkt
index a85982a0a5..34ab5f9f29 100644
--- a/collects/mred/private/wx/gtk/window.rkt
+++ b/collects/mred/private/wx/gtk/window.rkt
@@ -380,13 +380,12 @@
 
     (define shown? #f)
     (define/public (direct-show on?)
-      (as-entry
-       (lambda ()
-         (if on?
-             (gtk_widget_show gtk)
-             (gtk_widget_hide gtk))
-         (set! shown? (and on? #t))
-         (register-child-in-parent on?)))
+      (atomically
+       (if on?
+           (gtk_widget_show gtk)
+           (gtk_widget_hide gtk))
+       (set! shown? (and on? #t))
+       (register-child-in-parent on?))
       (when on? (reset-child-dcs)))
     (define/public (show on?)
       (direct-show on?))
diff --git a/collects/racket/draw/dc.rkt b/collects/racket/draw/dc.rkt
index d1b36fe50f..5fb4dc8943 100644
--- a/collects/racket/draw/dc.rkt
+++ b/collects/racket/draw/dc.rkt
@@ -538,6 +538,7 @@
         (cairo_stroke cr2)
         (cairo_destroy cr2)
         (let* ([p (cairo_pattern_create_for_surface s)])
+          (cairo_surface_destroy s)
           (cairo_pattern_set_extend p CAIRO_EXTEND_REPEAT)
           (cairo_set_source cr p)
           (cairo_pattern_destroy p))))
diff --git a/collects/racket/draw/lock.rkt b/collects/racket/draw/lock.rkt
deleted file mode 100644
index ccdd8b4231..0000000000
--- a/collects/racket/draw/lock.rkt
+++ /dev/null
@@ -1,47 +0,0 @@
-#lang racket/base
-(require (for-syntax racket/base)
-         ffi/unsafe/atomic)
-
-(provide (protect-out as-entry
-                      as-exit
-                      entry-point))
-
-;; We need atomic mode for a couple of reasons:
-;;
-;; * We may need to bracket some (trusted) operations so that the
-;;   queue thread doesn't poll for events during the operation.
-;;
-;; * The scheme/gui classes have internal-consistency requirements.
-;;   When the user creates an object or calls a method, or when the
-;;   system invokes a callback, many steps may be required to
-;;   initialize or reset fields to maintain invariants. To ensure that
-;;   other threads do not call methods during a time when invariants
-;;   do not hold, we force all of the following code to be executed in
-;;   a single threaded manner, and we temporarily disable breaks.
-;;
-;; Atomic mode is implemented with a single monitor: all entry points
-;; into the code use `entry-point' or `as-entry', and all points with
-;; this code that call back out to user code uses `as-exit'.
-;;
-;; If an exception is raised within an `enter'ed area, control is
-;; moved back outside by the exception handler, and then the exception
-;; is re-raised. The user can't tell that the exception was caught an
-;; re-raised. But without the catch-and-reraise, the user's exception
-;; handler might try to use GUI elements from a different thread, or
-;; other such things, leading to deadlock.
-
-(define as-entry call-as-atomic)
-
-(define as-exit call-as-nonatomic)
-
-(define-syntax entry-point 
-  (lambda (stx)
-    (syntax-case stx (lambda #%plain-lambda case-lambda)
-      [(_ (lambda args body1 body ...))
-       (syntax (lambda args (as-entry (lambda () body1 body ...))))]
-      [(_ (#%plain-lambda args body1 body ...))
-       (syntax (#%plain-lambda args (as-entry (lambda () body1 body ...))))]
-      [(_ (case-lambda [vars body1 body ...] ...))
-       (syntax (case-lambda 
-                [vars (as-entry (lambda () body1 body ...))]
-                ...))])))
diff --git a/collects/racket/draw/region.rkt b/collects/racket/draw/region.rkt
index d7f2bd13bc..339c2fd01f 100644
--- a/collects/racket/draw/region.rkt
+++ b/collects/racket/draw/region.rkt
@@ -1,12 +1,12 @@
 #lang scheme/base
 (require scheme/class
+         ffi/unsafe/atomic
          "syntax.ss"
          "local.ss"
          "cairo.ss"
          "dc-path.ss"
          "dc-intf.ss"
-         "point.ss"
-         "lock.ss")
+         "point.ss")
 
 (provide region%)
 
@@ -152,25 +152,34 @@
 
     (def/public (in-region? [real? x]
                             [real? y])
-      (as-entry
-       (lambda ()
-         (unless temp-cr
-           (set! temp-cr
-                 (cairo_create
-                  (cairo_image_surface_create CAIRO_FORMAT_A8 1 1))))
-         (let-values ([(x y)
-                       (if matrix
-                           ;; need to use the DC's current transformation
-                           (let ([m (send dc get-clipping-matrix)])
-                             (values (+ (* x (vector-ref m 0))
-                                        (* y (vector-ref m 2))
-                                        (vector-ref m 4))
-                                     (+ (* x (vector-ref m 1))
-                                        (* y (vector-ref m 3))
-                                        (vector-ref m 5))))
-                           ;; no transformation needed
-                           (values x y))])
-           (install-region temp-cr #t (lambda (cr v) (and v (cairo_in_fill temp-cr x y))))))))
+      (let ([cr (call-as-atomic
+                 (lambda ()
+                   (cond
+                    [temp-cr 
+                     (begin0 temp-cr (set! temp-cr #f))]
+                    [else
+                     (let ([s (cairo_image_surface_create CAIRO_FORMAT_A8 1 1)])
+                       (begin0
+                        (cairo_create s)
+                        (cairo_surface_destroy s)))])))])
+        (let-values ([(x y)
+                      (if matrix
+                          ;; need to use the DC's current transformation
+                          (let ([m (send dc get-clipping-matrix)])
+                            (values (+ (* x (vector-ref m 0))
+                                       (* y (vector-ref m 2))
+                                       (vector-ref m 4))
+                                    (+ (* x (vector-ref m 1))
+                                       (* y (vector-ref m 3))
+                                       (vector-ref m 5))))
+                          ;; no transformation needed
+                          (values x y))])
+          (begin0 
+           (install-region cr #t (lambda (cr v) (and v (cairo_in_fill cr x y))))
+           (call-as-atomic
+            (cond
+             [temp-cr (cairo_destroy cr)]
+             [else (set! temp-cr cr)]))))))
 
     (def/public (set-arc [real? x]
                          [real? y]