|
Three functions, about 70 lines of LISP code implement concurrency for Common LISP
May 26, 2007
URL:http://www.drdobbs.com/parallel/multitasking-for-common-lisp/199702507
Multiprocessor computers are readily available. Most personal computers already have specialized multiprocessor systems with additional processors handling features such a as graphics or sound. To better use the power inherent in multiprocessor systems, languages with concurrent tasking must be developed.
The concept of concurrent programming also serves us well on single processor systems. Many programming projects are best thought of as multitasking jobs, perhaps with intertask communication. A familiar example of multitasking is the MS-DOS print facility, which copies a file to the line printer while the computer is being used for other tasks. In a single processor environment, the concurrent tasks are interleaved (time shared).
This article discusses the design and implementation of a concurrent LISP interpreter (CLI) based on a construct that allows simultaneous evaluation of a list of LISP forms; see Listing One. CLI also allows for intertask communication. The native language for CLI is Gold Hill Computers' Golden Common LISP; other full-featured LISPs should allow a parallel implementation.
;; initialization of parameters
(setf *time-slice* 10) ; quantum for switching
(setf *beep-switch* t) ; beep when switching
(setf *random-seed* 10013)
(setf *semaphore-list* nil)
;; The function which sets up the concurrent processes
(defun cobegin (&rest forms)
; initialize
(setf *pseudo-time* 0 ; used to count pseudo-time
*switching?* t ; inhibit switching if nil
*concur-length* (list-length forms))
; create a list of the correct length for storing results
(setf stack-results-list (make-list *concur-length*))
; create the stack groups
(make-stack-groups *concur-length*
(setf *stack-group-names*
(make-sym-list *concur-length*))
forms)
; initiate task execution
(switch-around)
; return the list of results
(mapcar 'eval stack-results-list)
)
;;; The evaluator which handles concurrency
(defun cli_eval (form)
; increment the pseudo-time
(setf *pseudo-time* (1+ *pseudo-time*))
(cond
; is it time to switch?
((and
; is switching enabled?
*switching?*
; don't switch if there's only 1 task
(> *concur-length* 1)
; is it the end of a time quantum?
(>= *pseudo-time* *time-slice*)
; don't want to leave the initial (gclisp) stack-group
(not (equal *current-stack-group*
*initial-stack-group*)))
; if so,
; beep if desired
(if *beep-switch* (beep))
; reset pseudo-time
(setf *pseudo-time* 0)
; suspend this task (and return to switch-around)
(stack-group-return nil)))
(let*
; evaluate this form
((value (evalhook form #'cli_eval nil))
S ; find the name of this stack-group
(name (assoc1 '*current-stack-group* *stack-group-names*)))
; save the value if appropriate
(cond (name
(set (nth (get name 'process-num) stack-results-list) value)))
; return the value of form
value)
)
;; The scheduler for concurrent execution
(defun switch-around ()
; disable switching during the switching
(setf *switching?* nil)
(let
; choose the next task
((next (next-stack *concur-length* *stack-group-names*)))
(cond
; if there are no more tasks, then we're done
((null next)
(setf *switching?* t))
; is the task finished?
((< 1 (stack-group-status (eval next)))
; if so,
; eliminate this task
(setf *stack-group-names*
(remove next *stack-group-names* ))
(setf *concur-length* (1- *concur-length*))
; make the memory reusable
(makunbound next)
; try another task
(switch-around))
; the task is ready to go
(t
(setf *switching?* t)
; initiate it
(funcall (eval next) nil)
; when its time-slice is done, we will return to here
; and switch again
(switch-around))))
)
;; HELP FUNCTIONS
;; this function returns the status of a stack group
;; (0: active, 1:resumable, 2:broken, 3:exhausted)
(defun stack-group-status (stack-group)
(multiple-value-setq
(offset segment) (%pointer stack-group))
(lsh (%contents segment (+ offset 41)) -1)
)
;; set up the stack-groups
(defun make-stack-groups (length name-list1 func-list)
(cond
; done
((null name-list1))
; otherwise
(t
; create a stack group of the desired name
S (set (car name-list1)
(stack-group-preset
; make the stack-group
(make-stack-group (car name-list1)
; change as appropriate
:regular-pdl-size 6000
:special-pdl-size 2000)
; initialize to evaluate the form
#'cli_eval (car func-list)))
; recursive call to handle the next form
(make-stack-groups (1- length) (cdr name-list1) (cdr func-list))))
)
;; create a list of names for stack-groups
(defun make-sym-list (length &optional l)
(cond
; are we done?
((= 0 length) l)
; nope
(t
(let
; create a name
((name (gensym)))
; give it a process identification number
(setf (get name 'process-num) (1- length))
; recursive call to finish the rest
(make-sym-list (1- length) (cons name l)))))
)
;; create a list of unique names with length n
(defun make-list (n &optional l)
(cond
((= 0 n) l)
(t
(make-list (1- n) (cons (gensym) l))))
)
;; selects next process to be executed
(defun next-stack (length name-list)
; choose the next process randomly
(nth
(rand 0 (1- length)) name-list)
)
;; a random number generator (since Golden doesn't have one built-in)
(defun rand (low-rand high-rand)
(setf
*random-seed*
(truncate (amod (* 25211.0 *random-seed*) 32768.0)))
(truncate
(+ low-rand (* (/ (float *random-seed*) 32768.0)
(1+ (- high-rand low-rand)))))
)
;; define the mod function (since Golden's is in the editor!)
(defun amod (real-num divisor)
(- real-num
(* (truncate (/ real-num divisor))
divisor))
)
S;; SEMAPHORE FUNCTIONS
;; handle the wait function
(defun wait (which)
; inhibit task switching
(setf *switching?* nil)
(cond
; if the semaphore is set at 1
((eq (eval which) 1)
; set it to 0 and retun
(set which 0)
(setf *switching?* t))
(t
; else put this process on hold
(let
; find its name
((process (assoc1 '*current-stack-group*
*stack-group-names*)))
; remove it from the ready processes
(setf *stack-group-names*
(remove process *stack-group-names*))
(setf *concur-length*
(1- *concur-length*))
; add it to the queue waiting upon this semaphore
(setf (get which 'queue)
(cons process (get which 'queue)))
; allow task switching
(setf *switching?* t)
; leave this process (and switch to another)
(stack-group-return nil))))
)
;; this function handles the SIGNAL operation.
(defun signal (which)
; inhibit task switching
(setf *switching?* nil)
(let
; get semaphore's queue
((process (get which 'queue)))
(cond
; are there are tasks waiting upon this semaphore?
((not (null process))
; if so,
; de-queue a task and add it to the ready tasks
(setf *stack-group-names*
(cons (car (last process)) *stack-group-names*))
(setf *concur-length*
(length *stack-group-names*))
; remove the task from this semaphore's queue
(setf (get which 'queue) (butlast process)))
; else set the semaphore to 1
(t (set which 1))))
; enable task switching
(setf *switching?* t)
)
;; initializes the semaphores
;; must be called before initiating concurrent tasking
S(defun initialize-semaphores (sl)
(setf *semaphore-list* (i-s-help sl nil))
)
(defun i-s-help (sl l)
(cond ((null sl) l)
(t
(let ((which (caar sl))
(value (cadar sl)))
(set which value)
(setf (get which 'queue) nil)
(i-s-help (cdr sl) (cons which l)))))
)
;; Find the name of a variable in the list given its unique value.
(defun assoc1 (name list)
(cond ((null list) nil)
(t (cond ((equal (eval (car list)) (eval name))
(car list))
(t (assoc1 name (cdr list))))))
)
;; EXAMPLES
; producer-consumer (pc)
;; The Producer-Consumer Problem (synchronized)
(defun pc ()
(setf buffer nil)
(setf information '(this is a test of semaphores))
; initializes the semaphores
(initialize-semaphores '(($ok-to-consume 0) ($ok-to-produce 1)))
; starts concurrent reading and writing.
(cobegin (list 'producer (length information))
(list 'consumer (length information)))
)
(defun producer (r)
(do ((i 0 (1+ i)))
((= i r) (print 'end-producer))
; start of critical region
(wait '$ok-to-produce)
(print 'read-by-producer<---)
(setf buffer (nth i information))
(princ buffer)
(signal '$ok-to-consume)
; end of critical region
)
)
(defun consumer (r)
(do ((i 0 (1+ i)))
((= i r) (print 'end-consumer))
; start of critical region
(wait '$ok-to-consume)
(print '----print-by-consumer--->)
(princ buffer)
(setf buffer nil)
(signal '$ok-to-produce)
; end of critical region
)
)
S;; The Producer-Consumer Problem (unsynchronized)
(defun un-pc ()
(setf buffer nil)
(setf information '(this is a test of semaphores))
;; starts concurrent reading and writing.
(cobegin (list 'un-producer (length information))
(list 'un-consumer (length information)))
)
(defun un-producer (r)
(do ((i 0 (1+ i)))
((= i r) (print 'end-producer))
(print 'read-by-producer<---)
(setf buffer (nth i information))
(princ buffer)
(terpri)
)
)
(defun un-consumer (r)
(do ((i 0 (1+ i)))
((= i r) (print 'end-consumer))
(print '----print-by-consumer--->)
(princ buffer)
(terpri)
(setf buffer nil)
)
)
;; A Note on Error Handling in CLI
; The most common error is stack-group-overflow, i.e., running out of
; memory space. Try reducing the size of each stack group (see function
make-stack-groups)r Whe' a' erro occur withi' concurren ?
; task tw problem result.
; First, the GCLisp error handling routines were not designed to work
; with stack groups. In particular, you cannot use Control-G to move up
; one listener level. This is because the listeners use the catch-throw
; construct, and the catch is in the original stack group (the one which
; initiated concurrent execution) not the one which contains the error.
; You can use cntrl-C to return to the top-level of the original stack
; group, but then you are confronted with problem two.
; When a stack group is exhausted, its name is unbound (in function
; switch-around) in order to reclaim the memory used. However, if there
; is an error, this unbinding will be skipped. Worse, GCLisp contains
; an apparent bug which does not allow reclamation of memory used by a
; stack group which terminates by being broken (i.e., with an error)
; instead of by exhaustion. Thus, any stack group which terminates in an
; error will continue to occupy (waste) memory. The only solution to this
; problem is to exit GCLisp and restart.
;; C. 1986 by Andrew P. Bernat.
;; Permission is granted for any noncommercial use with appropriate
;; credit to the author.
I assume the reader has a background in LISP, including an understanding of the importance of eval and environments. A good introduction to LISP may be found in R.A. Brooks' Programming In Common LISP. The classic advanced source is Allen's Anatomy of LISP. Discussions of concurrent programming may be found in most survey of programming language texts (for example, E. Horowitz's Fundamentals of Programming Languages. A more complete discussion (including a concurrent Pascal interpreter written in Pascal) is given in M. Ben-Ari's Principles of Concurrent Programming. Several implementations of concurrent LISP have been presented at the biennial LISP conferences (1980, 1982, 1984), and the proceedings are available from the Association for Computing Machinery.
In order to simulate true concurrency on a single processor system, our interpreter must allow for switching between tasks. In other words, we execute a single task for a (short) perdio of time, then switch between tasks randomly. In this way, our concurret tasks can assume an order of execution, just as tasks run on separate processors run independently. The two features the interpreter must have in order to handle this task switching are knowledge of the state of computation of each task and a task switching mechanism.
The state of computation of each task is defined by knowledge of all variable bindings and the current evalution state. A symbol (atom) in LISP has four associated properties:
The last three properties are known globally so they have the same values across concurrent tasks. The stack of bindings represents locally assigned values. Such values disappear when the defining environment is left. Bindings are unique to the defining function so they are not carried across tasks. Our concurrent interpreter must remember the correct bindings for each task independently.
The current evaluation state consists of information as execution address, register contents, etc., and is essentially the information required whenever a subprogram is made in any language. This information is unique for each task, must be retained as we switch between tasks so that a task may be resumed precisely where it suspended.
The second fetaure required is the ability to randomly switch between the tasks. In other words, at the end of a given quantum of processor time, we wish to suspend the task currently executing and to begin execution of a randomly selected task. This process continues until all tasks have finished execution. Note that if we did not require this randomly interleaved capability, concurrent programming would reduce to sequential evaluation of a list of forms, which may be trivially implemented in LISP.
Three schemes present themselves for providing task switching. The first would be, to depend upon an external interrupt, presumably from a hardware clock, to cause the interpreter to switch. The difficulty is that we do not wish to interrupt LISP primitive operations or we would quickly corrupt the system. In addition, writing an interrupt routine that would work gracefully with an existent LISP interpreter is a large undertaking.
A second scheme is to implement a complete LISP interpreter extended to include the concurrent capability. This type of interpreter might even be written in LISP (see Programming in Common LISP for such an interpreter but without concurrency). This interpreter could monitor the number of calls to itself and gracefully switch tasks as desired. But the interpreter requires a large amount of system memory, which is already tight.
The third scheme, adopted here, is to define a new eval procedure on top of the sYstern's eval. In this way, all function evaluation must pass through our eval routine, which can count the number of calls to itself and switch tasks at appropriate intervals. However, some evaluations are not switchable (those that handle the actual task switching, for example), so we must allow for the ability to turn off switching as desired.
We need to represent each concurrent task by an object that allows us to retain complete knowledge of the evaluation state of the task toge3ther with a list of applicable bindings. We also must be able to pick up this object, evaluate it for a period of time, suspend its evaluation so that we may evaluate another task, and later resume the original task.
Common LISP has exactly the object required: a stack-group. Stack-groups are functional objects with the attributes of a task. (Stack-groups are not a feature of Common LISP -- they are copied from Zeta LISP.) Stack-groups contain exactly the, information needed to implement a concurrent interpreter. A single stack-group is the LISP equivalent of a single task.
It is possible to initiate a stack-group (remember they have the attributes of a task), suspend a stack-group, and then resume it. Thus our switching algorithm consists of:
Implementation of the interpreter requires three major new routines:
In CLI, these three functions exactly are cobegin, cli_eval, and switch-around, respectively. They are described in Figure 1.
Figure 1: Routines cobegin, cli_eval, and switch-around are the heart of the interpreter.
COBEGIN
- Input: the forms to be evaluated concurrently (the tasks)
Output: a list of the values to these forms
- initialize pseudo clock used to switch between tasks
- create a stack group for each concurrent task
- initiate concurrent execution
- create a list of the values of the tasks
CLI_EVAL
- Input: a form to be evaluated
Output: the value of the form
- increment pseudo clock
- if switching is enabled
and we have reached the end of a time slice
and we are in concurrent mode,
then
- suspend current task and enable switching
else
- evaluate the form
- return the value
SWITCH-AROUND
- Input: none
Output: none
- if all tasks are complete,
then
- return
else
- randomly choose a task to execute
- if this task has completed,
then
- eliminate it from the list of tasks
- try again
else
- initiate task execution
Let's discuss each routine briefly. Keep in mind these key facts:
Cobegin is the only function of the three directly called by the user. The main purpose of this function is to create a stack-group for each input form (the tasks to be executed concurrently) and to begin concurrent execution by calling switch-around. Each stack-group is initialized to call upon cli_eval to evaluate its form.
In order to implement cli_eval, we use the Common LISP function evalhook. Evalhook takes as arguments the to evalutate this form (cli_eval). Attempting to evaluate the input form will typically cause evaluation of a number of subsidiary forms, and for each of these cli_eval will be used. However, the standard eval is used for the final evaluation of itself. It is this bypassing of cli_eval that enables us to use the standard eval for all function evaluations because each subsidary form will eventually be evaluated directly by a call to cli_eval. The primary purposes of cli_eval are to initiate switching between, if necessary, evaluate the form, and return a value.
Switch-around handles choosing the next task to execute and then resuming the execution of this task by calling the task's stack-group as a function (using funcall). Note that this means that when a stack-group issuspended, control returns to the form following this fun-call -- which is a recursive call to switch-around to choose a new task. Switch-around also handles deleting completed tasks (their stack-groups will be exhausted).
These three functions, consisting of about 70 lines of LISP code including subsidieary routines, implement concurrency in Common LISP. This ability is a real testimonial to both the power and elegance of LISP and the importance of including such powerful primitives as stack-groups.
Many problems to be solved concurrently require that the several tasks communicate with each other so that certain operations may be synchronized. One famous example of need for such communication is the prodducer/consumer problem that arises when producer and consumer tasks both need access to the same memory location.
The producer's task is to place information into the memory location for use. The producer is supplying this information one record at a time and the consumer using it one record at a time. The difficulty arises because the memory location holds only a record. If the producer attempts to supply records faster than they are accepted by the consumer, or if the consumer attempts to access them faster than supplied by the producer, chaos reigns. This is a simplified version of a very common problem: Consider a text editor -- data is not able to be until read into a buffer from the disk.
The solution is to synchronize the two through an interprocess mechanism. Many such mechanisms have been developed. Here we will choose to use semaphores (see Fundamentals of Programming Languages) due to their simplicity. A semaphore is a global two-valued variable together with two operations: wait and signal. These operations are described in pseudocode in Figure 2. A wait operation essentially places a task in sleeping status until a signal operations occurs (in another task) to wake it up. Note that during the signal and wait operations, we must be careful task switching does not occur, or the semaphore variables mahy be modified incorrectly.
Figure 2: The Semaphore Functions
WAIT
- Input: a semaphore name
Output: none
- if semaphore's value = 1,
then
- set value to 0
- return
else
- remove this task from ready list
- place this task in the queue waiting upon this semaphore
- switch to another task
SIGNAL
- Input: a semaphore name
Output: none
- if there are processes waiting upon this semaphore,
then
- remove one from the queue and add it to the ready list
- returnu else
- set the semaphore's value = 1
In the producer/consumer problem, one semaphore is used to specify that the buffer is full and the consumer needs to retrieve it. Figure 3 gives the pseudocode for implementing this producer/consumer solution.
Figure 3: CLI LISP Synchronized Producer and Consumer Tasks
PRODUCER - CONSUMER
- empty the buffer
- create a list of information for the example
(could be read in)
- initialize the semaphores
($ok-to-produce $ok-to-consume)
- start the concurrent producer and consumer tasks
PRODUCER
- repeat until the information is exhausted
- wait until the buffer is empty
(using semaphore $ok-to-produce)
(this suspends PRODUCER)
- fill the buffer
- signal that the buffer is full
(using semaphore $ok-to-consume)
(this wakes up CONSUMER)
CONSUMER
- repeat until the information is exhausted
- wait until the buffer is full
(using semaphore $ok-to-consume)
(this suspends CONSUMER)
- access the buffer
- signal that the buffer is empty
(using semaphore $ok-to-produce)
(this wakes up PRODUCER)
Figure 4 illustrates the importance of such synchronization. In Figure 4A, we have concurrent producer and consumer task synchronization; Figure 4B shows teh relevance of such synchronization by removing the semaphores.
Figure 4: The importance of synchronization.
(A)
* (pc)
READ-BY-PRODUCER<--- THIS
----PRINT-BY-CONSUMER---> THIS
READ-BY-PRODUCER<--- IS
----PRINT-BY-CONSUMER---> IS
READ-BY-PRODUCER<--- A
----PRINT-BY-CONSUMER---> A
READ-BY-PRODUCER<--- TEST
----PRINT-BY-CONSUMER---> TEST
READ-BY-PRODUCER<--- OF
----PRINT-BY-CONSUMER---> OF
READ-BY-PRODUCER<--- SEMAPHORES
END-PRODUCER
----PRINT-BY-CONSUMER---> SEMAPHORES
END-CONSUMER
(END-PRODUCER END-CONSUMER)
*
(B)
* (un-pc)
READ-BY-PRODUCER<---A
READ-BY-PRODUCER<--- TEST
READ-BY-PRODUCER<--- OF
READ-BY-PRODUCER<---
----PRINT-BY-CONSUMER---> SEMAPHORES
SEMAPHORES
----PRINT-BY-CONSUMER---> NIL
END-PRODUCER
---PRINT-BY-CONSUMER--->NIL
----PRINT-BY-CONSUMER---> NIL
----PRINT-BY-CONSUMER---> NIL
----PRINT-BY-CONSUMER---> NIL
END-CONSUMER
(END-PRODUCER END-CONSUMER)
The concurrent LISP interpreter presented here provides a vehicle for exploration of the burgeoning area of multiprocessor parallel programming.
The major deficiency in the present implementation is the lack of memory space available to handle the stack-groups. Common LISP is a large program leaving little room for concurrent tasks. Moving to a larger memory space would allow the fully recursive implementation of concurrency. This may readily be accomplished by using bindings to give local rather than global values to stack-group variables. A longer-term goal would be to allow the LISP interpreter itself to decide which forms might profitably be executed in parallel instead of having to use cobegin explicitly. This is quite feasible in a purely functionallcinguage such as pure LISP but becomes difficult when we allow global variables.
Allen,J. Anatomy of LISP. McGraw-Hill, 1978.
Ben-Ari, M. Principles of Concurrent Programming. Prentice-Hall,1982.
Horowitz, E. Fundamentals of Programming Languages. Computer Science Press, 1984.
Courtesy AI Expert
Terms of Service | Privacy Statement | Copyright © 2024 UBM Tech, All rights reserved.