fix minor potential GC bugs and add some debugging support

collects/mred/private/wx/cocoa/queue.rkt

@@ -391,4 +391,4 @@
   (post-dummy-event) ; why do we need this? 'nextEventMatchingMask:' seems to hang if we don't use it
   (set-ffi-obj! 'scheme_sleep #f _pointer (function-ptr sleep-until-event 
                                                         (_fun #:atomic? #t 
-                                                              _float _pointer -> _void))))
+                                                              _float _gcpointer -> _void))))

collects/mred/private/wx/common/queue.rkt

@@ -66,7 +66,7 @@
 
 (define-mz scheme_add_evt (_fun _Scheme_Type
                                 (_fun #:atomic? #t _scheme -> _int)
-                                (_fun #:atomic? #t _scheme _pointer -> _void)
+                                (_fun #:atomic? #t _scheme _gcpointer -> _void)
                                 _pointer
                                 _int
                                 -> _void))
@@ -189,7 +189,7 @@
                                           _racket _racket -> _void)
                                     _racket ; data
                                     _int ; strong?
-                                    -> _pointer))
+                                    -> _gcpointer))
 
 (define (shutdown-eventspace! e ignored)
   ;; atomic mode

collects/mred/private/wx/gtk/queue.rkt

@@ -118,10 +118,10 @@
 (define POLLERR #x8)
 (define POLLHUP #x10)
 
-(define-mz scheme_get_fdset (_fun _pointer _int -> _pointer))
-(define-mz scheme_fdset (_fun _pointer _int -> _void))
-(define-mz scheme_set_wakeup_time (_fun _pointer _double -> _void))
-(define-mz scheme_add_fd_eventmask (_fun _pointer _int -> _void)
+(define-mz scheme_get_fdset (_fun _pointer _int -> _gcpointer))
+(define-mz scheme_fdset (_fun _gcpointer _int -> _void))
+(define-mz scheme_set_wakeup_time (_fun _gcpointer _double -> _void))
+(define-mz scheme_add_fd_eventmask (_fun _gcpointer _int -> _void)
   #:fail #f)
 
 (define (install-wakeup fds)

src/racket/gc2/gc2.h

@@ -262,6 +262,12 @@ GC2_EXTERN intptr_t GC_malloc_stays_put_threshold();
    objects that never move, and where pointers are allowed
    into the object's interior. */
 
+GC2_EXTERN int GC_is_on_allocated_page(void *p);
+/* 
+   Returns 1 if p refers to a page of memory on which
+   the GC allocates objects (although p may or may not
+   be a valid pointer to the start of an alloctaed object). */
+
 /***************************************************************************/
 /* Memory tracing                                                          */
 /***************************************************************************/

src/racket/gc2/newgc.c

@@ -2962,6 +2962,13 @@ void GC_fixup(void *pp)
   GC_fixup2(pp, GC_get_GC());
 }
 
+int GC_is_on_allocated_page(void *p)
+{
+  NewGC *gc = GC_get_GC();
+  return !!pagemap_find_page(gc->page_maps, p);
+}
+
+
 /*****************************************************************************/
 /* memory stats and traces                                                   */
 /*****************************************************************************/

src/racket/src/port.c

@@ -730,7 +730,7 @@ void *scheme_alloc_fdset_array(int count, int permanent)
   if (permanent)
     return scheme_malloc_eternal(count * (dynamic_fd_size + sizeof(intptr_t)));
   else
-    return scheme_malloc_atomic(count * (dynamic_fd_size + sizeof(intptr_t)));
+    return scheme_malloc_atomic_allow_interior(count * (dynamic_fd_size + sizeof(intptr_t)));
 }
 
 void *scheme_init_fdset_array(void *fdarray, int count)

src/racket/src/salloc.c

@@ -529,6 +529,18 @@ Scheme_Object *scheme_make_external_cptr(GC_CAN_IGNORE void *cptr, Scheme_Object
   o = scheme_make_cptr(NULL, typetag);
   SCHEME_CPTR_FLAGS(o) |= 0x1;
   SCHEME_CPTR_VAL(o) = cptr;
+
+#if 0
+  /* For debugging. An external pointer onto a GCable page is
+     not necessarily a bug (e.g. it might be a Win32 handle that
+     happens to look like a pointer to a GCable page) --- but it 
+     probably is, so it's worth a look when it happens. */
+# ifdef MZ_PRECISE_GC
+  if (GC_is_on_allocated_page(cptr))
+    printf("%p is on collectable page\n", cptr);
+# endif
+#endif
+
   return o;
 }