From bcbe42f4ffb06877d01846f7e6bf4d959db07a63 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 21 Oct 2010 15:39:42 -0700
Subject: [PATCH] improve protection against multiple instantiation

---
 collects/mred/private/wx/common/once.rkt  | 14 ++++++++++++++
 collects/mred/private/wx/common/queue.rkt | 12 ++----------
 collects/mred/private/wx/common/utils.rkt |  3 ++-
 collects/racket/gui/dynamic.rkt           |  6 ++++--
 4 files changed, 22 insertions(+), 13 deletions(-)
 create mode 100644 collects/mred/private/wx/common/once.rkt

diff --git a/collects/mred/private/wx/common/once.rkt b/collects/mred/private/wx/common/once.rkt
new file mode 100644
index 0000000000..c0e49a640a
--- /dev/null
+++ b/collects/mred/private/wx/common/once.rkt
@@ -0,0 +1,14 @@
+#lang racket/base
+(require ffi/unsafe)
+
+(provide scheme_register_process_global)
+
+;; This module must be instantiated only once:
+
+(define scheme_register_process_global
+  (get-ffi-obj 'scheme_register_process_global #f (_fun _string _pointer -> _pointer)))
+
+(let ([v (scheme_register_process_global "GRacket-support-initialized"
+                                         (cast 1 _scheme _pointer))])
+  (when v
+    (error "cannot instantiate `racket/gui/base' a second time in the same process")))
diff --git a/collects/mred/private/wx/common/queue.rkt b/collects/mred/private/wx/common/queue.rkt
index 5f717ea357..042a9281c6 100644
--- a/collects/mred/private/wx/common/queue.rkt
+++ b/collects/mred/private/wx/common/queue.rkt
@@ -5,7 +5,8 @@
          racket/class
          "rbtree.rkt"
          "../../lock.rkt"
-         "handlers.rkt")
+         "handlers.rkt"
+         "once.rkt")
 
 (provide queue-evt
          set-check-queue!
@@ -54,15 +55,6 @@
 
          scheme_register_process_global)
 
-;; ------------------------------------------------------------
-;; This module must be instantiated only once:
-
-(define-mz scheme_register_process_global (_fun _string _pointer -> _pointer))
-(let ([v (scheme_register_process_global "GRacket-support-initialized"
-                                         (cast 1 _scheme _pointer))])
-  (when v
-    (error "cannot start GRacket a second time in the same process")))
-
 ;; ------------------------------------------------------------
 ;; Create a Scheme evt that is ready when a queue is nonempty
 
diff --git a/collects/mred/private/wx/common/utils.rkt b/collects/mred/private/wx/common/utils.rkt
index 5e7e4f0224..1d9948dcf2 100644
--- a/collects/mred/private/wx/common/utils.rkt
+++ b/collects/mred/private/wx/common/utils.rkt
@@ -1,6 +1,7 @@
 #lang racket/base
 (require ffi/unsafe
-         ffi/unsafe/define)
+         ffi/unsafe/define
+         "once.rkt")
 
 (provide define-mz)
 
diff --git a/collects/racket/gui/dynamic.rkt b/collects/racket/gui/dynamic.rkt
index 787b16cb54..800836da54 100644
--- a/collects/racket/gui/dynamic.rkt
+++ b/collects/racket/gui/dynamic.rkt
@@ -18,5 +18,7 @@
 (define-namespace-anchor anchor)
 
 (define (gui-dynamic-require sym)
-  (parameterize ([current-namespace (namespace-anchor->empty-namespace anchor)])
-    (dynamic-require 'mred sym)))
+  (if (gui-available?)
+      (parameterize ([current-namespace (namespace-anchor->empty-namespace anchor)])
+        (dynamic-require 'mred sym))
+      (error "racket/gui/base is not available")))