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)))