1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
@node Custom thread synchronization
@section Custom thread synchronization
@cindex suspending threads
@cindex resuming suspended threads
@stindex threads-internal
Along with several useful thread synchronization abstraction facilities
built-in to Scheme48, there is also a simple and lower-level mechanism
for suspending & resuming threads. The following bindings are exported
from the @code{threads-internal} structure.
@cindex thread cells
@cindex thread queues
Threads have a field for a @embedref{Cells, cell} that is used when the
thread is suspended. When it is ready to run, it is simply @code{#f}.
Suspending a thread involves setting its cell to a cell accessible
outside, so the thread can later be awoken. When the thread is awoken,
its cell field and the contents of the cell are both set to @code{#f}.
Often, objects involved in the synchronization of threads will have a
@embedref{Queues, queue} of thread cells. There are two specialized
operations on thread cell queues that simplify filtering out cells of
threads that have already been awoken.
@deffn procedure maybe-commit-and-block cell @returns{} boolean
@deffnx procedure maybe-commit-and-block-on-queue @returns{} boolean
These attempt to commit the current proposal. If the commit fails,
they immediately return @code{#f}. Otherwise, they suspend the current
thread. @code{Maybe-commit-and-block} first sets the current thread's
cell to @var{cell}, which should contain the current thread.
@code{Maybe-commit-and-block-on-queue} adds a cell containing the
current thread to @var{queue} first. When the current thread is
finally resumed, these return @code{#t}.
@end deffn
@deffn procedure maybe-commit-and-make-ready thread-or-queue @returns{} boolean
Attempts to commit the current proposal. If the commit fails, this
returns @code{#f}. Otherwise, @code{maybe-commit-and-make-ready}
awakens the specified thread[s] by clearing the thread/each thread's
cell and sending a message to the relevant scheduler[s] and returns
@code{#t}. If @var{thread-or-queue} is a thread, it simply awakens
that; if it is a queue, it empties the queue and awakens each thread in
it.
@end deffn
@deffn procedure maybe-dequeue-thread! thread-cell-queue @returns{} thread or boolean
@deffnx procedure thread-queue-empty? thread-cell-queue @returns{} boolean
@code{Maybe-dequeue-thread!} returns the next thread cell's contents in
the queue of thread cells @var{thread-cell-queue}. It removes cells
that have been emptied, @ie{} whose threads have already been awoken.
@code{Thread-queue-empty?} returns @code{#t} if there are no cells in
@var{thread-cell-queue} that contain threads, @ie{} threads that are
still suspended. It too removes cells that have been emptied.
@end deffn
For example, the definition of @embedref{Higher-level synchronization,
placeholders} is presented here. Placeholders contain two fields: the
cached value (set when the placeholder is set) & a queue of threads
waiting (set to @code{#f} when the placeholder is assigned).
@lisp
(define-synchronized-record-type placeholder :placeholder
(really-make-placeholder queue)
(value queue) ; synchronized fields
placeholder?
(queue placeholder-queue set-placeholder-queue!)
(value placeholder-real-value set-placeholder-value!))
(define (make-placeholder)
(really-make-placeholder (make-queue)))
(define (placeholder-value placeholder)
;; Set up a new proposal for the transaction.
(with-new-proposal (lose)
(cond ((placeholder-queue placeholder)
;; There's a queue of waiters. Attempt to commit the
;; proposal and block. We'll be added to the queue if the
;; commit succeeds; if it fails, retry.
=> (lambda (queue)
(or (maybe-commit-and-block-on-queue queue)
(lose))))))
;; Once our thread has been awoken, the placeholder will be set.
(placeholder-real-value placeholder))
(define (placeholder-set! placeholder value)
;; Set up a new proposal for the transaction.
(with-new-proposal (lose)
(cond ((placeholder-queue placeholder)
=> (lambda (queue)
;; Clear the queue, set the value field.
(set-placeholder-queue! placeholder #f)
(set-placeholder-value! placeholder value)
;; Attempt to commit our changes and awaken all of the
;; waiting threads. If the commit fails, retry.
(if (not (maybe-commit-and-make-ready queue))
(lose))))
(else
;; Someone assigned it first. Since placeholders are
;; single-assignment cells, this is an error.
(error "placeholder is already assigned"
placeholder
(placeholder-real-value placeholder))))))@end lisp
|
