sicp-3-4-2-mechanisms-for-controlling-concurrency

#lang racket
(require racket/mpair)

;; The book provides most of the code to make a serializer, but it's not complete
;; because that would be machine-dependent.  So here is a version using Racket
;; semaphores:

(define (make-serializer)
  (define sema (make-semaphore 1))
  (lambda (p)
    (define (serialized-p arg)
      (call-with-semaphore sema p false arg))
    serialized-p))

;;;;;;;;;;
;; 3.39 ;;
;;;;;;;;;;

#|
x = 10
P1: read x twice, take the product, write the product
P2: read x once, add 1, write the sum

If we serialize all of P2, but only the "read x twice and take the product"
part of P1, then three possibilities remain:

101: P1 runs, then P2 runs
121: P2 runs, then P1 runs
100: P1 reads x twice and takes the product, then P2 runs, then P1 sets x

110 is not possible because we cannot interleave between the two reads of P1,
and 11 is not possible because we cannot interleave between the read and write
of P2.
|#

;;;;;;;;;;
;; 3.40 ;;
;;;;;;;;;;

#|
P1 is read x twice, take the product, and write the product.
P2 is read x three times, take the product, and write the product.

Describe P1 as the sequence of four atomic operations: r1, r2, p1, w1,
namely, two reads, a multiplication, and a write.

Describe P2 as the sequence of five atomic operations: s1, s2, s3, p2, w2,
namely, three reads, a multiplication, and a write.

Without serialization, we can interleave these nine operations in any
order we want, so long as the four operations for P1 are in order and the
five operations for P2 are in order.
|#

(define (sublist? lst1 lst2)
  ;  All the elements of lst1 appear in lst2 and in the same order.
  (define (loop xs ys)
    (cond [(empty? xs) true]
          [else
            (define memb (member (first xs) ys))
            (if memb
              (loop (rest xs) memb)
              false)]))
  (loop lst1 lst2))

(define (interleaved-sequences as bs)
  (sequence->list (sequence-filter
                    (lambda (perm) (and (sublist? as perm)
                                        (sublist? bs perm)))
                    (in-permutations (append as bs)))))

