allow cyclic values over place channels

collects/tests/racket/place-channel.rktl

@@ -104,10 +104,21 @@ END
   (place-channel-send pl pc5)
   (test "Ready5" sync pc6)
 
+  (let ([try-graph
+         (lambda (s)
+           (let ([v (read (open-input-string s))])
+             (place-channel-send pc5 v)
+             (test v place-channel-receive pc6)))])
+    (try-graph "#0=(#0# . #0#)")
+    (try-graph "#0=#(#0# 7 #0#)")
+    (try-graph "#0=#s(thing 7 #0#)"))
+
   (check-exn exn:fail? (λ () (place-channel-send pl (open-output-string))))
   (check-not-exn (λ () (place-channel-send pl "Test String")))
-  (check-not-exn (λ () (place-channel-send pl (string->path "C:\\Windows"))))
+  (check-not-exn (λ () (place-channel-send pl (bytes->path #"/tmp/unix" 'unix))))
+  (check-not-exn (λ () (place-channel-send pl (bytes->path #"C:\\Windows" 'windows))))
 
   (place-wait pl)
 )
 
+(report-errs)

collects/tests/racket/place.rktl

@@ -34,3 +34,5 @@
           (printf "Hello form place 2\n")
           (sync never-evt))])
   (place-kill p))
+
+(report-errs)

src/racket/src/places.c

@@ -802,6 +802,7 @@ static Scheme_Object *trivial_copy(Scheme_Object *so)
 Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table **ht)
 {
   Scheme_Object *new_so = so;
+  int skip_hash;
 
   /* First, check for simple values that don't need to be hashed: */
   new_so = trivial_copy(so);
@@ -814,6 +815,14 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
     }
   }
 
+  if (!*ht) {
+    Scheme_Hash_Table *_ht;
+    _ht = scheme_make_hash_table(SCHEME_hash_ptr);
+    *ht = _ht;
+  }
+
+  skip_hash = 0;
+
   switch (SCHEME_TYPE(so)) {
     case scheme_char_type:
       new_so = scheme_make_char(SCHEME_CHAR_VAL(so));
@@ -874,9 +883,17 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
         Scheme_Object *car;
         Scheme_Object *cdr;
         Scheme_Object *pair;
+
+        /* handle cycles: */
+        pair = scheme_make_pair(scheme_false, scheme_false);
+        scheme_hash_set(*ht, so, pair);
+        skip_hash = 1;
+
         car = scheme_places_deep_copy_worker(SCHEME_CAR(so), ht);
         cdr = scheme_places_deep_copy_worker(SCHEME_CDR(so), ht);
-        pair = scheme_make_pair(car, cdr);
+        SCHEME_CAR(pair) = car;
+        SCHEME_CDR(pair) = cdr;
+
         new_so = pair;
       }
       break;
@@ -886,6 +903,11 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
         intptr_t i;
         intptr_t size = SCHEME_VEC_SIZE(so);
         vec = scheme_make_vector(size, 0);
+
+        /* handle cycles: */
+        scheme_hash_set(*ht, so, vec);
+        skip_hash = 1;
+
         for (i = 0; i <size ; i++) {
           Scheme_Object *tmp;
           tmp = scheme_places_deep_copy_worker(SCHEME_VEC_ELS(so)[i], ht);
@@ -944,6 +966,11 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
 
         nprefab_key = scheme_places_deep_copy_worker(stype->prefab_key, ht);
         nst = (Scheme_Serialized_Structure*) scheme_make_serialized_struct_instance(nprefab_key, size);
+
+        /* handle cycles: */
+        scheme_hash_set(*ht, so, (Scheme_Object *)nst);
+        skip_hash = 1;
+
         for (i = 0; i <size ; i++) {
           Scheme_Object *tmp;
           tmp = scheme_places_deep_copy_worker((Scheme_Object*) st->slots[i], ht);
@@ -964,6 +991,11 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
         size = st->num_slots;
         stype = scheme_lookup_prefab_type(SCHEME_CDR(st->prefab_key), size);
         nst = (Scheme_Structure*) scheme_make_blank_prefab_struct_instance(stype);
+
+        /* handle cycles: */
+        scheme_hash_set(*ht, so, (Scheme_Object *)nst);
+        skip_hash = 1;
+
         for (i = 0; i <size ; i++) {
           Scheme_Object *tmp;
           tmp = scheme_places_deep_copy_worker((Scheme_Object*) st->slots[i], ht);
@@ -979,11 +1011,7 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
       break;
   }
 
-  if (!*ht) {
+  if (!skip_hash)
-    Scheme_Hash_Table *_ht;
-    _ht = scheme_make_hash_table(SCHEME_hash_ptr);
-    *ht = _ht;
-  }
     scheme_hash_set(*ht, so, new_so);
 
   return new_so;
@@ -1296,7 +1324,7 @@ Scheme_Object *scheme_place_send(int argc, Scheme_Object *args[]) {
   else {
     scheme_wrong_count_m("place-channel-send", 2, 2, argc, args, 0);
   }
-  return scheme_true;
+  return scheme_void;
 }
 
 Scheme_Object *scheme_place_receive(int argc, Scheme_Object *args[]) {
@@ -1317,7 +1345,7 @@ Scheme_Object *scheme_place_receive(int argc, Scheme_Object *args[]) {
   else {
     scheme_wrong_count_m("place-channel-receive", 1, 1, argc, args, 0);
   }
-  return scheme_true;
+  ESCAPED_BEFORE_HERE;
 }
 
 # ifdef MZ_PRECISE_GC