Bigloo supports fair threads (see Section
Thread), a
specification of cooperative threads. In this framework a thread must
explicitly or implicitly
yield the processor to the scheduler
(see Section
Scheduler). Explicit cooperation is achieved by
library functions such as
thread-yield!
or
thread-sleep!
. Implicit cooperation is achieved by forms such
as
(thread-await! (make-input-signal p '(#\Newline)))
that
blocks the current thread until the character
#\Newline
is read on
input port
p
. The scheduler
does not preempt a running thread to
allocate the processor to another waiting thread. Fair threads have two
drawbacks over preemptive threads:
- Cooperative threads are not skilled to benefit of multi processors
platforms.
- Single threads programs must be adapted in order to be ran
concurrently.
On the other hand, Fair threads have advantages that make them
suitable for a high level programming language such as Scheme:
- Fair threads have a strong and well defined semantic. Multi threaded
programs using Fair threads are deterministic thus programs
that deploy Fair threads are predictable.
- Fair threads are easier to program with because they hide most the
of the concurrent programming pitfalls. In particular, since Fair
threads enforce a strong synchronization, there
is no need to deploy techniques such as mutex, semaphore
or condition variables.
This whole chapter has been written in collaboration with
Frédéric
Boussinot. It uses materials on Fair threads that can be found at
http://www-sop.inria.fr/mimosa/rp/FairThreads/html/FairThreads.html.
8.1 Introduction to Fair Threads
|
Fair threads are cooperative threads run by a fair scheduler which
gives them equal access to the processor. Fair threads can communicate
using broadcast events. Their semantics does not depends on the
executing platform. Fine control over fair threads execution is
possible allowing the programming of specific user-defined scheduling
strategies.
Contrary to standard sequential programming where the processor
executes a single program, in concurrent programming the processor is
a shared resource which is dispatched to several programs. The term
concurrent is appropriate because programs can be seen as
concurrently competing to gain access to the processor, in order to
execute.
Threads are a basic mean for concurrent programming, and are widely
used in operating systems. At language level, threads offer a way to
structure programs by decomposing systems in several concurrent
components; in this respect, threads are useful for modularity.
However, threads are generally considered as low-level primitives
leading to over-complex programming. Moreover, threads generally have
loose semantics, in particular depending on the underlying executing
platform; to give them a precise semantics is a difficult task, and
this is a clearly identified problem to get portable code.
Bigloo proposes a new framework with clear and simple semantics, and
with an efficient implementation. In it, threads are called
fair; basically a fair thread is a cooperative thread executed
in a context in which all threads always have equal access to the
processor. Fair threads have a deterministic semantics, relying on
previous work belonging to the so-called reactive approach.
8.2 Programming with Fair threads
|
All ports of Bigloo JVM back-end (see
Compiler Description)
support Fair threads. Only few ports of Bigloo native back-end support
Fair threads. Please refer to the installation documentation (file
INSTALL) to check which native ports support Fair threads.
Fair threads are available by the mean of a Bigloo library. That is,
when compiling and linking with threads, it is required to use a
library
module clause (see
Module Declaration) such as:
(module http-server
(library fthread)
...)
|
When the Fair thread library is deployed the
cond-expand
form (see
SRFIs) evaluate
fthread
and
SRFI-18
clauses.
For the sake of the example we present in this section a small web
server implemented with Fair threads. This server only supports Http
GET
request but it supports concurrent requests. That is, the
server is able to server several clients simultaneously.
First, the server needs to create a
socket
server (see the
Socket
documentation):
(define (start-http-server)
(let ((s (make-server-socket)))
(print "Http server started: " (socket-port-number s))
s))
|
Then a Fair thread implementing the web server is created and ran:
(let* ((svr (start-http-server))
(thd (make-thread (make-http-server svr) 'http-server))
(ts (thread-start! thd)))
(scheduler-start!)
(fprint (current-error-port) "Shuting down http server...")
(socket-shutdown svr))
|
The functions
make-thread
and
thread-start!
(see
Section
Thread) start the execution of a new thread. The
function
scheduler-start!
(see Section
Scheduler) manages
the execution of all threads.
The body of the server is a thunk, created by the
make-http-server
function. Its definition is:
(define (make-http-server s::socket)
(lambda ()
(let loop ()
(let ((s2 (thread-await! (make-accept-signal s))))
(thread-start! (make-thread (lambda () (http-eval s2))))
(thread-yield!)
(loop)))))
|
The function
thread-await!
waits for a connection to the socket
server
s2
. This blocks the current thread but it does not block the
scheduler and the execution of other threads in it. That is, when the thread
running the http server waits for a connection to the socket server,
the other threads started in the scheduler keep executing. When a connection
is established, a new thread is created that evaluates
(
http-eval
) the request. When this thread is started the http
server cooperates (
thread-yield!
).
(define (http-eval s::socket)
(define (readline)
(thread-await! (make-input-signal (socket-input s)
'(#\Newline #\Return))))
(let* ((lines (let loop ((line (readline)))
(thread-yield!)
(if (and (string? line) (=fx (string-length line) 1))
'()
(cons (substring line 0 (-fx (string-length line) 1))
(loop (readline))))))
(line (car lines)))
(http-get "index.html" s)
(socket-close s)))
|
The client request is first read. This is done using the non blocking form
of input
(thread-await! (make-input-signal (socket-input s) '(#\Newline #\Return)))
.
This blocks the current thread until a character
#\Newline
or
#\Return
is read. Then, the value of that call is either the
``end of file'' object or the a string of characters.
Each time a line is read, the thread cooperates (
thread-yield!
).
The explanation is the same as for the socket connection. Without this
explicit cooperation, the call to
thread-await!
would always
return the same string of characters.
At this point, let us suppose that we want our web server able to serve
HTML, Shell and Scheme pages. For this
http-get
looks at the
suffix of the file to be downloaded:
(define (http-get fname s::socket)
(case (string->symbol (suffix fname)
((scm)
(http-get-scm fname s))
((sh)
(http-get-sh fname s))
(else
(http-get-html fname s)))))
|
For the first two requests, a new process is spawned. For the last
one, a file is opened:
(define (http-get-scm file s::socket)
(let ((proc (run-process "bigloo" "-i" "-s" file output: pipe:)))
(http-get-input (process-output-port proc) s)))
(define (http-get-sh file s::socket)
(let ((proc (run-process "sh" "-f" file output: pipe:)))
(http-get-input (process-output-port proc) s)))
(define (http-get-html fname s::socket)
(if (file-exists? fname)
(let ((p (open-input-file fname)))
(http-get-input p s)
(close-input-port p))
(http-reply s "plain" "Can't find file \"" fname "\"")))
|
The function
http-get-input
reads all the characters from an input port.
(define (http-get-input p::input-port s::socket)
(let loop ((res '()))
(let ((v (thread-await! (make-input-signal p 1024))))
(thread-yield!)
(if (eof-object? v)
(apply http-reply s "html" (reverse! res))
(loop (cons v res))))))
|
It must be noted here that since the characters are read with
thread-await!
which does not block the scheduler, while a client
request is being processed, the scheduler is able to handle
simultaneously other requests. The form
(thread-await! (make-input-signal p 1024))
blocks the
current thread until at most
1024
characters have been read
from input port
p
.
The function
http-reply
simply writes a list of strings to the
output port associated with the socket connection:
(define (http-reply socket::socket kind . str)
(let ((p (socket-output socket)))
(thread-await! (make-output-signal p "HTTP/1.0 200 Ok\r
Server: test_httpd/%x\r
Connection: close\r
Content-type: text/"))
(thread-await! (make-output-signal p kind))
(thread-await! (make-output-signal p "\r\n\r\n"))
(for-each (lambda (s) (thread-await! (make-output-signal p s))) str)
(thread-await! (make-output-signal p "\r\n"))))
|
Bigloo uses a set of
primitive functions to create, run and
handle thread. For the sake of standardization the name and semantic
of SRFI-18 (Multithreading support) has been used. This section presents
only the mandatory functions to program with Fair threads in Bigloo. The
Section
SRFI-18 presents the functions that are not necessary
to Bigloo but supported for compliance with SRFI-18.
current-thread | SRFI-18 function |
Returns the current thread.
|
thread? obj | SRFI-18 function |
Returns #t if obj is a thread, otherwise returns #f .
|
make-thread thunk [name ] | SRFI-18 function |
Returns a new thread which is not started yet. The body of the thread
is the body of the procedure thunk . The optional argument name
can be use to identify the thread. It can be any Bigloo value.
(make-thread (lambda () (print 1) (thread-yield!) (print 2)) 'my-thread)
|
|
thread-start! thread [scheduler ] | SRFI-18 function |
Runs a thread created with make-thread . If scheduler is
provided, the thread is started this particular scheduler. Otherwise,
it is started in the current scheduler (see Section Scheduler).
Threads are started at the beginning of reactions
(see Section Scheduler).
|
thread-name thread | SRFI-18 function |
Returns the name of the thread that has been passed to
make-thread .
|
thread-specific thread | SRFI-18 function |
thread-specific-set! thread obj | SRFI-18 function |
Returns and sets value in the specific field of the thread . If no
value has been set, thread-specific returns an unspecified value.
(let ((t (make-thread (lambda ()
(print (thread-specific (current-thread)))))))
(thread-specific-set! t 'foo)
(thread-start! t)) -| foo
|
|
thread-cleanup thread | Bigloo function |
thread-cleanup-set! thread fun | Bigloo function |
Associates a cleanup function to a thread. The cleanup function is called
with the result value of the thread. The cleanup function is executed
in a context where current-thread is the thread owning the
cleanup function.
(let ((t (make-thread (lambda () 'done) 'foo)))
(thread-cleanup-set! t (lambda (v) (print (thread-name (current-thread))
", exit value: " v)))
(thread-start! t)) -| foo, exit value: done
|
|
thread-yield! | SRFI-18 function |
The current thread cooperates. That is, it is suspend for the
reaction and the scheduler selects a new thread to be resumed. The
scheduler resumes the next avaliable thread. If there is only one
thread started in the scheduler, the same thread is resumed.
A reaction correspond to the invocation of a scheduler-react!
call (see Section Scheduler).
|
thread-sleep! timeout | SRFI-18 function |
The current thread cooperates during exactly timeout
reactions (see Scheduler). It is suspended and the scheduler
selects a new thread to be resumed. If there is only one thread started in the
scheduler, the same thread will be resumed.
(let ((t1 (make-thread
(lambda () (thread-sleep! 2) (display 'foo))))
(t2 (make-thread
(lambda () (let loop ((n 1))
(display n)
(thread-yield!)
(if (< n 5)
(loop (+ n 1))))))))
(thread-start! t1)
(thread-start! t2)
(scheduler-start!)) -| 12foo34
|
|
thread-terminate! thread | SRFI-18 function |
Terminates thread at the end of the current reaction.
|
thread-join! thread [timeout [timeout-val ]] | SRFI-18 function |
The current thread waits until the thread terminates or until
the timeout is reached (when supplied). If the timeout is
reached, thread-join! returns timeout-val . If thread
terminates, thread-join! returns the end-result of the thread
or the end-exception if that thread terminates abnormally.
If several threads wait for the termination of the same thread, they are
all notified of the termination during the current reaction.
(let* ((t1 (thread-start!
(make-thread (lambda ()
(thread-sleep! 3)
'foo))))
(t2 (thread-start!
(make-thread (lambda ()
(print "t1: " (thread-join! t1 1))))))
(t3 (thread-start!
(make-thread (lambda ()
(print "t2: " (thread-join! t1 2 'bar))))))
(t3 (thread-start!
(make-thread (lambda ()
(print "t3: " (thread-join! t1))))))
(t4 (thread-start!
(make-thread (lambda ()
(print "t4: " (thread-join! t1)))))))
(scheduler-start!))
-| t1: #|%uncaught-exception [reason: (exception . join-timeout)]|
t2: bar
t3: foo
t4: foo
|
|
thread-suspend! thread | Bigloo function |
thread-resume! thread | Bigloo function |
Suspends/resumes the thread at the end of reaction. While suspended
a thread is not eligible to get the processor by the scheduler.
|
thread-await! signal [timeout ] | Bigloo function |
Blocks the thread until signal has been broadcast or until
timeout is elapsed. The function thread-await! returns
the value associated with the previous emissions of the signal that
took place during the reaction.
(let ((t1 (thread-start!
(make-thread
(lambda ()
(display (thread-await! 'foo))
(display (thread-await! 'bar))))))
(t2 (thread-start!
(make-thread
(lambda ()
(broadcast! 'foo 'val1-foo)
(broadcast! 'foo 'val2-foo)))))
(t3 (thread-start!
(make-thread
(lambda ()
(thread-sleep! 2)
(broadcast! 'bar 'val-bar))))))
(let loop ((n 1))
(display n)
(scheduler-react! (default-scheduler))
(loop (+ n 1))))
-| 1val2-foo23val-bar456...
|
The function thread-await! cannot be used to intercept all the signals
broadcasted during a reaction. This is illustrated by the following example
were obviously thread-await! cannot intercept the emission of the
signal:
(thread-start! (make-thread (lambda ()
(tread-await! 'foo)
(broadcast! 'foo 1))))
(thread-start! (make-thread (lambda ()
(broadcast! 'foo 2))))
|
|
thread-get-values! signal | Bigloo function |
Terminates the instant for the thread (as thread-yield! ) and
returns, hence at the next instant, all the values associated with
broadcast signal (see Section Signal) during the previous scheduler
reaction (see Section Scheduler).
Example:
(thread-start! (make-thread
(lambda ()
(for-each print (thread-get-values! 'foo)))))
(thread-start! (make-thread
(lambda ()
(broadcast! 'foo 1)
(broadcast! 'foo 'foo)
(broadcast! 'foo "blabla"))))
-| 1
foo
blabla
|
Example:
(let ((t1 (thread-start!
(make-thread
(lambda ()
(for-each print (thread-get-values! 'foo)))
't1)))
(t2 (thread-start!
(make-thread
(lambda ()
(broadcast! 'foo (current-thread))
(thread-yield!)
;; this second broadcast won't be intercepted
;; because it occurs during the next reaction
(broadcast! 'foo (current-thread)))
't2)))
(t3 (thread-start!
(make-thread
(lambda ()
(broadcast! 'foo (current-thread))
(broadcast! 'foo (current-thread)))
't3))))
(scheduler-start!))
-| #<thread:t2>
#<thread:t3>
#<thread:t3>
|
|
thread-await-values! signal [timeout ] | Bigloo function |
This blocks the current thread until signal has been broadcast.
It then returns, at the next instant, all the values associated with
all the broadcasts that took place during the instant.
It can be defined as:
(define (thread-await-values! signal . tmt)
(apply thread-await! signal tmt)
(thread-get-values signal))
|
|
thread-await*! signals [timeout ] | Bigloo function |
Wait for one of a list of signals. The function thread-await*!
can be compared to the Unix select function. The argument
signals is a list of signal identifier. The function
thread-await*! blocks the current thread until one of the signal in
the list signals is broadcast or until the optional numerical argument
timeout is elapsed. If the thread unblocks because the timeout is
elapsed, thread-await*! returns #f . Otherwise it returns two
values that have to be collected with multiple-value-bind (see
Control Features). The first one is the value of the broadcast
signal. The second one is the broadcast signal.
Example:
(let ((res #f))
(thread-start!
(make-thread (lambda ()
(let ((sig* (list 'foo 'bar)))
(multiple-value-bind (val1 sig1)
(thread-await*! sig*)
(multiple-value-bind (val2 sig2)
(thread-await*! sig*)
(thread-yield!)
(multiple-value-bind (val3 sig3)
(thread-await*! sig*)
(set! res (list sig1 sig2 sig3)))))))))
(thread-start!
(make-thread (lambda ()
(thread-sleep! 2)
(broadcast! 'foo 1))))
(thread-start!
(make-thread (lambda ()
(thread-sleep! 3)
(broadcast! 'bar 2))))
(scheduler-start!)
res)
=> '(foo foo bar)
|
A second example using timeouts:
(let ((res #f))
(thread-start!
(make-thread (lambda ()
(let ((sig* (list 'foo 'bar)))
(multiple-value-bind (val1 sig1)
(thread-await*! sig* 1)
(thread-yield!)
(multiple-value-bind (val2 sig2)
(thread-await*! sig* 1)
(thread-yield!)
(multiple-value-bind (val3 sig3)
(thread-await*! sig* 2)
(set! res (list sig1 sig2 sig3)))))))))
(thread-start!
(make-thread (lambda ()
(thread-sleep! 2)
(broadcast! 'foo 1))))
(thread-start!
(make-thread (lambda ()
(thread-sleep! 3)
(broadcast! 'bar 2))))
(scheduler-start!)
res)
=> '(#f foo bar)
|
|
thread-get-values*! signals | Bigloo function |
Terminates the instant for the thread (as thread-yield! ) and
returns, hence at the next instant, all the values associated with
all broadcast signals (see Section Signal) during the previous
scheduler reaction (see Section Scheduler). The function
thread-get-values*! returns an alist made of the scanned signal
and their values. That is the length of the returns list is the length
of the list signals . If a signal of the list signals has not
been broadcast, its associated entry the list returned by
thread-get-values*! has an empty cdr .
Example:
(let ((s1 'foo)
(s2 'bar)
(s3 'gee)
(res #f))
(thread-start!
(make-thread (lambda ()
(thread-sleep! 2)
(broadcast! 'foo (current-time))
(broadcast! 'bar 0))))
(thread-start!
(make-thread (lambda ()
(thread-await*! (list s1 s2 s3))
(set! res (thread-get-values*! (list s1 s2 s3))))))
(thread-start!
(make-thread (lambda ()
(thread-sleep! 2)
(broadcast! 'bar (current-time)))))
(scheduler-start!)
res)
=> ((foo 3) (bar 3 0) (gee))
|
Used with asynchronous signal, the functions thread-await*! and
thread-get-values*! can be used to read concurrently, in a non
blocking way, several files.
|
thread-await-values*! signals [timeout ] | Bigloo function |
This blocks the current thread until at least one of signals has
been broadcast. It then returns, at the next instant, all the values associated
with all the broadcasts that took place during the instant. It can be
defined as:
(define (thread-await-values*! signal . tmt)
(apply thread-await*! signal tmt)
(thread-get-values*! signal))
|
|
make-scheduler [envs ] | Bigloo function |
Creates a new scheduler. The optional arguments envs are
fair thread environments which will be defined in forthcoming
Bigloo releases.
|
scheduler? obj | Bigloo function |
Returns #t if obj is a scheduler. Otherwise returns #f .
|
current-scheduler | Bigloo function |
Returns the current scheduler. The current scheduler is the scheduler
used in the last call to scheduler-react! or scheduler-start! .
It always exists a current scheduler. That is, it is optional for an
application to create a scheduler.
|
scheduler-react! [scheduler ] | Bigloo function |
Executes all the treads started (see thread-start! ,
Section Thread) in the scheduler until all the threads are
blocked. A thread is blocked if the has explicitly yield the processor
(thread-yield! and thread-sleep! ) or because it is waiting
a signal (thread-await! ). A thread
can be selected several times during the same reaction.
The function scheduler-react! returns a symbol denoting the
state of the scheduler. The possible states are:
ready The Scheduler is ready to execute some threads.
done All the threads started in the scheduler have terminated.
await All the threads started in the scheduler are waiting for
a signal.
An invocation of scheduler-react! is called a reaction.
|
scheduler-start! [arg [scheduler ]] | Bigloo function |
Executes scheduler-react! as long as the scheduler is not done.
If the optional argument scheduler is not provided,
scheduler-start! uses the current scheduler
(see current-scheduler ). The optional arg can either be:
- An integer standing for the number of times
scheduler-react!
must be called.
- A procedure
f of one argument. The procedure f
is invoked after each reaction. It is passed a value i which is
the iteration number of the scheduler. The reactions of the scheduler
are stopped when f returns #f .
(let* ((s (make-scheduler))
(t (make-thread (lambda ()
(let loop ((n 0))
(display n)
(thread-yield!)
(loop (+ 1 n)))))))
(scheduler-start! 10 s))
-| 0123456789
(let* ((s (make-scheduler))
(t (make-thread (lambda ()
(let loop ((n 0))
(display n)
(thread-yield!)
(loop (+ 1 n)))))))
(scheduler-start! (lambda (i) (read-char)) s))
-| 0123456789
|
|
scheduler-terminate! [scheduler ] | Bigloo function |
Terminates all the threads in scheduler .
|
scheduler-instant [scheduler ] | Bigloo function |
Returns the current reaction number of scheduler . The reaction
number is the number of times scheduler-react! has been invoked
passing scheduler as argument.
|
broadcast! signal [val ] | Bigloo function |
Broadcasts signal to all threads started in scheduler
immediately, that is during the reaction. This function can only
be called from within a running thread. If the optional argument val
is omitted, the signal is broadcast with an unspecified value.
(thread-start! (make-thread
(lambda ()
(thread-await! 'foo)
(print (scheduler-instant (current-scheduler))))))
(thread-start! (make-thread
(lambda ()
(broadcast! 'foo))))
(scheduler-start!)
-| 1
|
|
scheduler-broadcast! scheduler signal [val ] | Bigloo function |
At the next react broadcasts signal to all threads started
in scheduler . This is used to impact running threads from outside
any threads. If the optional argument val
is omitted, the signal is broadcast with an unspecified value.
|
make-input-signal input-port obj [scheduler ] | Bigloo function |
The argument obj can either be: a integer, a string, a pair. The
condition for raising the signal depends on the type of obj .
See also fair-read/rp .
- integer:
This function returns a new signal that can be used anywhere a
signal is expected (e.g.,
thread-await! ). In addition, it
spawns a asynchronous process that broadcasts, in
scheduler , the created signal
when len characters are read to the input-port . The
value associated with the signal is either the ``end of file'' object when
no more characters are available on the port or a string composed
of the characters read on input-port . Note that the string length
could be lesser than len is less characters are available.
See Section Introduction for examples using make-input-signal .
- string:
The signal is raised when the pattern
obj is read on input-port .
- list of strings:
The signal is raised when one of the patterns in the list
obj is read on
input-port .
- list of characters:
The signal is raised when the character in the list
obj is read
on input-port .
|
make-send-chars-signal input-port output-port string [len ] [scheduler ] | Bigloo function |
Copies len characters from input-port to output-port . If
the optional argument len is left empty, all the characters of
input-port are copied.
|
make-output-signal output-port string [scheduler ] | Bigloo function |
This function behaves as make-input-signal expect that the
signal is raised when the string is written on
on output-port .
|
make-connect-signal socket [scheduler ] | Bigloo function |
This function behaves as make-input-signal expect that the
signal is raised when a connection is established on socket .
The connection is established via the function socket-accept-connection
See Section Socket for the definition of this last function.
|
make-accept-signal socket [scheduler ] | Bigloo function |
This function behaves as make-input-signal expect that the
signal is raised when a connection is established on socket . The
socket client holding the connection is returned. If an error has occurred
during the connection, the value #f is returned.
The connection is established via the function socket-accept .
See Section Introduction for an example using make-accept-signal .
See Section Socket for the definition of
make-accept-signal .
|
make-process-signal process [scheduler ] | Bigloo function |
This function behaves has make-input-signal expect that the
signal is raised when the process completes.
Example:
(thread-start! (make-thread
(lambda ()
(let* ((p (run-process "bigloo" "-i" "foo.scm"))
(r (thread-await! (make-process-signal p))))
(print "process termination: " r)))))
(thread-start! (make-thread
(lambda ()
...)))
|
|
make-sleep-signal ms [scheduler ] | Bigloo function |
Sleep for at least ms microseconds.
|
fair-read/rp gram port | Bigloo procedure |
Read from the input port port according to the regular grammar
gram . This function automatically collaborates with other threads. It
can thus be used to implement non-blocking readings
(see also make-input-signal ).
|
Bigloo implements SRFI-18 (Multithreading support). This SRFI is
available at
http://srfi.schemers.org/srfi-18/srfi-18.html. One
should keep in mind that since the Bigloo scheduler is cooperative
Bigloo threads must
cooperate at some point in order not to
block the execution of other threads. The functions enforcing
cooperation are
thread-yield!
,
thread-sleep!
,
thread-join!
and
thread-await!
. In addition the SRFI-18
mutex-unlock
function enforce cooperation.
mutex? obj | SRFI-18 function |
make-mutex obj [name ] | SRFI-18 function |
mutex-name mutex | SRFI-18 function |
mutex-specific mutex | SRFI-18 function |
mutex-specific-set! mutex obj | SRFI-18 function |
mutex-state mutex | SRFI-18 function |
mutex-lock! mutex [timeout [thread ]] | SRFI-18 function |
mutex-unlock! mutex [condition-variable [timeout ]] | SRFI-18 function |
(let ((m (make-mutex)))
(thread-start!
(make-thread (lambda ()
(let loop ()
(if (mutex-lock! m 0)
(begin
(display "locked")
(mutex-unlock! m))
(begin
(thread-yield!)
(loop))))))))
-| locked
(let ((res '()))
(define (mutex-lock-recursively! mutex)
(if (eq? (mutex-state mutex) (current-thread))
(let ((n (mutex-specific mutex)))
(mutex-specific-set! mutex (+ n 1)))
(begin
(mutex-lock! mutex)
(mutex-specific-set! mutex 0))))
(define (mutex-unlock-recursively! mutex)
(let ((n (mutex-specific mutex)))
(if (= n 0)
(mutex-unlock! mutex)
(mutex-specific-set! mutex (- n 1)))))
(thread-start!
(make-thread
(lambda ()
(let ((m (make-mutex)))
(mutex-lock-recursively! m)
(mutex-lock-recursively! m)
(mutex-lock-recursively! m)
(set! res (cons (mutex-specific m) res))
(mutex-unlock-recursively! m)
(mutex-unlock-recursively! m)
(mutex-unlock-recursively! m)
(set! res (cons (mutex-specific m) res))))))
res)
=> (0 2)
|
|
condition-variable? obj | SRFI-18 function |
make-condition-variable [name ] | SRFI-18 function |
condition-variable-name cv | SRFI-18 function |
condition-variable-specific! cv | SRFI-18 function |
condition-variable-specific-set! cv obj | SRFI-18 function |
condition-variable-signal! cv | SRFI-18 function |
condition-variable-broadcast! cv | SRFI-18 function |
(let ((res 0))
(define (make-semaphore n)
(vector n (make-mutex) (make-condition-variable)))
(define (semaphore-wait! sema)
(mutex-lock! (vector-ref sema 1))
(let ((n (vector-ref sema 0)))
(if (> n 0)
(begin
(vector-set! sema 0 (- n 1))
(mutex-unlock! (vector-ref sema 1)))
(begin
(mutex-unlock! (vector-ref sema 1) (vector-ref sema 2))
(semaphore-wait! sema)))))
(define (semaphore-signal-by! sema increment)
(mutex-lock! (vector-ref sema 1))
(let ((n (+ (vector-ref sema 0) increment)))
(vector-set! sema 0 n)
(if (> n 0)
(condition-variable-broadcast! (vector-ref sema 2)))
(mutex-unlock! (vector-ref sema 1))))
(let ((sema (make-semaphore 10)))
(let ((t1 (thread-start! (make-thread
(lambda ()
(semaphore-wait! sema)
(set! res (current-time))))))
(t2 (thread-start! (make-thread
(lambda ()
(let loop ((n 10))
(if (> n 0)
(begin
(semaphore-signal-by! sema 1)
(thread-yield!)
(loop (- n 1))))))))))
(scheduler-start!)
res)))
=> 2
|
|
current-time [scheduler ] | SRFI-18 function |
Returns the reaction number of scheduler .
|
time? obj | SRFI-18 function |
time->seconds obj | SRFI-18 function |
|
current-exception-handler | SRFI-18 function |
with-exception-handler handler thunk | SRFI-18 function |
raise obj | SRFI-18 function |
join-timeout-exception? obj | SRFI-18 function |
abandoned-mutex-exception? obj | SRFI-18 function |
terminated-thread-exception? obj | SRFI-18 function |
uncaught-exception? obj | SRFI-18 function |
uncaught-exception-reason exc | SRFI-18 function |
|