From f3de3e4584fdd581f29eb2e202ce89ad76aacafc Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 30 Apr 2019 20:28:38 -0600 Subject: [PATCH] cs & threads: repairs for places Includes a repair for handling vectors and prefab structs that are involved in cycles. --- .../tests/racket/parallel-build.rkt | 6 +++-- racket/src/thread/place-message.rkt | 23 +++++++++++-------- racket/src/thread/place-object.rkt | 2 +- racket/src/thread/place.rkt | 4 ++-- 4 files changed, 20 insertions(+), 15 deletions(-) diff --git a/pkgs/racket-test/tests/racket/parallel-build.rkt b/pkgs/racket-test/tests/racket/parallel-build.rkt index 44c63b4345..1e50b69a59 100644 --- a/pkgs/racket-test/tests/racket/parallel-build.rkt +++ b/pkgs/racket-test/tests/racket/parallel-build.rkt @@ -23,11 +23,13 @@ ['output (printf " Output from: ~a\n~a~a" work out err)] [else (eprintf " Error compiling ~a\n~a\n~a~a" work msg out err)]))) +(define compiled (car (use-compiled-file-paths))) + (define (delete-files f) (delete-file f) (let-values ([(base name dir?) (split-path f)]) - (delete-file (build-path base "compiled" (path-add-suffix name #".dep"))) - (delete-file (build-path base "compiled" (path-add-suffix name #".zo"))))) + (delete-file (build-path base compiled (path-add-suffix name #".dep"))) + (delete-file (build-path base compiled (path-add-suffix name #".zo"))))) (delete-files tmp1) (delete-files tmp2) diff --git a/racket/src/thread/place-message.rkt b/racket/src/thread/place-message.rkt index 469a925bfb..0df0876c44 100644 --- a/racket/src/thread/place-message.rkt +++ b/racket/src/thread/place-message.rkt @@ -45,21 +45,24 @@ (or (not direct?) (and (immutable? v) (not (impersonator? v)))) - (let ([graph (hash-set graph v #t)]) - (for/and ([e (in-vector v)]) - (loop e graph)))) + (or (hash-ref graph v #f) + (let ([graph (hash-set graph v #t)]) + (for/and ([e (in-vector v)]) + (loop e graph))))) (and (immutable-prefab-struct-key v) - (let ([graph (hash-set graph v #t)]) - (for/and ([e (in-vector (struct->vector v))]) - (loop e graph)))) + (or (hash-ref graph v #f) + (let ([graph (hash-set graph v #t)]) + (for/and ([e (in-vector (struct->vector v))]) + (loop e graph))))) (and (hash? v) (or (not direct?) (and (immutable? v) (not (impersonator? v)))) - (let ([graph (hash-set graph v #t)]) - (for/and ([(k v) (in-hash v)]) - (and (loop k graph) - (loop v graph))))) + (or (hash-ref graph v #f) + (let ([graph (hash-set graph v #t)]) + (for/and ([(k v) (in-hash v)]) + (and (loop k graph) + (loop v graph)))))) (and (not direct?) (or (cpointer? v) (and (or (fxvector? v) diff --git a/racket/src/thread/place-object.rkt b/racket/src/thread/place-object.rkt index 0aa61edd30..713a5a76f9 100644 --- a/racket/src/thread/place-object.rkt +++ b/racket/src/thread/place-object.rkt @@ -23,7 +23,7 @@ [current-thread #:mutable] ; running Racket thread, needed for accounting [post-shutdown #:mutable] ; list of callbacks [pumpers #:mutable] ; vector of up to three pumper threads - [pending-break #:mutable] ; #f, 'break, 'hangup, or 'terminate + [pending-break #:mutable] ; #f, 'break, 'hang-up, or 'terminate done-waiting ; hash table of places to ping when this one ends [wakeup-handle #:mutable] [dequeue-semas #:mutable]); semaphores reflecting place-channel waits to recheck diff --git a/racket/src/thread/place.rkt b/racket/src/thread/place.rkt index 5e70f064b2..9461ac3ca9 100644 --- a/racket/src/thread/place.rkt +++ b/racket/src/thread/place.rkt @@ -124,8 +124,8 @@ (define/who (place-break p [kind #f]) (check who place? p) - (unless (or (not kind) (eq? kind 'hangup) (eq? kind 'terminate)) - (raise-argument-error who "(or/c #f 'hangup 'terminate)" kind)) + (unless (or (not kind) (eq? kind 'hang-up) (eq? kind 'terminate)) + (raise-argument-error who "(or/c #f 'hang-up 'terminate)" kind)) (atomically (host:mutex-acquire (place-lock p)) (define pending-break (place-pending-break p))