├── Makefile
├── doc
    ├── BUILDING.txt
    ├── Makefile
    ├── html.xsl
    ├── doc.txt
    ├── doc.xml
    └── doc.html
├── README.txt
├── package.lisp
├── basic.lisp
├── null-queue.lisp
├── calispel.asd
├── COPYRIGHT.txt
├── alt.lisp
├── test.lisp
└── core.lisp


/Makefile:
--------------------------------------------------------------------------------
1 | prepare_release:
2 | 	$(MAKE) -C doc
3 | 
4 | clean:
5 | 	$(MAKE) -C doc clean
6 | 


--------------------------------------------------------------------------------
/doc/BUILDING.txt:
--------------------------------------------------------------------------------
1 | To build the documentation on Debian, install "docbook-xsl" and "w3m".
2 | 
3 | For other systems, you'll need to install the equivalent packages or
4 | get the stylesheets and w3m yourself, and then adjust the path of the
5 | import in html.xsl.
6 | 


--------------------------------------------------------------------------------
/README.txt:
--------------------------------------------------------------------------------
1 | Calispel is a Common Lisp library for thread-safe message-passing
2 | channels, in the style of the occam programming language.
3 | 
4 | Written by J.P. Larocque <jpl-software at thoughtcrime.us>.  Based on
5 | work by Roger Peppe and Russ Cox; see COPYRIGHT.txt for full
6 | attribution.
7 | 
8 | See doc/doc.html or doc/doc.txt for usage examples and a reference.
9 | 


--------------------------------------------------------------------------------
/doc/Makefile:
--------------------------------------------------------------------------------
 1 | all: doc.html doc.txt
 2 | 
 3 | clean:
 4 | 	rm -f doc.html doc.txt
 5 | 
 6 | doc.html: doc.xml
 7 | #	When the stylesheets warn, they print a message but exit without error.
 8 | 	if [ "$$(xsltproc --output doc.html \
 9 | 	                  --stringparam section.autolabel 1 \
10 | 	                  --stringparam toc.section.depth 4 \
11 | 	                  html.xsl doc.xml 2>&1 \
12 | 	         | tee /dev/stderr)" ]; then \
13 | 		rm -f doc.html; \
14 | 		exit 1; \
15 | 	fi
16 | 
17 | doc.txt: doc.html
18 | 	w3m -dump doc.html > doc.txt
19 | 


