The Trunk: Kernel-eem.975.mcz

Eliot Miranda uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-eem.975.mcz

==================== Summary ====================

Name: Kernel-eem.975
Author: eem
Time: 7 January 2016, 12:32:33.854762 pm
UUID: 00437240-a4b8-42ec-82fb-9c48040d7f6e
Ancestors: Kernel-eem.974

Mutate Mutex and Monitor to the new representation and primitives.

Modify Process>>terminate to take a generic approach to ensure blocks in critical sections vua a pragma (#criticalSection) and provide an explanatory comment, plus /not/ aborting the ensure: block if no progress has been made.

=============== Diff against Kernel-eem.974 ===============

Item was added:
+ (PackageInfo named: 'Kernel') preamble: '((Mutex allInstances allSatisfy: [:m| (m instVarNamed: ''owner'') isNil])
+ and: [Monitor allInstances allSatisfy: [:m| (m instVarNamed: ''ownerProcess'') isNil]]) ifFalse:
+ [self error: ''Some Mutexes and/or Monitors are owned.  Cannot safely mutate.  ABort load and resolve this before loading for safety.'']'!

Item was changed:
  ----- Method: MethodContext>>isClosureContext (in category 'closure support') -----
  isClosureContext
+ ^closureOrNil ~~ nil!
-
- ^ self isExecutingBlock!

Item was changed:
  ----- Method: MethodContext>>isExecutingBlock (in category 'accessing') -----
  isExecutingBlock
+ "Is this executing a block versus a method"
- "Is this executing a block versus a method?  In the new closure
- implemetation this is true if closureOrNil is not nil, in which case
- it should be holding a BlockClosure."
 
+ ^ self method notNil and: [self method isBlockMethod]!
- ^closureOrNil isClosure!

Item was changed:
  LinkedList subclass: #Monitor
  instanceVariableNames: 'ownerProcess defaultQueue queueDict queuesMutex mutex nestingLevel'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Kernel-Processes'!
 
+ !Monitor commentStamp: 'eem 1/7/2016 11:38' prior: 0!
- !Monitor commentStamp: 'md 3/3/2006 09:19' prior: 0!
  A monitor provides process synchronization that is more high level 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 execute code inside a critical section of a monitor.
