'From Squeak3.2gamma of 15 January 2002 [latest update: #4889] on 1 July 2002 at 11:14:27 pm'! Object subclass: #Monitor instanceVariableNames: 'mutex ownerProcess defaultQueue queueDict ' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Processes'! !Monitor commentStamp: 'NS 7/1/2002 22:22' prior: 0! A monitor provides process synchronization that is more highlevel than the one provided by a Semaphore. Similar to the classical definition of a Monitor, it has the following properties: 1) At any time, only one process can be executing code inside a critcal section of a monitor. 2) A monitor is reentrant, which means that the active process in a monitor does never get blocked when it enters a (nested) critical section of the same monitor. 3) Inside a critcal section, a process can wait for an event that maybe coupled to a certain condition. If the condition is not fulfilled, the process leaves the monitor temporarily (in order to let other processes enter) and waits until another process signals the event. Then, the original process checks the condition again (this often necessary because the state of the monitor could have changed in the meantime) and continues if it is fulfilled. 4) The monitor is fair, which means that the process that is waiting on a signaled condition the longest gets activated first. 5) The monitor allows to define timeouts after which a process gets activated automatically. Basic usage: Monitor>>critcal: aBlock Critical section. Executes aBlock as a critcal section. At any time, only one process can be executing code in a critical section. NOTE: All the following synchronization operations are only valid inside the critical section of the monitor!! Monitor>>wait Unconditional waiting for the default event. The current process gets blocked and leaves the monitor, which means that the monitor allows another process to execute critical code. When the default event is signaled, the original process is resumed. Monitor>>waitWhile: aBlock Conditional waiting for the default event. The current process gets blocked and leaves the monitor only if the argument block evaluates to true. This means that another process can enter the monitor. When the default event is signaled, the original process is resumed, which means that the condition (argument block) is checked again. Only if it evaluates to false, execution proceeds. Otherwise, the process gets blcoked and leaves the monitor again... Monitor>>waitUntil: aBlock Conditional waiting for the default event. See Monitor>>waitWhile: aBlock. Monitor>>signal One process waiting for the default event is woken up. Monitor>>signalAll All processes waiting for the default event are woken up. Using non-default (specific) events: Monitor>>waitFor: aSymbol Unconditional waiting for the non-default event represented by the argument symbol. Same as Monitor>>wait, but the process gets only reactivated by the specific event and not the default event. Monitor>>waitWhile: aBlock for: aSymbol Confitional waiting for the non-default event represented by the argument symbol. Same as Monitor>>waitWhile:for:, but the process gets only reactivated by the specific event and not the default event. Monitor>>waitUntil: aBlock for: aSymbol Confitional waiting for the non-default event represented by the argument symbol. See Monitor>>waitWhile:for: aBlock. Monitor>>signal: aSymbol One process waiting for the given event is woken up. If there is no process waiting for this specific event, a process waiting for the default event gets resumed. Monitor>>signalAll: aSymbol All process waiting for the given event or the default event are woken up. Monitor>>signalReallyAll All processes waiting for any events (default or specific) are woken up. Using timeouts Monitor>>waitMaxMilliseconds: anInteger Monitor>>waitFor: aSymbol maxMilliseconds: anInteger Same as Monitor>>wait (resp. Monitor>>waitFor:), but the process gets automatically woken up when the specified time has passed. Monitor>>waitWhile: aBlock maxMilliseconds: anInteger Monitor>>waitWhile: aBlock for: aSymbol maxMilliseconds: anInteger Same as Monitor>>waitWhile: (resp. Monitor>>waitWhile:for:), but the process gets automatically woken up when the specified time has passed. Monitor>>waitUntil: aBlock maxMilliseconds: anInteger Monitor>>waitUntil: aBlock for: aSymbol maxMilliseconds: anInteger Same as Monitor>>waitUntil: (resp. Monitor>>waitUntil:for:), but the process gets automatically woken up when the specified time has passed. Usage examples See code in class MBoundedCounter and compare it to the clumsy BoundedCounter that iw written wihout a monitor.! !Monitor methodsFor: 'synchronization' stamp: 'NS 7/1/2002 21:54'! critical: aBlock "Critical section. Executes aBlock as a critcal section. At any time, only one process can be executing code in a critical section. NOTE: All the following synchronization operations are only valid inside the critical section of the monitor!!" [self enter. aBlock value] ensure: [self exit].! ! !Monitor methodsFor: 'waiting-basic' stamp: 'NS 7/1/2002 21:55'! wait "Unconditional waiting for the default event. The current process gets blocked and leaves the monitor, which means that the monitor allows another process to execute critical code. When the default event is signaled, the original process is resumed." ^ self waitMaxMilliseconds: nil! ! !Monitor methodsFor: 'waiting-basic' stamp: 'NS 7/1/2002 21:56'! waitUntil: aBlock "Conditional waiting for the default event. See Monitor>>waitWhile: aBlock." ^ self waitUntil: aBlock for: nil! ! !Monitor methodsFor: 'waiting-basic' stamp: 'NS 7/1/2002 21:56'! waitWhile: aBlock "Conditional waiting for the default event. The current process gets blocked and leaves the monitor only if the argument block evaluates to true. This means that another process can enter the monitor. When the default event is signaled, the original process is resumed, which means that the condition (argument block) is checked again. Only if it evaluates to false, execution proceeds. Otherwise, the process gets blcoked and leaves the monitor again..." ^ self waitWhile: aBlock for: nil! ! !Monitor methodsFor: 'waiting-specific' stamp: 'NS 7/1/2002 21:58'! waitFor: aSymbolOrNil "Unconditional waiting for the non-default event represented by the argument symbol. Same as Monitor>>wait, but the process gets only reactivated by the specific event and not the default event." ^ self waitFor: aSymbolOrNil maxMilliseconds: nil! ! !Monitor methodsFor: 'waiting-specific' stamp: 'NS 7/1/2002 22:01'! waitUntil: aBlock for: aSymbolOrNil "Confitional waiting for the non-default event represented by the argument symbol. See Monitor>>waitWhile:for: aBlock." ^ self waitUntil: aBlock for: aSymbolOrNil maxMilliseconds: nil! ! !Monitor methodsFor: 'waiting-specific' stamp: 'NS 7/1/2002 22:01'! waitWhile: aBlock for: aSymbolOrNil "Confitional waiting for the non-default event represented by the argument symbol. Same as Monitor>>waitWhile:for:, but the process gets only reactivated by the specific event and not the default event." ^ self waitWhile: aBlock for: aSymbolOrNil maxMilliseconds: nil! ! !Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:03'! waitFor: aSymbolOrNil maxMilliseconds: anIntegerOrNil "Same as Monitor>>waitFor:, but the process gets automatically woken up when the specified time has passed." self checkOwnerProcess. self waitInQueue: (self queueFor: aSymbolOrNil) maxMilliseconds: anIntegerOrNil.! ! !Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:04'! waitFor: aSymbolOrNil maxSeconds: aNumber "Same as Monitor>>waitFor:, but the process gets automatically woken up when the specified time has passed." ^ self waitFor: aSymbolOrNil maxMilliseconds: (aNumber * 1000) asInteger! ! !Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:04'! waitMaxMilliseconds: anIntegerOrNil "Same as Monitor>>wait, but the process gets automatically woken up when the specified time has passed." ^ self waitFor: nil maxMilliseconds: anIntegerOrNil! ! !Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:05'! waitMaxSeconds: aNumber "Same as Monitor>>wait, but the process gets automatically woken up when the specified time has passed." ^ self waitMaxMilliseconds: (aNumber * 1000) asInteger! ! !Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:05'! waitUntil: aBlock for: aSymbolOrNil maxMilliseconds: anIntegerOrNil "Same as Monitor>>waitUntil:for:, but the process gets automatically woken up when the specified time has passed." ^ self waitWhile: [aBlock value not] for: aSymbolOrNil maxMilliseconds: anIntegerOrNil! ! !Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:05'! waitUntil: aBlock for: aSymbolOrNil maxSeconds: aNumber "Same as Monitor>>waitUntil:for:, but the process gets automatically woken up when the specified time has passed." ^ self waitUntil: aBlock for: aSymbolOrNil maxMilliseconds: (aNumber * 1000) asInteger! ! !Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:05'! waitUntil: aBlock maxMilliseconds: anIntegerOrNil "Same as Monitor>>waitUntil:, but the process gets automatically woken up when the specified time has passed." ^ self waitUntil: aBlock for: nil maxMilliseconds: anIntegerOrNil! ! !Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:06'! waitUntil: aBlock maxSeconds: aNumber "Same as Monitor>>waitUntil:, but the process gets automatically woken up when the specified time has passed." ^ self waitUntil: aBlock maxMilliseconds: (aNumber * 1000) asInteger! ! !Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:06'! waitWhile: aBlock for: aSymbolOrNil maxMilliseconds: anIntegerOrNil "Same as Monitor>>waitWhile:for:, but the process gets automatically woken up when the specified time has passed." self checkOwnerProcess. self waitWhile: aBlock inQueue: (self queueFor: aSymbolOrNil) maxMilliseconds: anIntegerOrNil.! ! !Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:06'! waitWhile: aBlock for: aSymbolOrNil maxSeconds: aNumber "Same as Monitor>>waitWhile:for:, but the process gets automatically woken up when the specified time has passed." ^ self waitWhile: aBlock for: aSymbolOrNil maxMilliseconds: (aNumber * 1000) asInteger! ! !Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:06'! waitWhile: aBlock maxMilliseconds: anIntegerOrNil "Same as Monitor>>waitWhile:, but the process gets automatically woken up when the specified time has passed." ^ self waitWhile: aBlock for: nil maxMilliseconds: anIntegerOrNil! ! !Monitor methodsFor: 'waiting-timeout' stamp: 'NS 7/1/2002 22:06'! waitWhile: aBlock maxSeconds: aNumber "Same as Monitor>>waitWhile:, but the process gets automatically woken up when the specified time has passed." ^ self waitWhile: aBlock maxMilliseconds: (aNumber * 1000) asInteger! ! !Monitor methodsFor: 'signaling-default' stamp: 'NS 7/1/2002 21:57'! signal "One process waiting for the default event is woken up." ^ self signal: nil! ! !Monitor methodsFor: 'signaling-default' stamp: 'NS 7/1/2002 21:57'! signalAll "All processes waiting for the default event are woken up." ^ self signalAll: nil! ! !Monitor methodsFor: 'signaling-specific' stamp: 'NS 7/1/2002 22:02'! signal: aSymbolOrNil "One process waiting for the given event is woken up. If there is no process waiting for this specific event, a process waiting for the default event gets resumed." | queue | self checkOwnerProcess. queue _ self queueFor: aSymbolOrNil. ((self normalizeQueueAndReturnIfEmpty: queue) and: [queue ~~ self defaultQueue]) ifTrue: [queue _ self defaultQueue]. self signalQueue: queue.! ! !Monitor methodsFor: 'signaling-specific' stamp: 'NS 7/1/2002 22:02'! signalAll: aSymbolOrNil "All process waiting for the given event or the default event are woken up." | queue | self checkOwnerProcess. queue _ self queueFor: aSymbolOrNil. self signalAllInQueue: self defaultQueue. queue ~~ self defaultQueue ifTrue: [self signalAllInQueue: queue].! ! !Monitor methodsFor: 'signaling-specific' stamp: 'NS 7/1/2002 22:02'! signalReallyAll "All processes waiting for any events (default or specific) are woken up." self checkOwnerProcess. self signalAll. self queueDict valuesDo: [:queue | self signalAllInQueue: queue].! ! !Monitor methodsFor: 'accessing' stamp: 'NS 7/1/2002 20:02'! cleanup self checkOwnerProcess. self critical: [self privateCleanup].! ! !Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 12:38'! checkOwnerProcess (ownerProcess == Processor activeProcess) ifFalse: [self error: 'Monitor access violation'].! ! !Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 12:37'! clearOwnerProcess ownerProcess _ nil.! ! !Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 15:06'! defaultQueue defaultQueue ifNil: [defaultQueue _ OrderedCollection new]. ^ defaultQueue! ! !Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 12:36'! enter self isOwnerProcess ifTrue: [^ self]. mutex wait. self setOwnerProcess.! ! !Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 12:36'! exit self clearOwnerProcess. mutex signal.! ! !Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 14:52'! exitAndWaitInQueue: anOrderedCollection maxMilliseconds: anIntegerOrNil | lock | anOrderedCollection isEmpty ifTrue: [ lock _ anOrderedCollection addLast: Semaphore new. ] ifFalse: [ lock _ anOrderedCollection last. (anIntegerOrNil notNil and: [lock isEmpty not]) ifTrue: [ lock _ anOrderedCollection addLast: Semaphore new. anOrderedCollection addLast: Semaphore new]]. self exit. anIntegerOrNil isNil ifTrue: [lock wait] ifFalse: [lock waitTimeoutMSecs: anIntegerOrNil]. self enter.! ! !Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 15:42'! isOwnerProcess ^ Processor activeProcess == ownerProcess! ! !Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 13:13'! lastSemaphoreInQueue: anOrderedCollection | last | anOrderedCollection isEmpty ifFalse: [last _ anOrderedCollection last]. ^ (last isKindOf: Semaphore) ifTrue: [last] ifFalse: [anOrderedCollection addLast: (Semaphore new)].! ! !Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 15:51'! normalizeQueue: anOrderedCollectionOrNil [anOrderedCollectionOrNil isEmptyOrNil not and: [anOrderedCollectionOrNil first isEmpty]] whileTrue: [anOrderedCollectionOrNil removeFirst].! ! !Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 16:01'! normalizeQueueAndReturnIfEmpty: anOrderedCollectionOrNil self normalizeQueue: anOrderedCollectionOrNil. ^ anOrderedCollectionOrNil isEmptyOrNil! ! !Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 17:08'! privateCleanup (self normalizeQueueAndReturnIfEmpty: defaultQueue) ifTrue: [defaultQueue _ nil]. queueDict ifNotNil: [ queueDict copy keysAndValuesDo: [:id :queue | (self normalizeQueueAndReturnIfEmpty: queue) ifTrue: [queueDict removeKey: id]]. queueDict isEmpty ifTrue: [queueDict _ nil]].! ! !Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 15:10'! queueDict queueDict ifNil: [queueDict _ IdentityDictionary new]. ^ queueDict.! ! !Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 15:12'! queueFor: aSymbol aSymbol ifNil: [^ self defaultQueue]. ^ self queueDict at: aSymbol ifAbsent: [self queueDict at: aSymbol put: OrderedCollection new].! ! !Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 12:37'! setOwnerProcess ownerProcess _ Processor activeProcess.! ! !Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 15:22'! signalAllInQueue: anOrderedCollection anOrderedCollection do: [:lock | [lock isEmpty] whileFalse: [lock signal]]. anOrderedCollection removeAllSuchThat: [:each | true].! ! !Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 16:02'! signalQueue: anOrderedCollection | lock | (self normalizeQueueAndReturnIfEmpty: anOrderedCollection) ifTrue: [^ self]. lock _ anOrderedCollection first. lock signal. lock isEmpty ifTrue: [anOrderedCollection removeFirst].! ! !Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 13:17'! waitInQueue: anOrderedCollection maxMilliseconds: anIntegerOrNil self exitAndWaitInQueue: anOrderedCollection maxMilliseconds: anIntegerOrNil.! ! !Monitor methodsFor: 'private' stamp: 'NS 7/1/2002 13:17'! waitWhile: aBlock inQueue: anOrderedCollection maxMilliseconds: anIntegerOrNil [aBlock value] whileTrue: [self exitAndWaitInQueue: anOrderedCollection maxMilliseconds: anIntegerOrNil].! ! !Monitor methodsFor: 'initialize-release' stamp: 'NS 7/1/2002 15:10'! initialize mutex _ Semaphore forMutualExclusion.! ! !Monitor class methodsFor: 'instance creation' stamp: 'NS 7/1/2002 15:33'! new ^ super new initialize! ! Monitor removeSelector: #addSynchProcess! Monitor removeSelector: #checkSynchProcess! Monitor removeSelector: #checkValidProcess! Monitor removeSelector: #isQueueEmpty:! Monitor removeSelector: #normalizeQueueAndReturnWhetherEmpty:! Monitor removeSelector: #registerSynchProcess! Monitor removeSelector: #removeSynchProcess! Monitor removeSelector: #synchronized:! Monitor removeSelector: #waitInQueue:! Monitor removeSelector: #waitUntil:inQueue:! Monitor removeSelector: #waitWhile:inQueue:! !Monitor reorganize! ('synchronization' critical:) ('waiting-basic' wait waitUntil: waitWhile:) ('waiting-specific' waitFor: waitUntil:for: waitWhile:for:) ('waiting-timeout' waitFor:maxMilliseconds: waitFor:maxSeconds: waitMaxMilliseconds: waitMaxSeconds: waitUntil:for:maxMilliseconds: waitUntil:for:maxSeconds: waitUntil:maxMilliseconds: waitUntil:maxSeconds: waitWhile:for:maxMilliseconds: waitWhile:for:maxSeconds: waitWhile:maxMilliseconds: waitWhile:maxSeconds:) ('signaling-default' signal signalAll) ('signaling-specific' signal: signalAll: signalReallyAll) ('accessing' cleanup) ('private' checkOwnerProcess clearOwnerProcess defaultQueue enter exit exitAndWaitInQueue:maxMilliseconds: isOwnerProcess lastSemaphoreInQueue: normalizeQueue: normalizeQueueAndReturnIfEmpty: privateCleanup queueDict queueFor: setOwnerProcess signalAllInQueue: signalQueue: waitInQueue:maxMilliseconds: waitWhile:inQueue:maxMilliseconds:) ('initialize-release' initialize) !