--------------------------------------------------------------------------------
/package.lisp:
--------------------------------------------------------------------------------
 1 | (in-package #:common-lisp-user)
 2 | 
 3 | (defpackage #:calispel
 4 |   (:export ;; Basic functionality.
 5 |            #:channel
 6 | 	   #:?
 7 |            #:!
 8 | 	   #:fair-alt
 9 | 	   #:pri-alt
10 | 	   #:otherwise
11 | 	   
12 | 	   #:null-queue
13 | 	   #:+null-queue+
14 | 	   
15 | 	   ;; Provided for dynamic alternation.
16 | 	   #:operation-alternate
17 | 	   #:operation
18 | 	   #:direction
19 | 	   #:value
20 | 	   #:send
21 | 	   #:receive
22 | 	   
23 | 	   ;; Testing.
24 | 	   #:test-channel
25 | 	   #:test-concurrency)
26 |   (:shadowing-import-from #:jpl-util
27 | 			  #:sort #:nsort
28 | 			  #:stable-sort #:nstable-sort)
29 |   (:use #:common-lisp))


--------------------------------------------------------------------------------
/basic.lisp:
--------------------------------------------------------------------------------
 1 | (in-package #:calispel)
 2 | 
 3 | (defun ? (channel &optional timeout)
 4 |   "Receive a value from CHANNEL, waiting up to TIMEOUT seconds (a
 5 | non-negative REAL number; or indefinitely when NIL).  Returns the
 6 | value (or NIL upon timeout) and a boolean indicating whether the
 7 | timeout expired before a value could be received."
 8 |   (let* ((op (make-instance 'operation :channel channel :direction 'receive))
 9 | 	 (chosen (operation-alternate timeout :first (list op))))
10 |     (if (null chosen)
11 | 	(values nil nil)
12 | 	(values (value chosen) t))))
13 | 
14 | (defun ! (channel value &optional timeout)
15 |   "Send VALUE on CHANNEL, waiting up to TIMEOUT seconds (a
16 | non-negative REAL number; or indefinitely when NIL).  Returns a
17 | boolean indicating whether the timeout expired before the value could
18 | be sent."
19 |   (let* ((op (make-instance 'operation :channel channel :direction 'send
20 | 			    :value value))
21 | 	 (chosen (operation-alternate timeout :first (list op))))
22 |     (not (null chosen))))
23 | 


--------------------------------------------------------------------------------
/doc/html.xsl:
--------------------------------------------------------------------------------
 1 | <?xml version='1.0'?>
 2 | <xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
 3 |                 xmlns:ng="http://docbook.org/docbook-ng"
 4 |                 xmlns:db="http://docbook.org/ns/docbook"
 5 |                 xmlns:exsl="http://exslt.org/common"
 6 |                 xmlns:exslt="http://exslt.org/common"
 7 |                 exclude-result-prefixes="db ng exsl exslt"
 8 |                 version='1.0'>
 9 |   <xsl:import href="file:///usr/share/xml/docbook/stylesheet/nwalsh/html/docbook.xsl"/>
10 |   
11 |   <!-- Unfortunately, docbook-xsl emits sloppy HTML, so we can't use
12 |        Strict. -->
13 |   <xsl:output method="html"
14 |               encoding="UTF-8"
15 |               indent="no"
16 | 	      doctype-public="-//W3C//DTD HTML 4.01 Transitional//EN"
17 | 	      doctype-system="http://www.w3.org/TR/html4/loose.dtd"/>
18 |   
19 |   <xsl:template match="replaceable">
20 |     <xsl:text>&lt;</xsl:text>
21 |     <xsl:call-template name="inline.italicseq"/>
22 |     <xsl:text>&gt;</xsl:text>
23 |   </xsl:template>
24 |   
25 |   <xsl:template match="type">
26 |     <xsl:call-template name="inline.monoseq"/>
27 |   </xsl:template>
28 | </xsl:stylesheet>
29 | 


--------------------------------------------------------------------------------
/null-queue.lisp:
--------------------------------------------------------------------------------
 1 | (in-package #:calispel)
 2 | 
 3 | (defclass null-queue (jpl-queues:queue)
 4 |   ()
 5 |   (:documentation "The null queue.  Used for unbuffered CHANNELs.
 6 | 
 7 | Think of it as the NULL class, but for queues."))
 8 | 
 9 | (defmethod jpl-queues:empty? ((queue null-queue))
10 |   t)
11 | 
12 | (defmethod jpl-queues:full? ((queue null-queue))
13 |   t)
14 | 
15 | (defmethod jpl-queues:size ((queue null-queue))
16 |   0)
17 | 
18 | (defmethod jpl-queues:capacity ((queue null-queue))
19 |   0)
20 | 
21 | (defmethod jpl-queues:enqueue (object (queue null-queue))
22 |   (error "It is an error to ENQUEUE to a NULL-QUEUE."))
23 | 
24 | (defmethod jpl-queues:dequeue ((queue null-queue))
25 |   (error "It is an error to DEQUEUE from a NULL-QUEUE."))
26 | 
27 | (defmethod jpl-queues:dequeue-object-if (predicate (queue null-queue) &key &allow-other-keys)
28 |   ;; We can guarantee that no matching OBJECT is in this QUEUE.
29 |   (values))
30 | 
31 | ;;; Since NULL-QUEUE has no state, we can keep a single instance.
32 | ;;; Don't think of it as the queue analog to NIL (of lists), because
33 | ;;; (EQ +NULL-QUEUE+ (MAKE-INSTANCE 'NULL-QUEUE)) is false.
34 | 
35 | (defparameter +null-queue+ (make-instance 'null-queue))
36 | 


--------------------------------------------------------------------------------
/calispel.asd:
--------------------------------------------------------------------------------
 1 | ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
 2 | 
 3 | (asdf:defsystem "calispel"
 4 |   :version "0.1"
 5 |   :maintainer "J.P. Larocque"
 6 |   :author "J.P. Larocque, et al. (see COPYRIGHT.txt)"
 7 |   :licence "ISC-style and other permissive (see COPYRIGHT.txt)"
 8 |   :description "Thread-safe message-passing channels, in the style of
 9 | the occam programming language."
10 |   :components (;; Core data structures and algorithms.
11 | 	       (:file "core"
12 |                 :depends-on ("null-queue"
13 | 			     "package"))
14 | 	       ;; Basic operations: ? and !
15 | 	       (:file "basic"
16 | 		:depends-on ("core"
17 | 			     "package"))
18 | 	       ;; The *-ALT macros.
19 | 	       (:file "alt"
20 | 		:depends-on ("core"
21 | 			     "package"))
22 | 	       ;; The null queue.
23 | 	       (:file "null-queue"
24 |                 :depends-on ("package"))
25 |                (:file "package"))
26 | ;;	       Package definition.
27 |   :depends-on ("jpl-queues"
28 | 	       "bordeaux-threads"
29 | 	       (:version "jpl-util" "0.2")))
30 | 
31 | (asdf:defsystem "calispel-test"
32 |   :version "0.1"
33 |   :maintainer "Rick Venn (richard.venn@gmail.com)"
34 |   :author "J.P. Larocque, et al. (see COPYRIGHT.txt)"
35 |   :licence "ISC-style and other permissive (see COPYRIGHT.txt)"
36 |   :description "Test suite for Calispel"
37 |   :depends-on (:calispel :eager-future2)
38 |   :components ((:file "test")))


--------------------------------------------------------------------------------
/COPYRIGHT.txt:
--------------------------------------------------------------------------------
 1 | Calispel is licensed under permissive, BSD-like terms, copied from the
 2 | ISC license:
 3 | 
 4 |     Copyright (c) 2009, Jean-Paul Guy Larocque
 5 |     
 6 |     Permission to use, copy, modify, and/or distribute this software
 7 |     for any purpose with or without fee is hereby granted, provided
 8 |     that the above copyright notice and this permission notice appear
 9 |     in all copies.
10 |     
11 |     THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
12 |     WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
13 |     WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
14 |     AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
15 |     CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
16 |     LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
17 |     NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
18 |     CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
19 | 
20 | This software was directly derived from "csp.tgz"
21 | <http://www.staff.ncl.ac.uk/roger.peppe/csp.tgz>, dated 2006-07-03,
22 | and published by Roger Peppe.  No copyright notice giving attribution
23 | to Roger Peppe or any specific licensing terms seem to have been
24 | included in that version.
25 | 
26 | That software was derived from "channel.c" of Plan 9 libthread:
27 | 
28 |     Copyright (c) 2005 Russ Cox,
29 |                        Massachusetts Institute of Technology
30 | 
31 |     Permission is hereby granted, free of charge, to any person
32 |     obtaining a copy of this software and associated documentation
33 |     files (the "Software"), to deal in the Software without
34 |     restriction, including without limitation the rights to use, copy,
35 |     modify, merge, publish, distribute, sublicense, and/or sell copies
36 |     of the Software, and to permit persons to whom the Software is
37 |     furnished to do so, subject to the following conditions:
38 |     
39 |     The above copyright notice and this permission notice shall be
40 |     included in all copies or substantial portions of the Software.
41 |     
42 |     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
43 |     EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
44 |     MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
45 |     NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
46 |     HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
47 |     WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
48 |     OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
49 |     DEALINGS IN THE SOFTWARE.
50 | 
51 | That software contains parts derived from an earlier library by Rob
52 | Pike, Sape Mullender, and Russ Cox:
53 | 
54 |     Copyright (c) 2003 by Lucent Technologies.
55 |     
56 |     Permission to use, copy, modify, and distribute this software for
57 |     any purpose without fee is hereby granted, provided that this
58 |     entire notice is included in all copies of any software which is
59 |     or includes a copy or modification of this software and in all
60 |     copies of the supporting documentation for such software.
61 |     
62 |     THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR
63 |     IMPLIED WARRANTY.  IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT
64 |     TECHNOLOGIES MAKE ANY REPRESENTATION OR WARRANTY OF ANY KIND
65 |     CONCERNING THE MERCHANTABILITY OF THIS SOFTWARE OR ITS FITNESS FOR
66 |     ANY PARTICULAR PURPOSE.
67 | 


--------------------------------------------------------------------------------
/alt.lisp:
--------------------------------------------------------------------------------
  1 | (in-package #:calispel)
  2 | 
  3 | (defclass alt-operation (operation)
  4 |   ((action :type function :initarg :action :reader action
  5 | 	   :initform (error "Must supply :ACTION.")
  6 |            :documentation "A function to be called when this OPERATION
  7 | succeeds.
  8 | 
  9 | When DIRECTION is SEND, the function is called with no arguments.
 10 | 
 11 | When DIRECTION is RECEIVE, the function is called with the received
 12 | value.
 13 | 
 14 | The result of this function is the result of the ALT macro form."))
 15 |   (:documentation "An OPERATION with bookkeeping for use by the *-ALT
 16 | macros."))
 17 | 
 18 | (defun invoke-action (op)
 19 |   "Invokes the action associated with the given ALT-OPERATION."
 20 |   (declare (type alt-operation op))
 21 |   (ecase (direction op)
 22 |     (send (funcall (action op)))
 23 |     (receive (funcall (action op) (value op)))))
 24 | 
 25 | ;;; Macros.
 26 | 
 27 | (defmacro fair-alt (&body clauses)
 28 |   "Performs one of the given channel operations, choosing fairly from
 29 | the set of operations that first becomes available, then evaluates
 30 | each of the forms associated with the selected operation.  If no
 31 | operation can immediately be made, waits until an operation is
 32 | available (optionally up to a given timeout).  The result is the
 33 | result of the final evaluated form (or no values if no clause was
 34 | executed).
 35 | 
 36 | clauses          ::= operation-clause* [otherwise-clause]
 37 | operation-clause ::= (operation form*)
 38 | otherwise-clause ::= ({otherwise | (otherwise [:timeout timeout])} form*)
 39 | operation        ::= (? channel [lambda-list [condition]]) ; receive
 40 |                    | (! channel value [condition])         ; send
 41 | 
 42 | channel: Evaluated to produce a CHANNEL to send to or receive from.
 43 | The channel forms associated with operations that do not pass the
 44 | condition are not evaluated.
 45 | 
 46 | lambda-list: Either a symbol naming a variable to be bound to the
 47 | value received from the channel, or a destructuring lambda list naming
 48 | a set of variables to be bound to the destructured value received from
 49 | the channel.  The bindings are visible to the associated forms.  If
 50 | the value cannot be destructured according to the lambda list, an
 51 | error is signalled.  Note that multiple receive clauses for the same
 52 | channel with different destructuring lambda-lists *cannot* be used for
 53 | pattern matching.
 54 | 
 55 | value: An expression whose primary value is used as the message to
 56 | send to the channel.  All value expressions are evaluated before
 57 | selecting an operation, except for those associated with operations
 58 | that do not pass the condition.
 59 | 
 60 | condition: Evaluated to produce a generalized boolean indicating
 61 | whether the associated operation-clause should receive further
 62 | consideration.  When condition is not given or its resulting value is
 63 | true, the associated operation is kept for consideration.  When the
 64 | resulting value is false, the operation is removed from
 65 | consideration (as if its associated channel never becomes ready for
 66 | sending/receiving).
 67 | 
 68 | form: Evaluated in sequence when the associated clause is executed.
 69 | The values of the evaluation of the last form of the effective clause
 70 | become the result of FAIR-ALT.
 71 | 
 72 | timeout: Evaluated to produce the duration, as a non-negative REAL
 73 | number of seconds, to wait for an effective operation to become
 74 | available before resorting to the otherwise-clause.  The result may
 75 | also be NIL to specify no time out.  When an otherwise-clause exists,
 76 | the default time out is 0, meaning that if none of the channels in the
 77 | operation-clauses are immediately available, the otherwise-clause
 78 | forms are executed immediately.  When there is no otherwise-clause,
 79 | the default time out is NIL.
 80 | 
 81 | It is useful to specify a timeout expression that conditionally
 82 | evaluates to NIL, in order to disable the time out and inhibit the
 83 | execution of the otherwise-clause (provided that there are channel
 84 | operations to wait for that haven't been excluded by a false
 85 | condition).
 86 | 
 87 | If there are no effective operations (because all the conditions
 88 | evaluated to false, or because no operations were specified), then the
 89 | otherwise-clause (if any) is executed immediately (even if the
 90 | specified time out is NIL).
 91 | 
 92 | Stylistically and for future compatibility, avoid side-effects in
 93 | channel, value, condition, and timeout expressions."
 94 |   (alt-code clauses :fair))
 95 | 
 96 | (defmacro pri-alt (&body clauses)
 97 |   "Performs one of the given channel operations, choosing the first
 98 | listed operation that becomes available, then evaluates each of the
 99 | forms associated with the selected operation.  If no operation can
100 | immediately be made, waits until an operation is available (optionally
101 | up to a given timeout).  The result is the result of the final
102 | evaluated form (or no values if no clause was executed).
103 | 
104 | The syntax and semantics (other than clause priority) are the same as
105 | with FAIR-ALT.  PRI-ALT is (currently) more efficient than FAIR-ALT."
106 |   (alt-code clauses :first))
107 | 
108 | (defun alt-code (clauses priority)
109 |   (let* ((otherwise-pos (position-if #'otherwise-clause? clauses))
110 | 	 (otherwise (unless (null otherwise-pos)
111 | 		      (elt clauses otherwise-pos)))
112 | 	 (ops (loop for clause in clauses
113 | 		    for i from 0
114 | 		    unless (and (not (null otherwise-pos))
115 | 				(= i otherwise-pos))
116 | 		    collecting clause)))
117 |     (unless (or (null otherwise-pos)
118 |                 (= otherwise-pos (1- (length clauses))))
119 |       ;; Also takes care of ensuring only one else-clause.
120 |       (error "Optional OTHERWISE clause must come last, and only once."))
121 |     (multiple-value-bind (timeout-form otherwise-forms)
122 | 	(if (null otherwise)
123 | 	    (values nil nil)
124 | 	    (parse-otherwise-clause otherwise))
125 |       (alt-body-code (map 'list #'op-clause-condition ops)
126 | 		     (map 'list #'op-clause-form ops)
127 | 		     priority
128 | 		     (not (null otherwise-pos)) timeout-form
129 | 		     otherwise-forms))))
130 | 
131 | (defun alt-body-code (op-conditions op-forms priority
132 | 		      otherwise-p timeout-form otherwise-forms)
133 |   (jpl-util:with-gensyms (ops% timeout% result%)
134 |     `(let* ((,ops% (let ((,ops% '()))
135 | 		     ,@(loop for condition in (reverse op-conditions)
136 | 			     for form in (reverse op-forms)
137 | 			     collecting `(when ,condition
138 | 					   (push ,form ,ops%)))
139 | 		     ,ops%))
140 | 	    (,timeout%
141 | 	     ;; Bind in new variable to give the user a pretty place
142 | 	     ;; name ("TIMEOUT") rather than an ugly one
143 | 	     ;; ("TIMEOUT%-1234").  (SBCL will include the place-name
144 | 	     ;; in the printed condition.)
145 | 	     (let ((timeout ,timeout-form))
146 | 	       ;; Use CHECK-TYPE rather than JPL-UTIL:ENSURE-TYPE to
147 | 	       ;; give the compiler a chance to optimize the check
148 | 	       ;; away.
149 | 	       (check-type timeout (or (real 0) null)
150 | 			   "a non-negative REAL number of seconds (or NIL)")
151 | 	       timeout))
152 | 	    (,result% (unless (endp ,ops%)
153 | 			(operation-alternate ,timeout% ,priority ,ops%))))
154 |        (cond ((null ,result%)
155 | 	      ,@(if otherwise-p
156 | 		    otherwise-forms
157 | 		    '((values))))
158 | 	     (t (invoke-action ,result%))))))
159 | 
160 | (defun otherwise-clause? (clause)
161 |   (and (listp clause)
162 |        (not (endp clause))
163 |        (or (eq 'otherwise (first clause))
164 | 	   (and (listp (first clause))
165 | 		(not (endp (first clause)))
166 | 		(eq 'otherwise (first (first clause)))))))
167 | 
168 | (defun parse-otherwise-clause (clause)
169 |   (declare (type list clause))
170 |   (destructuring-bind (head &body body) clause
171 |     (if (eq head 'otherwise)
172 | 	(values 0 body)
173 | 	(destructuring-bind (head &key (timeout 0)) head
174 | 	  (assert (eq head 'otherwise))
175 | 	  (values timeout body)))))
176 | 
177 | (defun op-clause-condition (clause)
178 |   (declare (type list clause))
179 |   (destructuring-bind ((operator &rest operands) &body body) clause
180 |     (declare (ignore body))
181 |     (ecase operator
182 |       (! (op-!-clause-condition operands))
183 |       (? (op-?-clause-condition operands)))))
184 | 
185 | (defun op-!-clause-condition (clause-operands)
186 |   (declare (type list clause-operands))
187 |   (destructuring-bind (channel-form value-form &optional (condition-form t))
188 |       clause-operands
189 |     (declare (ignore channel-form value-form))
190 |     condition-form))
191 | 
192 | (defun op-?-clause-condition (clause-operands)
193 |   (declare (type list clause-operands))
194 |   (destructuring-bind (channel-form &optional lambda-list (condition-form t))
195 |       clause-operands
196 |     (declare (ignore channel-form lambda-list))
197 |     condition-form))
198 | 
199 | (defun op-clause-form (clause)
200 |   (declare (type list clause))
201 |   (destructuring-bind ((operator &rest operands) &body body) clause
202 |     (ecase operator
203 |       (! (op-!-clause-form operands body))
204 |       (? (op-?-clause-form operands body)))))
205 | 
206 | (defun op-!-clause-form (clause-operands body)
207 |   (declare (type list clause-operands body))
208 |   (destructuring-bind (channel-form value-form &optional condition-form)
209 |       clause-operands
210 |     (declare (ignore condition-form))
211 |     `(make-instance 'alt-operation
212 |                     :direction 'send
213 |                     :channel ,channel-form
214 |                     :value ,value-form
215 |                     :action (lambda () ,@body))))
216 | 
217 | (defun op-?-clause-form (clause-operands body)
218 |   (declare (type list clause-operands body))
219 |   (destructuring-bind (channel-form &optional
220 | 		       (lambda-list nil lambda-list-p)
221 | 		       condition-form)
222 |       clause-operands
223 |     (declare (ignore condition-form))
224 |     (jpl-util:with-gensyms (message%)
225 |       (let ((action-expr
226 | 	     (cond ((not lambda-list-p)
227 | 		    `(lambda (,message%)
228 | 		       (declare (ignore ,message%))
229 | 		       ,@body))
230 | 		   ((listp lambda-list)
231 | 		    `(lambda (,message%)
232 | 		       (destructuring-bind ,lambda-list ,message%
233 | 			 ,@body)))
234 | 		   ((symbolp lambda-list)
235 | 		    `(lambda (,lambda-list)
236 | 		       ,@body))
237 | 		   (t (error "LAMBDA-LIST of receive clause must be ~
238 |                               a list, a symbol, or unspecified, not ~S."
239 | 			     lambda-list)))))
240 | 	`(make-instance 'alt-operation
241 | 			:direction 'receive
242 | 			:channel ,channel-form
243 | 			:action ,action-expr)))))
244 | 


--------------------------------------------------------------------------------
/test.lisp:
--------------------------------------------------------------------------------
  1 | (defpackage #:calispel-test
  2 |   (:use #:common-lisp #:calispel #:jpl-queues))
  3 | 
  4 | (in-package #:calispel-test)
  5 | 
  6 | (defun divide-vector (vector count)
  7 |   "Returns a vector of COUNT vectors with elements from VECTOR.  The
  8 | resulting vectors will be roughly the same length (some may be 1
  9 | longer than others), and the sum of the lengths will be equal to the
 10 | length of VECTOR.  The order of elements in the returned vectors is
 11 | not assured."
 12 |   (declare (type vector vector)
 13 | 	   (type jpl-util:array-dimension count))
 14 |   (unless (plusp count)
 15 |     (error "COUNT must be greater than zero."))
 16 |   (let* ((element-type (array-element-type vector))
 17 | 	 (shares (make-array count
 18 | 			     :element-type 'jpl-util:array-dimension
 19 | 			     :initial-element (floor (length vector) count)))
 20 | 	 (subvectors (make-array count
 21 | 				 :element-type `(vector (vector ,element-type)))))
 22 |     (dotimes (i (mod (length vector) count))
 23 |       (incf (aref shares i)))
 24 |     (assert (= (length vector)
 25 | 	       (reduce #'+ shares :initial-value 0)))
 26 |     (dotimes (i count)
 27 |       (setf (aref subvectors i)
 28 | 	    (make-array (aref shares i) :element-type element-type)))
 29 |     (loop for vector-start = 0 then vector-end
 30 | 	  for length across shares
 31 | 	  for vector-end = (+ vector-start length)
 32 | 	  for subvector across subvectors
 33 | 	  doing (replace subvector vector
 34 | 			 :start2 vector-start :end2 vector-end))
 35 |     subvectors))
 36 | 
 37 | (defun control-channel-vector (count)
 38 |   "Returns a vector of COUNT channels suitable for controlling
 39 | threads."
 40 |   (loop with out = (make-array count :element-type 'channel)
 41 | 	for i below count
 42 | 	for buffer = (make-instance 'jpl-queues:unbounded-fifo-queue)
 43 | 	for channel = (make-instance 'channel :buffer buffer)
 44 | 	doing (setf (aref out i) channel)
 45 | 	finally (return out)))
 46 | 
 47 | ;;; 1000000 messages is enough to keep my 32-bit 2.4GHz dual Xeon with
 48 | ;;; SBCL 1.0.18 busy for almost 2 minutes on unbuffered channels.
 49 | ;;; (Note that there are artificial slowdowns in this test function.)
 50 | ;;; We need at least ~10 seconds of runtime, and that includes on
 51 | ;;; faster multicore machines of the future.
 52 | (defun test-channel (channel &key (message-count 2000000)
 53 | 		     (reader-count 4) (writer-count 4)
 54 | 		     (verbose-p nil))
 55 |   "Tests CHANNEL by writing MESSAGE-COUNT messages to it.  The CHANNEL
 56 | must not have any buffered messages at the time this function is
 57 | called, and no other thread may operate on CHANNEL for the duration of
 58 | this function call.  The buffer of CHANNEL, if any, must be exact (it
 59 | must not drop messages).
 60 | 
 61 | WRITER-COUNT writer threads are created to write to the channel.
 62 | 
 63 | READER-COUNT reader threads are created to read from the channel.
 64 | 
 65 | The CHANNEL is tested under reader-contention, writer-contention, and
 66 | natural conditions.  Under the reader-contention condition, writer
 67 | threads will intentionally become slow in order to induce multiple
 68 | readers contending for CHANNEL; the buffer of CHANNEL (if any) should
 69 | become empty.  Under the writer-contention condition, reader threads
 70 | will intentionally become slow in order to induce multiple writer
 71 | threads contending for CHANNEL; the buffer of CHANNEL (if any) should
 72 | become full (or grow indefinately if unbounded).  Under the natural
 73 | condition, no thread will intentionally slow down to induce contention
 74 | on the other side.  The condition which is in effect cycles once every
 75 | 3 seconds; therefore, a high enough MESSAGE-COUNT should be given so
 76 | that this function takes at least ~10 seconds to run."
 77 |   (declare (type jpl-util:array-dimension
 78 | 		 message-count reader-count writer-count))
 79 |   ;; FIXME: Figure out how to test FIFO order of FIFO-buffered (or
 80 |   ;; unbuffered) channels.  Probably involves precise timestamps.
 81 |   (let* (;; MESSAGES is the set of messages that will be written to
 82 | 	 ;; the channel.  Specifically, it is the set of integers
 83 | 	 ;; [0,MESSAGE-COUNT).  We store the messages in vectors for
 84 | 	 ;; convenience, but note that putting anything other than the
 85 | 	 ;; aforementioned set of integers into MESSAGES will result
 86 | 	 ;; in trouble during verification.
 87 | 	 (messages (loop with ms = (make-array message-count
 88 | 					       :element-type 'fixnum)
 89 | 			 for i below (length ms)
 90 | 			 doing (setf (aref ms i) i)
 91 | 			 finally (return ms)))
 92 | 	 ;; Each writer thread gets a vector of messages that it must
 93 | 	 ;; write to CHANNEL (in any order).  When the vector is
 94 | 	 ;; exhausted, the thread terminates.
 95 | 	 (writer-message-vectors (divide-vector messages writer-count))
 96 | 	 ;; Per-thread control channels used to induce slowdown or (in
 97 | 	 ;; the case of reader threads) request termination.
 98 | 	 (reader-controls (control-channel-vector reader-count))
 99 | 	 (writer-controls (control-channel-vector writer-count))
100 | 	 ;; Each reader thread manages its own vector of elements that
101 | 	 ;; it has read from the channel.  When it receives the
102 | 	 ;; :CLEAN-UP message on READER-CONTROL, it enters the
103 | 	 ;; clean-up state.  In that state, if it cannot read from
104 | 	 ;; CHANNEL without blocking, it writes its result vector to
105 | 	 ;; READER-RESULTS and terminates.
106 | 	 (reader-results (make-instance
107 | 			  'channel
108 | 			  :buffer (make-instance
109 | 				   'jpl-queues:unbounded-random-queue)))
110 | 	 ;; Just before any thread terminates, it writes a message
111 | 	 ;; with its thread object to this channel.  The main thread
112 | 	 ;; waits until all threads have written their expiration
113 | 	 ;; notice to this channel.
114 | 	 (thread-expiration
115 | 	  (make-instance 'channel
116 | 			 :buffer (make-instance 'jpl-queues:bounded-fifo-queue
117 | 						:capacity (+ reader-count
118 | 							     writer-count))))
119 | 	 ;; These track the currently-alive threads.  The order of the
120 | 	 ;; threads within these vectors is not significant.
121 | 	 (readers (make-array reader-count :fill-pointer 0))
122 | 	 (writers (make-array writer-count :fill-pointer 0))
123 | 	 ;; The current contention condition.
124 | 	 (condition nil)
125 | 	 ;; The next time (in terms of
126 | 	 ;; JPL-UTIL:GET-REASONABLE-REAL-TIME) that the contention
127 | 	 ;; condition should be cycled.
128 | 	 (condition-cycle-time 0)
129 | 	 ;; The start and end times of the threads (in terms of
130 | 	 ;; JPL-UTIL:GET-REASONABLE-REAL-TIME).
131 | 	 start-time end-time)
132 |     (flet ((reader (control)
133 | 	     (let ((out (make-array 1024 :element-type 'fixnum
134 | 				    :adjustable t :fill-pointer 0))
135 | 		   (cleanup? nil)
136 | 		   (slow? nil))
137 | 	       (loop
138 | 		 (when slow?
139 | 		   (sleep 1/100))
140 | 		 (pri-alt ((? control msg)
141 | 			   (ecase msg
142 | 			     (:clean-up (setf cleanup? t))
143 | 			     (:high-speed (setf slow? nil))
144 | 			     (:low-speed (setf slow? t))))
145 | 			  ((? channel msg)
146 | 			   (declare (type fixnum msg))
147 | 			   (vector-push-extend msg out))
148 | 			  ((otherwise :timeout (if cleanup? 0 nil))
149 | 			   (! reader-results out)
150 | 			   (! thread-expiration (bt:current-thread))
151 | 			   (return))))))
152 | 	   (writer (control messages-v)
153 | 	     (declare (type (vector fixnum) messages-v))
154 | 	     (let ((i 0)
155 | 		   (slow? nil))
156 | 	       (declare (type fixnum i))
157 | 	       (loop
158 | 		 (when slow?
159 | 		   (sleep 1/100))
160 | 		 (pri-alt ((? control msg)
161 | 			   (ecase msg
162 | 			     (:high-speed (setf slow? nil))
163 | 			     (:low-speed (setf slow? t))))
164 | 			  ((! channel (aref messages-v i))
165 | 			   (incf i)
166 | 			   (when (= i (length messages-v))
167 | 			     (! thread-expiration (bt:current-thread))
168 | 			     (return)))))))
169 | 	   (safe-vector-push (new-element vector)
170 | 	     (unless (vector-push new-element vector)
171 | 	       (error "Ran out of room for new element."))))
172 |       (when verbose-p
173 | 	(format t "~&Starting threads.~&"))
174 |       (setf start-time (jpl-util:get-reasonable-real-time))
175 |       (loop for i from 1
176 | 	    for name = (format nil "Calispel-test-reader-~D" i)
177 | 	    for control across reader-controls
178 | 	    doing (safe-vector-push (bt:make-thread (jpl-util:curry-left
179 | 						     #'reader control)
180 | 						    :name name)
181 | 				    readers))
182 |       (loop for i from 1
183 | 	    for name = (format nil "Calispel-test-writer-~D" i)
184 | 	    for messages-v across writer-message-vectors
185 | 	    for control across writer-controls
186 | 	    doing (safe-vector-push (bt:make-thread (jpl-util:curry-left
187 | 						     #'writer
188 | 						     control messages-v)
189 | 						    :name name)
190 | 				    writers))
191 |       (labels ((cycle-condition ()
192 | 		 (unless (< (jpl-util:get-reasonable-real-time)
193 | 			    condition-cycle-time)
194 | 		   (setf condition (ecase condition
195 | 				     ((nil) :none)
196 | 				     (:none :reader)
197 | 				     (:reader :writer)
198 | 				     (:writer :none)))
199 | 		   (setf condition-cycle-time
200 | 			 (+ 3 (jpl-util:get-reasonable-real-time)))
201 | 		   (flet ((tell-all (control-v msg)
202 | 			    (loop for control across control-v
203 | 				  doing (! control msg))))
204 | 		     (ecase condition
205 | 		       (:none (tell-all reader-controls :high-speed)
206 | 			      (tell-all writer-controls :high-speed))
207 | 		       (:reader (tell-all reader-controls :high-speed)
208 | 				(tell-all writer-controls :low-speed))
209 | 		       (:writer (tell-all reader-controls :low-speed)
210 | 				(tell-all writer-controls :high-speed))))))
211 | 	       (time-until-next-cycle ()
212 | 		 (max 0 (- condition-cycle-time
213 | 			   (jpl-util:get-reasonable-real-time))))
214 | 	       (wait-until-threads-terminate (thread-type-label thread-vector)
215 | 		 (loop
216 | 		   (cycle-condition)
217 | 		   (when (zerop (length thread-vector))
218 | 		     (return))
219 | 		   (pri-alt ((? thread-expiration thread)
220 | 			     (unless (vector-pop-element thread-vector
221 | 							 thread)
222 | 			       (error "While awaiting the termination of ~
223 |                                        ~A threads, got an unexpected ~
224 |                                        thread: ~S"
225 | 				      thread-type-label thread))
226 | 			     (when verbose-p
227 | 			       (format t "~&Reaped ~A thread: ~S~&"
228 | 				       thread-type-label thread)))
229 | 			    ((otherwise :timeout (time-until-next-cycle))))))
230 | 	       (vector-pop-element (vector element)
231 | 		 ;; Returns true when ELEMENT was in VECTOR.
232 | 		 (let ((pos (position element vector)))
233 | 		   (unless (null pos)
234 | 		     (jpl-util:vector-delete vector pos))
235 | 		   (not (null pos)))))
236 | 	(cycle-condition)
237 | 	(wait-until-threads-terminate "writer" writers)
238 | 	;; Ask all readers to terminate when they get the chance.
239 | 	(loop for control across reader-controls
240 | 	      doing (! control :clean-up))
241 | 	(wait-until-threads-terminate "reader" readers)
242 | 	(setf end-time (jpl-util:get-reasonable-real-time))
243 | 	(when verbose-p
244 | 	  (format t "~&All threads finished.~&"))
245 | 	;; Collect and verify results.
246 | 	(let ((seen-messages (make-array message-count :element-type 'bit
247 | 					 :initial-element 0))
248 | 	      (duplicate-count 0)
249 | 	      (drop-count 0)
250 | 	      (result-vector-count 0))
251 | 	  (loop
252 | 	    (pri-alt ((? reader-results result-v)
253 | 		      (incf result-vector-count)
254 | 		      (loop for message across result-v
255 | 			    unless (zerop (aref seen-messages message))
256 | 			    doing (incf duplicate-count)
257 | 			    doing (setf (aref seen-messages message) 1)))
258 | 		     (otherwise (return))))
259 | 	  (assert (= reader-count result-vector-count))
260 | 	  (loop for message from 0
261 | 		for seen-bit across seen-messages
262 | 		when (zerop seen-bit)
263 | 		doing (incf drop-count))
264 | 	  (unless (and (zerop duplicate-count)
265 | 		       (zerop drop-count))
266 | 	    (error "~D duplicated message~:P and ~D dropped message~:P."
267 | 		   duplicate-count drop-count)))
268 | 	;; Verify no buffered messages in CHANNEL and other channels.
269 | 	(pri-alt ((? channel)
270 | 		  (error "Lingering messages on CHANNEL."))
271 | 		 ((? reader-results)
272 | 		  (error "Lingering messages on READER-RESULTS."))
273 | 		 ((? thread-expiration)
274 | 		  (error "Lingering messages on THREAD-EXPIRATION."))
275 | 		 ((otherwise :timeout 3)
276 | 		  (values)))
277 | 	(flet ((verify-control (label chan)
278 | 		 (loop
279 | 		   (pri-alt ((? chan msg)
280 | 			     (case msg
281 | 			       ((:low-speed :high-speed)) ; No-op.
282 | 			       (otherwise
283 | 				(error "Lingering non-speed messages on ~A ~
284 |                                         control channel."
285 | 				       label))))
286 | 			    (otherwise (return))))))
287 | 	  (loop for control across reader-controls
288 | 		doing (verify-control "reader" control))
289 | 	  (loop for control across writer-controls
290 | 		doing (verify-control "writer" control)))
291 | 	(when verbose-p
292 | 	  (let* ((time (- end-time start-time))
293 | 		 (rate (/ message-count time)))
294 | 	    (format t "~&Succeeded: ~,2F seconds run-time, ~
295 |                        ~,2F messages/second.~&"
296 | 		    time rate)))
297 | 	(values)))))
298 | 
299 | ;;; These parameters keep my dual Xeon busy for about 12 minutes.
300 | (defun test-concurrency (&rest kw-args &key
301 |  			 ;; Enumerate the allowable keyword args, even
302 |  			 ;; the ones used only by TEST-CHANNEL, to
303 |  			 ;; prevent accepting VERBOSE-P.  We can't let
304 |  			 ;; multiple threads print concurrently.
305 | 			 (channel-count 8)
306 | 			 (make-channel-fn (lambda () (make-instance 'channel)))
307 | 			 (message-count 2000000)
308 | 			 (reader-count 4) (writer-count 4))
309 |   "Tests concurrency by creating CHANNEL-COUNT CHANNELs and running
310 | TEST-CHANNEL against each, simultaneously.
311 | 
312 | MAKE-CHANNEL-FN is a designator of a function of no arguments that
313 | returns a fresh CHANNEL.  It is used to produce the test channels.
314 | 
315 | MESSAGE-COUNT, READER-COUNT, and WRITER-COUNT are as in TEST-CHANNEL;
316 | note that these values are per-channel-test, not globally."
317 |   (declare (ignore message-count reader-count writer-count))
318 |   (let ((futures (loop repeat channel-count
319 | 		       collecting (let ((channel (funcall make-channel-fn)))
320 | 				    (eager-future2:pexec
321 | 				      (apply #'test-channel channel
322 | 					     :allow-other-keys t kw-args))))))
323 |     ;; YIELD them to block until all the TEST-CHANNEL calls return,
324 |     ;; and to check for caught errors.
325 |     (dolist (future futures)
326 |       (eager-future2:yield future))))
327 | 


--------------------------------------------------------------------------------
/core.lisp:
--------------------------------------------------------------------------------
  1 | (in-package #:calispel)
  2 | 
  3 | ;;; DIRECTION type.
  4 | 
  5 | (deftype direction ()
  6 |   '(member send receive))
  7 | 
  8 | (defun opposite-direction (direction)
  9 |   (declare (type direction direction))
 10 |   (ecase direction
 11 |     (send 'receive)
 12 |     (receive 'send)))
 13 | 
 14 | ;;; CHANNEL class.
 15 | 
 16 | (defclass channel ()
 17 |   ((buffer :type jpl-queues:queue :reader buffer
 18 | 	   :initarg :buffer :initform +null-queue+
 19 | 	   :documentation "The QUEUE used to buffer pending objects.
 20 | 
 21 | The QUEUE must not be holding any objects, and the QUEUE must not be
 22 | used again unless the CHANNEL owning it is never used
 23 | again.  (Exception: QUEUEs that strictly have no state, such as
 24 | instances of NULL-QUEUE, may be shared among CHANNELs.)")
 25 |    (send-operation-queue :type jpl-queues:queue
 26 | 			 :reader send-operation-queue
 27 | 			 :initform (make-instance
 28 | 				    'jpl-queues:unbounded-random-queue)
 29 | 			 :documentation "A queue of all the
 30 | OPERATIONs waiting to send to this CHANNEL.  An OPERATION may be
 31 | waiting to send only when BUFFER is full.")
 32 |    (receive-operation-queue :type jpl-queues:queue
 33 | 			    :reader receive-operation-queue
 34 | 			    :initform (make-instance
 35 | 				       'jpl-queues:unbounded-random-queue)
 36 | 			    :documentation "A queue of all the
 37 | OPERATIONs waiting to receive from this channel.  An OPERATION may be
 38 | waiting to receive only when BUFFER is empty."))
 39 |   (:documentation "A communication channel."))
 40 | 
 41 | (defmethod initialize-instance :after ((channel channel) &key &allow-other-keys)
 42 |   (unless (jpl-queues:empty? (buffer channel))
 43 |     (error "The BUFFER of CHANNEL has objects in queue: ~S"
 44 | 	   (buffer channel))))
 45 | 
 46 | (defmethod print-object ((channel channel) stream)
 47 |   (print-unreadable-object (channel stream :type t :identity t)
 48 |     (format stream "buffer: ~S" (buffer channel))))
 49 | 
 50 | (defun operation-queue (channel direction)
 51 |   "Returns the queue of all the OPERATIONs waiting to move data in
 52 | DIRECTION on CHANNEL.  When DIRECTION is SEND, the returned OPERATIONs
 53 | are those waiting until the BUFFER of CHANNEL is no longer full.  When
 54 | RECEIVE, the returned OPERATIONs are those waiting until the BUFFER is
 55 | no longer empty."
 56 |   (declare (type channel channel)
 57 | 	   (type direction direction))
 58 |   (ecase direction
 59 |     (send (send-operation-queue channel))
 60 |     (receive (receive-operation-queue channel))))
 61 | 
 62 | ;;; Global lock.
 63 | ;;; 
 64 | ;;; This lock protects all channel state, globally.  The original code
 65 | ;;; has this to say:
 66 | ;;; 
 67 | ;;;     One can go through a lot of effort to avoid this global lock.
 68 | ;;;     You have to put locks in all the CHANNELs and all the
 69 | ;;;     OPERATIONs.  at the beginning of OPERATION-ALTERNATE you have
 70 | ;;;     to lock all the CHANNELs, but then to try to actually execute
 71 | ;;;     an OPERATION you have to lock the other guy's OPERATIONs, so
 72 | ;;;     that other people aren't trying to use him in some other
 73 | ;;;     alternation at the same time.
 74 | ;;;     
 75 | ;;;     It's just not worth the extra effort.
 76 | ;;; 
 77 | ;;; At least one special case has to be avoided (as alluded to above):
 78 | ;;; 
 79 | ;;;   * Thread 1 is blocking on an ALTERNATION with two OPERATIONs.
 80 | ;;;     Operation 1 is to receive from Channel 1.  Operation 2 is to
 81 | ;;;     receive from Channel 2.
 82 | ;;;   
 83 | ;;;   * Thread 2 is in OPERATION-ALTERNATE with one operation
 84 | ;;;     (Operation 3): send to Channel 1.
 85 | ;;;   
 86 | ;;;   * Thread 3 is in OPERATION-ALTERNATE with one operation
 87 | ;;;     (Operation 4): send to Channel 2.
 88 | ;;;   
 89 | ;;;   * Thread 2 and Thread 3 are running simultaneously.
 90 | ;;;   
 91 | ;;;   * It must be guaranteed that only either O1 or O2 is selected
 92 | ;;;     for the alternation in T1.
 93 | ;;; 
 94 | ;;; Now let's play out what happens:
 95 | ;;; 
 96 | ;;;   * At the same time, T2 dequeues O1 from C1's receiving operation
 97 | ;;;     queue, and T3 dequeues O2 from C2's receiving operation queue.
 98 | ;;; 
 99 | ;;; So, we need some magical (and probably quite complicated) way of
100 | ;;; locking just enough of the data structures to prevent the conflict
101 | ;;; in the last bullet point, or we need a way for one thread to see
102 | ;;; there's a conflict and "retry" back to OPERATION-ALTERNATE,
103 | ;;; looking for another ready operation (also probably quite
104 | ;;; complicated).
105 | ;;; 
106 | ;;; Nomatter how you slice it, the solution will be hard, and proving
107 | ;;; its correctness even harder.  What performance gain (if any, with
108 | ;;; all that fine-grained locking) do you get?  Is it worth it?
109 | ;;; 
110 | ;;; And finally, you'd also have to give consideration to
111 | ;;; *RANDOM-STATE*, to ensure the current RANDOM-STATE (shared among
112 | ;;; threads) won't be accessed and updated by RANDOM concurrently.
113 | ;;; RANDOM is used directly in this library, and in JPL-QUEUES.
114 | (defvar *lock*
115 |   (bt:make-lock)
116 |   "A lock protecting the global channel state.  The lock must be held
117 | whenever any data is being accessed (unless it can be proven that no
118 | other thread can access that data).  Specifically, that means
119 | CHANNELs, OPERATIONs, and ALTERNATIONs that other threads can
120 | potentially get access to.")
121 | 
122 | ;;; OPERATION class.
123 | 
124 | (defclass operation ()
125 |   ((direction :type direction :initarg :direction :reader direction
126 |               :initform (error "Must supply :DIRECTION.")
127 |               :documentation "Which DIRECTION this OPERATION is trying
128 | to move data in.
129 | 
130 | When SEND, the OPERATION is interested in sending the value specified
131 | by :VALUE to CHANNEL.
132 | 
133 | When RECEIVE, the OPERATION is interested in receiving a value from
134 | CHANNEL.")
135 |    (channel :type channel :initarg :channel :reader channel
136 |             :initform (error "Must supply :CHANNEL.")
137 |             :documentation "The CHANNEL this OPERATION is interested
138 | in operating on.")
139 |    (value :initarg :value :accessor value
140 |           :documentation "The value associated with this OPERATION.
141 | 
142 | When sending, this is the value to send.
143 | 
144 | When receiving, this is the received value if the OPERATION has
145 | executed, or undefined if it has not.")
146 |    (alternation :type alternation :accessor alternation
147 | 		:documentation "The ALTERNATION (if any) that this
148 | OPERATION is a member of."))
149 |   (:documentation "A potential operation (receive or send) to perform
150 | on a channel.  An OPERATION instance represents an interest to perform
151 | the operation; it does not represent an operation that definitely will
152 | be or has been carried out."))
153 | 
154 | ;;; ALTERNATION class.
155 | 
156 | (defclass alternation ()
157 |   ((operations :type list :reader operations :initarg :operations
158 | 	       :initform (error "Must supply :OPERATIONS.")
159 | 	       :documentation "The set of OPERATIONs waiting to
160 | occur (as a list).")
161 |    (selected :type (or operation null) :accessor selected :initform nil
162 | 	     :documentation "The OPERATION selected by a thread that
163 | took action, or NIL if no OPERATION has yet been executed by another
164 | thread.
165 | 
166 | The thread that writes to SELECTED is generally a different thread
167 | than that which waits on the ALTERNATION.
168 | 
169 | The OPERATION, when given, must have been executed, and it must appear
170 | in the OPERATIONS slot.")
171 |    (selection-cv :reader selection-cv :initform (bt:make-condition-variable)
172 | 		 :documentation "A condition variable which is
173 | notified when an OPERATION has been selected and was written to the
174 | SELECTED slot.
175 | 
176 | The thread that waits on SELECTION-CV is generally that which is
177 | waiting on the ALTERNATION."))
178 |   (:documentation "Represents a waiting alternation of several
179 | OPERATIONs.  That is, represents the act of waiting for the associated
180 | OPERATION that first becomes available."))
181 | 
182 | ;;; OPERATION functions.
183 | 
184 | (defun operation-alternate (timeout priority ops)
185 |   "Given a list of at least one OPERATION, executes the first one that
186 | becomes available within TIMEOUT seconds and returns that OPERATION.
187 | If TIMEOUT seconds have elapsed without any of the OPERATIONs becoming
188 | available, returns NIL.  If TIMEOUT is NIL, waits indefinitely.
189 | 
190 | If one or more of the OPERATIONs can be executed immediately, which
191 | one is chosen depends on the value of PRIORITY.  When PRIORITY
192 | is :FIRST, the first OPERATION listed in OPS that can be executed is
193 | chosen.  When PRIORITY is :FAIR, one of the OPERATIONs that can be
194 | executed immediately is chosen at random."
195 |   (declare (type (or (real 0) null) timeout)
196 | 	   (type (member :first :fair) priority)
197 | 	   (type list ops))
198 |   (when (endp ops)
199 |     (error "At least one OPERATION must be given."))
200 |   (bt:with-lock-held (*lock*)
201 |     ;; Seek an immediately-executable operation.
202 |     (let ((ready-op
203 | 	   (ecase priority
204 | 	     (:first (find-if #'operation-ready? ops))
205 | 	     (:fair
206 | 	      ;; If we want to ridiculously microoptimize for the many
207 | 	      ;; ready OPERATIONs case, we could use reservoir
208 | 	      ;; sampling to avoid consing up a list of all ready
209 | 	      ;; OPERATIONs and scanning over it twice.
210 | 	      (let ((ready-ops (remove-if (complement #'operation-ready?)
211 | 					  ops)))
212 | 		(unless (endp ready-ops)
213 | 		  (elt ready-ops (random (length ready-ops)))))))))
214 |       (cond ((not (null ready-op))
215 | 	     (execute-operation ready-op)
216 | 	     ready-op)
217 | 	    ((or (null timeout)
218 | 		 (plusp timeout))
219 | 	     (let ((alt (make-instance 'alternation :operations ops)))
220 | 	       (dolist (op ops)
221 | 		 (setf (alternation op) alt))
222 | 	       (alternation-wait timeout alt)
223 | 	       (selected alt)))
224 | 	    (t nil)))))
225 | 
226 | (defun alternation-wait (timeout alternation)
227 |   "Given an ALTERNATION, waits up to TIMEOUT seconds for another
228 | thread to execute one of its OPERATIONs (or indefinitely when TIMEOUT
229 | is NIL).  The SELECTED slot of ALTERNATION must initially be NIL.
230 | 
231 | Upon return, if another thread executed one of the OPERATIONs of
232 | ALTERNATION, that OPERATION will appear in the SELECTED slot of
233 | ALTERNATION.  Otherwise (if timed-out), that slot will be NIL.
234 | 
235 | Must be called with *LOCK* held."
236 |   (declare (type (or (real 0) null) timeout)
237 | 	   (type alternation alternation))
238 |   (let ((start-time (jpl-util:get-reasonable-real-time)))
239 |     ;; FIXME: this is a hack, and a bit wasteful.  Find or create a
240 |     ;; reasonable timers library that can do this.
241 |     (unless (null timeout)
242 |       ;; EAGER-FUTURE explicitly leaves the dynamic environment
243 |       ;; unpsecified.
244 |       (let ((lock *lock*))
245 | 	(bt:make-thread
246 |          (lambda ()
247 |            (sleep timeout)
248 |            (bt:with-lock-held (lock)
249 |              (bt:condition-notify (selection-cv alternation)))))))
250 |     (labels ((elapsed-time ()
251 | 	       (- (jpl-util:get-reasonable-real-time)
252 | 		  start-time))
253 | 	     (timeout-expired? ()
254 | 	       (and (not (null timeout))
255 | 		    (>= (elapsed-time) timeout))))
256 |       (assert (null (selected alternation)))
257 |       (map nil #'enqueue-operation-with-channel
258 | 	   (operations alternation))
259 |       (unwind-protect
260 | 	   (loop
261 | 	     (bt:condition-wait (selection-cv alternation) *lock*)
262 | 	     (unless (null (selected alternation))
263 | 	       (return))
264 | 	     (when (timeout-expired?)
265 | 	       (return)))
266 | 	(when (null (selected alternation))
267 | 	  (map nil #'dequeue-operation-with-channel
268 | 	       (operations alternation)))))))
269 | 
270 | (defun enqueue-operation-with-channel (op)
271 |   "Given an OPERATION that is about to wait, enqueues it with the
272 | vector of OPERATIONs waiting on CHANNEL (where CHANNEL is the CHANNEL
273 | that the OPERATION is interested in).
274 | 
275 | Must be called with *LOCK* held."
276 |   (jpl-queues:enqueue op (operation-queue (channel op) (direction op))))
277 | 
278 | (defun dequeue-operation-with-channel (op)
279 |   "Given an OPERATION that will no longer be waiting, dequeues it from
280 | the vector of OPERATIONs waiting on CHANNEL (where CHANNEL is the
281 | CHANNEL that the OPERATION was interested in).
282 | 
283 | Must be called with *LOCK* held."
284 |   (jpl-queues:dequeue-object op (operation-queue (channel op) (direction op))))
285 | 
286 | (defun operation-ready? (op)
287 |   "Returns a boolean value indicating whether the given OPERATION can
288 | be executed.
289 | 
290 | Must be called with *LOCK* held."
291 |   (declare (type operation op))
292 |   (let ((channel (channel op))
293 | 	(direction (direction op)))
294 |     (or (not (jpl-queues:empty? (operation-queue
295 | 				 channel (opposite-direction direction))))
296 | 	(ecase direction
297 | 	  (send (not (jpl-queues:full? (buffer channel))))
298 | 	  (receive (not (jpl-queues:empty? (buffer channel))))))))
299 | 
300 | (defun execute-operation (op)
301 |   "Executes the given OPERATION.  It must be ready (per
302 | OPERATION-READY?).
303 | 
304 | Must be called with *LOCK* held."
305 |   (declare (type operation op))
306 |   (assert (operation-ready? op))
307 |   ;; Find an OPERATION waiting on the same CHANNEL for communication
308 |   ;; in the opposite direction that we can exchange data with.
309 |   (let ((opposite-ops (operation-queue (channel op)
310 | 				       (opposite-direction (direction op)))))
311 |     (cond ((not (jpl-queues:empty? opposite-ops))
312 |            (let ((other-op (jpl-queues:dequeue opposite-ops)))
313 |              (ecase (direction op)
314 |                (receive (enqueue/dequeue-channel-from-op-to-op other-op op))
315 |                (send (enqueue/dequeue-channel-from-op-to-op op other-op)))
316 | 	     ;; This needs to be done immediately, not in
317 | 	     ;; ALTERNATION-WAIT; another thread could jump in when
318 | 	     ;; *LOCK* is released, see these queued OPERATIONs, and
319 | 	     ;; try to execute them.  Oops!
320 | 	     (map nil #'dequeue-operation-with-channel
321 | 		  (operations (alternation other-op)))
322 | 	     (setf (selected (alternation other-op)) other-op)
323 |              (bt:condition-notify (selection-cv (alternation other-op)))))
324 | 	  ;; If there's no waiting opposite OPERATION, then the queue
325 | 	  ;; must be buffered.  Go ahead and enqueue/dequeue from that
326 | 	  ;; buffer.
327 |           (t (ecase (direction op)
328 |                (receive (dequeue-channel-for-operation op))
329 |                (send (enqueue-channel-for-operation op)))))))
330 | 
331 | (defun enqueue/dequeue-channel-from-op-to-op (sending-op receiving-op)
332 |   "Given SENDING-OP (an OPERATION interested in sending to a channel),
333 | and RECEIVING-OP (an OPERATION interested in receiving from the same
334 | channel), enqueues SENDING-OP's object and dequeues an object for
335 | RECEIVING-OP, at the same time.
336 | 
337 | Must be called with *LOCK* held."
338 |   (declare (type operation sending-op receiving-op))
339 |   (assert (eq 'send (direction sending-op)))
340 |   (assert (eq 'receive (direction receiving-op)))
341 |   (assert (eq (channel sending-op) (channel receiving-op)))
342 |   (let ((channel (channel sending-op)))
343 |     (cond ((jpl-queues:empty? (buffer channel))
344 | 	   ;; Since the CHANNEL has no queued objects, it is safe to
345 | 	   ;; copy directly.
346 | 	   (operation-transfer sending-op receiving-op))
347 | 	  (t
348 | 	   ;; The CHANNEL has buffered objects.  If we copy directly,
349 | 	   ;; SENDING-OP's object will be cutting in front of the
350 | 	   ;; older, buffered objects.  To ensure fair order,
351 | 	   ;; enqueue/dequeue separately.
352 | 	   
353 | 	   ;; Dequeue before enqueuing, in-case the buffer is full, in
354 | 	   ;; order to make room first.
355 | 	   (dequeue-channel-for-operation receiving-op)
356 | 	   (enqueue-channel-for-operation sending-op)))))
357 | 
358 | (defun operation-transfer (sending-op receiving-op)
359 |   "Transfers one object from SENDING-OP to RECEIVING-OP.
360 | 
361 | SENDING-OP must be interested in sending, and RECEIVING-OP in
362 | receiving.  They must be interested in the same channel, and the
363 | channel's BUFFER must be empty.
364 | 
365 | Must be called with *LOCK* held."
366 |   (declare (type operation sending-op receiving-op))
367 |   (assert (eq 'send (direction sending-op)))
368 |   (assert (eq 'receive (direction receiving-op)))
369 |   (assert (eq (channel sending-op) (channel receiving-op)))
370 |   (assert (jpl-queues:empty? (buffer (channel sending-op))))
371 |   (setf (value receiving-op) (value sending-op)))
372 | 
373 | (defun dequeue-channel-for-operation (receiving-op)
374 |   "Dequeues the oldest object from the the BUFFER of the CHANNEL that
375 | RECEIVING-OP is interested in receiving from, storing it in
376 | RECEIVING-OP.
377 | 
378 | RECEIVING-OP must be interested in receiving.  The CHANNEL must have
379 | at least one object in its BUFFER.
380 | 
381 | Must be called with *LOCK* held."
382 |   (declare (type operation receiving-op))
383 |   (assert (eq 'receive (direction receiving-op)))
384 |   (let ((buffer (buffer (channel receiving-op))))
385 |     (assert (not (jpl-queues:empty? buffer)))
386 |     (setf (value receiving-op) (jpl-queues:dequeue buffer))))
387 | 
388 | (defun enqueue-channel-for-operation (sending-op)
389 |   "Enqueues the object stored in SENDING-OP to the BUFFER of the
390 | CHANNEL that SENDING-OP is interested in sending to.
391 | 
392 | SENDING-OP must be interested in sending.  The CHANNEL must have room
393 | in its BUFFER for at least one object.
394 | 
395 | Must be called with *LOCK* held."
396 |   (declare (type operation sending-op))
397 |   (assert (eq 'send (direction sending-op)))
398 |   (let ((buffer (buffer (channel sending-op))))
399 |     (assert (not (jpl-queues:full? buffer)))
400 |     (jpl-queues:enqueue (value sending-op) buffer)))
401 | 


--------------------------------------------------------------------------------
/doc/doc.txt:
--------------------------------------------------------------------------------
  1 | Calispel
  2 | 
  3 | J.P. Larocque
  4 | 
  5 | ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
  6 | 
  7 | Table of Contents
  8 | 
  9 | 1. Introduction
 10 | 
 11 |     1.1. Obtaining Calispel
 12 |     1.2. Copying
 13 |     1.3. Contact Information
 14 | 
 15 | 2. Examples
 16 | 3. Reference
 17 | 
 18 |     3.1. The CHANNEL Class
 19 |     3.2. ? and !: Basic I/O Functions
 20 |     3.3. PRI-ALT and FAIR-ALT: Alternation Among Several Operations
 21 |     3.4. Dynamic Alternation
 22 | 
 23 | 1. Introduction
 24 | 
 25 | Calispel is a Common Lisp library for thread-safe message-passing channels, in
 26 | the style of the occam programming language.
 27 | 
 28 | Calispel channels let one thread communicate with another, facilitating
 29 | unidirectional communication of any Lisp object. Channels may be unbuffered,
 30 | where a sender waits for a receiver (or vice versa) before either operation can
 31 | continue, or channels may be buffered with flexible policy options.
 32 | 
 33 | Because sending and receiving on a channel may block, either operation can time
 34 | out after a specified amount of time.
 35 | 
 36 | A syntax for alternation is provided (like ALT in occam, or Unix select()):
 37 | given a sequence of operations, any or all of which may block, alternation
 38 | selects the first operation that doesn't block and executes associated code.
 39 | Alternation can also time out, executing an "otherwise" clause if no operation
 40 | becomes available within a set amount of time.
 41 | 
 42 | Many CSP- and occam-style channel libraries offer features like parallel
 43 | execution (i.e. occam PAR). Calispel is a message-passing library, and as such
 44 | leaves the role of threading abstractions and utilities left to be filled by
 45 | perfectly good, complementary libraries such as Bordeaux-Threads and Eager
 46 | Future.
 47 | 
 48 | 1.1. Obtaining Calispel
 49 | 
 50 | The latest version of Calispel, with accompanying documentation, can be found
 51 | at: http://www.thoughtcrime.us/software/calispel/
 52 | 
 53 | The most recent release is 0.1, released 2009-10-19. It depends on: jpl-queues
 54 | 0.1, cl-jpl-util 0.2, Eager Future 0.1, Bordeaux Threads
 55 | 
 56 |   ● calispel-0.1.tar.gz: ASDF package
 57 |   ● calispel-0.1.tar.gz.sign: OpenPGP detached signature
 58 | 
 59 | I sign all my software with OpenPGP, key ID 0x80555CED7394F948, fingerprint
 60 | 2771 AF53 5D09 BDFB A8D0 BEF3 8055 5CED 7394 F948.
 61 | 
 62 | 1.2. Copying
 63 | 
 64 | The software and this document are licensed under permissive, BSD-like terms,
 65 | copied from the ISC license:
 66 | 
 67 |     Copyright © 2009, Jean-Paul Guy Larocque
 68 | 
 69 |     Permission to use, copy, modify, and/or distribute this software for any
 70 |     purpose with or without fee is hereby granted, provided that the above
 71 |     copyright notice and this permission notice appear in all copies.
 72 | 
 73 |     THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 74 |     WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 75 |     MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
 76 |     SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 77 |     WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 78 |     ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR
 79 |     IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 80 | 
 81 | This software was directly derived from "csp.tgz", dated 2006-07-03, and
 82 | published by Roger Peppe. No copyright notice giving attribution to Roger Peppe
 83 | or any specific licensing terms seem to have been included in that version.
 84 | 
 85 | That software was derived from "channel.c" of Plan 9 libthread:
 86 | 
 87 |     Copyright © 2005 Russ Cox, Massachusetts Institute of Technology
 88 | 
 89 |     Permission is hereby granted, free of charge, to any person obtaining a
 90 |     copy of this software and associated documentation files (the "Software"),
 91 |     to deal in the Software without restriction, including without limitation
 92 |     the rights to use, copy, modify, merge, publish, distribute, sublicense,
 93 |     and/or sell copies of the Software, and to permit persons to whom the
 94 |     Software is furnished to do so, subject to the following conditions:
 95 | 
 96 |     The above copyright notice and this permission notice shall be included in
 97 |     all copies or substantial portions of the Software.
 98 | 
 99 |     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
100 |     IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
101 |     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
102 |     AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
103 |     LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
104 |     FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
105 |     DEALINGS IN THE SOFTWARE.
106 | 
107 | That software contains parts derived from an earlier library by Rob Pike, Sape
108 | Mullender, and Russ Cox:
109 | 
110 |     Copyright © 2003 by Lucent Technologies.
111 | 
112 |     Permission to use, copy, modify, and distribute this software for any
113 |     purpose without fee is hereby granted, provided that this entire notice is
114 |     included in all copies of any software which is or includes a copy or
115 |     modification of this software and in all copies of the supporting
116 |     documentation for such software.
117 | 
118 |     THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
119 |     WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT TECHNOLOGIES MAKE
120 |     ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
121 |     OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
122 | 
123 | 1.3. Contact Information
124 | 
125 | The author welcomes feedback, questions, help requests, and bug reports via
126 | e-mail: J.P. Larocque <jpl-software at thoughtcrime.us>
127 | 
128 | 2. Examples
129 | 
130 | Create a channel with no buffering:
131 | 
132 | (defparameter *chan*
133 |   (make-instance 'calispel:channel))
134 | 
135 | In another thread, sleep for 1 second, then send the number 42 to the channel.
136 | In the current thread, receive from the channel. At first, there will be no
137 | value available, so ? will wait until the other thread sends the value.
138 | 
139 | (progn
140 |   (eager-future:pexec
141 |     (sleep 1)
142 |     (calispel:! *chan* 42))
143 |   (calispel:? *chan*))
144 | => 42
145 |    T
146 | 
147 | (42 is the value received, and T indicates that the receive was successful—it
148 | did not time out.)
149 | 
150 | Sending to the channel will also block without a waiting receiver, because
151 | channels are unbuffered by default. This will attempt to send to the channel,
152 | then time out after 2 seconds:
153 | 
154 | (calispel:! *chan* 'foo 2)
155 | => NIL
156 | 
157 | (NIL indicates that the send was not successful—it timed out.)
158 | 
159 | Create a new channel that is buffered:
160 | 
161 | (defparameter *chan*
162 |   (make-instance 'calispel:channel
163 |                  :buffer (make-instance 'jpl-queues:bounded-fifo-queue :capacity 2)))
164 | 
165 | This channel will accept up to two values that have not yet been received
166 | before sends will block:
167 | 
168 | (loop for i from 1
169 |       while (calispel:! *chan* i 0)
170 |       finally (format t "~&Stopped before ~:R value.~&" i))
171 | >> Stopped before third value.
172 | 
173 | Now let's print them back out:
174 | 
175 | (loop
176 |   (multiple-value-bind (value success?)
177 |       (calispel:? *chan* 0)
178 |     (when success?
179 |       (format t "~&Value: ~S~&" value))
180 |     (unless success?
181 |       (return))))
182 | >> Value: 1
183 | Value: 2
184 | 
185 | Suppose that we have many channels that we're interested in receiving from or
186 | sending to. We can use alternation to select the first operation that is
187 | available, and then perform some action associated with the operation:
188 | 
189 | (let ((chan1 (make-instance 'calispel:channel)) ; chan1 goes unused
190 |       (chan2 (make-instance 'calispel:channel)))
191 |   (eager-future:pexec
192 |     (calispel:! chan2 42))
193 |   (calispel:pri-alt
194 |     ((calispel:? chan1)
195 |      ;; Nothing is sent to CHAN1, so it can't be ready.
196 |      (format t "~&Got a value from CHAN1, but that should never happen.~&"))
197 |     ((calispel:? chan2 value)
198 |      ;; CHAN2 has either had something sent to it, or it soon will,
199 |      ;; so this will execute.
200 |      (format t "~&Got value from CHAN2: ~S~&" value))))
201 | >> Got value from CHAN2: 42
202 | 
203 | What if there's more than one operation that is immediately possible? PRI-ALT
204 | chooses the first one available...
205 | 
206 | (let ((chan1 (make-instance 'calispel:channel))
207 |       (chan2 (make-instance 'calispel:channel)))
208 |   (eager-future:pexec
209 |     (calispel:! chan1 'foo))
210 |   (eager-future:pexec
211 |     (calispel:! chan2 'bar))
212 |   (sleep 1) ; Wait for both CHAN1 and CHAN2 to become ready.
213 |   (calispel:pri-alt
214 |     ((calispel:? chan1 value)
215 |      (format t "~&Got value from CHAN1: ~S~&" value))
216 |     ((calispel:? chan2 value)
217 |      (format t "~&Got value from CHAN2: ~S~&" value))))
218 | >> Got value from CHAN1: FOO
219 | 
220 | ...whereas FAIR-ALT chooses any of the available operations:
221 | 
222 | (let ((chan1 (make-instance 'calispel:channel))
223 |       (chan2 (make-instance 'calispel:channel)))
224 |   (eager-future:pexec
225 |     (calispel:! chan1 'foo))
226 |   (eager-future:pexec
227 |     (calispel:! chan2 'bar))
228 |   (sleep 1) ; Wait for both CHAN1 and CHAN2 to become ready.
229 |   (calispel:fair-alt
230 |     ((calispel:? chan1 value)
231 |      (format t "~&Got value from CHAN1: ~S~&" value))
232 |     ((calispel:? chan2 value)
233 |      (format t "~&Got value from CHAN2: ~S~&" value))))
234 | >> Got value from CHAN1: FOO
235 | (or, determined randomly)
236 | >> Got value from CHAN2: BAR
237 | 
238 | Just like ? and !, PRI-ALT and FAIR-ALT allow time outs to be specified. An
239 | OTHERWISE clause is executed if no operation can be immediately performed,
240 | effectively putting a time out of 0 on all the operations:
241 | 
242 | (let ((chan1 (make-instance 'calispel:channel))
243 |       (chan2 (make-instance 'calispel:channel)))
244 |   (eager-future:pexec
245 |     (sleep 1)
246 |     (calispel:! chan1 'foo))
247 |   (calispel:pri-alt
248 |     ((calispel:? chan1 value)
249 |      (format t "~&Got value from CHAN1: ~S~&" value))
250 |     ((calispel:? chan2 value)
251 |      (format t "~&Got value from CHAN2: ~S~&" value))
252 |     (otherwise (format t "~&Timed-out.~&"))))
253 | >> Timed-out.
254 | 
255 | You can also wait up to a certain amount of time before executing the OTHERWISE
256 | clause:
257 | 
258 | (let ((chan1 (make-instance 'calispel:channel))
259 |       (chan2 (make-instance 'calispel:channel)))
260 |   (eager-future:pexec
261 |     (sleep 1)
262 |     (calispel:! chan1 'foo))
263 |   (calispel:pri-alt
264 |     ((calispel:? chan1 value)
265 |      (format t "~&Got value from CHAN1: ~S~&" value))
266 |     ((calispel:? chan2 value)
267 |      (format t "~&Got value from CHAN2: ~S~&" value))
268 |     ((otherwise :timeout 5)
269 |      (format t "~&Timed-out.~&"))))
270 | >> Got value from CHAN1: FOO
271 | 
272 | (Try increasing the SLEEP delay to 6 to see that the PRI-ALT will still time
273 | out.)
274 | 
275 | 3. Reference
276 | 
277 | 3.1. The CHANNEL Class
278 | 
279 | Syntax. 
280 | 
281 | (MAKE-INSTANCE 'CHANNEL &key BUFFER)
282 | => (A CHANNEL instance.)
283 | 
284 | A channel is a medium that communicates messages from one thread to another.
285 | 
286 | All channels have a buffer. The default buffer doesn't do anything—it's always
287 | full and always empty. It has no storage.
288 | 
289 | BUFFER specifies the jpl-queues queue to buffer messages with.
290 | 
291 | Sending to a channel blocks when there is no other thread waiting to receive
292 | from it and there is no room in the buffer (i.e. JPL-QUEUES:FULL? returns
293 | true). Receiving from a channel blocks when there is no other thread waiting to
294 | send to it and there are no objects in the buffer (i.e. JPL-QUEUES:EMPTY?
295 | returns true).
296 | 
297 | To improve throughput with better parallelism, a meaningful buffer is
298 | recommended so that threads can perform useful work instead of waiting on other
299 | threads. Any jpl-queues queue may be used, but note:
300 | 
301 |   ● The queue need not be "synchronized" (an instance of
302 |     JPL-QUEUES:SYNCHRONIZED-QUEUE): Calispel has its own synchronization, so
303 |     external synchronization will only add overhead.
304 |   ● The queue may not be shared with any other channels or be used for anything
305 |     else, even if it's "synchronized." (Pedantic exception: if the queue
306 |     strictly has no state, then it doesn't matter if it's shared. The default
307 |     "null" queue has no state, and it is shared.)
308 | 
309 | 3.2. ? and !: Basic I/O Functions
310 | 
311 | Syntax. 
312 | 
313 | (? CHANNEL &optional TIMEOUT)
314 | => VALUE
315 |    RECEIVED-OK?
316 | 
317 | (! CHANNEL VALUE &optional TIMEOUT)
318 | => SENT-OK?
319 | 
320 | ? receives a value from CHANNEL, waiting up to TIMEOUT seconds (a non-negative
321 | REAL number; or indefinitely if unspecified or NIL). If a value can be received
322 | before the time out, the value and T (indicating success) are returned.
323 | Otherwise, NIL and NIL (indicating failure) are returned.
324 | 
325 | ! sends VALUE to CHANNEL, waiting up to TIMEOUT seconds (a non-negative REAL
326 | number; or indefinitely if unspecified or NIL). If the value can be sent before
327 | the time out, T (indicating success) is returned. Otherwise, NIL (indicating
328 | failure) is returned.
329 | 
330 | 3.3. PRI-ALT and FAIR-ALT: Alternation Among Several Operations
331 | 
332 | Syntax. 
333 | 
334 | (PRI-ALT operation-clause* [otherwise-clause])
335 | (FAIR-ALT operation-clause* [otherwise-clause])
336 | => (For either macro: the result of the final evaluated form,
337 |     or no values if no clause was executed.)
338 | 
339 | operation-clause ::= (operation form*)
340 | otherwise-clause ::= ({otherwise | (otherwise [:timeout timeout])} form*)
341 | operation        ::= (? channel [lambda-list [condition]]) ; receive
342 |                    | (! channel value [condition])         ; send
343 | 
344 | Performs one of the given channel operations, choosing one from the set of
345 | operations that first becomes available, then evaluates each of the forms
346 | associated with the selected operation. If no operation can immediately be
347 | made, waits until an operation is available (optionally up to a given timeout).
348 | 
349 | When there are multiple operations that can be immediately carried-out, PRI-ALT
350 | selects the first one listed, whereas FAIR-ALT chooses one at random.
351 | 
352 | channel
353 | 
354 |     Evaluated to produce a CHANNEL to send to or receive from. The channel
355 |     forms associated with operations that do not pass the condition are not
356 |     evaluated.
357 | 
358 | lambda-list
359 | 
360 |     Either a symbol naming a variable to be bound to the value received from
361 |     the channel, or a destructuring lambda list^[1] naming a set of variables
362 |     to be bound to the destructured value received from the channel. The
363 |     bindings are visible to the associated forms. If the value cannot be
364 |     destructured according to the lambda list, an error is signalled. Note that
365 |     multiple receive clauses for the same channel with different destructuring
366 |     lambda-lists cannot be used for pattern matching.
367 | 
368 | value
369 | 
370 |     An expression whose primary value is used as the message to send to the
371 |     channel. All value expressions are evaluated before selecting an operation,
372 |     except for those associated with operations that do not pass the condition.
373 | 
374 | condition
375 | 
376 |     Evaluated to produce a generalized boolean indicating whether the
377 |     associated operation-clause should receive further consideration. When
378 |     condition is not given or its resulting value is true, the associated
379 |     operation is kept for consideration. When the resulting value is false, the
380 |     operation is removed from consideration (as if its associated channel never
381 |     becomes ready for sending/receiving).
382 | 
383 | form
384 | 
385 |     Evaluated in sequence when the associated clause is executed. The values of
386 |     the evaluation of the last form of the effective clause become the result
387 |     of the macro.
388 | 
389 | timeout
390 | 
391 |     Evaluated to produce the duration, as a non-negative REAL number of
392 |     seconds, to wait for an effective operation to become available before
393 |     resorting to the otherwise-clause. The result may also be NIL to specify no
394 |     time out. When an otherwise-clause exists, the default time out is 0,
395 |     meaning that if none of the channels in the operation-clauses are
396 |     immediately available, the otherwise-clause forms are executed immediately.
397 |     When there is no otherwise-clause, the default time out is NIL.
398 | 
399 | It is useful to specify a timeout expression that conditionally evaluates to
400 | NIL, in order to disable the time out and inhibit the execution of the
401 | otherwise-clause (provided that there are channel operations to wait for that
402 | haven't been excluded by false conditions).
403 | 
404 | If there are no effective operations (because all the conditions evaluated to
405 | false, or because no operations were specified), then the otherwise-clause (if
406 | any) is executed immediately (even if the specified time out is NIL).
407 | 
408 | Stylistically and for future compatibility, avoid side-effects in channel,
409 | value, condition, and timeout expressions.
410 | 
411 | 3.4. Dynamic Alternation
412 | 
413 | It is possible to dynamically construct a set of operations to alternate upon.
414 | 
415 | The general procedure is to instantiate OPERATION for each kind of operation
416 | you wish to perform. For sending operations, you will need to give the value to
417 | send with :VALUE. Pass the OPERATION instances, as a list, to
418 | OPERATION-ALTERNATE. OPERATION-ALTERNATE will either immediately execute one of
419 | the OPERATION instances, or block until another thread executes an operation
420 | which allows one of the given operations to execute. The selected operation,
421 | after having been executed, is returned. If the selected operation was a
422 | receive operation, the value received will available with the VALUE accessor.
423 | 
424 | Please see the documentation in the source code for OPERATION-ALTERNATE and the
425 | OPERATION class.
426 | 
427 | 
428 | ━━━━━━━━━━━━━━
429 | 
430 | ^[1] See: Common Lisp HyperSpec, sec. 3.4.5 Destructuring Lambda Lists
431 | 
432 | 


--------------------------------------------------------------------------------
/doc/doc.xml:
--------------------------------------------------------------------------------
  1 | <?xml version="1.0"?>
  2 | <!DOCTYPE article PUBLIC "-//OASIS//DTD DocBook XML V4.5//EN"
  3 |           "http://www.oasis-open.org/docbook/xml/4.5/docbookx.dtd">
  4 | <article>
  5 |   <artheader id="top">
  6 |     <title>Calispel</title>
  7 |     <author><firstname>J.P.</firstname> <surname>Larocque</surname></author>
  8 |   </artheader>
  9 |   
 10 |   <section id="sec-intro">
 11 |     <title>Introduction</title>
 12 |     
 13 |     <para>Calispel is a Common Lisp library for thread-safe
 14 |       message-passing channels, in the style of the occam programming
 15 |       language.</para>
 16 |     
 17 |     <para>Calispel channels let one thread communicate with another,
 18 |       facilitating unidirectional communication of any Lisp object.
 19 |       Channels may be unbuffered, where a sender waits for a receiver
 20 |       (or vice versa) before either operation can continue, or
 21 |       channels may be buffered with flexible policy options.</para>
 22 |     
 23 |     <para>Because sending and receiving on a channel may block, either
 24 |       operation can time out after a specified amount of time.</para>
 25 |     
 26 |     <para>A syntax for alternation is provided (like <code>ALT</code>
 27 |       in occam, or Unix <code>select()</code>): given a sequence of
 28 |       operations, any or all of which may block, alternation selects
 29 |       the first operation that doesn't block and executes associated
 30 |       code.  Alternation can also time out, executing an "otherwise"
 31 |       clause if no operation becomes available within a set amount of
 32 |       time.</para>
 33 |     
 34 |     <para>Many CSP- and occam-style channel libraries offer features
 35 |       like parallel execution (i.e. occam <code>PAR</code>).  Calispel
 36 |       is a message-passing library, and as such leaves the role of
 37 |       threading abstractions and utilities left to be filled by
 38 |       perfectly good, complementary libraries such
 39 |       as <ulink url="http://common-lisp.net/project/bordeaux-threads/">Bordeaux-Threads</ulink>
 40 |       and <ulink url="http://common-lisp.net/project/eager-future/">Eager
 41 |       Future</ulink>.</para>
 42 | 
 43 |     <section id="sec-obtaining">
 44 |       <title>Obtaining Calispel</title>
 45 |       
 46 |       <para>The latest version of Calispel, with accompanying
 47 |       documentation, can be found at:
 48 |       <ulink url="http://www.thoughtcrime.us/software/calispel/"/></para>
 49 |       
 50 |       <para>The most recent release is 0.1, released 2009-10-19.  It
 51 | 	depends on:
 52 | 	<simplelist type="inline">
 53 | 	  <member><ulink url="http://www.thoughtcrime.us/software/jpl-queues/">jpl-queues</ulink>
 54 | 	    0.1</member>
 55 | 	  <member><ulink url="http://www.thoughtcrime.us/software/cl-jpl-util/">cl-jpl-util</ulink>
 56 | 	    0.2</member>
 57 | 	  <member><ulink url="http://common-lisp.net/project/eager-future/">Eager Future</ulink>
 58 | 	    0.1</member>
 59 | 	  <member><ulink url="http://common-lisp.net/project/bordeaux-threads/">Bordeaux Threads</ulink></member>
 60 | 	</simplelist>
 61 | 	
 62 | 	<itemizedlist>
 63 | 	  <listitem><ulink url="http://www.thoughtcrime.us/software/calispel/calispel-0.1.tar.gz">calispel-0.1.tar.gz</ulink>:
 64 | 	    ASDF package</listitem>
 65 | 	  <listitem><ulink url="http://www.thoughtcrime.us/software/calispel/calispel-0.1.tar.gz.sign">calispel-0.1.tar.gz.sign</ulink>:
 66 |             OpenPGP detached signature</listitem>
 67 | 	</itemizedlist>
 68 |       </para>
 69 |     
 70 |       <para>I sign all my software with OpenPGP, key ID 0x80555CED7394F948,
 71 | 	fingerprint 2771 AF53 5D09 BDFB A8D0 BEF3 8055 5CED 7394 F948.</para>
 72 |     </section>
 73 |     
 74 |     <section id="sec-copying">
 75 |       <title>Copying</title>
 76 |       
 77 |       <para>The software and this document are licensed under
 78 | 	permissive, BSD-like terms, copied from the ISC
 79 | 	license:</para>
 80 |       
 81 |       <blockquote>
 82 | 	<para>Copyright &copy; 2009, Jean-Paul Guy Larocque</para>
 83 | 	
 84 | 	<para>Permission to use, copy, modify, and/or distribute this
 85 | 	  software for any purpose with or without fee is hereby
 86 | 	  granted, provided that the above copyright notice and this
 87 | 	  permission notice appear in all copies.</para>
 88 | 	
 89 | 	<para>THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR
 90 | 	  DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE
 91 | 	  INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
 92 | 	  FITNESS.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
 93 | 	  SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY
 94 | 	  DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
 95 | 	  PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
 96 | 	  OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH
 97 | 	  THE USE OR PERFORMANCE OF THIS SOFTWARE.</para>
 98 |       </blockquote>
 99 |       
100 |       <para>This software was directly derived from
101 | 	"<ulink url="http://www.staff.ncl.ac.uk/roger.peppe/csp.tgz">csp.tgz</ulink>",
102 | 	dated 2006-07-03, and published by Roger Peppe.  No copyright
103 | 	notice giving attribution to Roger Peppe or any specific
104 | 	licensing terms seem to have been included in that
105 | 	version.</para>
106 |       
107 |       <para>That software was derived from "channel.c" of Plan 9
108 | 	libthread:</para>
109 |       
110 |       <blockquote>
111 | 	<para>Copyright &copy; 2005 Russ Cox, Massachusetts Institute
112 | 	  of Technology</para>
113 | 	
114 | 	<para>Permission is hereby granted, free of charge, to any
115 | 	  person obtaining a copy of this software and associated
116 | 	  documentation files (the "Software"), to deal in the
117 | 	  Software without restriction, including without limitation
118 | 	  the rights to use, copy, modify, merge, publish, distribute,
119 | 	  sublicense, and/or sell copies of the Software, and to
120 | 	  permit persons to whom the Software is furnished to do so,
121 | 	  subject to the following conditions:</para>
122 | 	
123 | 	<para>The above copyright notice and this permission notice
124 | 	  shall be included in all copies or substantial portions of
125 | 	  the Software.</para>
126 | 	
127 | 	<para>THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF
128 | 	  ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO
129 | 	  THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
130 | 	  PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS
131 | 	  OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
132 | 	  OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
133 | 	  OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
134 | 	  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
135 | 	  SOFTWARE.</para>
136 |       </blockquote>
137 |       
138 |       <para>That software contains parts derived from an earlier
139 | 	library by Rob Pike, Sape Mullender, and Russ Cox:</para>
140 |       
141 |       <blockquote>
142 | 	<para>Copyright &copy; 2003 by Lucent Technologies.</para>
143 | 	
144 | 	<para>Permission to use, copy, modify, and distribute this
145 | 	  software for any purpose without fee is hereby granted,
146 | 	  provided that this entire notice is included in all copies
147 | 	  of any software which is or includes a copy or modification
148 | 	  of this software and in all copies of the supporting
149 | 	  documentation for such software.</para>
150 | 	
151 | 	<para>THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR
152 | 	  IMPLIED WARRANTY.  IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT
153 | 	  TECHNOLOGIES MAKE ANY REPRESENTATION OR WARRANTY OF ANY KIND
154 | 	  CONCERNING THE MERCHANTABILITY OF THIS SOFTWARE OR ITS FITNESS FOR
155 | 	  ANY PARTICULAR PURPOSE.</para>
156 |       </blockquote>
157 |     </section>
158 |     
159 |     <section id="sec-contact">
160 |       <title>Contact Information</title>
161 |       
162 |       <para>The author welcomes feedback, questions, help requests,
163 | 	and bug reports via e-mail: J.P. Larocque &lt;jpl-software at
164 | 	thoughtcrime.us&gt;</para>
165 |     </section>
166 |   </section>
167 |   
168 |   <section id="sec-examples">
169 |     <title>Examples</title>
170 |     
171 |     <para>Create a channel with no buffering:</para>
172 |     
173 |     <informalexample>
174 |       <programlisting>(defparameter *chan*
175 |   (make-instance 'calispel:channel))</programlisting>
176 |     </informalexample>
177 |     
178 |     <para>In another thread, sleep for 1 second, then send the number
179 |       42 to the channel.  In the current thread, receive from the
180 |       channel.  At first, there will be no value available,
181 |       so <link linkend="sec-basic_io"><function>?</function></link>
182 |       will wait until the other thread sends the value.</para>
183 |     
184 |     <informalexample>
185 |       <programlisting>(progn
186 |   (eager-future:pexec
187 |     (sleep 1)
188 |     (calispel:! *chan* 42))
189 |   (calispel:? *chan*))
190 | =&gt; 42
191 |    T</programlisting>
192 |     </informalexample>
193 |     
194 |     <para>(<literal>42</literal> is the value received,
195 |       and <literal>T</literal> indicates that the receive was
196 |       successful&mdash;it did not time out.)</para>
197 |       
198 |     <para>Sending to the channel will also block without a waiting
199 |       receiver, because channels are unbuffered by default.  This will
200 |       attempt to send to the channel, then time out after 2
201 |       seconds:</para>
202 |     
203 |     <informalexample>
204 |       <programlisting>(calispel:! *chan* 'foo 2)
205 | =&gt; NIL</programlisting>
206 |     </informalexample>
207 |     
208 |     <para>(<literal>NIL</literal> indicates that the send was not
209 |       successful&mdash;it timed out.)</para>
210 |     
211 |     <para>Create a new channel that is buffered:</para>
212 |     
213 |     <informalexample>
214 |       <programlisting>(defparameter *chan*
215 |   (make-instance 'calispel:channel
216 |                  :buffer (make-instance '<ulink url="http://www.thoughtcrime.us/software/jpl-queues/#sec-classes-bounded_fifo_queue">jpl-queues:bounded-fifo-queue</ulink> :capacity 2)))</programlisting>
217 |     </informalexample>
218 |     
219 |     <para>This channel will accept up to two values that have not yet
220 |       been received before sends will block:</para>
221 |     
222 |     <informalexample>
223 |       <programlisting>(loop for i from 1
224 |       while (calispel:! *chan* i 0)
225 |       finally (format t "~&amp;Stopped before ~:R value.~&amp;" i))
226 | &gt;&gt; Stopped before third value.</programlisting>
227 |     </informalexample>
228 |     
229 |     <para>Now let's print them back out:</para>
230 |     
231 |     <informalexample>
232 |       <programlisting>(loop
233 |   (multiple-value-bind (value success?)
234 |       (calispel:? *chan* 0)
235 |     (when success?
236 |       (format t "~&amp;Value: ~S~&amp;" value))
237 |     (unless success?
238 |       (return))))
239 | &gt;&gt; Value: 1
240 | Value: 2</programlisting>
241 |     </informalexample>
242 |     
243 |     <para>Suppose that we have many channels that we're interested in
244 |       receiving from or sending to.  We can
245 |       use <link linkend="sec-alt_macros">alternation</link> to select
246 |       the first operation that is available, and then perform some
247 |       action associated with the operation:</para>
248 |     
249 |     <informalexample>
250 |       <programlisting>(let ((chan1 (make-instance 'calispel:channel)) ; chan1 goes unused
251 |       (chan2 (make-instance 'calispel:channel)))
252 |   (eager-future:pexec
253 |     (calispel:! chan2 42))
254 |   (calispel:pri-alt
255 |     ((calispel:? chan1)
256 |      ;; Nothing is sent to CHAN1, so it can't be ready.
257 |      (format t "~&amp;Got a value from CHAN1, but that should never happen.~&amp;"))
258 |     ((calispel:? chan2 value)
259 |      ;; CHAN2 has either had something sent to it, or it soon will,
260 |      ;; so this will execute.
261 |      (format t "~&amp;Got value from CHAN2: ~S~&amp;" value))))
262 | &gt;&gt; Got value from CHAN2: 42</programlisting>
263 |     </informalexample>
264 |     
265 |     <para>What if there's more than one operation that is immediately
266 |       possible?  <link linkend="sec-alt_macros"><function>PRI-ALT</function></link>
267 |       chooses the first one available...</para>
268 |     
269 |     <informalexample>
270 |       <programlisting>(let ((chan1 (make-instance 'calispel:channel))
271 |       (chan2 (make-instance 'calispel:channel)))
272 |   (eager-future:pexec
273 |     (calispel:! chan1 'foo))
274 |   (eager-future:pexec
275 |     (calispel:! chan2 'bar))
276 |   (sleep 1) ; Wait for both CHAN1 and CHAN2 to become ready.
277 |   (calispel:pri-alt
278 |     ((calispel:? chan1 value)
279 |      (format t "~&amp;Got value from CHAN1: ~S~&amp;" value))
280 |     ((calispel:? chan2 value)
281 |      (format t "~&amp;Got value from CHAN2: ~S~&amp;" value))))
282 | &gt;&gt; Got value from CHAN1: FOO</programlisting>
283 |     </informalexample>
284 |     
285 |     <para>...whereas <link linkend="sec-alt_macros"><function>FAIR-ALT</function></link>
286 |       chooses any of the available operations:</para>
287 |     
288 |     <informalexample>
289 |       <programlisting>(let ((chan1 (make-instance 'calispel:channel))
290 |       (chan2 (make-instance 'calispel:channel)))
291 |   (eager-future:pexec
292 |     (calispel:! chan1 'foo))
293 |   (eager-future:pexec
294 |     (calispel:! chan2 'bar))
295 |   (sleep 1) ; Wait for both CHAN1 and CHAN2 to become ready.
296 |   (calispel:fair-alt
297 |     ((calispel:? chan1 value)
298 |      (format t "~&amp;Got value from CHAN1: ~S~&amp;" value))
299 |     ((calispel:? chan2 value)
300 |      (format t "~&amp;Got value from CHAN2: ~S~&amp;" value))))
301 | &gt;&gt; Got value from CHAN1: FOO
302 | <emphasis>(or, determined randomly)</emphasis>
303 | &gt;&gt; Got value from CHAN2: BAR</programlisting>
304 |     </informalexample>
305 |     
306 |     <para>Just
307 |       like <link linkend="sec-basic_io"><function>?</function>
308 |       and <function>!</function></link>, <function>PRI-ALT</function>
309 |       and <function>FAIR-ALT</function> allow time outs to be
310 |       specified.  An <code>OTHERWISE</code> clause is executed if no
311 |       operation can be immediately performed, effectively putting a
312 |       time out of 0 on all the operations:</para>
313 |     
314 |     <informalexample>
315 |       <programlisting>(let ((chan1 (make-instance 'calispel:channel))
316 |       (chan2 (make-instance 'calispel:channel)))
317 |   (eager-future:pexec
318 |     (sleep 1)
319 |     (calispel:! chan1 'foo))
320 |   (calispel:pri-alt
321 |     ((calispel:? chan1 value)
322 |      (format t "~&amp;Got value from CHAN1: ~S~&amp;" value))
323 |     ((calispel:? chan2 value)
324 |      (format t "~&amp;Got value from CHAN2: ~S~&amp;" value))
325 |     (otherwise (format t "~&amp;Timed-out.~&amp;"))))
326 | &gt;&gt; Timed-out.</programlisting>
327 |       </informalexample>
328 |     
329 |     <para>You can also wait up to a certain amount of time before
330 |       executing the <code>OTHERWISE</code> clause:</para>
331 |     
332 |     <informalexample>
333 |       <programlisting>(let ((chan1 (make-instance 'calispel:channel))
334 |       (chan2 (make-instance 'calispel:channel)))
335 |   (eager-future:pexec
336 |     (sleep 1)
337 |     (calispel:! chan1 'foo))
338 |   (calispel:pri-alt
339 |     ((calispel:? chan1 value)
340 |      (format t "~&amp;Got value from CHAN1: ~S~&amp;" value))
341 |     ((calispel:? chan2 value)
342 |      (format t "~&amp;Got value from CHAN2: ~S~&amp;" value))
343 |     ((otherwise :timeout 5)
344 |      (format t "~&amp;Timed-out.~&amp;"))))
345 | &gt;&gt; Got value from CHAN1: FOO</programlisting>
346 |     </informalexample>
347 |     
348 |     <para>(Try increasing the <function>SLEEP</function> delay to 6
349 |       to see that the <function>PRI-ALT</function> will still time
350 |       out.)</para>
351 |   </section>
352 |   
353 |   <section id="sec-reference">
354 |     <title>Reference</title>
355 |     
356 |     <section id="sec-channel">
357 |       <title>The <type>CHANNEL</type> Class</title>
358 |       
359 |       <formalpara>
360 | 	<title>Syntax</title>
361 | 	
362 | 	<synopsis>(<function>MAKE-INSTANCE</function> <literal>'CHANNEL</literal> &amp;key <varname>BUFFER</varname>)
363 | =&gt; <emphasis>(A <type>CHANNEL</type> instance.)</emphasis></synopsis>
364 |       </formalpara>
365 |       
366 |       <para>A channel is a medium that communicates messages from one
367 | 	thread to another.</para>
368 |       
369 |       <para>All channels have a buffer.  The default buffer doesn't do
370 | 	anything&mdash;it's always full and always empty.  It has no
371 | 	storage.</para>
372 |       
373 |       <para><code>BUFFER</code> specifies
374 | 	the <ulink url="http://www.thoughtcrime.us/software/jpl-queues/#sec-classes">jpl-queues
375 | 	  queue</ulink> to buffer messages with.</para>
376 |       
377 |       <para>Sending to a channel blocks when there is no other thread
378 | 	waiting to receive from it and there is no room in the buffer
379 | 	(i.e. <ulink url="http://www.thoughtcrime.us/software/jpl-queues/#sec-api-full"><function>JPL-QUEUES:FULL?</function></ulink>
380 | 	returns true).  Receiving from a channel blocks when there is
381 | 	no other thread waiting to send to it and there are no objects
382 | 	in the buffer
383 | 	(i.e. <ulink url="http://www.thoughtcrime.us/software/jpl-queues/#sec-api-empty"><function>JPL-QUEUES:EMPTY?</function></ulink>
384 | 	returns true).</para>
385 |       
386 |       <para>To improve throughput with better parallelism, a
387 | 	meaningful buffer is recommended so that threads can perform
388 | 	useful work instead of waiting on other threads.
389 | 	Any jpl-queues queue may be used, but
390 | 	note:</para>
391 |       
392 |       <itemizedlist>
393 | 	<listitem>The queue need not be "synchronized" (an instance
394 | 	  of <type>JPL-QUEUES:SYNCHRONIZED-QUEUE</type>): Calispel has
395 | 	  its own synchronization, so external synchronization will only
396 | 	  add overhead.</listitem>
397 | 	
398 | 	<listitem>The queue may not be shared with any other channels
399 | 	  or be used for anything else, even if it's "synchronized."
400 | 	  (Pedantic exception: if the queue strictly has no state,
401 | 	  then it doesn't matter if it's shared.  The default "null"
402 | 	  queue has no state, and it is shared.)</listitem>
403 |       </itemizedlist>
404 |     </section>
405 |     
406 |     <section id="sec-basic_io">
407 |       <title><function>?</function> and <function>!</function>:
408 | 	Basic I/O Functions</title>
409 |       
410 |       <formalpara>
411 | 	<title>Syntax</title>
412 | 	
413 | 	<synopsis>(<function>?</function> <varname>CHANNEL</varname> &amp;optional <varname>TIMEOUT</varname>)
414 | =&gt; <varname>VALUE</varname>
415 |    <varname>RECEIVED-OK?</varname></synopsis>
416 | 
417 | 	<synopsis>(<function>!</function> <varname>CHANNEL</varname> <varname>VALUE</varname> &amp;optional <varname>TIMEOUT</varname>)
418 | =&gt; <varname>SENT-OK?</varname></synopsis>
419 |       </formalpara>
420 |       
421 |       <para><function>?</function> receives a value
422 | 	from <varname>CHANNEL</varname>, waiting up
423 | 	to <varname>TIMEOUT</varname> seconds (a
424 | 	non-negative <ulink url="http://www.lispworks.com/documentation/HyperSpec/Body/t_real.htm#real"><type>REAL</type></ulink>
425 | 	number; or indefinitely if unspecified
426 | 	or <literal>NIL</literal>).  If a value can be received before
427 | 	the time out, the value and <literal>T</literal> (indicating
428 | 	success) are returned.  Otherwise, <literal>NIL</literal>
429 | 	and <literal>NIL</literal> (indicating failure) are
430 | 	returned.</para>
431 | 	
432 |       <para><function>!</function> sends <varname>VALUE</varname>
433 | 	to <varname>CHANNEL</varname>, waiting up
434 | 	to <varname>TIMEOUT</varname> seconds (a
435 | 	non-negative <ulink url="http://www.lispworks.com/documentation/HyperSpec/Body/t_real.htm#real"><type>REAL</type></ulink>
436 | 	number; or indefinitely if unspecified
437 | 	or <literal>NIL</literal>).  If the value can be sent before
438 | 	the time out, <literal>T</literal> (indicating success) is
439 | 	returned.  Otherwise, <literal>NIL</literal> (indicating
440 | 	failure) is returned.</para>
441 |     </section>
442 |     
443 |     <section id="sec-alt_macros">
444 |       <title><function>PRI-ALT</function>
445 | 	and <function>FAIR-ALT</function>: Alternation Among Several
446 | 	Operations</title>
447 |       
448 |       <formalpara>
449 | 	<title>Syntax</title>
450 | 	
451 | 	<synopsis>(<function>PRI-ALT</function> operation-clause* [otherwise-clause])
452 | (<function>FAIR-ALT</function> operation-clause* [otherwise-clause])
453 | =&gt; <emphasis>(For either macro: the result of the final evaluated <varname>form</varname>,
454 |     or no values if no clause was executed.)</emphasis>
455 | 
456 | operation-clause ::= (operation <varname>form</varname>*)
457 | otherwise-clause ::= ({otherwise | (otherwise [:timeout <varname>timeout</varname>])} <varname>form</varname>*)
458 | operation        ::= (? <varname>channel</varname> [<varname>lambda-list</varname> [<varname>condition</varname>]]) ; receive
459 |                    | (! <varname>channel</varname> <varname>value</varname> [<varname>condition</varname>])         ; send</synopsis>
460 |       </formalpara>
461 | 
462 |       <para>Performs one of the given channel operations, choosing one
463 | 	from the set of operations that first becomes available, then
464 | 	evaluates each of the forms associated with the selected
465 | 	operation.  If no operation can immediately be made, waits
466 | 	until an operation is available (optionally up to a given
467 | 	<code>timeout</code>).</para>
468 |       
469 |       <para>When there are multiple operations that can be immediately
470 | 	carried-out, <function>PRI-ALT</function> selects the first
471 | 	one listed, whereas <function>FAIR-ALT</function> chooses one
472 | 	at random.</para>
473 |       
474 |       <variablelist>
475 | 	<varlistentry>
476 | 	  <term><varname>channel</varname></term>
477 | 	  <listitem>
478 | 	    <para>Evaluated to produce
479 | 	      a <link linkend="sec-channel"><type>CHANNEL</type></link>
480 | 	      to send to or receive from.  The channel forms
481 | 	      associated with operations that do not pass the
482 | 	      condition are not evaluated.</para>
483 | 	  </listitem>
484 | 	</varlistentry>
485 | 
486 | 	<varlistentry>
487 | 	  <term><varname>lambda-list</varname></term>
488 | 	  <listitem>
489 | 	    <para>Either a symbol naming a variable to be bound to the
490 | 	      value received from the channel, or a destructuring lambda
491 | 	      list<footnote id="destructuring_lambda_list">
492 | 		<para>See: Common Lisp HyperSpec,
493 | 		sec. <ulink url="http://www.lispworks.com/documentation/HyperSpec/Body/03_de.htm">3.4.5
494 | 		Destructuring Lambda Lists</ulink></para>
495 | 	      </footnote> naming a set of variables to be bound to the
496 | 	      destructured value received from the channel.  The
497 | 	      bindings are visible to the associated forms.  If the
498 | 	      value cannot be destructured according to the lambda
499 | 	      list, an error is signalled.  Note that multiple receive
500 | 	      clauses for the same channel with different
501 | 	      destructuring lambda-lists <emphasis>cannot</emphasis>
502 | 	      be used for pattern matching.</para>
503 | 	  </listitem>
504 | 	</varlistentry>
505 | 	
506 | 	<varlistentry>
507 | 	  <term><varname>value</varname></term>
508 | 	  <listitem>
509 | 	    <para>An expression whose primary value is used as the
510 | 	      message to send to the channel.  All value expressions
511 | 	      are evaluated before selecting an operation, except for
512 | 	      those associated with operations that do not pass the
513 | 	      condition.</para>
514 | 	  </listitem>
515 | 	</varlistentry>
516 | 
517 | 	<varlistentry>
518 | 	  <term><varname>condition</varname></term>
519 | 	  <listitem>
520 | 	    <para>Evaluated to produce a generalized boolean
521 | 	      indicating whether the associated operation-clause
522 | 	      should receive further consideration.  When condition is
523 | 	      not given or its resulting value is true, the associated
524 | 	      operation is kept for consideration.  When the resulting
525 | 	      value is false, the operation is removed from
526 | 	      consideration (as if its associated channel never
527 | 	      becomes ready for sending/receiving).</para>
528 | 	  </listitem>
529 | 	</varlistentry>
530 | 
531 | 	<varlistentry>
532 | 	  <term><varname>form</varname></term>
533 | 	  <listitem>
534 | 	    <para>Evaluated in sequence when the associated clause is
535 | 	      executed.  The values of the evaluation of the last form
536 | 	      of the effective clause become the result of the
537 | 	      macro.</para>
538 | 	  </listitem>
539 | 	</varlistentry>
540 | 	
541 | 	<varlistentry>
542 | 	  <term><varname>timeout</varname></term>
543 | 	  <listitem>
544 | 	    <para>Evaluated to produce the duration, as a non-negative
545 | 	      <ulink url="http://www.lispworks.com/documentation/HyperSpec/Body/t_real.htm#real"><type>REAL</type></ulink>
546 | 	      number of seconds, to wait for an effective operation to
547 | 	      become available before resorting to the
548 | 	      <code>otherwise-clause</code>.  The result may also
549 | 	      be <literal>NIL</literal> to specify no time out.  When
550 | 	      an <code>otherwise-clause</code> exists, the default
551 | 	      time out is 0, meaning that if none of the channels in
552 | 	      the operation-clauses are immediately available, the
553 | 	      <code>otherwise-clause</code> forms are executed
554 | 	      immediately.  When there is
555 | 	      no <code>otherwise-clause</code>, the default time out
556 | 	      is
557 | 	      <literal>NIL</literal>.</para>
558 | 	  </listitem>
559 | 	</varlistentry>
560 |       </variablelist>
561 |       
562 |       <para>It is useful to specify a <code>timeout</code> expression that
563 | 	conditionally evaluates to <literal>NIL</literal>, in order to
564 | 	disable the time out and inhibit the execution of the
565 | 	<code>otherwise-clause</code> (provided that there are channel
566 | 	operations to wait for that haven't been excluded by false
567 | 	conditions).</para>
568 |       
569 |       <para>If there are no effective operations (because all the
570 | 	conditions evaluated to false, or because no operations were
571 | 	specified), then the <code>otherwise-clause</code> (if any) is
572 | 	executed immediately (even if the specified time out
573 | 	is <literal>NIL</literal>).</para>
574 |       
575 |       <para>Stylistically and for future compatibility, avoid
576 | 	side-effects
577 | 	in <code>channel</code>, <code>value</code>, <code>condition</code>,
578 | 	and <code>timeout</code> expressions.</para>
579 |     </section>
580 |     
581 |     <section id="sec-dynamic_alternation">
582 |       <title>Dynamic Alternation</title>
583 |       
584 |       <para>It is possible to dynamically construct a set of
585 | 	operations to alternate upon.</para>
586 |       
587 |       <para>The general procedure is to
588 | 	instantiate <type>OPERATION</type> for each kind of operation
589 | 	you wish to perform.  For sending operations, you will need to
590 | 	give the value to send with <code>:VALUE</code>.  Pass
591 | 	the <type>OPERATION</type> instances, as a list,
592 | 	to <function>OPERATION-ALTERNATE</function>.  <function>OPERATION-ALTERNATE</function>
593 | 	will either immediately execute one of
594 | 	the <type>OPERATION</type> instances, or block until another
595 | 	thread executes an operation which allows one of the given
596 | 	operations to execute.  The selected operation, after having
597 | 	been executed, is returned.  If the selected operation was a
598 | 	receive operation, the value received will available with
599 | 	the <function>VALUE</function> accessor.</para>
600 |       
601 |       <para>Please see the documentation in the source code
602 | 	for <function>OPERATION-ALTERNATE</function> and
603 | 	the <type>OPERATION</type> class.</para>
604 |     </section>
605 |   </section>
606 | </article>
607 | 


--------------------------------------------------------------------------------
/doc/doc.html:
--------------------------------------------------------------------------------
  1 | <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
  2 | <html><head><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"><title>Calispel</title><meta name="generator" content="DocBook XSL Stylesheets V1.73.2"></head><body bgcolor="white" text="black" link="#0000FF" vlink="#840084" alink="#0000FF"><div class="article" lang="en"><div class="titlepage"><div><div><h1 class="title"><a name="top"></a>Calispel</h1></div><div><div class="author"><h3 class="author"><span class="firstname">J.P.</span> <span class="surname">Larocque</span></h3></div></div></div><hr></div><div class="toc"><p><b>Table of Contents</b></p><dl><dt><span class="section"><a href="#sec-intro">1. Introduction</a></span></dt><dd><dl><dt><span class="section"><a href="#sec-obtaining">1.1. Obtaining Calispel</a></span></dt><dt><span class="section"><a href="#sec-copying">1.2. Copying</a></span></dt><dt><span class="section"><a href="#sec-contact">1.3. Contact Information</a></span></dt></dl></dd><dt><span class="section"><a href="#sec-examples">2. Examples</a></span></dt><dt><span class="section"><a href="#sec-reference">3. Reference</a></span></dt><dd><dl><dt><span class="section"><a href="#sec-channel">3.1. The <code class="type">CHANNEL</code> Class</a></span></dt><dt><span class="section"><a href="#sec-basic_io">3.2. <code class="function">?</code> and <code class="function">!</code>:
  3 | 	Basic I/O Functions</a></span></dt><dt><span class="section"><a href="#sec-alt_macros">3.3. <code class="function">PRI-ALT</code>
  4 | 	and <code class="function">FAIR-ALT</code>: Alternation Among Several
  5 | 	Operations</a></span></dt><dt><span class="section"><a href="#sec-dynamic_alternation">3.4. Dynamic Alternation</a></span></dt></dl></dd></dl></div><div class="section" lang="en"><div class="titlepage"><div><div><h2 class="title" style="clear: both"><a name="sec-intro"></a>1. Introduction</h2></div></div></div><p>Calispel is a Common Lisp library for thread-safe
  6 |       message-passing channels, in the style of the occam programming
  7 |       language.</p><p>Calispel channels let one thread communicate with another,
  8 |       facilitating unidirectional communication of any Lisp object.
  9 |       Channels may be unbuffered, where a sender waits for a receiver
 10 |       (or vice versa) before either operation can continue, or
 11 |       channels may be buffered with flexible policy options.</p><p>Because sending and receiving on a channel may block, either
 12 |       operation can time out after a specified amount of time.</p><p>A syntax for alternation is provided (like <code class="code">ALT</code>
 13 |       in occam, or Unix <code class="code">select()</code>): given a sequence of
 14 |       operations, any or all of which may block, alternation selects
 15 |       the first operation that doesn't block and executes associated
 16 |       code.  Alternation can also time out, executing an "otherwise"
 17 |       clause if no operation becomes available within a set amount of
 18 |       time.</p><p>Many CSP- and occam-style channel libraries offer features
 19 |       like parallel execution (i.e. occam <code class="code">PAR</code>).  Calispel
 20 |       is a message-passing library, and as such leaves the role of
 21 |       threading abstractions and utilities left to be filled by
 22 |       perfectly good, complementary libraries such
 23 |       as <a class="ulink" href="http://common-lisp.net/project/bordeaux-threads/" target="_top">Bordeaux-Threads</a>
 24 |       and <a class="ulink" href="http://common-lisp.net/project/eager-future/" target="_top">Eager
 25 |       Future</a>.</p><div class="section" lang="en"><div class="titlepage"><div><div><h3 class="title"><a name="sec-obtaining"></a>1.1. Obtaining Calispel</h3></div></div></div><p>The latest version of Calispel, with accompanying
 26 |       documentation, can be found at:
 27 |       <a class="ulink" href="http://www.thoughtcrime.us/software/calispel/" target="_top">http://www.thoughtcrime.us/software/calispel/</a></p><p>The most recent release is 0.1, released 2009-10-19.  It
 28 | 	depends on:
 29 | 	<span class="simplelist"><a class="ulink" href="http://www.thoughtcrime.us/software/jpl-queues/" target="_top">jpl-queues</a>
 30 | 	    0.1, <a class="ulink" href="http://www.thoughtcrime.us/software/cl-jpl-util/" target="_top">cl-jpl-util</a>
 31 | 	    0.2, <a class="ulink" href="http://common-lisp.net/project/eager-future/" target="_top">Eager Future</a>
 32 | 	    0.1, <a class="ulink" href="http://common-lisp.net/project/bordeaux-threads/" target="_top">Bordeaux Threads</a></span>
 33 | 	
 34 | 	</p><div class="itemizedlist"><ul type="disc"><li><a class="ulink" href="http://www.thoughtcrime.us/software/calispel/calispel-0.1.tar.gz" target="_top">calispel-0.1.tar.gz</a>:
 35 | 	    ASDF package</li><li><a class="ulink" href="http://www.thoughtcrime.us/software/calispel/calispel-0.1.tar.gz.sign" target="_top">calispel-0.1.tar.gz.sign</a>:
 36 |             OpenPGP detached signature</li></ul></div><p>
 37 |       </p><p>I sign all my software with OpenPGP, key ID 0x80555CED7394F948,
 38 | 	fingerprint 2771 AF53 5D09 BDFB A8D0 BEF3 8055 5CED 7394 F948.</p></div><div class="section" lang="en"><div class="titlepage"><div><div><h3 class="title"><a name="sec-copying"></a>1.2. Copying</h3></div></div></div><p>The software and this document are licensed under
 39 | 	permissive, BSD-like terms, copied from the ISC
 40 | 	license:</p><div class="blockquote"><blockquote class="blockquote"><p>Copyright © 2009, Jean-Paul Guy Larocque</p><p>Permission to use, copy, modify, and/or distribute this
 41 | 	  software for any purpose with or without fee is hereby
 42 | 	  granted, provided that the above copyright notice and this
 43 | 	  permission notice appear in all copies.</p><p>THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR
 44 | 	  DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE
 45 | 	  INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
 46 | 	  FITNESS.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
 47 | 	  SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY
 48 | 	  DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
 49 | 	  PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
 50 | 	  OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH
 51 | 	  THE USE OR PERFORMANCE OF THIS SOFTWARE.</p></blockquote></div><p>This software was directly derived from
 52 | 	"<a class="ulink" href="http://www.staff.ncl.ac.uk/roger.peppe/csp.tgz" target="_top">csp.tgz</a>",
 53 | 	dated 2006-07-03, and published by Roger Peppe.  No copyright
 54 | 	notice giving attribution to Roger Peppe or any specific
 55 | 	licensing terms seem to have been included in that
 56 | 	version.</p><p>That software was derived from "channel.c" of Plan 9
 57 | 	libthread:</p><div class="blockquote"><blockquote class="blockquote"><p>Copyright © 2005 Russ Cox, Massachusetts Institute
 58 | 	  of Technology</p><p>Permission is hereby granted, free of charge, to any
 59 | 	  person obtaining a copy of this software and associated
 60 | 	  documentation files (the "Software"), to deal in the
 61 | 	  Software without restriction, including without limitation
 62 | 	  the rights to use, copy, modify, merge, publish, distribute,
 63 | 	  sublicense, and/or sell copies of the Software, and to
 64 | 	  permit persons to whom the Software is furnished to do so,
 65 | 	  subject to the following conditions:</p><p>The above copyright notice and this permission notice
 66 | 	  shall be included in all copies or substantial portions of
 67 | 	  the Software.</p><p>THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF
 68 | 	  ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO
 69 | 	  THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
 70 | 	  PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS
 71 | 	  OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 72 | 	  OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
 73 | 	  OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 74 | 	  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
 75 | 	  SOFTWARE.</p></blockquote></div><p>That software contains parts derived from an earlier
 76 | 	library by Rob Pike, Sape Mullender, and Russ Cox:</p><div class="blockquote"><blockquote class="blockquote"><p>Copyright © 2003 by Lucent Technologies.</p><p>Permission to use, copy, modify, and distribute this
 77 | 	  software for any purpose without fee is hereby granted,
 78 | 	  provided that this entire notice is included in all copies
 79 | 	  of any software which is or includes a copy or modification
 80 | 	  of this software and in all copies of the supporting
 81 | 	  documentation for such software.</p><p>THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR
 82 | 	  IMPLIED WARRANTY.  IN PARTICULAR, NEITHER THE AUTHORS NOR LUCENT
 83 | 	  TECHNOLOGIES MAKE ANY REPRESENTATION OR WARRANTY OF ANY KIND
 84 | 	  CONCERNING THE MERCHANTABILITY OF THIS SOFTWARE OR ITS FITNESS FOR
 85 | 	  ANY PARTICULAR PURPOSE.</p></blockquote></div></div><div class="section" lang="en"><div class="titlepage"><div><div><h3 class="title"><a name="sec-contact"></a>1.3. Contact Information</h3></div></div></div><p>The author welcomes feedback, questions, help requests,
 86 | 	and bug reports via e-mail: J.P. Larocque &lt;jpl-software at
 87 | 	thoughtcrime.us&gt;</p></div></div><div class="section" lang="en"><div class="titlepage"><div><div><h2 class="title" style="clear: both"><a name="sec-examples"></a>2. Examples</h2></div></div></div><p>Create a channel with no buffering:</p><div class="informalexample"><pre class="programlisting">(defparameter *chan*
 88 |   (make-instance 'calispel:channel))</pre></div><p>In another thread, sleep for 1 second, then send the number
 89 |       42 to the channel.  In the current thread, receive from the
 90 |       channel.  At first, there will be no value available,
 91 |       so <a class="link" href="#sec-basic_io" title="3.2. ? and !: Basic I/O Functions"><code class="function">?</code></a>
 92 |       will wait until the other thread sends the value.</p><div class="informalexample"><pre class="programlisting">(progn
 93 |   (eager-future:pexec
 94 |     (sleep 1)
 95 |     (calispel:! *chan* 42))
 96 |   (calispel:? *chan*))
 97 | =&gt; 42
 98 |    T</pre></div><p>(<code class="literal">42</code> is the value received,
 99 |       and <code class="literal">T</code> indicates that the receive was
100 |       successful—it did not time out.)</p><p>Sending to the channel will also block without a waiting
101 |       receiver, because channels are unbuffered by default.  This will
102 |       attempt to send to the channel, then time out after 2
103 |       seconds:</p><div class="informalexample"><pre class="programlisting">(calispel:! *chan* 'foo 2)
104 | =&gt; NIL</pre></div><p>(<code class="literal">NIL</code> indicates that the send was not
105 |       successful—it timed out.)</p><p>Create a new channel that is buffered:</p><div class="informalexample"><pre class="programlisting">(defparameter *chan*
106 |   (make-instance 'calispel:channel
107 |                  :buffer (make-instance '<a class="ulink" href="http://www.thoughtcrime.us/software/jpl-queues/#sec-classes-bounded_fifo_queue" target="_top">jpl-queues:bounded-fifo-queue</a> :capacity 2)))</pre></div><p>This channel will accept up to two values that have not yet
108 |       been received before sends will block:</p><div class="informalexample"><pre class="programlisting">(loop for i from 1
109 |       while (calispel:! *chan* i 0)
110 |       finally (format t "~&amp;Stopped before ~:R value.~&amp;" i))
111 | &gt;&gt; Stopped before third value.</pre></div><p>Now let's print them back out:</p><div class="informalexample"><pre class="programlisting">(loop
112 |   (multiple-value-bind (value success?)
113 |       (calispel:? *chan* 0)
114 |     (when success?
115 |       (format t "~&amp;Value: ~S~&amp;" value))
116 |     (unless success?
117 |       (return))))
118 | &gt;&gt; Value: 1
119 | Value: 2</pre></div><p>Suppose that we have many channels that we're interested in
120 |       receiving from or sending to.  We can
121 |       use <a class="link" href="#sec-alt_macros" title="3.3. PRI-ALT and FAIR-ALT: Alternation Among Several Operations">alternation</a> to select
122 |       the first operation that is available, and then perform some
123 |       action associated with the operation:</p><div class="informalexample"><pre class="programlisting">(let ((chan1 (make-instance 'calispel:channel)) ; chan1 goes unused
124 |       (chan2 (make-instance 'calispel:channel)))
125 |   (eager-future:pexec
126 |     (calispel:! chan2 42))
127 |   (calispel:pri-alt
128 |     ((calispel:? chan1)
129 |      ;; Nothing is sent to CHAN1, so it can't be ready.
130 |      (format t "~&amp;Got a value from CHAN1, but that should never happen.~&amp;"))
131 |     ((calispel:? chan2 value)
132 |      ;; CHAN2 has either had something sent to it, or it soon will,
133 |      ;; so this will execute.
134 |      (format t "~&amp;Got value from CHAN2: ~S~&amp;" value))))
135 | &gt;&gt; Got value from CHAN2: 42</pre></div><p>What if there's more than one operation that is immediately
136 |       possible?  <a class="link" href="#sec-alt_macros" title="3.3. PRI-ALT and FAIR-ALT: Alternation Among Several Operations"><code class="function">PRI-ALT</code></a>
137 |       chooses the first one available...</p><div class="informalexample"><pre class="programlisting">(let ((chan1 (make-instance 'calispel:channel))
138 |       (chan2 (make-instance 'calispel:channel)))
139 |   (eager-future:pexec
140 |     (calispel:! chan1 'foo))
141 |   (eager-future:pexec
142 |     (calispel:! chan2 'bar))
143 |   (sleep 1) ; Wait for both CHAN1 and CHAN2 to become ready.
144 |   (calispel:pri-alt
145 |     ((calispel:? chan1 value)
146 |      (format t "~&amp;Got value from CHAN1: ~S~&amp;" value))
147 |     ((calispel:? chan2 value)
148 |      (format t "~&amp;Got value from CHAN2: ~S~&amp;" value))))
149 | &gt;&gt; Got value from CHAN1: FOO</pre></div><p>...whereas <a class="link" href="#sec-alt_macros" title="3.3. PRI-ALT and FAIR-ALT: Alternation Among Several Operations"><code class="function">FAIR-ALT</code></a>
150 |       chooses any of the available operations:</p><div class="informalexample"><pre class="programlisting">(let ((chan1 (make-instance 'calispel:channel))
151 |       (chan2 (make-instance 'calispel:channel)))
152 |   (eager-future:pexec
153 |     (calispel:! chan1 'foo))
154 |   (eager-future:pexec
155 |     (calispel:! chan2 'bar))
156 |   (sleep 1) ; Wait for both CHAN1 and CHAN2 to become ready.
157 |   (calispel:fair-alt
158 |     ((calispel:? chan1 value)
159 |      (format t "~&amp;Got value from CHAN1: ~S~&amp;" value))
160 |     ((calispel:? chan2 value)
161 |      (format t "~&amp;Got value from CHAN2: ~S~&amp;" value))))
162 | &gt;&gt; Got value from CHAN1: FOO
163 | <span class="emphasis"><em>(or, determined randomly)</em></span>
164 | &gt;&gt; Got value from CHAN2: BAR</pre></div><p>Just
165 |       like <a class="link" href="#sec-basic_io" title="3.2. ? and !: Basic I/O Functions"><code class="function">?</code>
166 |       and <code class="function">!</code></a>, <code class="function">PRI-ALT</code>
167 |       and <code class="function">FAIR-ALT</code> allow time outs to be
168 |       specified.  An <code class="code">OTHERWISE</code> clause is executed if no
169 |       operation can be immediately performed, effectively putting a
170 |       time out of 0 on all the operations:</p><div class="informalexample"><pre class="programlisting">(let ((chan1 (make-instance 'calispel:channel))
171 |       (chan2 (make-instance 'calispel:channel)))
172 |   (eager-future:pexec
173 |     (sleep 1)
174 |     (calispel:! chan1 'foo))
175 |   (calispel:pri-alt
176 |     ((calispel:? chan1 value)
177 |      (format t "~&amp;Got value from CHAN1: ~S~&amp;" value))
178 |     ((calispel:? chan2 value)
179 |      (format t "~&amp;Got value from CHAN2: ~S~&amp;" value))
180 |     (otherwise (format t "~&amp;Timed-out.~&amp;"))))
181 | &gt;&gt; Timed-out.</pre></div><p>You can also wait up to a certain amount of time before
182 |       executing the <code class="code">OTHERWISE</code> clause:</p><div class="informalexample"><pre class="programlisting">(let ((chan1 (make-instance 'calispel:channel))
183 |       (chan2 (make-instance 'calispel:channel)))
184 |   (eager-future:pexec
185 |     (sleep 1)
186 |     (calispel:! chan1 'foo))
187 |   (calispel:pri-alt
188 |     ((calispel:? chan1 value)
189 |      (format t "~&amp;Got value from CHAN1: ~S~&amp;" value))
190 |     ((calispel:? chan2 value)
191 |      (format t "~&amp;Got value from CHAN2: ~S~&amp;" value))
192 |     ((otherwise :timeout 5)
193 |      (format t "~&amp;Timed-out.~&amp;"))))
194 | &gt;&gt; Got value from CHAN1: FOO</pre></div><p>(Try increasing the <code class="function">SLEEP</code> delay to 6
195 |       to see that the <code class="function">PRI-ALT</code> will still time
196 |       out.)</p></div><div class="section" lang="en"><div class="titlepage"><div><div><h2 class="title" style="clear: both"><a name="sec-reference"></a>3. Reference</h2></div></div></div><div class="section" lang="en"><div class="titlepage"><div><div><h3 class="title"><a name="sec-channel"></a>3.1. The <code class="type">CHANNEL</code> Class</h3></div></div></div><p><b>Syntax. </b></p><pre class="synopsis">(<code class="function">MAKE-INSTANCE</code> <code class="literal">'CHANNEL</code> &amp;key <code class="varname">BUFFER</code>)
197 | =&gt; <span class="emphasis"><em>(A <code class="type">CHANNEL</code> instance.)</em></span></pre><p>A channel is a medium that communicates messages from one
198 | 	thread to another.</p><p>All channels have a buffer.  The default buffer doesn't do
199 | 	anything—it's always full and always empty.  It has no
200 | 	storage.</p><p><code class="code">BUFFER</code> specifies
201 | 	the <a class="ulink" href="http://www.thoughtcrime.us/software/jpl-queues/#sec-classes" target="_top">jpl-queues
202 | 	  queue</a> to buffer messages with.</p><p>Sending to a channel blocks when there is no other thread
203 | 	waiting to receive from it and there is no room in the buffer
204 | 	(i.e. <a class="ulink" href="http://www.thoughtcrime.us/software/jpl-queues/#sec-api-full" target="_top"><code class="function">JPL-QUEUES:FULL?</code></a>
205 | 	returns true).  Receiving from a channel blocks when there is
206 | 	no other thread waiting to send to it and there are no objects
207 | 	in the buffer
208 | 	(i.e. <a class="ulink" href="http://www.thoughtcrime.us/software/jpl-queues/#sec-api-empty" target="_top"><code class="function">JPL-QUEUES:EMPTY?</code></a>
209 | 	returns true).</p><p>To improve throughput with better parallelism, a
210 | 	meaningful buffer is recommended so that threads can perform
211 | 	useful work instead of waiting on other threads.
212 | 	Any jpl-queues queue may be used, but
213 | 	note:</p><div class="itemizedlist"><ul type="disc"><li>The queue need not be "synchronized" (an instance
214 | 	  of <code class="type">JPL-QUEUES:SYNCHRONIZED-QUEUE</code>): Calispel has
215 | 	  its own synchronization, so external synchronization will only
216 | 	  add overhead.</li><li>The queue may not be shared with any other channels
217 | 	  or be used for anything else, even if it's "synchronized."
218 | 	  (Pedantic exception: if the queue strictly has no state,
219 | 	  then it doesn't matter if it's shared.  The default "null"
220 | 	  queue has no state, and it is shared.)</li></ul></div></div><div class="section" lang="en"><div class="titlepage"><div><div><h3 class="title"><a name="sec-basic_io"></a>3.2. <code class="function">?</code> and <code class="function">!</code>:
221 | 	Basic I/O Functions</h3></div></div></div><p><b>Syntax. </b></p><pre class="synopsis">(<code class="function">?</code> <code class="varname">CHANNEL</code> &amp;optional <code class="varname">TIMEOUT</code>)
222 | =&gt; <code class="varname">VALUE</code>
223 |    <code class="varname">RECEIVED-OK?</code></pre><pre class="synopsis">(<code class="function">!</code> <code class="varname">CHANNEL</code> <code class="varname">VALUE</code> &amp;optional <code class="varname">TIMEOUT</code>)
224 | =&gt; <code class="varname">SENT-OK?</code></pre><p><code class="function">?</code> receives a value
225 | 	from <code class="varname">CHANNEL</code>, waiting up
226 | 	to <code class="varname">TIMEOUT</code> seconds (a
227 | 	non-negative <a class="ulink" href="http://www.lispworks.com/documentation/HyperSpec/Body/t_real.htm#real" target="_top"><code class="type">REAL</code></a>
228 | 	number; or indefinitely if unspecified
229 | 	or <code class="literal">NIL</code>).  If a value can be received before
230 | 	the time out, the value and <code class="literal">T</code> (indicating
231 | 	success) are returned.  Otherwise, <code class="literal">NIL</code>
232 | 	and <code class="literal">NIL</code> (indicating failure) are
233 | 	returned.</p><p><code class="function">!</code> sends <code class="varname">VALUE</code>
234 | 	to <code class="varname">CHANNEL</code>, waiting up
235 | 	to <code class="varname">TIMEOUT</code> seconds (a
236 | 	non-negative <a class="ulink" href="http://www.lispworks.com/documentation/HyperSpec/Body/t_real.htm#real" target="_top"><code class="type">REAL</code></a>
237 | 	number; or indefinitely if unspecified
238 | 	or <code class="literal">NIL</code>).  If the value can be sent before
239 | 	the time out, <code class="literal">T</code> (indicating success) is
240 | 	returned.  Otherwise, <code class="literal">NIL</code> (indicating
241 | 	failure) is returned.</p></div><div class="section" lang="en"><div class="titlepage"><div><div><h3 class="title"><a name="sec-alt_macros"></a>3.3. <code class="function">PRI-ALT</code>
242 | 	and <code class="function">FAIR-ALT</code>: Alternation Among Several
243 | 	Operations</h3></div></div></div><p><b>Syntax. </b></p><pre class="synopsis">(<code class="function">PRI-ALT</code> operation-clause* [otherwise-clause])
244 | (<code class="function">FAIR-ALT</code> operation-clause* [otherwise-clause])
245 | =&gt; <span class="emphasis"><em>(For either macro: the result of the final evaluated <code class="varname">form</code>,
246 |     or no values if no clause was executed.)</em></span>
247 | 
248 | operation-clause ::= (operation <code class="varname">form</code>*)
249 | otherwise-clause ::= ({otherwise | (otherwise [:timeout <code class="varname">timeout</code>])} <code class="varname">form</code>*)
250 | operation        ::= (? <code class="varname">channel</code> [<code class="varname">lambda-list</code> [<code class="varname">condition</code>]]) ; receive
251 |                    | (! <code class="varname">channel</code> <code class="varname">value</code> [<code class="varname">condition</code>])         ; send</pre><p>Performs one of the given channel operations, choosing one
252 | 	from the set of operations that first becomes available, then
253 | 	evaluates each of the forms associated with the selected
254 | 	operation.  If no operation can immediately be made, waits
255 | 	until an operation is available (optionally up to a given
256 | 	<code class="code">timeout</code>).</p><p>When there are multiple operations that can be immediately
257 | 	carried-out, <code class="function">PRI-ALT</code> selects the first
258 | 	one listed, whereas <code class="function">FAIR-ALT</code> chooses one
259 | 	at random.</p><div class="variablelist"><dl><dt><span class="term"><code class="varname">channel</code></span></dt><dd><p>Evaluated to produce
260 | 	      a <a class="link" href="#sec-channel" title="3.1. The CHANNEL Class"><code class="type">CHANNEL</code></a>
261 | 	      to send to or receive from.  The channel forms
262 | 	      associated with operations that do not pass the
263 | 	      condition are not evaluated.</p></dd><dt><span class="term"><code class="varname">lambda-list</code></span></dt><dd><p>Either a symbol naming a variable to be bound to the
264 | 	      value received from the channel, or a destructuring lambda
265 | 	      list<sup>[<a name="destructuring_lambda_list" href="#ftn.destructuring_lambda_list" class="footnote">1</a>]</sup> naming a set of variables to be bound to the
266 | 	      destructured value received from the channel.  The
267 | 	      bindings are visible to the associated forms.  If the
268 | 	      value cannot be destructured according to the lambda
269 | 	      list, an error is signalled.  Note that multiple receive
270 | 	      clauses for the same channel with different
271 | 	      destructuring lambda-lists <span class="emphasis"><em>cannot</em></span>
272 | 	      be used for pattern matching.</p></dd><dt><span class="term"><code class="varname">value</code></span></dt><dd><p>An expression whose primary value is used as the
273 | 	      message to send to the channel.  All value expressions
274 | 	      are evaluated before selecting an operation, except for
275 | 	      those associated with operations that do not pass the
276 | 	      condition.</p></dd><dt><span class="term"><code class="varname">condition</code></span></dt><dd><p>Evaluated to produce a generalized boolean
277 | 	      indicating whether the associated operation-clause
278 | 	      should receive further consideration.  When condition is
279 | 	      not given or its resulting value is true, the associated
280 | 	      operation is kept for consideration.  When the resulting
281 | 	      value is false, the operation is removed from
282 | 	      consideration (as if its associated channel never
283 | 	      becomes ready for sending/receiving).</p></dd><dt><span class="term"><code class="varname">form</code></span></dt><dd><p>Evaluated in sequence when the associated clause is
284 | 	      executed.  The values of the evaluation of the last form
285 | 	      of the effective clause become the result of the
286 | 	      macro.</p></dd><dt><span class="term"><code class="varname">timeout</code></span></dt><dd><p>Evaluated to produce the duration, as a non-negative
287 | 	      <a class="ulink" href="http://www.lispworks.com/documentation/HyperSpec/Body/t_real.htm#real" target="_top"><code class="type">REAL</code></a>
288 | 	      number of seconds, to wait for an effective operation to
289 | 	      become available before resorting to the
290 | 	      <code class="code">otherwise-clause</code>.  The result may also
291 | 	      be <code class="literal">NIL</code> to specify no time out.  When
292 | 	      an <code class="code">otherwise-clause</code> exists, the default
293 | 	      time out is 0, meaning that if none of the channels in
294 | 	      the operation-clauses are immediately available, the
295 | 	      <code class="code">otherwise-clause</code> forms are executed
296 | 	      immediately.  When there is
297 | 	      no <code class="code">otherwise-clause</code>, the default time out
298 | 	      is
299 | 	      <code class="literal">NIL</code>.</p></dd></dl></div><p>It is useful to specify a <code class="code">timeout</code> expression that
300 | 	conditionally evaluates to <code class="literal">NIL</code>, in order to
301 | 	disable the time out and inhibit the execution of the
302 | 	<code class="code">otherwise-clause</code> (provided that there are channel
303 | 	operations to wait for that haven't been excluded by false
304 | 	conditions).</p><p>If there are no effective operations (because all the
305 | 	conditions evaluated to false, or because no operations were
306 | 	specified), then the <code class="code">otherwise-clause</code> (if any) is
307 | 	executed immediately (even if the specified time out
308 | 	is <code class="literal">NIL</code>).</p><p>Stylistically and for future compatibility, avoid
309 | 	side-effects
310 | 	in <code class="code">channel</code>, <code class="code">value</code>, <code class="code">condition</code>,
311 | 	and <code class="code">timeout</code> expressions.</p></div><div class="section" lang="en"><div class="titlepage"><div><div><h3 class="title"><a name="sec-dynamic_alternation"></a>3.4. Dynamic Alternation</h3></div></div></div><p>It is possible to dynamically construct a set of
312 | 	operations to alternate upon.</p><p>The general procedure is to
313 | 	instantiate <code class="type">OPERATION</code> for each kind of operation
314 | 	you wish to perform.  For sending operations, you will need to
315 | 	give the value to send with <code class="code">:VALUE</code>.  Pass
316 | 	the <code class="type">OPERATION</code> instances, as a list,
317 | 	to <code class="function">OPERATION-ALTERNATE</code>.  <code class="function">OPERATION-ALTERNATE</code>
318 | 	will either immediately execute one of
319 | 	the <code class="type">OPERATION</code> instances, or block until another
320 | 	thread executes an operation which allows one of the given
321 | 	operations to execute.  The selected operation, after having
322 | 	been executed, is returned.  If the selected operation was a
323 | 	receive operation, the value received will available with
324 | 	the <code class="function">VALUE</code> accessor.</p><p>Please see the documentation in the source code
325 | 	for <code class="function">OPERATION-ALTERNATE</code> and
326 | 	the <code class="type">OPERATION</code> class.</p></div></div><div class="footnotes"><br><hr width="100" align="left"><div class="footnote"><p><sup>[<a name="ftn.destructuring_lambda_list" href="#destructuring_lambda_list" class="para">1</a>] </sup>See: Common Lisp HyperSpec,
327 | 		sec. <a class="ulink" href="http://www.lispworks.com/documentation/HyperSpec/Body/03_de.htm" target="_top">3.4.5
328 | 		Destructuring Lambda Lists</a></p></div></div></div></body></html>
329 | 


--------------------------------------------------------------------------------