diff --git a/ex-3_46-xx.scm b/ex-3_46-xx.scm index ca9aac5..c3b88b0 100644 --- a/ex-3_46-xx.scm +++ b/ex-3_46-xx.scm @@ -1,8 +1,170 @@ (load "util.scm") -(display "\nex-3.46\n") +(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))) -(display "\nex-3.47\n") +(define (make-mutex) + (let ((cell (list false))) + (define (the-mutex m) + (cond ((eq? m 'acquire) + (if (test-and-set! cell) + (the-mutex 'acquire))) ; retry + ((eq? m 'release) (clear! cell)))) + the-mutex)) + +(define (clear! cell) + (set-car! cell false)) + +(define (test-and-set! cell) + (without-interrupts + (lambda () + (if (car cell) + true + (begin (set-car! cell true) + false))))) + +(display "\nex-3.46\n") +(display "[answered]\n") +; See page 207 in 2020 BuJo. + +(display "\nex-3.47 - semaphore\n") + +(define (make-semaphore max-count) + (if (< max-count 1) + (error "semaphore count must be at least 1") + (let ((mutex-acquire (make-mutex)) + (mutex-release (make-mutex)) + (count 0)) + (define (acquire) + (mutex-acquire 'acquire) + (if (< count max-count) + (begin + (mutex-release 'acquire) + (set! count (+ count 1)) + (mutex-release 'release) + (mutex-acquire 'release) + 'ok) + (begin + (mutex-acquire 'release) + (acquire)))) + (define (release) + (mutex-release 'acquire) + (set! count (- count 1)) + (mutex-release 'release)) + (define (the-semaphore s) + (cond + ((eq? s 'acquire) (acquire)) + ((eq? s 'release) (release)) + ((eq? s 'count) count) + ((eq? s 'remaining) (- max-count count)) + (else "operation not supported" s))) + the-semaphore))) + +(define s (make-semaphore 3)) +(assert (s 'count) 0) +(s 'acquire) +(s 'acquire) +(s 'acquire) +(assert (s 'remaining) 0) +(s 'release) +(s 'acquire) +(s 'release) +(s 'release) +(s 'release) +(assert (s 'remaining) 3) + +(define (make-semaphore max-count) + (if (< max-count 1) + (error "semaphore count must be at least 1") + (let ((cell (list #f)) + (count 0)) + (define (acquire) + (if (test-and-set! cell) + (acquire) + (if (< count max-count) + (begin + (set! count (+ count 1)) + (clear! cell) + 'ok) + (begin + (clear! cell) + (acquire))))) + (define (release) + (if (test-and-set! cell) + (release) + (begin + (set! count (- count 1)) + (clear! cell)))) + (define (the-semaphore s) + (cond + ((eq? s 'acquire) (acquire)) + ((eq? s 'release) (release)) + ((eq? s 'count) count) + ((eq? s 'remaining) (- max-count count)) + (else "operation not supported" s))) + the-semaphore))) + +(define s (make-semaphore 3)) +(assert (s 'count) 0) +(s 'acquire) +(s 'acquire) +(s 'acquire) +(assert (s 'remaining) 0) +(s 'release) +(s 'acquire) +(s 'release) +(s 'release) +(s 'release) +(assert (s 'remaining) 3) (display "\nex-3.48\n") +(define (make-account-and-serializer 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) + (else (error "Unknown request -- MAKE-ACCOUNT" + m)))) + dispatch)) + +(define (deposit account amount) + (let ((s (account 'serializer)) + (d (account 'deposit))) + ((s d) amount))) + +(define (exchange account1 account2) + (let ((difference (- (account1 'balance) + (account2 'balance)))) + ((account1 'withdraw) difference) + ((account2 'deposit) difference))) + +(define (serialized-exchange account1 account2) + (let ((serializer1 (account1 'serializer)) + (serializer2 (account2 'serializer))) + ((serializer1 (serializer2 exchange)) + account1 + account2))) + +(define a (make-account-and-serializer 100)) +(define b (make-account-and-serializer 40)) +(serialized-exchange a b) +(assert (a 'balance) 40) +