a. Peter, Paul, Maryの払出しをa, b, cと書くと事象の順の可能性は
(a b c)
(a c b)
(b a c)
(b c a)
(c a b)
(c b a)
があり, それぞれでbalanceの最終値は
(a b c) 100 → 110 → 90 → 45
(a c b) 100 → 110 → 55 → 35
(b a c) 100 → 80 → 90 → 45
(b c a) 100 → 80 → 40 → 50
(c a b) 100 → 50 → 60 → 40
(c b a) 100 → 50 → 30 → 40

b.
残高にアクセスを0, 残高の設定を1とすると a0, b0, c0, a1, b1,c1の事象がある. 可
能な事象の順を発生するプログラムを書く. 

(define (extend-event event)
  (define (a0 x)
   (if (not (member 'a0 x))
       (cons (cons 'a0 x) (b0 x))
       (b0 x)))
 (define (b0 x)
   (if (not (member 'b0 x))
       (cons (cons 'b0 x) (c0 x))
       (c0 x)))
 (define (c0 x)
   (if (not (member 'c0 x))
       (cons (cons 'c0 x) (a1 x))
       (a1 x)))
 (define (a1 x)
   (if (and (member 'a0 x) (not (member 'a1 x)))
       (cons (cons 'a1 x) (b1 x))
       (b1 x)))
 (define (b1 x)
   (if (and (member 'b0 x) (not (member 'b1 x)))
       (cons (cons 'b1 x) (c1 x))
       (c1 x)))
 (define (c1 x)
   (if (and (member 'c0 x) (not (member 'c1 x)))
       (cons (cons 'c1 x) '())
       '()))
(let ((new-event (apply append (map (lambda (x) (a0 x)) event))))
  (if (< (length (car new-event)) 6)
      (extend-event new-event)
      new-event))) 

(extend-event '(()))で90通りのeventのリストが得られる. 

((c1 b1 a1 c0 b0 a0) (b1 c1 a1 c0 b0 a0) (c1 a1 b1 c0 b0 a0) (a1 c1 b1 c0 b0 a0)
 (b1 a1 c1 c0 b0 a0) (a1 b1 c1 c0 b0 a0) (c1 b1 c0 a1 b0 a0) (b1 c1 c0 a1 b0 a0)
 (c1 c0 b1 a1 b0 a0) (c1 a1 c0 b1 b0 a0) (a1 c1 c0 b1 b0 a0) (c1 c0 a1 b1 b0 a0)
 (c1 b1 a1 b0 c0 a0) (b1 c1 a1 b0 c0 a0) (c1 a1 b1 b0 c0 a0) (a1 c1 b1 b0 c0 a0)
 (b1 a1 c1 b0 c0 a0) (a1 b1 c1 b0 c0 a0) (c1 b1 b0 a1 c0 a0) (b1 c1 b0 a1 c0 a0)
 (b1 b0 c1 a1 c0 a0) (b1 a1 b0 c1 c0 a0) (a1 b1 b0 c1 c0 a0) (b1 b0 a1 c1 c0 a0)
 (c1 b1 c0 b0 a1 a0) (b1 c1 c0 b0 a1 a0) (c1 c0 b1 b0 a1 a0) (c1 b1 b0 c0 a1 a0)
 (b1 c1 b0 c0 a1 a0) (b1 b0 c1 c0 a1 a0) (c1 b1 a1 c0 a0 b0) (b1 c1 a1 c0 a0 b0)
 (c1 a1 b1 c0 a0 b0) (a1 c1 b1 c0 a0 b0) (b1 a1 c1 c0 a0 b0) (a1 b1 c1 c0 a0 b0)
 (c1 b1 c0 a1 a0 b0) (b1 c1 c0 a1 a0 b0) (c1 c0 b1 a1 a0 b0) (c1 a1 c0 b1 a0 b0)
 (a1 c1 c0 b1 a0 b0) (c1 c0 a1 b1 a0 b0) (c1 b1 a1 a0 c0 b0) (b1 c1 a1 a0 c0 b0)
 (c1 a1 b1 a0 c0 b0) (a1 c1 b1 a0 c0 b0) (b1 a1 c1 a0 c0 b0) (a1 b1 c1 a0 c0 b0)
 (c1 a1 a0 b1 c0 b0) (a1 c1 a0 b1 c0 b0) (a1 a0 c1 b1 c0 b0) (b1 a1 a0 c1 c0 b0)
 (a1 b1 a0 c1 c0 b0) (a1 a0 b1 c1 c0 b0) (c1 a1 c0 a0 b1 b0) (a1 c1 c0 a0 b1 b0)
 (c1 c0 a1 a0 b1 b0) (c1 a1 a0 c0 b1 b0) (a1 c1 a0 c0 b1 b0) (a1 a0 c1 c0 b1 b0)
 (c1 b1 a1 b0 a0 c0) (b1 c1 a1 b0 a0 c0) (c1 a1 b1 b0 a0 c0) (a1 c1 b1 b0 a0 c0)
 (b1 a1 c1 b0 a0 c0) (a1 b1 c1 b0 a0 c0) (c1 b1 b0 a1 a0 c0) (b1 c1 b0 a1 a0 c0)
 (b1 b0 c1 a1 a0 c0) (b1 a1 b0 c1 a0 c0) (a1 b1 b0 c1 a0 c0) (b1 b0 a1 c1 a0 c0)
 (c1 b1 a1 a0 b0 c0) (b1 c1 a1 a0 b0 c0) (c1 a1 b1 a0 b0 c0) (a1 c1 b1 a0 b0 c0)
 (b1 a1 c1 a0 b0 c0) (a1 b1 c1 a0 b0 c0) (c1 a1 a0 b1 b0 c0) (a1 c1 a0 b1 b0 c0)
 (a1 a0 c1 b1 b0 c0) (b1 a1 a0 c1 b0 c0) (a1 b1 a0 c1 b0 c0) (a1 a0 b1 c1 b0 c0)
 (b1 a1 b0 a0 c1 c0) (a1 b1 b0 a0 c1 c0) (b1 b0 a1 a0 c1 c0) (b1 a1 a0 b0 c1 c0)
 (a1 b1 a0 b0 c1 c0) (a1 a0 b1 b0 c1 c0))

それぞれの事象の順の最終balanceを計算するプログラムは

(define (final-balance event)
  (define (process-event event)
    (if (null? event) balance
        (let ((next-event (car event)))
          (cond ((eq? next-event 'a0) (set! a (+ balance 10)))
                ((eq? next-event 'b0) (set! b (- balance 20)))
                ((eq? next-event 'c0) (set! c (- balance (/ balance 2))))
                ((eq? next-event 'a1) (set! balance a))
                ((eq? next-event 'b1) (set! balance b))
                ((eq? next-event 'c1) (set! balance c)))
        (process-event (cdr event)))))
  (define a 0)
  (define b 0)
  (define c 0)
  (define balance 100)
  (process-event (reverse event)))

これを駆動するプログラムは

(define (balance-test event balance-list)
  (if (null? event) balance-list
      (let ((next-balance (final-balance (car event))))
            (if (member next-balance balance-list)
                (balance-test (cdr event) balance-list)
                (balance-test (cdr event) (cons next-balance balance-list))))))

これを実行すると

(balance-test (extend-event '(())) '()) → (60 35 45 30 90 40 55 110 80 50)

30, 35, 40, 45, 50, 55, 60, 80, 90, 110の10通り

110: は生じない. (* x x) の二つのxは直列化されているので, 1回目が10, 2回目が11
ということはない. 
11:  は生じない. P2はxの設定まで直列化されているから. 
100: は生じる可能性あり. P1がx(10)の二乗を作る. (ここは直列化) P2が11を作り設定
する. その後P1が100を設定する. 

0 1 2 3
| | | |    ← 相手プロセスがx^3を書き込むタイミング
 x x !     ← xはxを取り出すタイミング !はx^2を書き込むタイミング


 x x x !
| | | | |  ← xはxを取り出すタイミング !はx^3を書き込むタイミング
4 5 6 7 8  ← 相手プロセスがx^2を書き込むタイミング

x^3の計算が先の終ったとすると, それを書き込むタイミングには0, 1, 2, 3の可能性があ
る. 0で書き込めば上のプロセスはそれの二乗を計算するから x^6が得られる
1 で書き込めば最初のxはx, 次のxはx^3だからx^4が得られる. 
2 で書き込めば相手の書いたx^3は上書きされて, x^2が得られる
3 で書き込めば自分の書いたx^2は上書きされて, x^3が得られる. 

同様にして, 上のプロセスが先に計算が終って書き込んだとする. 4で書き込めばx^6が
得られる. 
5 で書き込めば, x * x^2 * x^2でx^5が得られる. 
6 で書き込めば  x * x * x^2でx^4が得られる. 
7 で書き込めば 相手のx^2を自分で上書きし, x^3が得られる. 
8 で書き込めば 自分のx^3が上書きされ, x^2が得られる. 

結局 x^2, x^3, x^4, x^5, x^6のいずれかが得られる. 

直列化すればx^6だけが得られる. 

depositやwithdrawでは(set! balance ...) でbalanceの値を更新するが, 
balanceの時はbalanceを読みに行くだけなので, 読み書きの事象が混ざり合うことはな
く, 直列化の必要はない. 

図のようにp1がcellを読みだし, p2がcellを読みだし, 
いずれも相手のプロセスが書き込む前に読みだしたので, falseと知り, 
独立にcellにtrueを書き込んで, それぞれの直列化された部分の同時に進入する. 

相互排除器を使うもの

(define (make-semaphore n)
  (let ((mutex (make-mutex)))
    (define (process-acquire)
      (mutex 'acquire)
      (if (n > 0)                   ;
          (set! n (- n 1))          ;n を変更するのでmutexで保護する. 
          (begin (mutex 'release) (process-acquire)))
                                    ;先に進めない時はmutexを解除
      (mutex 'release))             ;セマフォ処理が済んだ時もmutexを解除
    (define (process-release)
      (mutex 'acquire)
      (set! n (+ n 1))
      (mutex 'release))
    (define (dispatch m)
      (cond ((eq? m 'acquire) (process-acquire))
            ((eq? m 'release) (process-release))
            (else (error "Unknown request SEMAPHORE" dispatch))))
  dispatch))

(define (P semaphore)
  (semaphore 'acquire))

(define (V semaphore)
  (semaphore 'release))


一方 test-and-set! は cellが1ビットのフラグで, これが偽ならその先の危
険区間には誰もいない. 真なら誰かいる ことを示す.

あるプロセスは危険区間のいり口で test-and-set!をする. 誰かがいればフラ
グは真で, test-and-set!も真を返す. 誰もいないとフラグは偽であったが, 
自分が危険区間に入るのだから, フラグは真にセットされる. しかし, 誰もい
なかったことを知らせるため偽が返る.

そこで, test-and-set!を使うと

(define (make-semaphore n)
 (let ((cell (list false)))
  (define (process-acquire)
   (define (block)              ;;cellが偽になるまでループして待つ. 
     (if (test-and-set! cell)
         (block)))
   (block)
   (if (n > 0) 
       (set! n (- n 1))         ;; n が 0 を超えていれば通過できる. 
       (begin (clear! cell) (process-acquire)))
                                ;;cellをクリアしてprocess-acquire
   (clear! cell))               ;;でループして待つ. 
  (define (process-release)
   (define (block)
     (if (test-and-set! cell)
         (block)))
   (blodk)
   (set! n (+ n 1))
   (clear! cell))
  (define (dispatch m)
   (cond ((eq? m 'acquire) (process-acquire))
         ((eq? m 'release) (process-release))
         (else (error "Unknown request TEST-AND-SET!" dispatch))))
 dispatch))