(define (result ops)
  (define x 10)
  (define r1 0)
  (define r2 0)
  (define p1 0)
  (define s1 0)
  (define s2 0)
  (define s3 0)
  (define p2 0)
  (define (process! op)
    (cond [(eq? op 'r1) (set! r1 x)]
          [(eq? op 'r2) (set! r2 x)]
          [(eq? op 'p1) (set! p1 (* r1 r2))]
          [(eq? op 'w1) (set! x p1)]
          [(eq? op 's1) (set! s1 x)]
          [(eq? op 's2) (set! s2 x)]
          [(eq? op 's3) (set! s3 x)]
          [(eq? op 'p2) (set! p2 (* s1 s2 s3))]
          [(eq? op 'w2) (set! x p2)]
          [else (error "Unknown op -- PROCESS!" op)]))
  (map process! ops)
  x)

(define seqs ; there are 126 such interleaved sequences
  (interleaved-sequences '(r1 r2 p1 w1) '(s1 s2 s3 p2 w2)))
(define possibilities
  (remove-duplicates
    (for/list ([ops seqs])
              (result ops))))
possibilities
;; '(1000000 100000 10000 1000 100)

;; So without serialization, there are five possibilities, but with serialization,
;; there is only one, namely 10 ^ 6.

;;;;;;;;;;
;; 3.41 ;;
;;;;;;;;;;

;; I don't see any reason to serialize a read operation.  The read doesn't change
;; anything, nor does it have component parts that need to be run consecutively.

;;;;;;;;;;
;; 3.42 ;;
;;;;;;;;;;

;; I don't think it matters whether we create the serialized procedure at account
;; creation or when dispatch is called.  The only thing that matters is that all
;; the serialized procedures use the same mutex, so each is protected from the
;; others.

;;;;;;;;;;
;; 3.43 ;;
;;;;;;;;;;

#|
Double serializing the exchange procedure, using both accounts' serializers,
protects the exchange operations from being interleaved with other account
operations from either account.  This makes exchange atomic.  So its behavior
will be as expected.

With the original definition of exchange, the exchange operation will not be
atomic, but it will be composed of four atomic operations, two reads, a
withdrawal, and a deposit.

To see how the original exchange definition might not preserve the three
balances, consider the following three exchanges:

acct1 = 10
acct2 = 20
acct3 = 30

P1: exchange accounts 1 and 2
P2: exchange accounts 2 and 3
P3: exchange accounts 1 and 3

The original exchange allows us to interleave P3 between reads of P1 and P2:

P1 reads acct1 = 10
P2 reads acct2 = 20
P3 makes acct1 = 30 and acct3 = 10
P1 reads acct2 = 20
P2 reads acct3 = 10
P1 adds 10 to acct1 and subtracts 10 from acct2, now acct1 = 40 and acc2 = 10
P2 subtracts 10 from acct2 and adds 10 to acct3, now acct2 = 0 and acct3 = 20

Final balances:
acct1 = 40
acct2 = 0
acct3 = 20

However the sum of all three balances cannot change.  This is because each
exchange adds and removes a fixed amount between accounts.  So total deposits
will always equal total withdrawals.
|#

;;;;;;;;;;
;; 3.44 ;;
;;;;;;;;;;

;; The problem with exchange was that balances could be mutated between reads.
;; Here there are no reads.  So this is OK.

;;;;;;;;;;
;; 3.45 ;;
;;;;;;;;;;

(define (exchange account1 account2)
  (define difference (- (account1 'balance) (account2 'balance)))
  ((account1 'withdraw) difference)
  ((account2 'deposit) difference))

(define (serialized-exchange account1 account2)
  (define serializer1 (account1 'serializer))
  (define serializer2 (account2 'serializer))
  ((serializer1 (serializer2 (exchange)))
   account1
   account2))

;; The problem is that account operations in serialized-exchange are triply
;; serialized, once by the foreign account and twice by the native account, and a
;; procedure that is serialized twice with the same mutex will hang the program.

;; example

(define ser (make-serializer))
(define serialized-sqr (ser sqr))
(define twice-serialized-sqr (ser serialized-sqr))
(sqr 2)
;; 4
(serialized-sqr 2)
;; 4
;; (twice-serialized-sqr 2)
;; ;; . . user break ; the repl hung

;;;;;;;;;;
;; 3.46 ;;
;;;;;;;;;;

;; The mutex is free when false, busy when true.

(define (make-mutex)
  (define cell (list false))
  (define (the-mutex m)
    (cond [(eq? m 'acquire)
           ; If mutex busy, try again.
           ; If mutex free, test-and-set! marked it busy, so do nothing.
           (when (test-and-set! cell)
             (the-mutex 'acquire))]
          ; Mark the mutex free.
          [(eq? m 'release)
           (clear! cell)]))
  the-mutex)

(define (clear! cell)
  ; Set cell to false, making mutex free.
  (set-mcar! cell false))

(define (test-and-set! cell)
  ; If mutex busy, cell is true, do nothing to cell, and return true.
  ; If mutex free, cell is false, set cell to true, and return false.
  (cond [(mcar cell)
         true]
        [else
          (set-mcar! cell true)
          false]))

;; test-and-set! is comprised of two operations, a read and a write.  In ordinary
;; code, this is not atomic.  So one operation could perform its read and write
;; between the read and write of another operation, allowing both operations to
;; acquire the mutex.

;;;;;;;;;;
;; 3.47 ;;
;;;;;;;;;;

;; SEMAPHORES IN TERMS OF MUTEXES

;; Use the count to allow only n processes at a time, and use the mutex to protect
;; the semaphore operations.

(define (make-semaphore1 n)
  (define mutex (make-mutex))
  (define number 0)
  (define (the-semaphore m)
    (cond [(eq? m 'acquire)
           (mutex 'acquire)
           (cond [(< number n)
                  (set! number (add1 number))
                  (mutex 'release)]
                 [else
                   (mutex 'release)
                   (the-semaphore 'acquire)])]
          [(eq? m 'release)
           (mutex 'acquire)
           (set! number (sub1 number))
           (mutex 'release)]))
  the-semaphore)

;; SEMAPHORES IN TERMS OF ATOMIC TEST-AND-SET!

(define (make-semaphore2 n)
  (define cell (list false))
  (define number 0)
  (define (the-semaphore m)
    (cond [(eq? m 'acquire)
           (when (test-and-set! cell)
             (the-semaphore 'acquire))
           (cond [(< number n)
                  (set! number (add1 number))
                  (clear! cell)]
                 [else
                   (clear! cell)
                   (the-semaphore 'acquire)])]
          [(eq? m 'release)
           (when (test-and-set! cell)
             (the-semaphore 'release))
           (set! number (sub1 number))
           (clear! cell)]))
  the-semaphore)

;;;;;;;;;;
;; 3.48 ;;
;;;;;;;;;;

(define (make-new-account balance account-number)
  (define (withdraw amount)
    (cond [(>= balance amount)
           (set! balance (- balance amount))
           balance]
          [else "Insufficient funds"]))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define serializer (make-serializer))
  (define (dispatch m)
    (cond [(eq? m 'withdraw) withdraw]
          [(eq? m 'deposit) deposit]
          [(eq? m 'balance) balance]
          [(eq? m 'serializer) serializer]
          [(eq? m 'account-number) account-number]
          [else (error "Unknown request -- MAKE-NEW-ACCOUNT" m)]))
  dispatch)

(define (new-exchange account1 account2)
  (define n1 (account1 'account-number))
  (define n2 (account2 'account-number))
  (define s1 (account1 'serializer))
  (define s2 (account2 'serializer))
  (if (< n1 n2)
    ((s2 (s1 exchange))
     account1
     account2)
    ((s1 (s2 exchange))
     account1
     account2)))

;; Deadlock occurred when one process had the mutex for account1 while the other
;; process had the mutex for account2, blocking each other.  But with this
;; exchange operation, both would try to acquire the mutex for the lower numbered
;; account first.  So they couldn't block each other.

;;;;;;;;;;
;; 3.49 ;;
;;;;;;;;;;

;; Imagine a bank trader that uses money from several accounts
;; non-deterministically.  He places trades from a master account, and behind the
;; scenes money is transferred between sub-accounts, based on the bank's exact
;; needs that day.  In this scenario two traders could still deadlock.