suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs & threads: repairs for places

Browse Source 
Includes a repair for handling vectors and prefab structs that are
involved in cycles.
This commit is contained in:
Matthew Flatt 2019-04-30 20:28:38 -06:00
parent 635c64e8bb
commit f3de3e4584
4 changed files with 20 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/racket-test/tests/racket/parallel-build.rkt
View File

@ -23,11 +23,13 @@
['output (printf " Output from: ~a\n~a~a" work out err)] ['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)]))) [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) (define (delete-files f)
(delete-file f) (delete-file f)
(let-values ([(base name dir?) (split-path 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 #".dep")))
(delete-file (build-path base "compiled" (path-add-suffix name #".zo"))))) (delete-file (build-path base compiled (path-add-suffix name #".zo")))))
(delete-files tmp1) (delete-files tmp1)
(delete-files tmp2) (delete-files tmp2)

9
racket/src/thread/place-message.rkt
View File

@ -45,21 +45,24 @@
(or (not direct?) (or (not direct?)
(and (immutable? v) (and (immutable? v)
(not (impersonator? v)))) (not (impersonator? v))))
(or (hash-ref graph v #f)
(let ([graph (hash-set graph v #t)]) (let ([graph (hash-set graph v #t)])
(for/and ([e (in-vector v)]) (for/and ([e (in-vector v)])
(loop e graph)))) (loop e graph)))))
(and (immutable-prefab-struct-key v) (and (immutable-prefab-struct-key v)
(or (hash-ref graph v #f)
(let ([graph (hash-set graph v #t)]) (let ([graph (hash-set graph v #t)])
(for/and ([e (in-vector (struct->vector v))]) (for/and ([e (in-vector (struct->vector v))])
(loop e graph)))) (loop e graph)))))
(and (hash? v) (and (hash? v)
(or (not direct?) (or (not direct?)
(and (immutable? v) (and (immutable? v)
(not (impersonator? v)))) (not (impersonator? v))))
(or (hash-ref graph v #f)
(let ([graph (hash-set graph v #t)]) (let ([graph (hash-set graph v #t)])
(for/and ([(k v) (in-hash v)]) (for/and ([(k v) (in-hash v)])
(and (loop k graph) (and (loop k graph)
(loop v graph))))) (loop v graph))))))
(and (not direct?) (and (not direct?)
(or (cpointer? v) (or (cpointer? v)
(and (or (fxvector? v) (and (or (fxvector? v)

2
racket/src/thread/place-object.rkt
View File

@ -23,7 +23,7 @@
[current-thread #:mutable] ; running Racket thread, needed for accounting [current-thread #:mutable] ; running Racket thread, needed for accounting
[post-shutdown #:mutable] ; list of callbacks [post-shutdown #:mutable] ; list of callbacks
[pumpers #:mutable] ; vector of up to three pumper threads [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 done-waiting ; hash table of places to ping when this one ends
[wakeup-handle #:mutable] [wakeup-handle #:mutable]
[dequeue-semas #:mutable]); semaphores reflecting place-channel waits to recheck [dequeue-semas #:mutable]); semaphores reflecting place-channel waits to recheck

4
racket/src/thread/place.rkt
View File

@ -124,8 +124,8 @@
(define/who (place-break p [kind #f]) (define/who (place-break p [kind #f])
(check who place? p) (check who place? p)
(unless (or (not kind) (eq? kind 'hangup) (eq? kind 'terminate)) (unless (or (not kind) (eq? kind 'hang-up) (eq? kind 'terminate))
(raise-argument-error who "(or/c #f 'hangup 'terminate)" kind)) (raise-argument-error who "(or/c #f 'hang-up 'terminate)" kind))
(atomically (atomically
(host:mutex-acquire (place-lock p)) (host:mutex-acquire (place-lock p))
(define pending-break (place-pending-break p)) (define pending-break (place-pending-break p))