5.2.5 Locks
(in-package "USER")
(defvar *account-number* 0)
(defstruct account
(lock nil)
(number (incf *account-number*))
; unique number for each account
(balance 0))
;;; Simple implementation of deposit, withdraw, and transfer.
(defun unsafe-deposit (amount account)
(incf (account-balance account) amount))
(defun unsafe-withdraw (amount account)
(decf (account-balance account) amount))
(defun unsafe-transfer (amount from-account to-account)
(unsafe-deposit amount to-account)
(unsafe-withdraw amount from-account))
;;; Function to transfer a small amount between 2 accounts.
(defun unsafe-transfer-random (account1 account2)
(if (zerop (random 2))
(unsafe-transfer (random 20)
account1
account2)
(unsafe-transfer (random 20)
account2
account1)))
;;; TEST-UNSAFE simulates the simultaneous transferring of
;;; funds between the two accounts in an unsafe manner.
(defun test-unsafe ()
(let ((peters-account (make-account :Balance 100))
(pauls-account (make-account :Balance 100))
;; Increase the frequency of scheduling to make it more
;; likely that errors will happen.
(*scheduling-quantum* 10))
;; Make two processes that transfer money. This funny
;; SETQ'ing lets the cleanup form of the UNWIND-PROTECT
;; refer to the processes created.
(let (p1 p2)
(unwind-protect
(progn
(setq p1 (make-process :name "transfer1"
:function
#'(lambda ()
(loop (unsafe-transfer-random
peters-account
pauls-account))))
p2 (make-process :name "transfer2"
:function
#'(lambda ()
(loop (unsafe-transfer-random
pauls-account
peters-account)))))
;; Allow the other processes to do their work.
(process-wait-with-timeout "sleep" 5
#'(lambda () nil)))
;; Dispose of the processes.
(when p1 (kill-process p1))
(when p2 (kill-process p2)))
;; Print out the discrepancy.
(format t "~%Total $~d."
(+ (account-balance peters-account)
(account-balance pauls-account))))))
In this example, the functiontest-unsafe does not work properly because it does not use locks. Two processes are run in parallel, each of which repeatedly transfers a small amount from one account to the other at random. If the function used locking to protect its critical sections, the total amount of money held by both accounts would always be $200. Since the processes are running in parallel without locks, however, the state of the accounts is not always consistent, which leads to an occasional error:> (loop (test-unsafe)) Total $-254. Total $213. Total $200. Total $200. Total $828. Total $613. Total $200. Total $200. Total $200. Total $200. Total $200. Total $200. Total $-41. Total $953. Total $200. Total $200. Total $354. Total $696. Total $200. Total $200. ...The next example shows a revised version of the check-balancing program. This version uses locks to ensure the consistency of the accounts and thus to prevent errors:
(in-package "USER")
(defun safe-deposit (amount account)
;; This lock prevents the race between reading the balance and
;; writing the new balance.
(with-process-lock ((account-lock account))
(incf (account-balance account) amount)))
(defun safe-withdraw (amount account)
;; This lock prevents the race between reading the balance and
;; writing the new balance.
(with-process-lock ((account-lock account))
(decf (account-balance account) amount)))
;;; SAFE-TRANSFER is considerably more complicated. It must lock
;;; both accounts before updating either. To avoid deadlocks, it
;;; locks the accounts in order. In addition, interruptions must
;;; be inhibited so that the update completes.
(defun safe-transfer (amount from-account to-account)
(if (< (account-number from-account)
(account-number to-account))
;; from-account has a lower number.
(with-process-lock ((account-lock from-account))
(with-process-lock ((account-lock to-account))
(with-interruptions-inhibited
(safe-withdraw amount from-account)
(safe-deposit amount to-account))))
;; to-account has a lower number.
(with-process-lock ((account-lock to-account))
(with-process-lock ((account-lock from-account))
(with-interruptions-inhibited
(safe-withdraw amount from-account)
(safe-deposit amount to-account))))))
(defun safe-transfer-random (account1 account2)
(if (zerop (random 2))
(safe-transfer (random 20)
account1
account2)
(safe-transfer (random 20)
account2
account1)))
;;; TEST-SAFE is a safe version of TEST-UNSAFE. Note the
;;; method of shutting down the processes. To be certain that the
;;; processes are not in a critical section, the function
;;; interrupts the processes to get them to kill themselves.
;;; (This precaution isn't necessary in this example because
;;; there is no critical code outside the locked regions, but it
;;; is good form.)
(defun test-safe ()
(let ((peters-account (make-account :Balance 100))
(pauls-account (make-account :Balance 100))
(*scheduling-quantum* 10))
(let (p1 p2)
(unwind-protect
(progn
(setq p1 (make-process :name "transfer1"
:function
#'(lambda ()
(loop (safe-transfer-random
peters-account
pauls-account))))
p2 (make-process :name "transfer2"
:function
#'(lambda ()
(loop (safe-transfer-random
pauls-account
peters-account)))))
(process-wait-with-timeout "sleep" 5 #'(lambda () nil)))
;; Since peters-account is created before pauls-account
;; it must have a lower number.
(with-process-lock ((account-lock peters-account))
(with-process-lock ((account-lock pauls-account))
(when p1
(interrupt-process p1 #'(lambda () (kill-process p1))))
(when p2
(interrupt-process p2 #'(lambda ()
(kill-process p2)))))))
(format t "~%Total $~d."
(+ (account-balance peters-account)
(account-balance pauls-account))))))
In this version, the functiontest-safe seizes the account locks to ensure that processes cannot simultaneously update the accounts. Thus, it produces the correct result reliably:> (loop (test-safe)) Total $200. Total $200. Total $200. Total $200. Total $200. Total $200. Total $200. Total $200. Total $200. Total $200. Total $200. Total $200. Total $200. Total $200. Total $200. Total $200. Total $200. Total $200. Total $200. Total $200. ...
Generated with Harlequin WebMaker