From f21280e24dd280b7d8ec70a5227910a788f070a2 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 5 Nov 2012 08:20:32 -0700
Subject: [PATCH] fix problems with non-parallel places

The implementation of message passing in thread-simulated
places had not kept up with the parallel implementation.
---
 collects/racket/place/private/th-place.rkt | 71 +++++++++++++++-------
 collects/tests/racket/place-channel.rkt    |  4 ++
 2 files changed, 52 insertions(+), 23 deletions(-)

diff --git a/collects/racket/place/private/th-place.rkt b/collects/racket/place/private/th-place.rkt
index bf44ad3a9e..55d04d57d4 100644
--- a/collects/racket/place/private/th-place.rkt
+++ b/collects/racket/place/private/th-place.rkt
@@ -70,38 +70,63 @@
   (values pch cch))
 
 (define (deep-copy x)
+  (define ht (make-hasheq))
+  (define (record v new-v)
+    (hash-set! ht v new-v)
+    new-v)
+  (define (with-placeholder o mk)
+    (define ph (make-placeholder #f))
+    (hash-set! ht o ph)
+    (define new-o (mk))
+    (placeholder-set! ph new-o)
+    new-o)
   (define (dcw o)
     (cond
       [(ormap (lambda (x) (x o)) (list number? char? boolean? null? void? string? symbol? TH-place-channel?)) o]
+      [(hash-ref ht o #f)
+       => values]
       [(cond
-        [(path? o) (path->bytes o)]
-        [(bytes? o) (if (pl-place-shared? o) o (bytes-copy o))]
-        [(fxvector? o) (if (pl-place-shared? o) o (fxvector-copy o))]
-        [(flvector? o) (if (pl-place-shared? o) o (flvector-copy o))]
+        [(path-for-some-system? o) o]
+        [(bytes? o) (if (pl-place-shared? o) o (record o (bytes-copy o)))]
+        [(fxvector? o) (if (pl-place-shared? o) o (record o (fxvector-copy o)))]
+        [(flvector? o) (if (pl-place-shared? o) o (record o (flvector-copy o)))]
         [else #f])
         => values]
       [(TH-place? o) (dcw (TH-place-ch o))]
-      [(pair? o) (cons (dcw (car o)) (dcw (cdr o)))]
-      [(vector? o) (vector-map! dcw (vector-copy o))]
-      [(hash-equal? o)
-       (for/fold ([nh (hash)]) ([p (in-hash-pairs o)])
-         (hash-set nh (dcw (car p)) (dcw (cdr p))))]
-      [(hash-eq? o)
-       (for/fold ([nh (hasheq)]) ([p (in-hash-pairs o)])
-         (hash-set nh (dcw (car p)) (dcw (cdr p))))]
-      [(hash-eqv? o)
-       (for/fold ([nh (hasheqv)]) ([p (in-hash-pairs o)])
-         (hash-set nh (dcw (car p)) (dcw (cdr p))))]
-      [(struct? o)
-        (define key (prefab-struct-key o))
-        (when (not key)
-          (error "Must be a prefab struct"))
-        (apply make-prefab-struct
-               key
-               (map dcw (cdr (vector->list (struct->vector o)))))]
+      [(pair? o) 
+       (with-placeholder
+        o
+        (lambda ()
+          (cons (dcw (car o)) (dcw (cdr o)))))]
+      [(vector? o) 
+       (vector-map! dcw (record o (vector-copy o)))]
+      [(hash? o) 
+       (with-placeholder
+        o
+        (lambda ()
+          (cond
+           [(hash-equal? o)
+            (for/fold ([nh (hash)]) ([p (in-hash-pairs o)])
+              (hash-set nh (dcw (car p)) (dcw (cdr p))))]
+           [(hash-eq? o)
+            (for/fold ([nh (hasheq)]) ([p (in-hash-pairs o)])
+              (hash-set nh (dcw (car p)) (dcw (cdr p))))]
+           [else ; (hash-eqv? o)
+            (for/fold ([nh (hasheqv)]) ([p (in-hash-pairs o)])
+              (hash-set nh (dcw (car p)) (dcw (cdr p))))])))]
+      [(and (struct? o)
+            (prefab-struct-key o))
+       =>
+       (lambda (key)
+         (with-placeholder
+          o
+          (lambda ()
+            (apply make-prefab-struct
+                   key
+                   (map dcw (cdr (vector->list (struct->vector o))))))))]
       [else (raise-mismatch-error 'place-channel-put "cannot transmit a message containing value: " o)]))
 
-  (dcw x))
+  (make-reader-graph (dcw x)))
 
 
 (define (th-place-channel-put pl msg)
diff --git a/collects/tests/racket/place-channel.rkt b/collects/tests/racket/place-channel.rkt
index 677f4a5b68..6ce2a7edb2 100644
--- a/collects/tests/racket/place-channel.rkt
+++ b/collects/tests/racket/place-channel.rkt
@@ -89,6 +89,8 @@
       (make-immutable-hash l1)
       (make-immutable-hasheq l2)
       (make-immutable-hasheqv l3)
+      (bytes->path x 'unix)
+      (bytes->path x 'windows)
       )))
 
 (define (channel-test-basic-types-master sender ch)
@@ -115,6 +117,8 @@
     ((make-hash l1) (make-immutable-hash l1))
     ((make-hasheq l2) (make-immutable-hasheq l2))
     ((make-hasheqv l3) (make-immutable-hasheqv l3))
+    (#"/tmp/unix" (bytes->path #"/tmp/unix" 'unix))
+    (#"C:\\Windows" (bytes->path #"C:\\Windows" 'windows))
     ))
 
 (define-place (place-worker ch)