cs & threads: repairs for places
Includes a repair for handling vectors and prefab structs that are involved in cycles.
This commit is contained in:
parent
635c64e8bb
commit
f3de3e4584
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Reference in New Issue
Block a user