budd@orstcs.cs.ORST.EDU (08/22/87)
The following is a short article that will appear in the next edition of the
Little Smalltalk newsletter; however I thought it might be of more general
intrest since it is not specific to Little Smalltalk. The code is given in
Little Smalltalk form, however it can be easily translated into other
dialects. The rest of the newletter should be ready about the middle of
september.
--tim budd
----------------------------------------------------
I was recently reading about a nifty new idea in BBN
Butterfly Lisp, a dialect of Scheme. The butterfly is a
multiprocessor machine, and the new feature is one primitive
they are experimenting with to provide the user with easy to
use multiprocessing primitives. I will simplify a bit here,
but basically the idea is to provide a new statement called
``future''. When the user evaluates an expression such as
(future expression)
What they get back is a box. At some future date the box
will contain the value of the expression. The computation
of the expression then takes place in parallel with the con-
tinuted execution of the program. If at some later time
they try to read the contents of the box, if the result of
the execution has not yet been completed the running process
is suspended until the expression is evaluated. Once the
box has been filled, however, it can be read and reread as
often as desired.
In BBN Lisp this primitive is implemented using con-
tinuations, something which is absent from Smalltalk. Never
the less, a similar idea can be easily produced. We will
create a new class, called Future. Instances of Future will
respond to two message; eval:, which takes as argument a
block and starts the task of evaluating it, and value, which
returns the value of the expression. Here is the class
description for future:
Class Future
| result sem |
[
eval: aBlock
sem <- Semaphore new: 0.
[ result <- aBlock value. sem signal ] fork
|
value
sem wait.
sem signal.
^ result
]
Here is one test case I tried using future:
Class Test
[
test | sum i x |
sum <- 0.
'about to create the future' print.
x <- Future new eval:
[ (1 to: 100) do: [:i | sum <- sum + 1].
'finished future' print. sum ].
'created future' print.
x value print.
'done with future' print
]
And here is a the output from this test case:
%st -i future.st
Little Smalltalk
Test new test
about to create the future
created future
finished future
100
done with future
Test
Notice how the program continued execution, printing a
message before execution of the ``future'' expression had
completed.miw@mucs.UX.CS.MAN.AC.UK (Mario Wolczko) (08/24/87)
I too noticed some time ago (after reading Halstead's paper on MultiLisp, in ACM Trans. on Prog. Langs., 7:4, Oct 1985, 501-538) that futures were a nice way of using parallelism. Anyway, I hacked a simple version of Future, very similar to Tim Budd's, except that the "value" message to retrieve the value from the future was not required. I used doesNotUnderstand: to trap all incoming messages and resynchronise the two processes. (This is an identical device to that described by Geoffrey Pascoe in the OOPSLA paper, "Encapsulators: a New Software Paradigm in Smalltalk-80", pp.341-346.) Building on this, Trevor Hopkins wrote lots and lots of code that used Futures to show what they could do, and also built lazy evaluators too using similar tricks. Below is some code that, as they say, I happen to have prepared earlier. Caveats: the future trick doesn't work on primitives that don't send messages to get internal state of argument objects. For example, primitive equivalence (==) compares the oops of the receiver and argument directly. If the argument is a Future, it will use its oop rather than the oop of the result of the Future. Similar problems are encountered on arithmetic primitives. Anyway, this may provide some entertainment for those of you who like to build your own control structures. Share and enjoy, Mario Wolczko ------------------------------------------------------------------------ Dept. of Computer Science ARPA: miw%ux.cs.man.ac.uk The University USENET: mcvax!ukc!man.cs.ux!miw Manchester M13 9PL JANET: miw@uk.ac.man.cs.ux U.K. +44-61-273 7121 x 5699 "Manchester---the home of Virtual Memory" ------------------------------------------------------------------------ 'From Smalltalk-80, version 2, of April 1, 1983 on 29 March 1987 at 5:13:27 pm'! !Object methodsFor: 'parallel evaluation'! touch "Simply returns self. If the receiver is an uncompleted Future or Lazy, this forces complete evaluation." ^self! ! 'From Smalltalk-80, version 2, of April 1, 1983 on 29 March 1987 at 5:03:50 pm'! !Array methodsFor: 'products'! dotProduct: anArray "Answers with the sum of the products of each element of the receiver with anArray. Creates an error if the receiver and anArray are different sizes." (self size = anArray size) ifFalse: [^self error: 'arrays must be the same size']. ^self fastDotProduct: anArray! fastDotProduct: anArray "Answers with the sum of the products of each element of the receiver with anArray." | sum | sum _ 0. 1 to: self size do: [:index | sum _ sum + ((self at: index) * (anArray at: index))]. ^sum! ! 'From Smalltalk-80, version 2, of April 1, 1983 on 29 March 1987 at 5:08:06 pm'! Object subclass: #Future instanceVariableNames: 'result semaphore ' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Processes'! Future comment: 'I represent an execution in progress. Any messages sent to me are delayed until execution has completed.'! !Future methodsFor: 'synchronising'! doesNotUnderstand: aMessage "Any message to a Future will end up here." semaphore wait. "Wait for evaluation to complete" "(if not already completed)" semaphore signal. "Wake up anything else that might be waiting" ^result perform: aMessage selector withArguments: aMessage arguments! ! !Future methodsFor: 'evaluating'! block: aBlock "Execute aBlock in parallel with whatever called me, but ensure that any messages sent to me before execution of the block has terminated are suspended until it has terminated." semaphore _ Semaphore new. [result _ aBlock value. semaphore signal] fork! block: aBlock value: aValue "Execute aBlock in parallel with whatever called me, but ensure that any messages sent to me before execution of the block has terminated are suspended until it has terminated." semaphore _ Semaphore new. [result _ aBlock value: aValue. semaphore signal] fork! block: aBlock value: value1 value: value2 "Execute aBlock in parallel with whatever called me, but ensure that any messages sent to me before execution of the block has terminated are suspended until it has terminated." semaphore _ Semaphore new. [result _ aBlock value: value1 value: value2. semaphore signal] fork! block: aBlock value: value1 value: value2 value: value3 "Execute aBlock in parallel with whatever called me, but ensure that any messages sent to me before execution of the block has terminated are suspended until it has terminated." semaphore _ Semaphore new. [result _ aBlock value: value1 value: value2 value: value3. semaphore signal] fork! block: aBlock valueWithArguments: anArray "Execute aBlock in parallel with whatever called me, but ensure that any messages sent to me before execution of the block has terminated are suspended until it has terminated." semaphore _ Semaphore new. [result _ aBlock valueWithArguments: anArray. semaphore signal] fork! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Future class instanceVariableNames: ''! !Future class methodsFor: 'examples'! example1 "Starts evaluating the factorial immediately, but waits until the result is available before printing the answer!!" | fac | fac _ [100 factorial] futureValue. Transcript show: 'evaluating factorial...'. Transcript show: fac printString "Future example1"! example2 "An example illustrating the use of multiple futures and explicit resynchronisation." "Starts evaluating both factorials immediately, but waits until both blocks have finished before continuing." | fac1 fac2 | fac1 _ [Transcript show: 'Starting fac1.. '. 100 factorial] futureValue. fac2 _ [Transcript show: 'Starting fac2.. '. 120 factorial] futureValue. fac2 touch. fac1 touch. Transcript show: 'both completed.'. "Future example2"! example3 "Example showing how arguments may be passed to futures." | temp | temp _ [:x :y | 10 * x * y] futureValue: 3 value: 4. Transcript cr; show: temp printString. "Future example3"! ! !Future class methodsFor: 'class initialization'! initialize "must avoid the checks" superclass _ nil "Future initialize."! ! Future initialize! 'From Smalltalk-80, version 2, of April 1, 1983 on 29 March 1987 at 5:09:10 pm'! Object subclass: #Lazy instanceVariableNames: 'result startSemaphore endSemaphore ' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Processes'! Lazy comment: 'I represent an execution which may not be required. I will not start execution until at least one message has been received. The messages sent to me are delayed until execution has completed.'! !Lazy methodsFor: 'synchronising'! doesNotUnderstand: aMessage "Any message to a Lazy will end up here." startSemaphore signal. "Start the evaluation." endSemaphore wait. "Wait until evaluation completed." endSemaphore signal. "Wake up anything else." ^result perform: aMessage selector withArguments: aMessage arguments "Perform the message, having re-synchronised."! ! !Lazy methodsFor: 'evaluating'! block: aBlock "Execute aBlock in parallel, but ensure that any messages sent to me before execution of the block has terminated are suspended until it has terminated. Do not start the evaluation until at least one message has been sent to the receiver." startSemaphore _ Semaphore new. endSemaphore _ Semaphore new. [startSemaphore wait. result _ aBlock value. endSemaphore signal] fork! block: aBlock value: aValue "Execute aBlock in parallel, but ensure that any messages sent to me before execution of the block has terminated are suspended until it has terminated. Do not start the evaluation until at least one message has been sent to the receiver." startSemaphore _ Semaphore new. endSemaphore _ Semaphore new. [startSemaphore wait. result _ aBlock value: aValue. endSemaphore signal] fork! block: aBlock value: value1 value: value2 "Execute aBlock in parallel, but ensure that any messages sent to me before execution of the block has terminated are suspended until it has terminated. Do not start the evaluation until at least one message has been sent to the receiver." startSemaphore _ Semaphore new. endSemaphore _ Semaphore new. [startSemaphore wait. result _ aBlock value: value1 value: value2. endSemaphore signal] fork! block: aBlock value: value1 value: value2 value: value3 "Execute aBlock in parallel, but ensure that any messages sent to me before execution of the block has terminated are suspended until it has terminated. Do not start the evaluation until at least one message has been sent to the receiver." startSemaphore _ Semaphore new. endSemaphore _ Semaphore new. [startSemaphore wait. result _ aBlock value: value1 value: value2 value: value3. endSemaphore signal] fork! block: aBlock valueWithArguments: anArray "Execute aBlock in parallel, but ensure that any messages sent to me before execution of the block has terminated are suspended until it has terminated. Do not start the evaluation until at least one message has been sent to the receiver." startSemaphore _ Semaphore new. endSemaphore _ Semaphore new. [startSemaphore wait. result _ aBlock valueWithArguments: anArray. endSemaphore signal] fork! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Lazy class instanceVariableNames: ''! !Lazy class methodsFor: 'class initialization'! initialize "must avoid the checks" superclass _ nil "Lazy initialize."! ! !Lazy class methodsFor: 'examples'! example1 "Evaluates the factorial, starting only when the result is actually required (when printString is sent)." | fac | fac _ [100 factorial] futureValue. Transcript show: 'Doing nothing. '. (Delay forSeconds: 2) wait. Transcript show: fac printString "Lazy example1"! example2 "Starts evaluating both factorials only when required (by the touch), and waits until both blocks have finished before continuing." | fac1 fac2 | fac1 _ [Transcript show: 'Starting fac1.. '. 100 factorial] lazyValue. fac2 _ [Transcript show: 'Starting fac2.. '. 120 factorial] lazyValue. fac2 touch. fac1 touch. Transcript show: 'both completed.'. "Lazy example2"! example3 "Demonstrates how to pass arguments to a lazy evaluation block." | temp | temp _ [:x :y :z | x * y * z] lazyValueWithArguments: #(2 3 4). Transcript cr; show: temp printString. "Lazy example3"! ! Lazy initialize! 'From Smalltalk-80, version 2, of April 1, 1983 on 29 March 1987 at 5:14:17 pm'! Object subclass: #ParallelEvaluation instanceVariableNames: 'futures ' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Processes'! ParallelEvaluation comment: 'I represent a collection of explicitly parallel computations. All of the computations are completed before I return. '! !ParallelEvaluation methodsFor: 'private'! initialize "Create a new OrderedCollection of futures." futures _ OrderedCollection new.! ! !ParallelEvaluation methodsFor: 'synchronisation'! do "Evaluates all futures in parallel, forcing resynchronisation." futures isEmpty ifTrue: [^nil]. futures do: [:each | each touch]! ! !ParallelEvaluation methodsFor: 'adding'! add: aBlock "Add aBlock to the collection of futures to be evaluated in parallel." futures addLast: (Future new block: aBlock)! add: aBlock value: aValue "Add aBlock to the collection of futures to be evaluated in parallel." futures addLast: (Future new block: aBlock value: aValue)! add: aBlock value: aValue value: anotherValue "Add aBlock to the collection of futures to be evaluated in parallel." futures addLast: (Future new block: aBlock value: aValue value: anotherValue)! add: aBlock value: aValue value: anotherValue value: bValue "Add aBlock to the collection of futures to be evaluated in parallel." futures addLast: (Future new block: aBlock value: aValue value: anotherValue value: bValue)! add: aBlock withArguments: anArray "Add aBlock to the collection of futures to be evaluated in parallel." futures addLast: (Future new block: aBlock valueWithArguments: anArray)! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ParallelEvaluation class instanceVariableNames: ''! !ParallelEvaluation class methodsFor: 'instance creation'! new ^super new initialize! ! !ParallelEvaluation class methodsFor: 'examples'! example1 "An example of using a parallel evaluation. " | t | t _ ParallelEvaluation new. t add: [Transcript cr; show: 'First block. ']. t add: [(Delay forSeconds: 5) wait. Transcript cr; show: 'Second block. ']. t add: [Transcript cr; show: 'Third block. ']. t add: [(Delay forSeconds: 2) wait. Transcript cr; show: 'Forth block. ']. t add: [Transcript cr; show: 'Fifth block. ']. t do. Transcript cr; show: 'All blocks finished. '. "ParallelEvaluation example1."! example2 "Uses the BlockContext method." [(Delay forSeconds: 2) wait. Transcript cr; show: 'First Block. '] inParallelWith: [Transcript cr; show: 'Second Block. ']. Transcript cr; show: 'Both blocks finished.' "ParallelEvaluation example2."! example3 "Also uses the BlockContext method." [Transcript cr; show: 'First Block. '] inParallelWith: [Transcript cr; show: 'Second Block. '] with: [Transcript cr; show: 'Third Block. ']. Transcript cr; show: 'All completed. ' "ParallelEvaluation example3."! example4 "Example showing how to pass arguments to blocks which are to be evaluated in parallel." [:x | Transcript cr; show: x printString] value: 10 inParallelWith: [:y | Transcript cr; show: (2 * y) printString] value: 3. "ParallelEvaluation example4."! sortExample "Uses a parallel in-place Quicksort algorithm to sort collections. Note that on a single processor, this is somewhat slower than the single-process version!!" Transcript show: ( #(5 4 4 3 2 2 1 6 5 6 8 7 6 6 4 5 6 7 6 5 4 3 2 1 2 3 4 5 6 7 8 9 0 9 8 7 6 5 4 3 2 1 2 3 4 5 6 7 8 9 0 9 8 7 6 5 4 3 2 1 1 2 4 6 6 6) asParallelSortedCollection) printString. "ParallelEvaluation sortExample."! sortExample2 "Uses a parallel in-place Quicksort algorithm to sort dictionaries. Note that on a single processor, this is somewhat slower than the single-process version!!" Transcript cr; show: ( Time millisecondsToRun: [Smalltalk asSortedCollection]) printString. Transcript cr; show: ( Time millisecondsToRun: [Smalltalk asParallelSortedCollection]) printString. "ParallelEvaluation sortExample2."! ! 'From Smalltalk-80, version 2, of April 1, 1983 on 29 March 1987 at 5:04:08 pm'! !BlockContext methodsFor: 'parallel evaluation'! futureValue "Fork a synchronised evaluation of myself. Starts the evaluation in parallel immediately." ^Future new block: self! futureValue: aValue "Fork a synchronised evaluation of myself. Starts the evaluation in parallel immediately." ^Future new block: self value: aValue! futureValue: aValue value: anotherValue "Fork a synchronised evaluation of myself. Starts the evaluation in parallel immediately." ^Future new block: self value: aValue value: anotherValue! futureValue: aValue value: anotherValue value: bValue "Fork a synchronised evaluation of myself. Starts the evaluation in parallel immediately." ^Future new block: self value: aValue value: anotherValue value: bValue! futureValueWithArguments: anArray "Fork a synchronised evaluation of myself. Starts the evaluation in parallel immediately." ^Future new block: self valueWithArguments: anArray! inParallelWith: aBlock "Executes the receiver in parallel with aBlock. Continue only after both have completed." | aParallelEvaluation | aParallelEvaluation _ ParallelEvaluation new add: self. aParallelEvaluation add: aBlock. aParallelEvaluation do! inParallelWith: aBlock value: aValue "Executes the receiver in parallel with aBlock. Continue only after both have completed." | aParallelEvaluation | aParallelEvaluation _ ParallelEvaluation new add: self. aParallelEvaluation add: aBlock value: aValue. aParallelEvaluation do! inParallelWith: aBlock with: anotherBlock "Executes the receiver in parallel with aBlock and anotherBlock. Continue only after all have completed." | aParallelEvaluation | aParallelEvaluation _ ParallelEvaluation new add: self. aParallelEvaluation add: aBlock. aParallelEvaluation add: anotherBlock. aParallelEvaluation do! lazyValue "Fork a synchronised evaluation of myself. Only starts the evaluation when the result is requested." ^Lazy new block: self! lazyValue: aValue "Fork a synchronised evaluation of myself. Only starts the evaluation when the result is requested." ^Lazy new block: self value: aValue! lazyValue: aValue value: anotherValue "Fork a synchronised evaluation of myself. Only starts the evaluation when the result is requested." ^Lazy new block: self value: aValue value: anotherValue! lazyValue: aValue value: anotherValue value: bValue "Fork a synchronised evaluation of myself. Only starts the evaluation when the result is requested." ^Lazy new block: self value: aValue value: anotherValue value: bValue! lazyValueWithArguments: anArray "Fork a synchronised evaluation of myself. Only starts the evaluation when the result is requested." ^Lazy new block: self valueWithArguments: anArray! parallelAnd: aBlock "Executes the receiver in parallel with aBlock. Once both have completed, perform a logical AND operation." | first second | first _ self futureValue. second _ aBlock futureValue. ^first touch & second touch! parallelEqv: aBlock "Executes the receiver in parallel with aBlock. Once both have completed, perform a logical equivalence (exclusive-NOR) operation." | first second | first _ self futureValue. second _ aBlock futureValue. ^first touch eqv: second touch! parallelOr: aBlock "Executes the receiver in parallel with aBlock. Once both have completed, perform a logical OR operation." | first second | first _ self futureValue. second _ aBlock futureValue. ^first touch | second touch! parallelPerform: aSymbol with: aBlock "Executes the receiver in parallel with aBlock. Once both have completed, perform the operation given by aSymbol." | first second | first _ self futureValue. second _ aBlock futureValue. ^first touch perform: aSymbol with: second touch! parallelXor: aBlock "Executes the receiver in parallel with aBlock. Once both have completed, perform a logical equivalence (exclusive-NOR) operation." | first second | first _ self futureValue. second _ aBlock futureValue. ^first touch xor: second touch! value: aValue inParallelWith: aBlock "Executes the receiver in parallel with aBlock. Continue only after both have completed." | aParallelEvaluation | aParallelEvaluation _ ParallelEvaluation new add: self value: aValue. aParallelEvaluation add: aBlock. aParallelEvaluation do! value: aValue inParallelWith: aBlock value: anotherValue "Executes the receiver in parallel with aBlock. Continue only after both have completed." | aParallelEvaluation | aParallelEvaluation _ ParallelEvaluation new add: self value: aValue. aParallelEvaluation add: aBlock value: anotherValue. aParallelEvaluation do! ! 'From Smalltalk-80, version 2, of April 1, 1983 on 29 March 1987 at 5:19:49 pm'! !SequenceableCollection methodsFor: 'parallel evaluation'! parallelDo: aBlock "Perform the block aBlock with all elements of the receiver in parallel, using a parallel evaluation mechanism." "Watch out for blocks with side-effects, as the blocks may be executed in any order." | index length aPE | aPE _ ParallelEvaluation new. index _ 0. length _ self size. [(index _ index + 1) <= length] whileTrue: [aPE add: aBlock value: (self at: index)]. aPE do "ensure all blocks have terminated before continuing."! ! 'From Smalltalk-80, version 2, of April 1, 1983 on 29 March 1987 at 5:20:34 pm'! !SortedCollection methodsFor: 'adding'! parallelAdd: newObject "Don't actually force a sort, as we will always resort later." ^super addLast: newObject! ! 'From Smalltalk-80, version 2, of April 1, 1983 on 29 March 1987 at 5:20:36 pm'! !SortedCollection methodsFor: 'adding'! parallelAddAll: aCollection "Use the parallel sorting mechanism, so always insert everything and resort." aCollection do: [:each | super addLast: each]. self parallelReSort! ! 'From Smalltalk-80, version 2, of April 1, 1983 on 29 March 1987 at 5:20:30 pm'! !SortedCollection methodsFor: 'private'! parallelReSort self parallelSort: firstIndex to: lastIndex! ! 'From Smalltalk-80, version 2, of April 1, 1983 on 29 March 1987 at 5:20:26 pm'! !SortedCollection methodsFor: 'private'! parallelSort: i to: j "Sort elements i through j of self to be nondescending according to sortBlock. Use the parallel evaluation mechanism to spawn off processes." | di dij dj tt ij k l n | "The prefix d means the data at that index." (n _ j + 1 - i) <= 1 ifTrue: [^self]. "Nothing to sort." "Sort di,dj." di _ self basicAt: i. dj _ self basicAt: j. (sortBlock value: di value: dj) "i.e., should di precede dj?" ifFalse: [self swap: i with: j. tt _ di. di _ dj. dj _ tt]. n > 2 ifTrue: "More than two elements." [ij _ (i + j) // 2. "ij is the midpoint of i and j." dij _ self basicAt: ij. "Sort di,dij,dj. Make dij be their median." (sortBlock value: di value: dij) "i.e. should di precede dij?" ifTrue: [(sortBlock value: dij value: dj) "i.e., should dij precede dj?" ifFalse: [self swap: j with: ij. dij _ dj]] ifFalse: "i.e. di should come after dij" [self swap: i with: ij. dij _ di]. n > 3 ifTrue: "More than three elements." ["Find k>i and l<j such that dk,dij,dl are in reverse order. Swap k and l. Repeat this procedure until k and l pass each other." k _ i. l _ j. [[l _ l - 1. k <= l and: [sortBlock value: dij value: (self basicAt: l)]] whileTrue. "i.e. while dl succeeds dij" [k _ k + 1. k <= l and: [sortBlock value: (self basicAt: k) value: dij]] whileTrue. "i.e. while dij succeeds dk" k <= l] whileTrue: [self swap: k with: l]. "Now l<k (either 1 or 2 less), and di through dl are all less than or equal to dk through dj. Sort those two segments in parallel." [self parallelSort: i to: l] inParallelWith: [self parallelSort: k to: j]]]! ! 'From Smalltalk-80, version 2, of April 1, 1983 on 29 March 1987 at 5:07:32 pm'! !Collection methodsFor: 'converting'! asParallelSortedCollection "Answer a new instance of SortedCollection whose elements are the elements of the receiver. The sort order is the default less than or equal ordering. Use the parallel sorting mechanism." | aSortedCollection | aSortedCollection _ SortedCollection new: self size. aSortedCollection parallelAddAll: self. ^aSortedCollection! ! 'From Smalltalk-80, version 2, of April 1, 1983 on 29 March 1987 at 5:07:27 pm'! !Collection methodsFor: 'converting'! asParallelSortedCollection: aBlock "Answer a new instance of SortedCollection whose elements are the elements of the receiver. The sort order is defined by the argument, aBlock. Use the parallel sorting method." | aSortedCollection | aSortedCollection _ SortedCollection new: self size. aSortedCollection sortBlock: aBlock. aSortedCollection parallelAddAll: self. ^aSortedCollection! ! 'From Smalltalk-80, version 2, of April 1, 1983 on 29 March 1987 at 5:07:48 pm'! !Dictionary methodsFor: 'converting'! asParallelSortedCollection | aSortedCollection | aSortedCollection _ SortedCollection new: self size. self associationsDo: [:association | aSortedCollection parallelAdd: association]. aSortedCollection parallelReSort. ^aSortedCollection! ! 'From Smalltalk-80, version 2, of April 1, 1983 on 29 March 1987 at 5:08:56 pm'! !Integer methodsFor: 'factorization and divisibility'! factorial3 "Answer the factorial of the receiver. For example, 6 factorial == 6*5*4*3*2*1. Signal an error if the receiver is less than 0. Use explicitly parallel eager evaluation." self > 0 ifTrue: [^self * [(self - 1) factorial] futureValue]. self = 0 ifTrue: [^1]. self error: 'factorial invalid for: ' , self printString! ! 'From Smalltalk-80, version 2, of April 1, 1983 on 29 March 1987 at 5:08:59 pm'! !Integer methodsFor: 'factorization and divisibility'! factorial4 "Answer the factorial of the receiver. For example, 6 factorial == 6*5*4*3*2*1. Signal an error if the receiver is less than 0. Use explicitly parallel lazy evaluation." self > 0 ifTrue: [^self * [(self - 1) factorial] lazyValue]. self = 0 ifTrue: [^1]. self error: 'factorial invalid for: ' , self printString! ! Object subclass: #BinaryIntegration instanceVariableNames: 'function ' classVariableNames: '' poolDictionaries: '' category: 'Parallel-algorithms'! BinaryIntegration comment: 'I represent a numerical integration of a function. I support a parallel recursive sub-division algorithm, in both a throttled and free form. '! !BinaryIntegration methodsFor: 'private'! function: aBlock "Set the function to be integrated to aBlock." function _ aBlock! ! !BinaryIntegration methodsFor: 'accessing'! areaBetween: left and: right "Answer the calculated area between the two numbers." ^self areaBetween: left and: right estimate: (self trapeziumBetween: left and: right) tolerance: 0.01! areaBetween: left and: right estimate: anEstimate tolerance: aTolerance "Answer the calculated area between the two numbers. Uses a parallel recursive sub-division algorithm." | mid areaLeft areaRight newEstimate | mid _ left + right / 2. areaLeft _ [self trapeziumBetween: left and: mid] futureValue. areaRight _ [self trapeziumBetween: mid and: right] futureValue. newEstimate _ (areaLeft touch) + (areaRight touch). (anEstimate - newEstimate) abs < aTolerance ifTrue: [^newEstimate] ifFalse: [ ^[self areaBetween: left and: mid estimate: areaLeft tolerance: aTolerance / 2] parallelPerform: #+ with: [self areaBetween: mid and: right estimate: areaRight tolerance: aTolerance / 2] ]! trapeziumBetween: left and: right "Answer the area for a trapezium between the left and right indices." ^(right - left) * ((self valueAt: left) + (self valueAt: right)) / 2! valueAt: aNumber "Answers a number computed by the function associated with the receiver at aNumber." ^function value: aNumber! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! BinaryIntegration class instanceVariableNames: ''! !BinaryIntegration class methodsFor: 'instance creation'! function: aBlock "Creates a new instance of a BinaryIntegration, with the function given by aBlock." ^super new function: aBlock! ! !BinaryIntegration class methodsFor: 'examples'! example1 "Illustrating the use of BinaryIntegration. Calculates the area under the curve given by the function, using a parallel recursive sub-division algorithm." | integration | integration _ BinaryIntegration function: [:x| (3*x*x*x) + (2*x*x) + 5]. Transcript cr; show: (integration areaBetween: 0 and: 5) printString. "BinaryIntegration example1." "The correct answer is given by the following expression:" "Transcript cr; show: (((5 raisedTo: 4) * 3/4) + ((5 raisedTo: 3) * 2/3) + (5 * 5) asFloat) printString."! example2 "Illustrating the use of BinaryIntegration. Calculates the area under the curve given by the function, using a parallel recursive sub-division algorithm. This version uses throttling to control the number of processes created at a time." | integration | integration _ BinaryIntegration function: [:x| (3.0*x*x*x) + (2.0*x*x) + 5.0]. Transcript cr; show: (integration throttledAreaBetween: 0 and: 5) printString. "BinaryIntegration example2."! ! Object subclass: #TwoDimMatrix instanceVariableNames: 'matrix ' classVariableNames: '' poolDictionaries: '' category: 'Parallel-algorithms'! TwoDimMatrix comment: 'I represent the class of two-dimensional arrays (matrices). My internal representation is an array of arrays. I support various operations in both serial and explicitly parallel form. '! !TwoDimMatrix methodsFor: 'private'! errorBadDims ^self error: 'matrices must have compatible dimensions'! errorBadSize ^self error: 'array is wrong size'! errorNotSame ^self error: 'matrices must be the same size'! errorNotSquare ^self error: 'matrix must be square'! rows: rows columns: columns "Sets the number of rows and columns in the matrix." matrix _ Array new: columns. 1 to: columns do: [:cols | matrix at: cols put: (Array new: rows)]! ! !TwoDimMatrix methodsFor: 'printing'! printOn: aStream matrix printOn: aStream! ! !TwoDimMatrix methodsFor: 'testing'! = aTwoDimMatrix "Answer whether the receiver contains the same elements as aTwoDimMatrix." | cols | (self sameSizeAs: aTwoDimMatrix) ifFalse: [^false]. 1 to: (self columns) do: [:cols | ((self column: cols) = (aTwoDimMatrix column: cols)) ifFalse: [^false]. ]. ^true! isCompatibleWith: aTwoDimMatrix "Answer whether the receiver has dimensions such that it can be multiplied by aTwoDimMatrix." ^(self columns = aTwoDimMatrix rows)! isSquare "Answer whether the receiver is a square matrix." ^self rows = self columns! isZero "Answer whether the receiver contains all zeros." ^self = (TwoDimMatrix rows: self rows columns: self columns) zero! sameSizeAs: aMatrix "Answer whether the receiver has the same dimensions as aMatrix." ^((self rows = aMatrix rows) & (self columns = aMatrix columns))! ! !TwoDimMatrix methodsFor: 'parallel operations'! lazyParallelAdd: aTwoDimMatrix "Answer a new TwoDimMatrix which contains futures to the sum of the receiver and aTwoDimMatrix. Only calculates a value for an element when it is actually required. Creates an error message if the receiver and aTwoDimMatrix are not the same size." | newMatrix | (self sameSizeAs: aTwoDimMatrix) ifFalse: [^self errorNotSame]. newMatrix _ TwoDimMatrix rows: (self rows) columns: (self columns). 1 to: (self columns) do: [:cols | 1 to: (self rows) do: [:rows | newMatrix at: (cols@rows) put: [(self at: (cols@rows)) + (aTwoDimMatrix at: (cols@rows))] lazyValue ]]. ^newMatrix! lazyParallelMultiply: aTwoDimMatrix "Answers with a new matrix containing lazys to the product of the receiver and aTwoDimMatrix. Only evaluates an element of the matrix when it is needed. Creates an error message if the dimensions are not compatible." | newMatrix | (self isCompatibleWith: aTwoDimMatrix) ifFalse: [^self errorBadDims]. newMatrix _ TwoDimMatrix rows: (self rows) columns: (aTwoDimMatrix columns). 1 to: (self rows) do: [:r | 1 to: (aTwoDimMatrix columns) do: [:c | newMatrix at: (c@r) put: ([:x :y | (self row: y) fastDotProduct: (aTwoDimMatrix column: x)] lazyValue: c value: r). ]]. ^newMatrix! lazyParallelSubtract: aTwoDimMatrix "Answer a new TwoDimMatrix which contains futures to the difference between the receiver and aTwoDimMatrix. Only calculates a value for an element when it is actually required. Creates an error message if the receiver and aTwoDimMatrix are not the same size." | newMatrix | (self sameSizeAs: aTwoDimMatrix) ifFalse: [^self errorNotSame]. newMatrix _ TwoDimMatrix rows: (self rows) columns: (self columns). 1 to: (self columns) do: [:cols | 1 to: (self rows) do: [:rows | newMatrix at: (cols@rows) put: [(self at: (cols@rows)) - (aTwoDimMatrix at: (cols@rows))] lazyValue ]]. ^newMatrix! parallelAdd: aTwoDimMatrix "Answer a new TwoDimMatrix which contains futures to the sum of the receiver and aTwoDimMatrix. Creates an error message if the receiver and aTwoDimMatrix are not the same size." | newMatrix | (self sameSizeAs: aTwoDimMatrix) ifFalse: [^self errorNotSame]. newMatrix _ TwoDimMatrix rows: (self rows) columns: (self columns). 1 to: (self columns) do: [:cols | 1 to: (self rows) do: [:rows | newMatrix at: (cols@rows) put: [(self at: (cols@rows)) + (aTwoDimMatrix at: (cols@rows))] futureValue ]]. ^newMatrix! parallelMultiply: aTwoDimMatrix "Answers with a new matrix containing futures to the product of the receiver and aTwoDimMatrix. Always evaluates every element of the matrix. Creates an error message if the dimensions are not compatible." | newMatrix | (self isCompatibleWith: aTwoDimMatrix) ifFalse: [^self errorBadDims]. newMatrix _ TwoDimMatrix rows: (self rows) columns: (aTwoDimMatrix columns). 1 to: (self rows) do: [:r | 1 to: (aTwoDimMatrix columns) do: [:c | newMatrix at: (c@r) put: ([:x :y | (self row: y) fastDotProduct: (aTwoDimMatrix column: x)] futureValue: c value: r) ]]. ^newMatrix! parallelSubtract: aTwoDimMatrix "Answer a new TwoDimMatrix which contains futures to the difference between the receiver and aTwoDimMatrix. Creates an error message if the receiver and aTwoDimMatrix are not the same size." | newMatrix | (self sameSizeAs: aTwoDimMatrix) ifFalse: [^self errorNotSame]. newMatrix _ TwoDimMatrix rows: (self rows) columns: (self columns). 1 to: (self columns) do: [:cols | 1 to: (self rows) do: [:rows | newMatrix at: (cols@rows) put: [(self at: (cols@rows)) - (aTwoDimMatrix at: (cols@rows))] futureValue ]]. ^newMatrix! ! !TwoDimMatrix methodsFor: 'filling'! identity "Fill the receiver with all zeros, except for the leading diagonal, which contains ones." self isSquare ifFalse: [^self errorNotSquare]. self zero. 1 to: (self columns) do: [:count | self at: (count@count) put: 1]! random "Fill the receiver with random numbers." | rand | rand _ Random new. 1 to: (self columns) do: [:cols | 1 to: (self rows) do: [:rows | self at: cols@rows put: rand next]]! zero "Set all the elements of the receiver to zero." 1 to: (self columns) do: [:cols | 1 to: (self rows) do: [:rows | self at: cols@rows put: 0]]! ! !TwoDimMatrix methodsFor: 'mathematical operations'! * aTwoDimMatrix "Answers with a new matrix representing the product of the receiver and aTwoDimMatrix. Creates an error message if the dimensions are not compatible." | newMatrix | (self isCompatibleWith: aTwoDimMatrix) ifFalse: [^self errorBadDims]. newMatrix _ TwoDimMatrix rows: (self rows) columns: (aTwoDimMatrix columns). 1 to: (self rows) do: [:r | 1 to: (aTwoDimMatrix columns) do: [:c | newMatrix at: (c@r) put: ((self row: r) fastDotProduct: (aTwoDimMatrix column: c)). ]]. ^newMatrix! + aTwoDimMatrix "Answer a new TwoDimMatrix which is the sum of the receiver and aTwoDimMatrix. Create an error message if the receiver and aTwoDimMatrix are not the same size." | newMatrix | (self sameSizeAs: aTwoDimMatrix) ifFalse: [^self errorNotSame]. newMatrix _ TwoDimMatrix rows: (self rows) columns: (self columns). 1 to: (self columns) do: [:cols | 1 to: (self rows) do: [:rows | newMatrix at: (cols@rows) put: ((self at: (cols@rows)) + (aTwoDimMatrix at: (cols@rows))) ]]. ^newMatrix! - aTwoDimMatrix "Answer a new TwoDimMatrix which is the difference of the receiver and aTwoDimMatrix. Create an error message if the receiver and aTwoDimMatrix are not the same size." | newMatrix | (self sameSizeAs: aTwoDimMatrix) ifFalse: [^self errorNotSame]. newMatrix _ TwoDimMatrix rows: (self rows) columns: (self columns). 1 to: (self columns) do: [:cols | 1 to: (self rows) do: [:rows | newMatrix at: (cols@rows) put: ((self at: (cols@rows)) - (aTwoDimMatrix at: (cols@rows))) ]]. ^newMatrix! ! !TwoDimMatrix methodsFor: 'accessing'! at: aPoint "Answer the value contained in the matrix corresponding to aPoint." | column | column _ matrix at: aPoint x. ^column at: aPoint y! at: aPoint put: aValue "Set the value in the matrix corresponding to aPoint." | column | column _ matrix at: aPoint x. column at: aPoint y put: aValue! column: aNumber "Answer an array corresponding to the column given by aNumber." ^matrix at: aNumber! column: aNumber from: anArray "Set the column in the receiver corresponding to aNumber to the values from anArray." (self column: aNumber) size = (anArray size) ifFalse: [^self errorBadSize]. 1 to: anArray size do: [:index | self at: aNumber@index put: (anArray at: index)].! columns "Answer the number of columns in the receiver." (matrix size = 0) ifTrue: [^0]. ^matrix size! row: aNumber "Answer an array corresponding to the row given by aNumber." | temp | temp _ Array new: (self columns). 1 to: (self columns) do: [:col | temp at: col put: (self at: (col@aNumber))]. ^temp! row: aNumber from: anArray "Set the row in the receiver corresponding to aNumber to the values from anArray." (self row: aNumber) size = (anArray size) ifFalse: [^self errorBadSize]. 1 to: anArray size do: [:index | self at: index@aNumber put: (anArray at: index)].! rows "Answer the number of rows in the receiver." (matrix size = 0) ifTrue: [^0]. ^matrix first size! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! TwoDimMatrix class instanceVariableNames: ''! !TwoDimMatrix class methodsFor: 'examples'! example1 "Illustrates the use of matrix addition." | a b | a _ TwoDimMatrix rows: 2 columns: 2. a row: 1 from: #(1 2). a row: 2 from: #(3 4). b _ TwoDimMatrix rows: 2 columns: 2. b column: 1 from: #(5 6). b column: 2 from: #(7 8). Transcript cr; show: (a + b) printString. "TwoDimMatrix example1."! example2 "Illustrates the use of matrix subtraction." | a b | a _ TwoDimMatrix rows: 2 columns: 2. a row: 1 from: #(1 2). a row: 2 from: #(3 4). b _ TwoDimMatrix rows: 2 columns: 2. b column: 1 from: #(5 6). b column: 2 from: #(7 8). Transcript cr; show: (b - a) printString. "TwoDimMatrix example2."! example3 "Illustrates the use of matrix operations. Note that matrices are *not* commutitive under multiplication, so that a*b <> b*a." | a b | a _ TwoDimMatrix rows: 2 columns: 2. a row: 1 from: #(1 2). a row: 2 from: #(3 4). b _ TwoDimMatrix rows: 2 columns: 2. b column: 1 from: #(5 6). b column: 2 from: #(7 8). Transcript cr; show: ((a+b)*(a-b)) printString. Transcript cr; show: ((a*a) - (b*b)) printString. Transcript cr; show: (((a+b)*(a-b)) = ((a*a)-(b*b))) printString. "TwoDimMatrix example3."! example4 "Multiplies together two large matrices." | a1 a2 | a1 _ (TwoDimMatrix rows: 12 columns: 10) random. a2 _ (TwoDimMatrix rows: 10 columns: 11) random. Transcript cr; show: (Time millisecondsToRun: [a1 * a2]) printString. "TwoDimMatrix example4."! example5 "Illustrates a parallel matrix addition using futures. The resulting matrix is always fully evaluated, even if only one element is required." | a1 a2 | a1 _ (TwoDimMatrix rows: 10 columns: 10) random. a2 _ (TwoDimMatrix rows: 10 columns: 10) random. Transcript cr; show: (Time millisecondsToRun: [(a1 parallelAdd: a2) at: 2@3]) printString "TwoDimMatrix example5."! example6 "Illustrates a parallel matrix addition using lazy evaluation. The resulting matrix is only evaluated when an element is actually required." | a1 a2 | a1 _ (TwoDimMatrix rows: 10 columns: 10) random. a2 _ (TwoDimMatrix rows: 10 columns: 10) random. Transcript cr; show: (Time millisecondsToRun: [(a1 lazyParallelAdd: a2) at: 2@3]) printString "TwoDimMatrix example6."! example7 "Illustrates the use of a Lazy-evaluated matrix multiplication. Only the value actually requested is calculated." | a1 a2 | a1 _ (TwoDimMatrix rows: 10 columns: 10) random. a2 _ (TwoDimMatrix rows: 10 columns: 10) random. Transcript cr; show: ((a1 lazyParallelMultiply: a2) at: 7@5) printString. "TwoDimMatrix example7."! example8 "Illustrates the use of a Lazy-evaluated matrix multiplication. Only the value actually requested is calculated. Compare with example9." | a1 a2 | a1 _ (TwoDimMatrix rows: 10 columns: 10) random. a2 _ (TwoDimMatrix rows: 10 columns: 10) random. Transcript cr; show: (Time millisecondsToRun: [ ((a1 lazyParallelMultiply: a2) at: 7@5) touch]) printString. "TwoDimMatrix example8."! example9 "Illustrates the use of a fully-evaluated parallel matrix multiplication. All values are calculated. Compare with example8." | a1 a2 | a1 _ (TwoDimMatrix rows: 10 columns: 10) random. a2 _ (TwoDimMatrix rows: 10 columns: 10) random. Transcript cr; show: (Time millisecondsToRun: [ ((a1 parallelMultiply: a2) at: 7@5) touch]) printString. "TwoDimMatrix example9."! ! !TwoDimMatrix class methodsFor: 'instance creation'! identity: aNumber "Answer a new matrix which is square, and is all zero except for the leading diagonal, which is 1." ^(self new rows: aNumber columns: aNumber) identity! rows: rows columns: columns "Create a new instance of the receiver, with the number of rows and columns given." ^super new rows: rows columns: columns! zero: aNumber "Answer a new matrix which is square, and is all zero." ^(self new rows: aNumber columns: aNumber) zero! ! 'From Smalltalk-80, version 2, of April 1, 1983 on 9 April 1987 at 9:20:16 pm'! !Number methodsFor: 'parallel intervals'! to: stop asyncParallelDo: aBlock "Create an Interval from the receiver up to the argument, stop, incrementing by 1. For each element of the interval, evaluate the block, aBlock, in parallel. Blocks are start immediately, and continue asynchronously." | nextValue aPE | nextValue _ self. aPE _ ParallelEvaluation new. [nextValue <= stop] whileTrue: [aPE add: aBlock value: nextValue. nextValue _ nextValue + 1]! to: stop by: step asyncParallelDo: aBlock "Create an Interval from the receiver up to the argument, stop, incrementing by step. For each element of the interval, evaluate the block, aBlock, in parallel. Blocks are started immediately, and continue asynchronously." | nextValue aPE | nextValue _ self. aPE _ ParallelEvaluation new. step < 0 ifTrue: [[stop <= nextValue] whileTrue: [aPE add: aBlock value: nextValue. nextValue _ nextValue + step]] ifFalse: [[stop >= nextValue] whileTrue: [aPE add: aBlock value: nextValue. nextValue _ nextValue + step]]! to: stop by: step parallelDo: aBlock "Create an Interval from the receiver up to the argument, stop, incrementing by step. For each element of the interval, evaluate the block, aBlock, in parallel. Ensure that all blocks are completed before continuing." | nextValue aPE | nextValue _ self. aPE _ ParallelEvaluation new. step < 0 ifTrue: [[stop <= nextValue] whileTrue: [aPE add: aBlock value: nextValue. nextValue _ nextValue + step]] ifFalse: [[stop >= nextValue] whileTrue: [aPE add: aBlock value: nextValue. nextValue _ nextValue + step]]. aPE do "ensure completion."! to: stop parallelDo: aBlock "Create an Interval from the receiver up to the argument, stop, incrementing by 1. For each element of the interval, evaluate the block, aBlock, in parallel. Ensure completion of all blocks before continuing." | nextValue aPE | nextValue _ self. aPE _ ParallelEvaluation new. [nextValue <= stop] whileTrue: [aPE add: aBlock value: nextValue. nextValue _ nextValue + 1]. aPE do "Ensure completion."! ! Transcript cr; show: 'Initializing Future'. Future initialize. Transcript cr; show: 'Initializing Lazy'. Lazy inLazy inLed u
johnson@uiucdcsp.cs.uiuc.edu (08/24/87)
I think that futures were first used in Multilisp at MIT. Whether that system was the first to use them or not, there was a paper on futures in Multilisp in TOPLAS a couple of years ago. I seem to remember that actor systems have used futures for awhile, too. There was also a paper on futures in Smalltalk in OOPSLA'86. I seemed to have loaned out my copy of the proceedings, so I can't reference it precisely. However, the authors of the paper were Japanese and the title of the paper was something like "Concurrent Smalltalk". They did not give any idea how futures were implemented, and gave them a different name. They used atomic objects to limit parallelism. It seems to me that futures and atomic objects are better mechanisms for parallelism and synchronization for object-oriented programming than processes and semaphores. They encourage the programmer to think about the values being passed rather than the flow of control. Flow of control is usually misleading, and seems especially so for object-oriented programming. One of the features of Multilisp futures was that the interface to a future was identical to that of their eventual values. In other words, if a future is going to return an integer then it can be added to another integer. A process using the future is blocked if the future has not been evaluated. The operation is resumed once the future "arrives". Thus, a future could be added to any Multilisp program by taking an expression and applying the "future" function to it. This made it very easy to turn a sequential program into a parallel one. If Smalltalk futures were like this then they would have to be objects that could trap any message, check to see whether their value had been calculated, and then forward the message to the value. This is essentially the same idea as an encapsulator, which was described in another OOPSLA'86 paper. Encapsulators are implemented by overriding the doesNotUnderstand: message. Unfortunately, this message seems to be slow. I am not sure if this is just a byproduct of the interpreter that I am using. I have thought of another mechanism that would make it easier to implement special objects like futures and atomic objects---give each class its own method lookup routine. This would probably be stored in an instance variable of the class. Most classes have the same method lookup routine, but encapsulator classes would each have their own. An efficient interpreter uses caching to reduce the number of method lookups, and method lookups are expensive, so it doesn't make much difference if a method lookup takes another memory reference or two. If encapsulators like futures are used very much then giving each class its own method lookup routine would probably improve performance significantly.