avoid crashing via GCed racket/gui instance

gui-lib/mred/private/wx/cocoa/queue.rkt

@@ -10,7 +10,8 @@
          "../common/queue.rkt"
          "../common/handlers.rkt"
          "../../lock.rkt"
-         "../common/freeze.rkt")
+         "../common/freeze.rkt"
+         "../common/keep-forever.rkt")
 
 (provide 
  (protect-out app
@@ -486,3 +487,4 @@
   (post-dummy-event) ; why do we need this? 'nextEventMatchingMask:' seems to hang if we don't use it
   (scheme_set_place_sleep (function-ptr sleep-until-event 
                                         (_fun #:atomic? #t _float _gcpointer -> _void))))
+(keep-forever sleep-until-event)

gui-lib/mred/private/wx/common/keep-forever.rkt

@@ -0,0 +1,12 @@
+#lang racket/base
+(require ffi/unsafe)
+
+(provide (protect-out keep-forever))
+
+(define forever (box null))
+
+;; Keeps as long as the place runs, at least:
+(void (malloc-immobile-cell forever))
+
+(define (keep-forever v)
+  (set-box! forever (cons v (unbox forever))))

gui-lib/mred/private/wx/common/queue.rkt

@@ -7,7 +7,8 @@
          "rbtree.rkt"
          "../../lock.rkt"
          "handlers.rkt"
-         "once.rkt")
+         "once.rkt"
+         "keep-forever.rkt")
 
 (provide 
  (protect-out queue-evt
@@ -86,6 +87,8 @@
 (define (queue-wakeup o fds)
   (do-queue-wakeup fds))
 (scheme_add_evt event-queue-type check-queue queue-wakeup #f 0)
+(keep-forever check-queue)
+(keep-forever queue-wakeup)
 (define queue-evt (let ([p (malloc 16)]
                         [p2 (malloc 'nonatomic _pointer)])
                     (memset p 0 16)

gui-lib/mred/private/wx/gtk/queue.rkt

@@ -9,7 +9,8 @@
          "clipboard.rkt"
          "const.rkt"
 	 "w32.rkt"
-         "unique.rkt")
+         "unique.rkt"
+         "../common/keep-forever.rkt")
 
 (provide (protect-out gtk-start-event-pump
                       try-to-sync-refresh
@@ -203,6 +204,8 @@
 (gdk_event_handler_set event-dispatch
                        #f
                        uninstall)
+(keep-forever event-dispatch)
+(keep-forever uninstall)
 
 (define (dispatch-all-ready)
   (pre-event-sync #f)