+ 2) A monitor is reentrant, which means that the active process in a monitor never gets blocked when it enters a (nested) critical section of the same monitor.  For example a monitor will not block when trying the following:
+ | m |
+ m := Monitor new.
+ m critical: [m critical: [#yes]]
+ whereas a Semaphore will deadlock:
+ | s |
+ s := Semaphore forMutualExclusion.
+ s critical: [s critical: [#no]]
- 2) A monitor is reentrant, which means that the active process in a monitor never gets blocked when it enters a (nested) critical section of the same monitor.
  3) Inside a critical section, a process can wait for an event that may be 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 is 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 you to define timeouts after which a process gets activated automatically.
 
 
  Basic usage:
 
  Monitor>>critical: aBlock
  Critical section.
  Executes aBlock as a critical section. At any time, only one process can execute 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, does execution proceed. Otherwise, the process gets blocked 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.!

Item was changed:
  ----- Method: Monitor>>checkOwnerProcess (in category 'private') -----
  checkOwnerProcess
+ "If the receiver is not already the owner of the section raise an error."
+ (self primitiveTestAndSetOwnershipOfCriticalSection
+ ifNil: [false]
+ ifNotNil:
+ [:alreadyOwner|
+ alreadyOwner
+ or: [self primitiveExitCriticalSection.
+ false]]) ifFalse:
+ [self error: 'Monitor access violation']!
- self isOwnerProcess
- ifFalse: [self error: 'Monitor access violation'].!

Item was changed:
+ ----- Method: Monitor>>critical: (in category 'mutual exclusion') -----
- ----- Method: Monitor>>critical: (in category 'synchronization') -----
  critical: aBlock
+ "Evaluate aBlock protected by the receiver."
+ <criticalSection>
+ ^self primitiveEnterCriticalSection
+ ifTrue: [aBlock value]
+ ifFalse: [aBlock ensure: [self primitiveExitCriticalSection]]!
- "Critical section.
- Executes aBlock as a critical 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].!

Item was added:
+ ----- Method: Monitor>>critical:ifLocked: (in category 'mutual exclusion') -----
+ critical: aBlock ifLocked: lockedBlock
+ "Answer the evaluation of aBlock protected by the receiver.  If it is already in a critical
+ section on behalf of some other process answer the evaluation of lockedBlock."
+ <criticalSection>
+ ^self primitiveTestAndSetOwnershipOfCriticalSection
+ ifNil: [lockedBlock value]
+ ifNotNil:
+ [:alreadyOwner|
+ alreadyOwner
+ ifTrue: [aBlock value]
+ ifFalse: [aBlock ensure: [self primitiveExitCriticalSection]]]!

Item was removed:
- ----- Method: Monitor>>enter (in category 'private') -----
- enter
- self isOwnerProcess ifTrue: [
- nestingLevel := nestingLevel + 1.
- ] ifFalse: [
- mutex wait.
- ownerProcess := Processor activeProcess.
- nestingLevel := 1.
- ].!

Item was removed:
- ----- Method: Monitor>>exit (in category 'private') -----
- exit
- nestingLevel := nestingLevel - 1.
- nestingLevel < 1 ifTrue: [
- ownerProcess := nil.
- mutex signal
- ].!

Item was changed:
  ----- Method: Monitor>>exitAndWaitInQueue:maxMilliseconds: (in category 'private') -----
  exitAndWaitInQueue: anOrderedCollection maxMilliseconds: anIntegerOrNil
 
+ [ | lock |
+ lock := queuesMutex critical: [ anOrderedCollection addLast: Semaphore new ].
+ self primitiveExitCriticalSection.
+ anIntegerOrNil
+ ifNil: [ lock wait ]
+ ifNotNil:
+ [ | delay |
+ delay := MonitorDelay
+ signalLock: lock
+ afterMSecs: anIntegerOrNil
+ inMonitor: self
+ queue: anOrderedCollection.
+ [ lock wait ] ensure: [ delay unschedule ] ] ]
+ ensure: [ self primitiveEnterCriticalSection ]!
- [
- | lock |
- lock := queuesMutex critical: [ anOrderedCollection addLast: Semaphore new ].
- self exit.
- anIntegerOrNil
- ifNil: [ lock wait ]
- ifNotNil: [
- | delay |
- delay := MonitorDelay
- signalLock: lock
- afterMSecs: anIntegerOrNil
- inMonitor: self
- queue: anOrderedCollection.
- [ lock wait ] ensure: [ delay unschedule ] ] ]
- ensure: [ self enter ]!

Item was changed:
  ----- Method: Monitor>>initialize (in category 'initialize-release') -----
  initialize
+ queuesMutex := Semaphore forMutualExclusion!
- mutex := Semaphore forMutualExclusion.
- queuesMutex := Semaphore forMutualExclusion.
- nestingLevel := 0.!

Item was removed:
- ----- Method: Monitor>>isOwnerProcess (in category 'private') -----
- isOwnerProcess
- ^ Processor activeProcess == ownerProcess!

Item was changed:
  LinkedList subclass: #Mutex
+ instanceVariableNames: 'owner'
- instanceVariableNames: 'owner semaphore'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Kernel-Processes'!
 
+ !Mutex commentStamp: 'eem 1/7/2016 11:36' prior: 0!
- !Mutex commentStamp: '<historical>' prior: 0!
  A Mutex is a light-weight MUTual EXclusion object being used when two or more processes need to access a shared resource concurrently. A Mutex grants ownership to a single process and will suspend any other process trying to aquire the mutex while in use. Waiting processes are granted access to the mutex in the order the access was requested.
 
+ A Mutex allows the owning process to reenter as many times as desired.  For example a Mutex will not block when trying the following:
+ | m |
+ m := Mutex new.
+ m critical: [m critical: [#yes]]
+ whereas a Semaphore will deadlock:
+ | s |
+ s := Semaphore forMutualExclusion.
+ s critical: [s critical: [#no]]
+
  Instance variables:
+ owner <Process|UndefinedObject> The process owning the mutex!
- semaphore <Semaphore> The (primitive) semaphore used for synchronization.
- owner <Process> The process owning the mutex.!

Item was changed:
  ----- Method: Mutex>>critical: (in category 'mutual exclusion') -----
  critical: aBlock
  "Evaluate aBlock protected by the receiver."
+ <criticalSection>
+ ^self primitiveEnterCriticalSection
+ ifTrue: [aBlock value]
+ ifFalse: [aBlock ensure: [self primitiveExitCriticalSection]]!
- | activeProcess |
- activeProcess := Processor activeProcess.
- activeProcess == owner ifTrue:[^aBlock value].
- ^semaphore critical:[
- owner := activeProcess.
- aBlock ensure:[owner := nil]].!

Item was added:
+ ----- Method: Mutex>>critical:ifLocked: (in category 'mutual exclusion') -----
+ critical: aBlock ifLocked: lockedBlock
+ "Answer the evaluation of aBlock protected by the receiver.  If it is already in a critical
+ section on behalf of some other process answer the evaluation of lockedBlock."
+ <criticalSection>
+ ^self primitiveTestAndSetOwnershipOfCriticalSection
+ ifNil: [lockedBlock value]
+ ifNotNil:
+ [:alreadyOwner|
+ alreadyOwner
+ ifTrue: [aBlock value]
+ ifFalse: [aBlock ensure: [self primitiveExitCriticalSection]]]!

Item was removed:
- ----- Method: Mutex>>initialize (in category 'initialize') -----
- initialize
- semaphore := Semaphore forMutualExclusion.!

Item was changed:
  ----- Method: Process>>terminate (in category 'changing process state') -----
  terminate
  "Stop the process that the receiver represents forever.  Unwind to execute pending ensure:/ifCurtailed: blocks before terminating."
 
  | ctxt unwindBlock oldList |
  self isActiveProcess ifTrue: [
  ctxt := thisContext.
  [ ctxt := ctxt findNextUnwindContextUpTo: nil.
  ctxt isNil
  ] whileFalse: [
  (ctxt tempAt: 2) ifNil:[
  ctxt tempAt: 2 put: nil.
  unwindBlock := ctxt tempAt: 1.
  thisContext terminateTo: ctxt.
  unwindBlock value].
  ].
  thisContext terminateTo: nil.
  self suspend.
  ] ifFalse:[
  "Always suspend the process first so it doesn't accidentally get woken up"
  oldList := self suspend.
  suspendedContext ifNotNil:[
+ "Figure out if we are terminating a process that is in the ensure: block of a critical section.
+ In this case, if the block has made progress, pop the suspendedContext so that we leave the
+ ensure: block inside the critical: without signaling the semaphore/exiting the primitive section,
+ since presumably this has already happened."
+ (suspendedContext isClosureContext
+ and: [(suspendedContext method pragmaAt: #criticalSection) notNil
+ and: [suspendedContext startpc > suspendedContext closure startpc]]) ifTrue:
+ [suspendedContext := suspendedContext home].
- "Figure out if we are terminating the process while waiting in Semaphore>>critical:
- In this case, pop the suspendedContext so that we leave the ensure: block inside
- Semaphore>>critical: without signaling the semaphore."
- (oldList class == Semaphore and:[
- suspendedContext method == (Semaphore compiledMethodAt: #critical:)]) ifTrue:[
- suspendedContext := suspendedContext home.
- ].
 
  "If we are terminating a process halfways through an unwind, try
  to complete that unwind block first."
+ (suspendedContext findNextUnwindContextUpTo: nil) ifNotNil:
+ [:outer|
+ (suspendedContext findContextSuchThat:[:c| c closure == (outer tempAt: 1)]) ifNotNil:
+ [:inner| "This is an unwind block currently under evaluation"
+ suspendedContext runUntilErrorOrReturnFrom: inner]].
- (suspendedContext findNextUnwindContextUpTo: nil) ifNotNil:[:outer|
- (suspendedContext findContextSuchThat:[:c| c closure == (outer tempAt: 1)]) ifNotNil:[:inner|
- "This is an unwind block currently under evaluation"
- suspendedContext runUntilErrorOrReturnFrom: inner.
- ].
- ].
 
  ctxt := self popTo: suspendedContext bottomContext.
+ ctxt == suspendedContext bottomContext ifFalse:
+ [self debug: ctxt title: 'Unwind error during termination']]]!
- ctxt == suspendedContext bottomContext ifFalse: [
- self debug: ctxt title: 'Unwind error during termination']].
- ].
- !

Item was changed:
  ----- Method: Semaphore>>critical: (in category 'mutual exclusion') -----
  critical: mutuallyExcludedBlock
  "Evaluate mutuallyExcludedBlock only if the receiver is not currently in
  the process of running the critical: message. If the receiver is, evaluate
  mutuallyExcludedBlock after the other critical: message is finished."
+ <criticalSection>
-
  | caught |
  "We need to catch eventual interruptions very carefully.
  The naive approach of just doing, e.g.,:
  self wait.
  aBlock ensure:[self signal].
  will fail if the active process gets terminated while in the wait.
  However, the equally naive:
  [self wait.
  aBlock value] ensure:[self signal].
  will fail too, since the active process may get interrupted while
  entering the ensured block and leave the semaphore signaled twice.
  To avoid both problems we make use of the fact that interrupts only
  occur on sends (or backward jumps) and use an assignment (bytecode)
+ right before we go into the wait primitive (which cannot be preempted)."
- right before we go into the wait primitive (which is not a real send and
- therefore not interruptable either)."
 
  caught := false.
  ^[
  caught := true.
  self wait.
  mutuallyExcludedBlock value
  ] ensure: [ caught ifTrue: [self signal] ]
  !