'From Squeak3.1alpha of 7 March 2001 [latest update: #4282] on 29 September 2001 at 8:46:43 pm'! Error subclass: #LindaError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Linda-Core'! Object subclass: #LindaTalkBlocking instanceVariableNames: 'tuple bed ' classVariableNames: '' poolDictionaries: '' category: 'Linda-TupleSpace'! Process subclass: #LindaTalkProcess instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Linda-TupleSpace'! Object subclass: #Subspace instanceVariableNames: 'mutex tuplesIn tuplesOut tuplesRd tuplesEval mixer ' classVariableNames: '' poolDictionaries: '' category: 'Linda-TupleSpace'! Object subclass: #Tuple instanceVariableNames: 'fields ' classVariableNames: '' poolDictionaries: '' category: 'Linda-Core'! Object subclass: #TupleSpace instanceVariableNames: 'subspaces ' classVariableNames: '' poolDictionaries: '' category: 'Linda-TupleSpace'! !TupleSpace commentStamp: '' prior: 0! TupleSpace example. TupleSpace example: 200. TupleSpace example: 200 priority: Processor userBackgroundPriority. TupleSpace example: 200 priority: Processor highIOPriority. ! !Object methodsFor: 'as yet unclassified'! asTuple "---------------------------------------------------- Project: Linda Author: Marcio Q. Marchini Modified: 30/11/93 Creates a tuple from a given object ---------------------------------------------------- " ^ Tuple with: self! ! !Object methodsFor: 'as yet unclassified' stamp: 'rww 7/2/2001 21:44'! isTuple ^false! ! !Object methodsFor: 'as yet unclassified' stamp: 'rww 9/9/2001 16:29'! | anObject " ---------------------------------------------------- Project: Linda Author: Marcio Q. Marchini Modified: 30/11/93 Creates a tuple with two objects: self and anObject ---------------------------------------------------- " ^ Tuple with: self with: anObject! ! !Object methodsFor: 'linda' stamp: 'rww 7/22/2001 23:00'! lindaMatch: anObject ^ anObject lindaMatchWithObject: self ! ! !Object methodsFor: 'linda' stamp: 'rww 7/22/2001 23:16'! lindaMatchWithBehavior: aBehavior ^ self isKindOf: aBehavior ! ! !Object methodsFor: 'linda' stamp: 'rww 7/22/2001 23:31'! lindaMatchWithBlock: aBlock (aBlock numArgs = 1) ifTrue: [^ aBlock value: self]. ^ false ! ! !Object methodsFor: 'linda' stamp: 'rww 7/22/2001 23:01'! lindaMatchWithObject: anObject (self = anObject) ifTrue: [^true]. ^false! ! !Object methodsFor: 'linda' stamp: 'rww 7/22/2001 23:05'! lindaMatchWithString: receiverString ^false! ! !Object methodsFor: 'linda' stamp: 'rww 7/22/2001 23:36'! lindaMatchWithTuple: aTuple ^ (aTuple arity = 1) and: [(aTuple parameter: 1) lindaMatch: self]! ! !Behavior methodsFor: 'linda' stamp: 'rww 7/22/2001 23:11'! lindaMatch: anObject ^ (super lindaMatch: anObject) or: [anObject lindaMatchWithBehavior: self] ! ! !Behavior methodsFor: 'linda' stamp: 'rww 7/22/2001 23:24'! lindaMatchWithBehavior: anotherBehavior | testBehavior | testBehavior := anotherBehavior. [testBehavior isNil] whileFalse: [(testBehavior == self) ifTrue: [^true]]. ^ false. ! ! !Behavior methodsFor: 'linda' stamp: 'rww 7/22/2001 23:17'! lindaMatchWithObject: anObject ^ anObject lindaMatchWithBehavior: self. ! ! !BlockContext methodsFor: 'linda stuff' stamp: 'bolot 8/3/1999 14:03'! forkLindaTalk "Creates a named LindaTalk process" ^ self forkLindaTalkNamed: 'LindaTalk Process'! ! !BlockContext methodsFor: 'linda stuff' stamp: 'bolot 8/3/1999 14:03'! forkLindaTalkAt: priority "Creates a named LindaTalk process with a given priority" ^ self forkLindaTalkAt: priority named: 'LindaTalk Process'! ! !BlockContext methodsFor: 'linda stuff' stamp: 'bolot 8/3/1999 14:04'! forkLindaTalkAt: priority named: aName "Creates a named LindaTalk process with a given priority and name" | forkedProcess | forkedProcess _ self newLindaTalkProcess. forkedProcess priority: priority. forkedProcess resume. " name: aName " ^forkedProcess! ! !BlockContext methodsFor: 'linda stuff' stamp: 'bolot 8/3/1999 14:05'! forkLindaTalkNamed: aName "Creates a named LindaTalk process" | forkedProcess | forkedProcess _ self newLindaTalkProcess. forkedProcess resume. " name: aName ; " ^forkedProcess! ! !BlockContext methodsFor: 'linda stuff' stamp: 'rww 7/22/2001 23:29'! lindaMatch: anObject ^ (super lindaMatch: anObject) or: [anObject lindaMatchWithBlock: self] ! ! !BlockContext methodsFor: 'linda stuff' stamp: 'rww 7/22/2001 23:30'! lindaMatchWithBlock: anotherBlock (self numArgs = 1) ifTrue: [^ self value: anotherBlock]. ^ false ! ! !BlockContext methodsFor: 'linda stuff' stamp: 'rww 7/22/2001 23:34'! lindaMatchWithObject: anObject ^ anObject lindaMatchWithBlock: self ! ! !BlockContext methodsFor: 'linda stuff' stamp: 'bolot 8/3/1999 14:06'! newLindaTalkProcess "Actually creates a named LindaTalk process" ^LindaTalkProcess forContext: [self value. Processor terminateActive] priority: Processor activePriority! ! !Collection methodsFor: 'as yet unclassified'! asTuple "---------------------------------------------------- Project: Linda Author: Marcio Q. Marchini Modified: 30/11/93 Creates a tuple from a collection of objects ---------------------------------------------------- " ^ Tuple new addAll: self; yourself! ! !LindaTalkBlocking methodsFor: 'as yet unclassified' stamp: 'bolot 8/2/1999 22:27'! initBed "Initializes the Semaphore used to synchronize the waiting processes" bed := self class newBed! ! !LindaTalkBlocking methodsFor: 'as yet unclassified' stamp: 'bolot 8/2/1999 22:27'! initTuple: aTuple tuple _ aTuple! ! !LindaTalkBlocking methodsFor: 'as yet unclassified' stamp: 'bolot 8/2/1999 22:28'! nilBed "Makes nil the Semaphore used to synchronize the waiting processes" bed := nil! ! !LindaTalkBlocking methodsFor: 'as yet unclassified' stamp: 'bolot 8/2/1999 22:29'! sleepProcess "Blocks the current process until a match happens. Probably a rd or in." self initBed. bed wait. self nilBed! ! !LindaTalkBlocking methodsFor: 'as yet unclassified' stamp: 'bolot 8/2/1999 22:29'! tuple "Returns the tuple which caused the blocking" ^ tuple ! ! !LindaTalkBlocking methodsFor: 'as yet unclassified' stamp: 'bolot 8/2/1999 22:29'! wakeUpProcess "Wakes up the process that was waiting for the tuple. Probably a rd or in." bed signal! ! !LindaTalkBlocking class methodsFor: 'as yet unclassified' stamp: 'bolot 8/2/1999 22:30'! forTuple: aTuple "Creates a new LindaTalkBlocking for the given tuple" ^ self new initTuple: aTuple; initBed; yourself! ! !LindaTalkBlocking class methodsFor: 'as yet unclassified' stamp: 'bolot 8/2/1999 22:31'! newBed "Returns a new bed for the processes to sleep (a Semaphore)" ^ Semaphore new! ! !LindaTalkProcess class methodsFor: 'as yet unclassified' stamp: 'bolot 8/3/1999 11:54'! terminateAll "Terminates all LindaTalkProcess" self allInstancesDo: [:ltp | ltp suspend ]! ! !ProcessorScheduler methodsFor: 'private' stamp: 'bolot 8/3/1999 11:53'! anyProcessesAbove: highestPriority "Do any instances of Process exist with higher priorities?" ^(Process "allInstances" allSubInstances select: [:aProcess | aProcess priority > highestPriority]) isEmpty "If anyone ever makes a subclass of Process, be sure to use allSubInstances."! ! !String methodsFor: 'linda' stamp: 'rww 7/22/2001 23:11'! lindaMatch: anObject ^ (super lindaMatch: anObject) or: [anObject lindaMatchWithString: self] ! ! !String methodsFor: 'linda' stamp: 'rww 7/22/2001 23:57'! lindaMatchWithString: receiverString ^ (receiverString match: self) or: [self match: receiverString] ! ! !Subspace methodsFor: 'accessing' stamp: 'bolot 8/2/1999 22:04'! inBlockings "Returns the collection of LindaTalkBlockings In" ^ tuplesIn! ! !Subspace methodsFor: 'accessing' stamp: 'bolot 8/2/1999 22:51'! rdBlockings "Returns the collection of LindaTalkBlockings Rd" ^ tuplesRd! ! !Subspace methodsFor: 'accessing' stamp: 'rww 7/27/2000 19:28'! tuplesEval "Returns the eval partition" ^ tuplesEval! ! !Subspace methodsFor: 'accessing' stamp: 'bolot 8/2/1999 23:18'! tuplesOut "Returns the out partition" ^ tuplesOut! ! !Subspace methodsFor: 'api' stamp: 'bolot 8/2/1999 22:02'! eval: tuple "Eval implementation. Call the primitive in the Tuple class. That primitive evaluates the blocks in parallel, and then the tuple becomes an ordinary tuple, which is outed" self class fork: [self liveToOrdinary: ( self runLiveTuple: tuple )]! ! !Subspace methodsFor: 'api' stamp: 'bolot 8/2/1999 22:03'! in: tuple "In implementation" ^ self inWaitingTuple: tuple.! ! !Subspace methodsFor: 'api' stamp: 'bolot 8/2/1999 22:44'! inp: tuple "Inp implementation" ^ self inNotWaitingTuple: tuple.! ! !Subspace methodsFor: 'api' stamp: 'bolot 8/2/1999 22:44'! justEval: tuple "Just like eval, but the resulting ordinary tuple is discarded after evaluation" self class fork: [ self runLiveTuple: tuple ]! ! !Subspace methodsFor: 'api' stamp: 'bolot 8/2/1999 22:48'! out: tuple "Out implementation" ^ self outPersistentTuple: tuple! ! !Subspace methodsFor: 'api' stamp: 'bolot 8/2/1999 22:50'! outi: tuple "Outi implementation" ^ self outNonPersistentTuple: tuple! ! !Subspace methodsFor: 'api' stamp: 'bolot 8/2/1999 22:50'! rd: tuple "Rd implementation" ^ self rdWaitingTuple: tuple.! ! !Subspace methodsFor: 'api' stamp: 'bolot 8/2/1999 23:14'! rdp: tuple "Rdp implementation" ^ self rdNotWaitingTuple: tuple! ! !Subspace methodsFor: 'api' stamp: 'rww 7/14/2000 02:04'! scan: tuple "Scan implementation" ^ self scanNotWaitingTuple: tuple.! ! !Subspace methodsFor: 'collection api' stamp: 'rww 7/1/2001 19:52'! copy "Returns a copy of the Subspace" | copy | self mutexBegin. copy := super copy zeroTuples. self inBlockings do: [:bloc | copy addInBlocking: bloc copy ]. self tuplesOut do: [:t | copy addOutTuple: t copy ]. self rdBlockings do: [:bloc | copy addRdBlocking: bloc copy]. self tuplesEval do: [:t | copy addLiveTuple: t copy]. self mutexEnd. ^ copy! ! !Subspace methodsFor: 'collection api' stamp: 'bolot 8/2/1999 22:44'! isEmpty "Informs if the subspace is empty. That is, no partition has tuples." ^ (self inBlockings isEmpty) and: [ (self rdBlockings isEmpty) and: [self tuplesOut isEmpty] ]! ! !Subspace methodsFor: 'initialize-release' stamp: 'rww 7/14/2000 02:04'! initialize "Initialize the instance variables. A semaphore for mutual exclusion and the 3 `partitions: In, Out, Rd." mutex := Semaphore new. mutex signal. self zeroTuples. mixer := true. "Mix tuples"! ! !Subspace methodsFor: 'initialize-release' stamp: 'rww 7/3/2001 13:31'! printOn: aStream aStream nextPutAll: 'Subspace ('. aStream nextPutAll: 'in: '. aStream nextPutAll: self inBlockings size printString. aStream nextPutAll: ' rd: '. aStream nextPutAll: self rdBlockings size printString. aStream nextPutAll: ' out: '. aStream nextPutAll: self tuplesOut size printString. aStream nextPutAll: ' eval: '. aStream nextPutAll: self tuplesEval size printString. aStream nextPutAll: ')'. ! ! !Subspace methodsFor: 'initialize-release' stamp: 'rww 7/14/2000 02:04'! zeroTuples "Empties all partitions" tuplesIn := OrderedCollection new. tuplesRd := OrderedCollection new. tuplesOut := OrderedCollection new. tuplesEval := OrderedCollection new.! ! !Subspace methodsFor: 'private-lookup' stamp: 'rww 7/22/2001 22:47'! inBlockingThatMatches: tuple "Returns the index of the LindaTalkBlocking In that matches tuple" | i | i := 1. self inBlockings do: [ :bloc | (tuple lindaMatch: bloc tuple) ifTrue: [ ^ i ]. i := i + 1]. ^ 0! ! !Subspace methodsFor: 'private-lookup' stamp: 'rww 7/22/2001 22:47'! tupleOutThatMatches: tuple "Returns the position of the out tuple that matches tuple" | i | i := 1. self tuplesOut do: [ :t | "The matching is FROM tuple space TO my tuple" (t lindaMatch: tuple ) ifTrue: [ ^ i ]. i := i + 1]. ^ 0! ! !Subspace methodsFor: 'private-lookup' stamp: 'rww 7/22/2001 22:47'! tuplesOutThatMatches: tuple "Returns the collection of positions of the out tuples that matches tuple" "The matching is FROM tuple space TO my tuple" ^self tuplesOut select: [ :t | t lindaMatch: tuple ]! ! !Subspace methodsFor: 'private-add/remove' stamp: 'bolot 8/2/1999 22:37'! addInBlocking: blocking "Add a new LindaTalkBlocking for the In primitive" tuplesIn add: blocking! ! !Subspace methodsFor: 'private-add/remove' stamp: 'bolot 8/2/1999 22:04'! addLiveTuple: tuple "Add the live tuple in the internal partition." tuplesEval addLast: tuple! ! !Subspace methodsFor: 'private-add/remove' stamp: 'bolot 8/2/1999 22:05'! addOutTuple: tuple "Add the tuple in the corresponding partition. Mix the order, so that there is no order relation in the tuple space" mixer ifTrue: [ tuplesOut addLast: tuple ] ifFalse: [ tuplesOut addFirst: tuple ]. mixer := mixer not.! ! !Subspace methodsFor: 'private-add/remove' stamp: 'bolot 8/2/1999 22:05'! addRdBlocking: blocking "Add a new LindaTalkBlocking for the Rd primitive" tuplesRd add: blocking! ! !Subspace methodsFor: 'private-add/remove' stamp: 'bolot 8/2/1999 23:14'! removeInBlocking: position "Removes the blocking" | bloc | bloc := self nthBlockingIn: position. self removeTuple: position fromPartition: tuplesIn. ^ bloc! ! !Subspace methodsFor: 'private-add/remove' stamp: 'bolot 8/2/1999 23:15'! removeLiveTuple: tuple "Removes a given live tuple from its partition" tuplesEval remove: tuple ifAbsent: [self error: 'Error in #removeLiveTuple:']! ! !Subspace methodsFor: 'private-add/remove' stamp: 'bolot 8/2/1999 23:15'! removeRdBlocking: position "Removes a rd blocking from the given position" | bloc| bloc := self nthBlockingRd: position. self removeTuple: position fromPartition: tuplesRd. ^ bloc! ! !Subspace methodsFor: 'private-add/remove' stamp: 'bolot 8/2/1999 23:15'! removeTuple: position fromPartition: partition "Removes a given tuple from a given partition" partition removeAt: position! ! !Subspace methodsFor: 'private-add/remove' stamp: 'rww 7/14/2000 02:04'! removeTupleOut: position "Removes a given out tuple from its partition" | t | t := self tupleOutInPosition: position. self removeTuple: position fromPartition: tuplesOut. ^ t! ! !Subspace methodsFor: 'private-eval' stamp: 'bolot 8/2/1999 22:45'! liveToOrdinary: tuple "Transforms a live tuple in ordinary" self out: tuple! ! !Subspace methodsFor: 'private-eval' stamp: 'rww 7/14/2000 02:04'! runLiveTuple: tuple "Live tuple creation kernel" | tupleEval | self mutexBegin; addLiveTuple: tuple; mutexEnd. tupleEval := tuple copy primEval; yourself. self mutexBegin; removeLiveTuple: tuple; mutexEnd. ^ tupleEval! ! !Subspace methodsFor: 'private' stamp: 'bolot 8/2/1999 22:39'! inNotWaitingTuple: tuple "inp. I do not get blocked if tuple is not available" ^ self inNotWaitingTupleNoSideEffect: tuple! ! !Subspace methodsFor: 'private' stamp: 'bolot 8/2/1999 22:41'! inNotWaitingTupleNoSideEffect: tuple "INP primitive" | match tupleOutThatMatched copy | copy := tuple copy. self mutexBegin. match := self tupleOutThatMatches: copy. (match = 0) ifTrue: [self mutexEnd. ^nil] ifFalse: ["Found one out tuple that matches" tupleOutThatMatched := self removeTupleOut: match. tupleOutThatMatched transferContentsTo: copy. self mutexEnd]. ^ copy "Modified by the match, but the original tuple is not changed"! ! !Subspace methodsFor: 'private' stamp: 'bolot 8/2/1999 22:41'! inWaitingTuple: tuple "In implementation. I will be blocked if there is no tuple." ^ self inWaitingTupleNoSideEffect: tuple! ! !Subspace methodsFor: 'private' stamp: 'bolot 8/2/1999 22:42'! inWaitingTupleNoSideEffect: tuple "IN primitive" | match tupleOutThatMatched copy blocking| copy := tuple copy. self mutexBegin. match := self tupleOutThatMatches: copy. (match = 0) ifTrue: ["No tuple matches. Add a blocking in the in partition " blocking := LindaTalkBlocking forTuple: copy. self addInBlocking: blocking; mutexEnd. blocking sleepProcess. "Out . Someone woke me up ."] ifFalse: ["Found one that matches" tupleOutThatMatched := self removeTupleOut: match. tupleOutThatMatched transferContentsTo: copy. self mutexEnd]. ^ copy "Modified by the match, but the original tuple is not changed"! ! !Subspace methodsFor: 'private' stamp: 'bolot 8/2/1999 22:47'! mutexBegin "Begin of mutual exclusion" mutex wait! ! !Subspace methodsFor: 'private' stamp: 'bolot 8/2/1999 22:47'! mutexEnd "End of mutual exclusion" mutex signal! ! !Subspace methodsFor: 'private' stamp: 'bolot 8/2/1999 22:47'! nthBlockingIn: position "Returns the in blocking in the given position" ^ tuplesIn at: position! ! !Subspace methodsFor: 'private' stamp: 'bolot 8/2/1999 22:48'! nthBlockingRd: position "Returns the rd blocking in the given position" ^ tuplesRd at: position! ! !Subspace methodsFor: 'private' stamp: 'bolot 8/2/1999 22:48'! outNonPersistentTuple: tuple "OUTI primitive. If there is any blocked rd or in, there will be match. The tuple, however, never stays in the space" self outNonPersistentTupleNoSideEffect: tuple! ! !Subspace methodsFor: 'private' stamp: 'bolot 8/2/1999 22:49'! outNonPersistentTupleNoSideEffect: tuple "OUTI implementation" | match tupleInThatMatched blocking | self mutexBegin. self wakeUpRdTuplesThatMatch: tuple. "Atention here" match := self inBlockingThatMatches: tuple. (match = 0 ) ifFalse: ["Found one that matches. Remove from in partition" blocking := self removeInBlocking: match. tupleInThatMatched := blocking tupla. tuple transferContentsTo: tupleInThatMatched. blocking wakeUpProcess]. self mutexEnd! ! !Subspace methodsFor: 'private' stamp: 'bolot 8/2/1999 22:49'! outPersistentTuple: tuple "Out implementation. If there is any rd or in, there will be match" self outPersistentTupleNoSideEffect: tuple! ! !Subspace methodsFor: 'private' stamp: 'bolot 8/2/1999 22:50'! outPersistentTupleNoSideEffect: tuple "OUT primitive" | match tupleInThatMatched blocking| self mutexBegin. self wakeUpRdTuplesThatMatch: tuple. "Atention here " match := self inBlockingThatMatches: tuple. (match = 0 ) ifTrue: ["No tuple matches. Add in the set of out tuples." self addOutTuple: tuple; wakeUpRdTuplesThatMatch: tuple] ifFalse: ["Found one that matches. Remove from the in partition" blocking := self removeInBlocking: match. tupleInThatMatched := blocking tuple. tuple transferContentsTo: tupleInThatMatched. blocking wakeUpProcess]. self mutexEnd! ! !Subspace methodsFor: 'private' stamp: 'bolot 8/2/1999 23:10'! rdNotWaitingTuple: tuple "Rdp primitive. I will not be blocked if there is no tuple available." ^ self rdNotWaitingTupleNoSideEffect: tuple! ! !Subspace methodsFor: 'private' stamp: 'rww 7/14/2000 02:04'! rdNotWaitingTupleNoSideEffect: tuple "Rdp implementation" | match tupleOutThatMatched copy| copy := tuple copy. self mutexBegin. match := self tupleOutThatMatches: copy. (match = 0) ifTrue: [ self mutexEnd. ^nil] ifFalse: ["Found one that matches" tupleOutThatMatched := self tupleOutInPosition: match. tupleOutThatMatched transferContentsTo: copy. self mutexEnd]. ^ copy "Modified by the match, but the original tuple is not changed"! ! !Subspace methodsFor: 'private' stamp: 'bolot 8/2/1999 23:12'! rdWaitingTuple: tuple "Rd implementation. I will be blocked if there is no tuple available" ^ self rdWaitingTupleNoSideEffect: tuple! ! !Subspace methodsFor: 'private' stamp: 'bolot 8/2/1999 23:14'! rdWaitingTupleNoSideEffect: tuple "RD primitive" | match tupleOutThatMatched copy blocking | copy := tuple copy. self mutexBegin. match := self tupleOutThatMatches: copy. (match = 0) ifTrue: ["No tuple matches. Add in the rd partition" blocking := LindaTalkBlocking forTuple: copy. self addRdBlocking: blocking; mutexEnd. blocking sleepProcess. "Out. Someone woke me up."] ifFalse: ["Found one that matches" tupleOutThatMatched := self tupleOutInPosition: match. tupleOutThatMatched transferContentsTo: copy. self mutexEnd]. ^ copy "Modified by the match, but the original tuple is not changed"! ! !Subspace methodsFor: 'private' stamp: 'rww 7/14/2000 02:04'! scanNotWaitingTuple: tuple "Scan primitive. I will not be blocked if there is no tuple available." ^ self scanNotWaitingTupleNoSideEffect: tuple! ! !Subspace methodsFor: 'private' stamp: 'rww 7/14/2000 02:04'! scanNotWaitingTupleNoSideEffect: tuple "Scan implementation" | matches copy | copy := tuple copy. self mutexBegin. matches := self tuplesOutThatMatches: copy. self mutexEnd. ^ matches! ! !Subspace methodsFor: 'private' stamp: 'bolot 8/2/1999 23:17'! tupleOutInPosition: position "Returns the out tuple in the given position" ^ tuplesOut at: position! ! !Subspace methodsFor: 'private' stamp: 'rww 7/22/2001 22:47'! wakeUpRdTuplesThatMatch: tuple "An out happened. Wake up processed that issued rd." | i size nthTuple nthBlocking | i := 1. size := self rdBlockings size. [ i > size ] whileFalse: [ nthBlocking := self nthBlockingRd: i. nthTuple := nthBlocking tuple. (tuple lindaMatch: nthTuple) ifTrue: [ nthBlocking := self removeRdBlocking: i. nthTuple := nthBlocking tuple. tuple transferContentsTo: nthTuple. nthBlocking wakeUpProcess. size := size - 1] ifFalse: [i := i + 1]]! ! !Subspace class methodsFor: 'as yet unclassified' stamp: 'bolot 8/2/1999 22:36'! evalDefaultPriority "Returns the default process priority" ^ Processor userBackgroundPriority! ! !Subspace class methodsFor: 'as yet unclassified' stamp: 'bolot 8/2/1999 22:37'! fork: aBlock "Creates the eval processes" ^ aBlock forkLindaTalkAt: self evalDefaultPriority! ! !Subspace class methodsFor: 'as yet unclassified' stamp: 'bolot 8/2/1999 22:37'! new "Creates and returns a new subspace" ^ super new initialize! ! !Tuple methodsFor: 'Linda API' stamp: 'rww 7/27/2000 08:58'! eval: contextTupleSpace "eval in the given tuple space" ^ contextTupleSpace eval: self! ! !Tuple methodsFor: 'Linda API' stamp: 'bolot 8/2/1999 23:28'! in: aTupleSpace "In at the given tuple space" ^ aTupleSpace in: self! ! !Tuple methodsFor: 'Linda API' stamp: 'bolot 8/2/1999 23:29'! inp: aTupleSpace "inp in the given tuple space" ^ aTupleSpace inp: self! ! !Tuple methodsFor: 'Linda API' stamp: 'bolot 8/3/1999 00:03'! out: aTupleSpace "out in the given tuple space" ^ aTupleSpace out: self! ! !Tuple methodsFor: 'Linda API' stamp: 'rww 7/27/2000 23:22'! outi: aTupleSpace "outi in the given tuple space" ^ aTupleSpace outi: self! ! !Tuple methodsFor: 'Linda API' stamp: 'rww 7/27/2000 19:18'! primEval "The actual eval. Forks the blocks in parallel, and replaces the parameters after the computations finish" | processes sync index| processes := Dictionary new. sync := Semaphore new. index := 1. self do: [:p | (p isKindOf: self lindaTalkComputing ) ifTrue: [ processes at: index put: p]. index := index + 1]. "I have index->process" processes associationsDo: [:assoc | self fork: assoc value parameter: assoc key synchronizingIn: sync]. processes keysDo: [:k | sync wait ]. "Wait all finish"! ! !Tuple methodsFor: 'Linda API' stamp: 'bolot 8/3/1999 00:07'! rd: aTupleSpace "rd in the given tuple space" ^ aTupleSpace rd: self! ! !Tuple methodsFor: 'Linda API' stamp: 'bolot 8/3/1999 00:08'! rdp: aTupleSpace "rdp in the given tuple space" ^ aTupleSpace rdp: self! ! !Tuple methodsFor: 'utils' stamp: 'bolot 8/2/1999 23:24'! - anIndex "Returns a new tuple, which is just like the original one, but without the element anIndex" ^ self copy removeAtIndex: anIndex; yourself! ! !Tuple methodsFor: 'utils' stamp: 'rww 8/26/2001 00:30'! = anotherTuple "Returns true if there is equality" | pSelf pOther | self arity = anotherTuple arity ifFalse: [^ false]. 1 to: self arity do: [:i | pSelf _ self parameter: i. pOther _ anotherTuple parameter: i. pSelf = pOther ifFalse: [^ false]]. ^ true! ! !Tuple methodsFor: 'utils' stamp: 'bolot 8/2/1999 23:24'! @ anIndex "Returns the given parameter" ^ self at: anIndex! ! !Tuple methodsFor: 'utils' stamp: 'bolot 8/2/1999 23:24'! addParameter: aTupleParameter "Adds another parameter to the original tuple" self add: aTupleParameter! ! !Tuple methodsFor: 'utils' stamp: 'bolot 8/2/1999 23:25'! arity "Returns the number of elements of the tuple" ^ self size! ! !Tuple methodsFor: 'utils' stamp: 'bolot 8/2/1999 23:25'! asTuple "Returns myself" ^ self! ! !Tuple methodsFor: 'utils' stamp: 'bolot 8/2/1999 23:25'! changeParameter: anIndex by: anObject "Changes a given parameter" self at: anIndex put: anObject! ! !Tuple methodsFor: 'utils' stamp: 'bolot 8/2/1999 23:27'! fork: aBlock parameter: anIndex synchronizingIn: semaphore "Forks a process for the corresponding live parameter. When finished, the process signals a semaphore, so that the root process which forked the live parameters can collect the results and assemble the resulting ordinary tuple." self class fork: [self changeParameter: anIndex by: aBlock value. semaphore signal]! ! !Tuple methodsFor: 'utils' stamp: 'rww 7/22/2001 23:34'! isFilter: anObject "Returns true is the object is a filter. This is not standard Linda. Filter is a block which takes the object as a parameters and returns either true or false. For instance: ( Integer | [:num | num < 3]) lindaMatch: ( 33 | 2 ) ( 33 | 2 ) lindaMatch: ( Integer | [:num | num < 3]) returns true" ^ (anObject isKindOf: self lindaTalkFilter) and: [ 1 = anObject numArgs]! ! !Tuple methodsFor: 'utils' stamp: 'bolot 8/2/1999 23:31'! isLindaTalkComputing: anObject "Informs if the object is a LindaTalk computing" ^ (anObject isKindOf: self lindaTalkComputing) and: [ 0 = anObject numArgs]! ! !Tuple methodsFor: 'utils' stamp: 'bolot 8/2/1999 23:31'! isPotential: anObject "Returns true if the given object is a potential (class)" ^ anObject isKindOf: Behavior! ! !Tuple methodsFor: 'utils' stamp: 'bolot 8/2/1999 23:32'! isPotentialParameter: anIndex "Returns true if the given parameter is a potential (class)" ^ self isPotential: (self at: anIndex )! ! !Tuple methodsFor: 'utils' stamp: 'rww 7/2/2001 21:45'! isTuple ^true! ! !Tuple methodsFor: 'utils' stamp: 'bolot 8/2/1999 23:32'! lindaTalkComputing "Returns the class that represents a LindaTalk computing. That is, the elements in a live tuple" ^ BlockContext! ! !Tuple methodsFor: 'utils' stamp: 'bolot 8/2/1999 23:32'! lindaTalkFilter "Returns the class that represents filters in LindaTalk" ^ BlockContext! ! !Tuple methodsFor: 'utils' stamp: 'bolot 8/3/1999 00:04'! parameter: anIndex "Returns the given tuple parameter (indexed)" ^ self at: anIndex! ! !Tuple methodsFor: 'utils' stamp: 'bolot 8/3/1999 00:07'! printOn: aStream "Shows the tuple" aStream nextPutAll: self class name , ':( '. 1 to: self size do: [:i | ( self isLindaTalkComputing: (self at: i)) ifTrue: [ aStream nextPutAll: '[...computing...]' ] ifFalse: [ ( self isFilter: (self at: i)) ifTrue: [ aStream nextPutAll: ' Filter [:x | ...filter x...]' ] ifFalse: [ (self at: i) printOn: aStream]]. aStream nextPutAll: ' | ']. aStream skip: -2. aStream nextPutAll: ') '! ! !Tuple methodsFor: 'utils' stamp: 'rww 7/27/2000 09:03'! transferContentsTo: anotherTuple "Implements the transfer from reals to potentials" | index | index := 1. anotherTuple do: [ :p | ((self isPotential: p) or: [self isFilter: p]) ifTrue: [ anotherTuple changeParameter: index by: (self parameter: index )]. index := index + 1]! ! !Tuple methodsFor: 'utils' stamp: 'bolot 8/3/1999 00:10'! | anElement "Adds another parameter to the original tuple" ^ self addParameter: anElement; yourself! ! !Tuple methodsFor: 'matching' stamp: 'rww 7/22/2001 23:37'! lindaMatch: anObject ^ (super lindaMatch: anObject) or: [anObject lindaMatchWithTuple: self] ! ! !Tuple methodsFor: 'matching' stamp: 'rww 7/23/2001 00:40'! lindaMatchWithObject: anObject ^ anObject lindaMatchWithTuple: self ! ! !Tuple methodsFor: 'matching' stamp: 'rww 7/23/2001 00:00'! lindaMatchWithTuple: anotherTuple "Returns true if there is matching" ( self arity = anotherTuple arity ) ifFalse: [ ^ false ]. 1 to: self arity do: [ :i | ((self parameter: i) lindaMatch: (anotherTuple parameter: i)) ifFalse: [ ^ false ] ]. ^ true ! ! !Tuple methodsFor: 'collection API' stamp: 'rww 7/27/2000 23:30'! add: aTupleParameter "Adds another parameter to the original tuple" fields := fields copyWith: aTupleParameter. ! ! !Tuple methodsFor: 'collection API' stamp: 'rww 7/14/2000 02:04'! addAll: aParameterCollection "Add a collection of parameters to the original tuple" aParameterCollection do: [:e | self add: e].! ! !Tuple methodsFor: 'collection API' stamp: 'rww 7/27/2000 23:29'! at: index "Get the parameter at the index" ^ fields at: index! ! !Tuple methodsFor: 'collection API' stamp: 'rww 7/27/2000 20:34'! at: index put: aTupleParameter "Put the parameter at the index" fields at: index put: aTupleParameter. ! ! !Tuple methodsFor: 'collection API' stamp: 'rww 7/27/2000 20:42'! do: aBlock fields do: [:eachField | aBlock value: eachField].! ! !Tuple methodsFor: 'collection API' stamp: 'rww 7/14/2000 02:04'! size ^fields size! ! !Tuple methodsFor: 'initialize-release' stamp: 'rww 7/25/2000 00:53'! initialize fields := OrderedCollection new. self class defaultArity timesRepeat: [self add: nil].! ! !Tuple class methodsFor: 'as yet unclassified' stamp: 'rww 7/23/2001 00:41'! example "Example of tuple matching" ^ ( 5 | nil | $f | Point ) lindaMatch: ( Integer | UndefinedObject | $f | (2@3) )! ! !Tuple class methodsFor: 'as yet unclassified' stamp: 'bolot 8/2/1999 23:23'! fork: aBlock "Creates an eval process" ^ Subspace fork: aBlock! ! !Tuple class methodsFor: 'instance creation' stamp: 'rww 7/14/2000 02:04'! defaultArity ^0! ! !Tuple class methodsFor: 'instance creation' stamp: 'rww 7/14/2000 02:04'! new ^super new initialize! ! !Tuple class methodsFor: 'instance creation' stamp: 'rww 7/27/2000 23:28'! with: anObject ^ self new add: anObject; yourself ! ! !Tuple class methodsFor: 'instance creation' stamp: 'rww 7/27/2000 23:28'! with: obj1 with: obj2 ^ self new add: obj1; add: obj2; yourself ! ! !TupleSpace methodsFor: 'core' stamp: 'bolot 8/3/1999 00:11'! compact "Deletes empty partitions" (self subspaces select: [:x | x isEmpty] ) keysDo: [:size | self subspaces removeKey: size]! ! !TupleSpace methodsFor: 'core' stamp: 'rww 7/27/2000 23:16'! copy "Returns a copy of the TupleSpace" | copy dic | copy := super copy. dic := Dictionary new. self subspaces associationsDo: [ :assoc | dic at: assoc key put: assoc value copy ]. copy subspaces: dic. ^ copy! ! !TupleSpace methodsFor: 'core' stamp: 'bolot 8/3/1999 00:11'! eval: tuple "Forwards the eval primitive to the right partition" ( self sub: tuple ) eval: tuple! ! !TupleSpace methodsFor: 'core' stamp: 'bolot 8/3/1999 00:12'! flush "Flushes (emties) the TupleSpace" ^ self initialize! ! !TupleSpace methodsFor: 'core' stamp: 'bolot 8/3/1999 00:12'! in: tuple "Forwards the in primitive to the right partition" ^ ( self sub: tuple ) in: tuple! ! !TupleSpace methodsFor: 'core' stamp: 'rww 7/27/2000 23:16'! initialize "Initializes the Dictionary that stores the TupleSpace partitions (Subspaces). These partition are based on the tuple arity" self subspaces: Dictionary new! ! !TupleSpace methodsFor: 'core' stamp: 'bolot 8/3/1999 00:13'! inp: tuple "Forwards the inp primitive to the right partition" ^ ( self sub: tuple ) inp: tuple! ! !TupleSpace methodsFor: 'core' stamp: 'bolot 8/3/1999 00:14'! justEval: tuple "Forwards the justEval primitive to the right partition" ( self sub: tuple ) justEval: tuple! ! !TupleSpace methodsFor: 'core' stamp: 'rww 7/1/2001 23:51'! newSubspace ^ Subspace new! ! !TupleSpace methodsFor: 'core' stamp: 'bolot 8/3/1999 00:14'! out: tuple "Forwards the out primitive to the right partition" ( self sub: tuple ) out: tuple! ! !TupleSpace methodsFor: 'core' stamp: 'bolot 8/3/1999 00:14'! outi: tuple "Forwards the outi primitive to the right partition" ( self sub: tuple ) outi: tuple! ! !TupleSpace methodsFor: 'core' stamp: 'bolot 8/3/1999 00:15'! partitions "Returns a collection of partitions with tuples (e.g. #(1 5 8 9) )." ^ subspaces keys asSortedCollection! ! !TupleSpace methodsFor: 'core' stamp: 'bolot 8/3/1999 00:15'! rd: tuple "Forwards the rd primitive to the right partition" ^ ( self sub: tuple ) rd: tuple! ! !TupleSpace methodsFor: 'core' stamp: 'bolot 8/3/1999 00:15'! rdp: tuple "Forwards the rdp primitive to the right partition" ^ ( self sub: tuple ) rdp: tuple! ! !TupleSpace methodsFor: 'core' stamp: 'rww 7/27/2000 23:18'! scan: tuple "Forwards the scan primitive to the right partition" ^ (self sub: tuple) scan: tuple ! ! !TupleSpace methodsFor: 'core' stamp: 'bolot 8/3/1999 00:16'! sub: tuple "Returns the subspace for the tuple. This is like hashing a big TuplaSpace in subspaces based on tuple sizes." ^ self subspaceForArity: tuple arity! ! !TupleSpace methodsFor: 'core' stamp: 'rww 7/1/2001 23:51'! subspaceForArity: tupleArity "Returns the subspace where the tuples of a given size are stored, etc." | newSub | ^ subspaces at: tupleArity ifAbsent: [subspaces at: tupleArity put: ( newSub := self newSubspace). ^ newSub ]! ! !TupleSpace methodsFor: 'core' stamp: 'bolot 8/3/1999 00:17'! subspaces "Returns the dictionary size -> subspace" ^ subspaces! ! !TupleSpace methodsFor: 'core' stamp: 'rww 7/27/2000 23:17'! subspaces: aDictionary "Changes the subspaces dictionary" subspaces := aDictionary! ! !TupleSpace methodsFor: 'errors' stamp: 'rww 7/14/2000 02:04'! errorNotKeyed self lindaError new messageText: 'TupleSpace is not keyed'; signal.! ! !TupleSpace methodsFor: 'errors' stamp: 'rww 7/14/2000 02:04'! lindaError ^self class lindaError.! ! !TupleSpace methodsFor: 'errors' stamp: 'rww 7/14/2000 02:04'! tupleNotFound self lindaError new messageText: 'Tuple not found'; signal.! ! !TupleSpace methodsFor: 'Collection API' stamp: 'rww 7/14/2000 02:04'! add: aTuple ^self out: aTuple! ! !TupleSpace methodsFor: 'Collection API' stamp: 'rww 7/14/2000 02:04'! detect: aTupleTemplate ^self detect: aTupleTemplate ifNone: [self tupleNotFound].! ! !TupleSpace methodsFor: 'Collection API' stamp: 'rww 7/14/2000 02:04'! detect: aTupleTemplate ifNone: aNoneBlock |result| result := self rdp: aTupleTemplate. ^ result ifNil: [aNoneBlock value].! ! !TupleSpace methodsFor: 'Collection API' stamp: 'rww 7/14/2000 02:04'! includes: aTupleTemplate ^self subspaces includes: aTupleTemplate! ! !TupleSpace methodsFor: 'Collection API' stamp: 'rww 7/14/2000 02:04'! remove: aTupleTemplate ^self remove: aTupleTemplate ifNone: [self tupleNotFound].! ! !TupleSpace methodsFor: 'Collection API' stamp: 'rww 7/14/2000 02:04'! remove: aTupleTemplate ifNone: aNoneBlock |result| result := self inp: aTupleTemplate. ^result ifNil: [aNoneBlock value].! ! !TupleSpace methodsFor: 'Collection API' stamp: 'rww 7/14/2000 02:04'! removeAll: aTupleTemplate |all| all := self scan: aTupleTemplate. all do: [:e | self remove: e]. ^all! ! !TupleSpace methodsFor: 'Collection API' stamp: 'rww 7/14/2000 02:04'! select: aTupleTemplate ^self scan: aTupleTemplate.! ! !TupleSpace methodsFor: 'Collection API' stamp: 'rww 7/26/2000 17:14'! syncDetect: aTupleTemplate ^ self rd: aTupleTemplate. ! ! !TupleSpace methodsFor: 'Collection API' stamp: 'rww 7/26/2000 17:14'! syncRemove: aTupleTemplate ^ self in: aTupleTemplate! ! !TupleSpace methodsFor: 'Collection API' stamp: 'rww 7/24/2000 09:16'! transientAdd: aTuple ^self outi: aTuple! ! !TupleSpace methodsFor: 'Collection API - not impl' stamp: 'rww 7/14/2000 02:04'! at: index self errorNotKeyed! ! !TupleSpace methodsFor: 'Collection API - not impl' stamp: 'rww 7/14/2000 02:04'! at: index put: anObject self errorNotKeyed! ! !TupleSpace methodsFor: 'Collection API - not impl' stamp: 'rww 7/14/2000 02:04'! collect: aTupleTemplate self notYetImplemented.! ! !TupleSpace methodsFor: 'Collection API - not impl' stamp: 'rww 7/14/2000 02:04'! do: anEvalTuple self notYetImplemented.! ! !TupleSpace class methodsFor: 'instance creation' stamp: 'bolot 8/3/1999 00:20'! new "Returns a new tuple space" ^ super new initialize! ! !TupleSpace class methodsFor: 'examples' stamp: 'rww 7/28/2000 00:59'! example self example: 100. ! ! !TupleSpace class methodsFor: 'examples' stamp: 'rww 7/29/2000 17:21'! example: numberOfTupleToWrite self example: numberOfTupleToWrite priority: Processor userBackgroundPriority. ! ! !TupleSpace class methodsFor: 'examples' stamp: 'rww 7/8/2001 21:58'! example: numberOfTupleToWrite priority: aPriority | tupleSpace | tupleSpace := self new. self runPerformanceOn: tupleSpace numberToWrite: numberOfTupleToWrite priority: aPriority. ! ! !TupleSpace class methodsFor: 'examples' stamp: 'rww 7/2/2001 22:37'! runPerformanceOn: tupleSpace numberToWrite: numberOfTupleToWrite priority: aPriority [ "Run the following code..." | count sem1 time1 sem2 time2 | sem1 := Semaphore new. sem2 := Semaphore new. count := 1. [| tuple | tuple := ('LindaTest' | ('Squeak Rulez!!->1.', count printString)). time1 := Time millisecondsToRun: [numberOfTupleToWrite timesRepeat: [ tupleSpace add: tuple copy. count := count + 1. ]. sem1 signal]. ] forkAt: aPriority. [| tuple | tuple := ('LindaTest' | String). time2 := Time millisecondsToRun: [numberOfTupleToWrite timesRepeat: [ tupleSpace syncRemove: tuple. ]. sem2 signal]. ] forkAt: aPriority. sem1 wait. sem2 wait. Transcript cr; cr; cr; show: self class name, ' performance with Priority: ', aPriority printString, '!!'; cr; show: '*** time to add ', numberOfTupleToWrite printString, ' tuples: '; show: (time1 / 1000) asFloat printString; cr; show: '*** time to remove ', numberOfTupleToWrite printString, ' tuples: '; show: (time2 / 1000) asFloat printString; cr; show: '*** tuple process rate: '; show: ((2*numberOfTupleToWrite)*1000/(time1 + time2)) asFloat printString; show: ' (tuples/second) '; cr; show: '*** tuple process rate per minute: '; show: ((2*numberOfTupleToWrite)*60*1000/(time1 + time2)) asFloat printString; show: ' (tuples/minute) '. ] forkAt: Processor userBackgroundPriority. ! ! !TupleSpace class methodsFor: 'documentation' stamp: 'bolot 8/3/1999 13:31'! basicExample "Alguns exemplos simples de utilizacao de Linda. Por via das duvidas, execute antes: Simple Linda example. Execute the following before running this example: TimeSlicer reinitialize. TupleSpace inicializaTupleSpaceDefault." "Selecione as tres linhas abaixo e execute com showIt" "It selects tres strings below and it executes with showIt" ( 'factorial' | 3 | [ 3 factorial] ) eval. ( 'factorial' | 6 | [ 6 factorial] ) eval. ( 'factorial' | Integer | Integer ) in. "Selecione as duas linhas abaixo e execute com showIt" "It selects the two strings below and it executes with showIt" ( 'mouse' | [ [Cursor sense y < 10] whileFalse: []. "Terminal bell." Cursor sense] ) eval. ( 'mouse' | Point ) rd. ( 'mouse' | Point ) in. "Selecione as duas linhas abaixo e execute com showIt" "It selects the two strings below and it executes with showIt" ( 'mouse' | [ [Cursor sense y < 10] whileFalse: [Time now printString displayAt: 100 @ 20]. Cursor sense x] | [ [Cursor sense x < 10] whileFalse: [Time now printString displayAt: 3 @ 100]. Cursor sense y] ) eval. ( 'mouse' | Integer | Integer ) in.! ! !TupleSpace class methodsFor: 'documentation' stamp: 'bolot 8/3/1999 14:08'! exemploDesenho "Exemplo do uso de Linda para despachar mensagens para um objeto Smalltalk, no estilo cliente-servidor. Aqui e' criada uma tupla viva, que despacha mensagens para uma outra tartaruga desenhar. O eval, entao, comporta-se como uma tartaruga servidora. Example of use of forwarding messages for a Smalltalk object, in the style client-server. Here one live tuple is created, and it forwards messages to another turtle to draw. The eval, entao, behave as a serving turtle" ( 'GC' | [ self exemploDesenhoTartServidora ] ) eval. "Dispara um processo que despacha mensagens" "A process goes off that forwards messages" ('GC' | 1 | (Message new setSelector: #displayLineFrom:to: arguments: ( Array with: (0@0) with: (100@100) ); yourself) ) out. ('GC' | 2 | (Message new setSelector: #displayString:at: arguments: ( Array with: ('cliente-servidor em LindaTalk') with: (60 @ 60) ); yourself) ) out. ('GC' | 3 | (Message new setSelector: #displayRectangle:at: arguments: (Array with: (50@10 extent: 50 @ 50) with: ( 60 @ 10) ); yourself) ) out. ('GC' | 4 | (Message new) ) out. "Manda processo terminar - It orders process to finish " ^ ('GC' | Object ) in. "Espera processo terminar - Wait process to finish"! ! !TupleSpace class methodsFor: 'documentation' stamp: 'bolot 8/3/1999 12:26'! exemploDesenhoTartServidora "Aqui implementa-se o kernel do tratamento de mensagens a serem despachadas. Sequencialmente, uma-a-uma, as mensagens sao tratadas. Veja o metodo #exemploDesenho Here kernel of the handling of messages is implemented to be dispatched. Sequentially, uma-a-uma, the treated messages sao. (It) sees method #exemploDesenho " | tupla gc service | Transcript show: '*** Comecando .... ***'. gc := ScheduledControllers activeController view graphicsContext. service := 1. [tupla := ( 'GC' | service | Message ) in . Transcript show: '**desenhar!! - to draw!!**'. (tupla @ 3 ) selector isNil] whileFalse: [gc perform: (tupla @ 3) selector withArguments: (tupla @ 3) arguments ]. ^ 'fim'! ! !TupleSpace class methodsFor: 'documentation' stamp: 'bolot 8/3/1999 12:33'! exemploEfeitoColateral "Exemplo para testar se a tupla in e' alterada ou se e' retornada uma nova tupla. Avalie antes o seguinte codigo: Example to test if a tuple in and modified or if and returned new tuple. Evaluate the following before running this example: TupleSpace initDefaultTupleSpace" | tuplaOut1 tuplaOut2 tuplaIn1 tuplaIn2 tuplaMatch | tuplaOut1 _ ( 23 | 'ver' ). " ver = to see " tuplaOut2 _ ( 24 | 'ver' ). tuplaMatch _ ( Integer | String ). tuplaOut1 out. tuplaOut2 out. tuplaIn1 _ tuplaMatch inp. tuplaIn1 isNil ifTrue: [ ^'Erro no espaco de tuplas - Error in the tuple space']. "Nao deveria dar erro aqui !!!!!!!!!!!!" "Nao would have to raise an error here!!!!!!!!!!!!" tuplaIn2 _ tuplaMatch inp. tuplaIn2 isNil ifTrue: [ ^'Esta implementacao possui efeito colateral - ', 'This implementacao possesss collateral effect']. "Nao deveria dar erro aqui se a implementacao fosse puramente funcional, ou seja, caso nao se alterasse a tupla match quando de uma primitiva de leitura do espaco. Dever-se-ia retornar uma nova tupla, que seria o resultado do match" "Nao would have to give error here if implementation was purely functional, or either, case nao if match when of a primitive of reading of the space modified tuple. Tuple would have to be returned new, that it would be the result of match" ^ 'Esta implementacao nao possui efeito colateral - ', 'This implementacao nao possesss collateral effect'! ! !TupleSpace class methodsFor: 'documentation' stamp: 'bolot 8/3/1999 13:19'! exemploRelogio "Exemplo do uso de Linda. Criam-se tuplas vivas, que ficam mostrando a hora na tela. Quando se aproxima o cursor de algum dos relogios, a tupla viva transforma-se em uma tupla ordinaria. Por via das duvidas, execute antes: They create live tuples, which are showing time on the screen. When the cursor of some of the relogios is come close, live tuple is changed into an ordinary tuple. Execute the following before running this example: TimeSlicer reinitialize. TupleSpace initDefaultTupleSpace. TupleSpace exemploRelogio." ( 'relogio' | [ [(Cursor sense x - 0) abs <= 5] whileFalse: [Time now printString displayAt: 0 @ 20]. Cursor sense x] ) eval. ( 'relogio' | [ [(Cursor sense x - 100) abs <= 5] whileFalse: [Time now printString displayAt: 100 @ 20]. Cursor sense x] ) eval. ( 'relogio' | [ [(Cursor sense x - 200) abs <= 5] whileFalse: [Time now printString displayAt: 200 @ 20]. Cursor sense x] ) eval. ( 'relogio' | [ [(Cursor sense x - 300) abs <= 5] whileFalse: [Time now printString displayAt: 300 @ 20]. Cursor sense x] ) eval. ( 'relogio' | [ [(Cursor sense x - 400) abs <= 5] whileFalse: [Time now printString displayAt: 400 @ 20]. Cursor sense x] ) eval. ^ ( 'relogio' | Integer ) in.! ! !TupleSpace class methodsFor: 'documentation' stamp: 'bolot 8/3/1999 13:28'! exemplosDeMatching "Alguns casos onde ocorre e onde nao ocorre o matching de tuplas. Some cases where it occurs and where nao occur matching of tuplas" "Matching com parametros reais apenas. Execute as tres linhas que seguem com showIt" "Matching with real parametros only. It executes tres strings that follow with showIt" TupleSpace initDefaultTupleSpace. ( (2@8) | 3 | 'marcio' ) out. ( (2@8) | 3 | 'marcio' ) inp. "Matching com parametros reais e potenciais . Execute as tres linhas que seguem com showIt" "Matching with real and potential parametros. It executes tres strings that follow with showIt" TupleSpace initDefaultTupleSpace. ( (2@8) | 3 | 'marcio' ) out. ( (2@8) | Integer | String) inp. "Matching com parametros reais e potenciais, com dois potenciais, um em cada tupla. Execute as tres linhas que seguem com showIt" "Matching with real and potential parameters, two potentials, one in each tuple. It executes tres strings that follow with showIt" TupleSpace initDefaultTupleSpace. ( (2@8) | Integer | 'marcio' ) out. ( Point | Integer | 'marcio' ) inp. "Matching com parametros reais e potenciais, mas com o parametro real na tupla in e o potencial na tupla out. Execute as tres linhas que seguem com showIt" "Matching with real and potential parametros, but with parametro real in tupla in and the potential in tupla out. It executes tres strings that follow with showIt" TupleSpace initDefaultTupleSpace. ( (2@8) | Integer | 'marcio' ) out. ( Point | 5 | String) inp.! ! !TupleSpace class methodsFor: 'documentation' stamp: 'bolot 8/3/1999 13:31'! exemplosNaoBloqueantes "Exemplo do uso de Linda. O objetivo aqui e' mostrar o comportamento das primitivas nao-bloqueantes (rdp e inp) Example of the behavior of the non-blocking primitives (rdp and inp)" "Selecione as tres linhas abaixo e execute com showIt" "Select the strings below and execute with showIt" ( 'fatorial' | 3 | [ 3 factorial] ) eval. ( 'fatorial' | 6 | [ 6 factorial] ) eval. ( 'fatorial' | Integer | Integer ) inp. "Selecione as duas linhas abaixo e execute com showIt" "Select the strings below and execute with showIt" ( 'mouse' | [ [Cursor sense y < 10] whileFalse: []. "Terminal bell." Cursor sense] ) eval. ( 'mouse' | Point ) rdp. ( 'mouse' | Point ) inp. "Selecione as duas linhas abaixo e execute com showIt" "Select the strings below and execute with showIt" ( 'mouse' | [ [Cursor sense y < 10] whileFalse: [Time now printString displayAt: 100 @ 20]. Cursor sense x] | [ [Cursor sense x < 10] whileFalse: [Time now printString displayAt: 3 @ 100]. Cursor sense y] ) eval. ( 'mouse' | Integer | Integer ) inp.! ! !TupleSpace class methodsFor: 'documentation' stamp: 'rww 7/28/2000 01:38'! philExample "TupleSpace philExample." ^self philExampleWithNumber: 5. ! ! !TupleSpace class methodsFor: 'documentation' stamp: 'rww 7/28/2000 01:38'! philExampleWithNumber: aNum "TupleSpace philExample." | numPhil tupleSpace | tupleSpace := TupleSpace new. numPhil := aNum. "Number of philosophers" ('numberOfPhilosophers' | numPhil ) out: tupleSpace. "Constants should be kept in tuple space" 1 to: numPhil do: [ :i | ('Phil #', i printString, ' now alive...') displayAt: 10@(i*20). ('fork' | i ) out: tupleSpace. "Creates the Nth fork" ('phil' | i ) out: tupleSpace. "Philosopher's ID" ('phil' | [self philLife: tupleSpace] ) eval: tupleSpace. "Creates the philosopher" "Give tickets to be used to enter the room" i < numPhil ifTrue: [ #( 'ticket') asTuple out: tupleSpace]]. ^ tupleSpace. ! ! !TupleSpace class methodsFor: 'documentation' stamp: 'rww 7/28/2000 01:37'! philLife: tupleSpace | phils numPhils myId myself| phils := ('numberOfPhilosophers' | Integer ) rd: tupleSpace. "Read the constant" numPhils := phils at: 2. myself := ('phil' | Integer ) in: tupleSpace. "Get my ID" myId := myself @ 2. "Get my ID" 10 timesRepeat: [ ('Phil #', myId printString, ' now thinking...') displayAt: 10@(myId*20). (Delay forMilliseconds: 200) wait. "Think for a while..." #( 'ticket') asTuple in: tupleSpace. "Obtain a ticket to eat" ('fork' | myId ) in: tupleSpace. "Get my left fork" ('fork' | ((myId \\ numPhils) + 1) ) in: tupleSpace. "Get my right fork" ('Phil #', myId printString, ' now eating...') displayAt: 10@(myId*20). (Delay forMilliseconds: 200) wait. "Eat for a while..." ('fork' | myId) out: tupleSpace. "Puts the left fork back on the table" ('fork' | ((myId \\ numPhils) + 1)) out: tupleSpace. "Same with the right one" #( 'ticket') asTuple out: tupleSpace. "Returns the ticket" ]. ('Phil #', myId printString, ' now done...') displayAt: 10@(myId*20). ^ Array with: myId with: 'fim'! ! !TupleSpace class methodsFor: 'error handling' stamp: 'rww 7/14/2000 02:04'! lindaError ^LindaError! ! !TupleSpace class reorganize! ('instance creation' new) ('examples' example example: example:priority: runPerformanceOn:numberToWrite:priority:) ('documentation' basicExample exemploDesenho exemploDesenhoTartServidora exemploEfeitoColateral exemploRelogio exemplosDeMatching exemplosNaoBloqueantes philExample philExampleWithNumber: philLife:) ('error handling' lindaError) ! !TupleSpace reorganize! ('core' compact copy eval: flush in: initialize inp: justEval: newSubspace out: outi: partitions rd: rdp: scan: sub: subspaceForArity: subspaces subspaces:) ('errors' errorNotKeyed lindaError tupleNotFound) ('Collection API' add: detect: detect:ifNone: includes: remove: remove:ifNone: removeAll: select: syncDetect: syncRemove: transientAdd:) ('Collection API - not impl' at: at:put: collect: do:) ! !Subspace reorganize! ('accessing' inBlockings rdBlockings tuplesEval tuplesOut) ('api' eval: in: inp: justEval: out: outi: rd: rdp: scan:) ('collection api' copy isEmpty) ('initialize-release' initialize printOn: zeroTuples) ('private-lookup' inBlockingThatMatches: tupleOutThatMatches: tuplesOutThatMatches:) ('private-add/remove' addInBlocking: addLiveTuple: addOutTuple: addRdBlocking: removeInBlocking: removeLiveTuple: removeRdBlocking: removeTuple:fromPartition: removeTupleOut:) ('private-eval' liveToOrdinary: runLiveTuple:) ('private' inNotWaitingTuple: inNotWaitingTupleNoSideEffect: inWaitingTuple: inWaitingTupleNoSideEffect: mutexBegin mutexEnd nthBlockingIn: nthBlockingRd: outNonPersistentTuple: outNonPersistentTupleNoSideEffect: outPersistentTuple: outPersistentTupleNoSideEffect: rdNotWaitingTuple: rdNotWaitingTupleNoSideEffect: rdWaitingTuple: rdWaitingTupleNoSideEffect: scanNotWaitingTuple: scanNotWaitingTupleNoSideEffect: tupleOutInPosition: wakeUpRdTuplesThatMatch:) !