261 lines
9.5 KiB
Racket
261 lines
9.5 KiB
Racket
;; 3.41: It is not necessary to serialise reading of the balance. The
|
|
;; only way this would be necessary is if reading and writing of
|
|
;; numbers wasn't atomic (so we could read a half-updated number).
|
|
;; However, the text suggests that this isn't the case, so there is no
|
|
;; problem with reading the balance to be unserialised. If there is a
|
|
;; write at the same time, the read will either get the value just
|
|
;; before or just after a write.
|
|
|
|
;; 3.42: I don't think it will make any difference to create the
|
|
;; serialised procedures in advance. It shouldn't make any difference
|
|
;; to what concurrency is allowed.
|
|
|
|
;; 3.43: In isolation, the exchange procedure permutes two balances,
|
|
;; leaving the third untouched. If all exchange procedures are run
|
|
;; sequentially, then as above, each call of the procedure permutes
|
|
;; two balances. So an arbitrarily long sequence of serialised calls
|
|
;; can only ever permute balances. See also written notes.
|
|
;; If deposit and withdraw are serialised but exchange is not, then
|
|
;; interleaving a1 <-> a2 and a2 <-> a3 leads to closing balances of
|
|
;; 20 on all accounts. Because deposit and withdaw are serialised,
|
|
;; the sum of the balances of all accounts is increased or decreased
|
|
;; by each deposit or withdrawal. Each exchange does one deposit and
|
|
;; one withdrawal of an equal amount, so the total balance is
|
|
;; preserved once both operations have been done.
|
|
;;
|
|
;; If deposit and withdraw are not serialised, then doing the
|
|
;; following does not preserve the total balance:
|
|
;; 1. Start exchanging a1 and a2. Read the balance of a1 to calculate
|
|
;; that a1 should be set to 20.
|
|
;; 2. Exchange a1 and a3. Now a1 has balance 30.
|
|
;; 3. Continue the original exchange and set the balance of a1 to be
|
|
;; 20 and the balance of a2 to be 10.
|
|
;; Now the total balance is 40 and not 60.
|
|
|
|
;; 3.44: The main difference between the exchange and transfer
|
|
;; operations, is that for exchange, the amount to be moved between
|
|
;; accounts is calculated based on their current balance. This makes
|
|
;; it important that the reads and writes are synchronised. For the
|
|
;; transfer case, the amount to be transfered is pre-computed and is
|
|
;; not dependent on the current balances of the accounts. As a
|
|
;; result, there is no need to serialise anything other than deposit
|
|
;; or withdrawal from each individual account.
|
|
|
|
;; 3.45: When serialise-exchange is called, we call the serialisers of
|
|
;; the two accounts and then call exchange. This calls withdraw and
|
|
;; deposit on the individual accounts. If each of these is also
|
|
;; serialised with the same serialiser that has already been used, we
|
|
;; have deadlock, as the serialiser cannot be called twice.
|
|
|
|
;; 3.46: If test-and-set! is not serialised then both processes can
|
|
;; test for the cell being set before either of them set it. So both
|
|
;; get a return of #f from test-and-set! and both get the mutex.
|
|
|
|
;; 3.47
|
|
|
|
#lang sicp
|
|
|
|
(#%require rebellion/concurrency/lock)
|
|
|
|
(define (until-success op)
|
|
(if (not (op))
|
|
(begin
|
|
(sleep 0)
|
|
(until-success op))))
|
|
|
|
(define (or-map op l)
|
|
(if (pair? l)
|
|
(if (op (car l))
|
|
#t
|
|
(or-map op (cdr l)))
|
|
#f))
|
|
|
|
(define (make-mutex-semaphore n)
|
|
(let ((l (make-lock))
|
|
(counter 0))
|
|
(letrec ((try-acquire!
|
|
(lambda ()
|
|
(lock!
|
|
l
|
|
(lambda ()
|
|
(cond ((< counter n)
|
|
(set! counter (+ counter 1))
|
|
#t)
|
|
(else
|
|
#f))))))
|
|
(try-release!
|
|
(lambda ()
|
|
(lock!
|
|
l
|
|
(lambda ()
|
|
(set! counter (- counter 1)))))))
|
|
(lambda (arg)
|
|
(cond ((eq? arg 'acquire!) (until-success try-acquire!))
|
|
((eq? arg 'release!) (until-success try-release!))
|
|
(else
|
|
(error "mutex-semaphore: invalid argument")))))))
|
|
|
|
(#%require rebellion/concurrency/atomic/boolean)
|
|
|
|
(define (make-atomic-semaphore n)
|
|
(define (make-atomics i)
|
|
(if (= i 0)
|
|
'()
|
|
(cons (make-atomic-boolean #f)
|
|
(make-atomics (- i 1)))))
|
|
(define (try-acquire-one! atomic)
|
|
(atomic-boolean-compare-and-set! atomic #f #t))
|
|
(define (try-release-one! atomic)
|
|
(atomic-boolean-compare-and-set! atomic #t #f))
|
|
(let ((atomics (make-atomics n)))
|
|
(lambda (arg)
|
|
(cond ((eq? arg 'acquire!)
|
|
(until-success (lambda () (or-map try-acquire-one! atomics))))
|
|
((eq? arg 'release!)
|
|
(until-success (lambda () (or-map try-release-one! atomics))))
|
|
((eq? arg 'atomics)
|
|
atomics)
|
|
(else
|
|
(error "atomic-semaphore: invalid argument"))))))
|
|
|
|
(#%require (only racket/base module+ thread thread-wait displayln sleep))
|
|
|
|
(module+ test
|
|
(define mutex-semaphore (make-mutex-semaphore 3))
|
|
(define atomic-semaphore (make-atomic-semaphore 3))
|
|
|
|
(#%require racket/trace)
|
|
|
|
(define (for-each f l)
|
|
(if (not (null? l))
|
|
(begin (f (car l))
|
|
(for-each f (cdr l)))))
|
|
|
|
(define (build-threads proc params)
|
|
(if (null? params)
|
|
'()
|
|
(cons (apply proc (car params))
|
|
(build-threads proc (cdr params)))))
|
|
|
|
(define (worker-proc name semaphore delay-time)
|
|
(thread
|
|
(lambda ()
|
|
(semaphore 'acquire!)
|
|
(displayln (list "Acquire" name))
|
|
(sleep delay-time)
|
|
(semaphore 'release!)
|
|
(displayln (list "Release" name)))))
|
|
|
|
(define (test-semaphore semaphore)
|
|
(let* ((worker-params `(("one" ,semaphore 2)
|
|
("two" ,semaphore 5)
|
|
("three" ,semaphore 3)
|
|
("four" ,semaphore 7)))
|
|
(threads (build-threads worker-proc worker-params)))
|
|
(for-each thread-wait threads)))
|
|
|
|
(test-semaphore atomic-semaphore)
|
|
(test-semaphore mutex-semaphore))
|
|
|
|
;; 3.48: In the exchange problem, deadlock may occur if one account is
|
|
;; involved in two simultaneous exchanges. For example, if a1<->a2 is
|
|
;; overlapped with a2<->a1 and the first process tries to lock a1
|
|
;; first, and the second process tries to lock a2 first. Exchanging
|
|
;; any other pair of accounts will not lead to deadlock because the
|
|
;; second exchange won't depend on the same two accounts as the
|
|
;; first. So whichever exchange gets to the common account first will
|
|
;; complete first, freeing the common account and allowing the other
|
|
;; exchange to complete.
|
|
;;
|
|
;; So the only problem case is where we do two simultaneous exchanges
|
|
;; with the same pair of accounts. If we always protect the accounts
|
|
;; in the same order, then one of the exchanges must get to the lowest
|
|
;; account first. Then the second exchange cannot start until the
|
|
;; first has completed.
|
|
|
|
;; A mutex is a semaphore of size 1
|
|
(module+ 3-48
|
|
(define (make-mutex) (make-atomic-semaphore 1))
|
|
|
|
;; Code from the book
|
|
|
|
(define (make-serializer)
|
|
(let ((mutex (make-mutex)))
|
|
(lambda (p)
|
|
(define (serialized-p . args)
|
|
(mutex 'acquire!)
|
|
(let ((val (apply p args)))
|
|
(mutex 'release!)
|
|
val))
|
|
serialized-p)))
|
|
|
|
;; Code for 3.48
|
|
|
|
(define account-number
|
|
(let ((serial 0))
|
|
(lambda ()
|
|
(set! serial (+ serial 1))
|
|
serial)))
|
|
|
|
(define (make-account-and-serializer account-number balance)
|
|
(define (withdraw amount)
|
|
(if (>= balance amount)
|
|
(begin (set! balance (- balance amount))
|
|
balance)
|
|
"Insufficient funds"))
|
|
(define (deposit amount)
|
|
(set! balance (+ balance amount))
|
|
balance)
|
|
(let ((balance-serializer (make-serializer)))
|
|
(define (dispatch m)
|
|
(cond ((eq? m 'withdraw) withdraw)
|
|
((eq? m 'deposit) deposit)
|
|
((eq? m 'balance) balance)
|
|
((eq? m 'serializer) balance-serializer)
|
|
((eq? m 'number) account-number)
|
|
(else (error "Unknown request -- MAKE-ACCOUNT"
|
|
m))))
|
|
dispatch))
|
|
|
|
(define (make-numbered-account balance)
|
|
(make-account-and-serializer (account-number) balance))
|
|
|
|
(define (exchange account1 account2)
|
|
(let ((difference (- (account1 'balance)
|
|
(account2 'balance))))
|
|
((account1 'withdraw) difference)
|
|
((account2 'deposit) difference)))
|
|
|
|
(define (serialized-exchange account1 account2)
|
|
(let* ((ac-number1 (account1 'number))
|
|
(ac-number2 (account2 'number))
|
|
(first-account (if (< ac-number1 ac-number2) account1 account2))
|
|
(second-account (if (< ac-number1 ac-number2) account2 account1))
|
|
(serializer1 (first-account 'serializer))
|
|
(serializer2 (second-account 'serializer)))
|
|
((serializer1 (serializer2 exchange))
|
|
account1
|
|
account2)))
|
|
|
|
(#%require rackunit)
|
|
(define (test-exchange)
|
|
(let ((account1 (make-numbered-account 20))
|
|
(account2 (make-numbered-account 30)))
|
|
(define thread1 (thread (lambda ()
|
|
(serialized-exchange account1 account2))))
|
|
(define thread2 (thread (lambda ()
|
|
(serialized-exchange account1 account2))))
|
|
(thread-wait thread1)
|
|
(thread-wait thread2)
|
|
|
|
(check-equal? (account1 'balance) 20)
|
|
(check-equal? (account2 'balance) 30)))
|
|
)
|
|
|
|
;; 3.49: One scenario where the deadlock avoidance scheme may fail is
|
|
;; where we need to get information about the account before deciding
|
|
;; if we need to lock it. For example: Peter and Paul share some
|
|
;; accounts, and both want to exchange the account with the highest
|
|
;; balance with the account with the lowest balance. (Not entirely
|
|
;; convinced about this answer.)
|