cs: tune thread-cell implementation
Speed up thread-cell access and make update safe for futures.
This commit is contained in:
parent
b5e145c755
commit
97c552e87b
|
@ -1,33 +1,37 @@
|
||||||
;; A "thread cell" is actually an "engine cell" at the Rumble level
|
;; A "thread cell" is actually an "engine cell" at the Rumble level
|
||||||
|
|
||||||
|
;; Need at least one mutable field, so allocated each time
|
||||||
(define-record-type (thread-cell create-thread-cell thread-cell?)
|
(define-record-type (thread-cell create-thread-cell thread-cell?)
|
||||||
(fields (mutable default-value) ; declare mutable so allocated each time
|
(fields default-value
|
||||||
preserved?))
|
preserved?
|
||||||
|
(mutable mutated?)))
|
||||||
|
|
||||||
(define make-thread-cell
|
(define make-thread-cell
|
||||||
(case-lambda
|
(case-lambda
|
||||||
[(v) (make-thread-cell v #f)]
|
[(v) (make-thread-cell v #f)]
|
||||||
[(v preserved?) (create-thread-cell v (and preserved? #t))]))
|
[(v preserved?) (create-thread-cell v (and preserved? #t) #f)]))
|
||||||
|
|
||||||
(define/who (thread-cell-ref c)
|
(define/who (thread-cell-ref c)
|
||||||
(check who thread-cell? c)
|
(check who thread-cell? c)
|
||||||
(unsafe-thread-cell-ref c))
|
(unsafe-thread-cell-ref c))
|
||||||
|
|
||||||
(define (unsafe-thread-cell-ref c)
|
(define (unsafe-thread-cell-ref c)
|
||||||
(let* ([t (current-engine-thread-cell-values)]
|
(if (thread-cell-mutated? c)
|
||||||
[v (if t
|
(let* ([t (current-engine-thread-cell-values)])
|
||||||
(hashtable-ref t c none)
|
(if t
|
||||||
none)])
|
(eq-hashtable-ref t c (thread-cell-default-value c))
|
||||||
(cond
|
(thread-cell-default-value c)))
|
||||||
[(eq? v none)
|
(thread-cell-default-value c)))
|
||||||
(thread-cell-default-value c)]
|
|
||||||
[else v])))
|
|
||||||
|
|
||||||
(define/who (thread-cell-set! c v)
|
(define/who (thread-cell-set! c v)
|
||||||
(check who thread-cell? c)
|
(check who thread-cell? c)
|
||||||
(hashtable-set! (current-engine-thread-cell-values)
|
(thread-cell-mutated?-set! c #t)
|
||||||
c
|
(let ([p (eq-hashtable-try-atomic-cell (current-engine-thread-cell-values) c v)])
|
||||||
v))
|
(cond
|
||||||
|
[p (set-cdr! p v)]
|
||||||
|
[else
|
||||||
|
;; Contention, so try again
|
||||||
|
(thread-cell-set! c v)])))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user