From: Ramakrishnan Muthukrishnan Date: Sat, 18 Jun 2011 09:17:29 +0000 (+0530) Subject: mutex discussions in the section X-Git-Url: https://git.rkrishnan.org/webform_css?a=commitdiff_plain;h=cabecb81ec718fa5cfe5b25f2f3cc9d9757af238;p=sicp.git mutex discussions in the section --- diff --git a/src/sicp/mutex.rkt b/src/sicp/mutex.rkt new file mode 100644 index 0000000..6937404 --- /dev/null +++ b/src/sicp/mutex.rkt @@ -0,0 +1,29 @@ +#lang racket + +(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))) + +(define (make-mutex) + (let ([cell (mcons #f '())]) + (define (the-mutex m) + (cond [(eq? m 'acquire) + (when (test-and-set! cell) + (the-mutex 'acquire))] ;; loop till we acquire the mutex + [(eq? m 'release) (clear! cell)])) + the-mutex)) + +(define (clear! cell) + (set-mcar! cell #f)) + +(define (test-and-set! cell) + (if (mcar cell) + #t + (begin (set-mcar! cell #t) + #f)))