1 665c255d 2023-08-04 jrmu (define (make-serializer)
 2 665c255d 2023-08-04 jrmu   (let ((mutex (make-mutex)))
 3 665c255d 2023-08-04 jrmu     (lambda (p)
 4 665c255d 2023-08-04 jrmu       (define (serialized-p . args)
 5 665c255d 2023-08-04 jrmu 	(mutex 'acqure)
 6 665c255d 2023-08-04 jrmu 	(let ((val (apply p args)))
 7 665c255d 2023-08-04 jrmu 	  (mutex 'release)
 8 665c255d 2023-08-04 jrmu 	  val))
 9 665c255d 2023-08-04 jrmu       serialized-p)))
10 665c255d 2023-08-04 jrmu 
11 665c255d 2023-08-04 jrmu (define (make-mutex)
12 665c255d 2023-08-04 jrmu   (let ((cell (list false)))
13 665c255d 2023-08-04 jrmu     (define (the-mutex m)
14 665c255d 2023-08-04 jrmu       (cond ((eq? m 'acquire)
15 665c255d 2023-08-04 jrmu 	     (if (test-and-set! cell)
16 665c255d 2023-08-04 jrmu 		 (the-mutex 'acquire)))
17 665c255d 2023-08-04 jrmu 	    ((eq? m 'release) (clear! cell))))
18 665c255d 2023-08-04 jrmu     the-mutex))
19 665c255d 2023-08-04 jrmu (define (clear! cell)
20 665c255d 2023-08-04 jrmu   (set-car! cell false))
21 665c255d 2023-08-04 jrmu (define (test-and-set! cell)
22 665c255d 2023-08-04 jrmu   (if (car cell)
23 665c255d 2023-08-04 jrmu       true
24 665c255d 2023-08-04 jrmu       (begin (set-car! cell true)
25 665c255d 2023-08-04 jrmu 	     false)))