]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/mutex.rkt
Solution to 4.44. A bit too verbose. Can be improved by better
[sicp.git] / src / sicp / mutex.rkt
1 #lang racket
2
3 (define (make-serializer)
4   (let ([mutex (make-mutex)])
5     (lambda (p)
6       (define (serialized-p . args)
7         (mutex 'acquire)
8         (let ([val (apply p args)])
9           (mutex 'release)
10           val))
11       serialized-p)))
12           
13 (define (make-mutex)
14   (let ([cell (mcons #f '())])
15     (define (the-mutex m)
16       (cond [(eq? m 'acquire)
17              (when (test-and-set! cell)
18                (the-mutex 'acquire))] ;; loop till we acquire the mutex
19             [(eq? m 'release) (clear! cell)]))
20     the-mutex))
21
22 (define (clear! cell)
23   (set-mcar! cell #f))
24
25 (define (test-and-set! cell)
26   (if (mcar cell)
27       #t
28       (begin (set-mcar! cell #t)
29              #f)))