send ffi pointers across places

collects/meta/props

@@ -1830,6 +1830,7 @@ path/s is either such a string or a list of them.
 "collects/tests/racket/place-chan-rand-help.rkt" responsible (tewk)
 "collects/tests/racket/place-chan-rand.rkt" responsible (tewk) drdr:random #t
 "collects/tests/racket/place-channel.rkt" responsible (tewk) drdr:command-line (racket "-tm" *) drdr:timeout 300
+"collects/tests/racket/place-channel-ffi.rkt" responsible (tewk) drdr:command-line (racket "-tm" *)
 "collects/tests/racket/place.rktl" responsible (tewk) drdr:command-line (racket "-f" *)
 "collects/tests/racket/port.rktl" drdr:command-line #f
 "collects/tests/racket/portlib.rktl" drdr:command-line #f

collects/tests/racket/place-channel-ffi.rkt

@@ -0,0 +1,42 @@
+#lang racket/base
+
+(require racket/place
+         ffi/unsafe
+         racket/runtime-path
+         (for-syntax racket/base))
+
+(provide main)
+
+(define-runtime-path libcrypto-so
+  (case (system-type)
+    [(windows) '(so "libeay32")]
+    [else '(so "libcrypto")]))
+
+(define libcrypto
+  (with-handlers ([exn:fail? (lambda (exn) 
+                               (log-warning (format "warning: couldn't load OpenSSL library: ~a"
+                                                    (if (exn? exn)
+                                                        (exn-message exn)
+                                                        exn)))
+                               #f)])
+    (ffi-lib libcrypto-so '("" "0.9.8b" "0.9.8" "0.9.7"))))
+
+(define-syntax-rule (define-crypto-func name func-signature)
+  (begin
+    (define name (and libcrypto (get-ffi-obj (quote name) libcrypto func-signature (lambda () #f))))
+    (provide name)))
+
+
+(define-cstruct _BN ([j1 _long] [top _int] [dmax _int] [neg _int] [flags _int]))
+(define-crypto-func BN_new          (_fun                                     -> _BN-pointer))
+
+(define (main)
+  (define bn (BN_new))
+  (set-BN-j1! bn 1334)
+  (printf "BN-j1 ~a ~v\n" (BN-j1 bn) (cpointer-tag bn))
+  (printf "BN tag ~v\n" BN-tag)
+  (define p (place ch
+                   (define b (place-channel-get ch))
+                   (printf "Got it ~a\n" (BN-j1 b))))
+  (place-channel-put p bn)
+  (place-wait p))

src/racket/src/place.c

@@ -997,6 +997,32 @@ static Scheme_Object *shallow_types_copy(Scheme_Object *so, Scheme_Hash_Table *h
         new_so = (Scheme_Object *) vec;
       }
       break;
+    case scheme_cpointer_type:
+      if (SCHEME_CPTR_FLAGS(so) & 0x1) {
+        if (copy) {
+          Scheme_Object *o;
+          Scheme_Object *o2;
+          if (SCHEME_CPTR_FLAGS(so) & 0x2) {
+            o = (Scheme_Object *)scheme_malloc_small_tagged(sizeof(Scheme_Offset_Cptr));
+            SCHEME_CPTR_FLAGS(o) |= 0x2;
+            ((Scheme_Offset_Cptr *)o)->offset = ((Scheme_Offset_Cptr *)so)->offset;
+          }
+          else
+            o = (Scheme_Object *)scheme_malloc_small_tagged(sizeof(Scheme_Cptr));
+
+          o->type = scheme_cpointer_type;
+          SCHEME_CPTR_FLAGS(o) |= 0x1;
+          SCHEME_CPTR_VAL(o) = SCHEME_CPTR_VAL(so);
+          o2 = shallow_types_copy(SCHEME_CPTR_TYPE(so), NULL, copy, can_raise_exn);
+          SCHEME_CPTR_TYPE(o) = o2;
+
+          return o;
+        }
+      }
+      else
+        bad_place_message(so);
+      break;
+
     default:
       new_so = NULL;
       break;
@@ -1803,6 +1829,7 @@ static void places_deserialize_worker(Scheme_Object **pso, Scheme_Hash_Table **h
     case scheme_windows_path_type:
     case scheme_flvector_type:
     case scheme_fxvector_type:
+    case scheme_cpointer_type:
       break;
     case scheme_symbol_type:
       break;