cs & threads: repairs for places

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

View File

@ -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)

View File

@ -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)

View File

@ -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

View File

@ -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))