--- a/RecursionLock.st Tue Aug 08 16:46:35 2017 +0100
+++ b/RecursionLock.st Wed Oct 04 21:32:06 2017 +0100
@@ -13,13 +13,26 @@
"{ NameSpace: Smalltalk }"
-Object subclass:#RecursionLock
- instanceVariableNames:'process sema'
+AbstractLock subclass:#RecursionLock
+ instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'Kernel-Processes'
!
+!RecursionLock primitiveDefinitions!
+%{
+#define THINLOCKING
+#ifdef THINLOCKING
+# include <thinlocks.h>
+static inline unsigned INT* stxGetLockwordPtr(OBJ o) {
+ return (unsigned INT*)(&__OINST(o, process));
+}
+
+#endif
+%}
+! !
+
!RecursionLock class methodsFor:'documentation'!
copyright
@@ -39,23 +52,47 @@
documentation
"
- like a Semaphore for mutual exclusion, but avoids the deadlock
+ Like a Semaphore for mutual exclusion, but avoids the deadlock
if a critical region is reentered by the same process again.
I.e. allows reentering the critical region IFF the current process
is the one which did the original locking.
+ NOTE:
+ The recursion lock is not only reentrant (same process may enter the
+ critical section multiple times) but also much faster than using
+ semaphore (`lock := Semaphore forMutualExclusion. lock critical:[...]`)
+
+ Therefore you're encouraged to use `RecursonLock` rather than
+ `Semaphore forMutualExclusion` whenever possible.
+
WARNING:
- for now, recursionLocks are not unlocked when an image is
+ For now, recursionLocks are not unlocked when an image is
restarted. You may have to recreate them to avoid a deadLock.
(this may change in the future, but recreating a recursionLock in
the #earlyRestart handling does not hurt)
+ Thinlocks
+
+ RecursionLocks uses `thinlocks`[1] to optimize locking in the common
+ case - this makes it much faster.
+ The `lockword` is stored in `process` instvar - when a `process` instvar
+ contains a small integer, recursion lock is `thin`, value of `count` instvas
+ is invalid (out of sync).
+
+ [1]: David F. Bacon, Ravi Konuru, Chet Murthy, Mauricio Serrano:
+ Thin locks: featherweight synchronization for Java, ACM SIGPLAN 1998
+
+
+
[author:]
- Claus Gittinger
+ Claus Gittinger
+ Jan Vrany (thinlock suppot)
[see also:]
- Semaphore
- Process ProcessorScheduler
+ Semaphore
+ Process ProcessorScheduler
+ AbstractLock
+ thinlocks.h
"
!
@@ -97,11 +134,89 @@
"same as new, for easy exchangability with regular mutual-exclusion Semaphores."
^ self new
+! !
+
+!RecursionLock methodsFor:'accessing'!
+
+count
+ ^ self processAndCount at: 2.
+
!
-new
- ^ self basicNew initialize
+owner
+ ^ self processAndCount at: 1.
+
+! !
+
+!RecursionLock methodsFor:'acquire & release'!
+
+acquireWithTimeoutMs: timeout
+ "
+ Acquire the lock:
+
+ * If the lock is not owned by any process, lock it and return immediately.
+ * If the lock is already owned by the calling process, return immediately.
+ * Otherwise, wait until owning process release it (by means of #release)
+ at most `timeout` milliseconds. If `timeout` is nil, wait forever.
+ Return `true` if the lock has been acquired or `false` if bot (e.g. wait
+ timed out)
+ "
+%{ /* NOCONTEXT */
+#ifdef THINLOCKING
+ if ( stxThinLock( stxGetLockwordPtr(self) ) == StxThinlockSuccess ) {
+ return (true);
+ }
+#endif
+%}.
+ "/ Inflate the lock if it's not yet inflated.
+ "/
+ "/ Note that #inflate method checks again if it's inflated or not,
+ "/ it may haopen some other thread inflated the lock in between the check
+ "/ here and code in #inflate.
+ "/
+ "/ Note that `someobject class == SmallInteger` is handled as a special
+ "/ case in stc and compiled as `__isSmallInteger(someobject)` and thus
+ "/ very fast - just bitwise and + non-zero test. Don't change.
+ process class == SmallInteger ifTrue:[ self inflate ].
+ ^ super acquireWithTimeoutMs: timeout
+!
+
+release
+ "
+ Release the lock. Return true of lock has been released, `false` if
+ not (because calling process does not own it).
+ "
+%{ /* NOCONTEXT */
+#ifdef THINLOCKING
+ if ( stxThinUnlock( stxGetLockwordPtr(self) ) == StxThinlockSuccess ) {
+ return (true);
+ }
+#endif
+%}.
+ "/ Inflate the lock if it's not yet inflated.
+ "/
+ "/ Note that #inflate method checks again if it's inflated or not,
+ "/ it may haopen some other thread inflated the lock in between the check
+ "/ here and code in #inflate
+ "/
+ "/ Note that `someobject class == SmallInteger` is handled as a special
+ "/ case in stc and compiled as `__isSmallInteger(someobject)` and thus
+ "/ very fast - just bitwise and + non-zero test. Don't change.
+ process class == SmallInteger ifTrue:[ self inflate ].
+ super release ifFalse:[
+ self error: ('Calling process does not own the lock (caller: %1, owner: %2)' bindWith: Processor activeProcess id with: (process isNil ifTrue:['<no owner>'] ifFalse:[process id])).
+ ].
+! !
+
+!RecursionLock methodsFor:'initialization'!
+
+initialize
+ super initialize.
+ process := 0.
+
+ "Modified: / 25-01-1997 / 00:19:15 / cg"
+ "Modified: / 29-08-2017 / 09:53:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!RecursionLock methodsFor:'printing & storing'!
@@ -122,32 +237,86 @@
aGCOrStream nextPutAll:' name: '.
(self name ? 'unnamed') printOn:aGCOrStream.
aGCOrStream nextPut:$).
-!
+! !
+
+!RecursionLock methodsFor:'private'!
+
+inflate
+ "Inflates (thin) lock (into fat lock). If the lock is already a fat lock,
+ #inflate is no-op.
-name
- "return the semaphores userFriendly name"
+ Called by:
+
+ * #acquire* in case of contention or if maximum nesting count
+ is exceeded (unlikely)
+ * #release in case of contention
+
+
+ "
- ^ sema name
+ | processAndCount wasBlocked |
+
- "Created: / 28.6.1997 / 16:19:40 / cg"
- "Modified: / 14.12.1999 / 21:03:46 / cg"
+ processAndCount := Array new: 2.
+ wasBlocked := OperatingSystem blockInterrupts.
+ "/ Note that `someobject class == SmallInteger` is handled as a special
+ "/ case in stc and compiled as `__isSmallInteger(someobject)` and thus
+ "/ very fast - just bitwise and + non-zero test. Don't change
+ process class == SmallInteger ifTrue:[
+ self processAndCountInto: processAndCount.
+ process := processAndCount at: 1.
+ count := processAndCount at: 2.
+ sema setCount: 0.
+ ].
+ wasBlocked ifFalse:[ OperatingSystem unblockInterrupts ].
+
!
-name:aString
- "set the semaphores userFriendly name"
+processAndCount
+ | processAndCount |
+
+ processAndCount := Array new: 2.
+ self processAndCountInto: processAndCount.
+ ^ processAndCount
- sema name:aString
+!
+
+processAndCountInto: anArray
+ "Fills in `anArray` with owning process and nesting count.
+
+ Note that by the time this method returns, the data in given array may
+ be already obsolete.
+ "
+ | pid cnt proc |
- "Created: / 28.6.1997 / 16:19:47 / cg"
- "Modified: / 14.12.1999 / 21:03:52 / cg"
-! !
+ "/ Note that `someobject class == SmallInteger` is handled as a special
+ "/ case in stc and compiled as `__isSmallInteger(someobject)` and thus
+ "/ very fast - just bitwise and + non-zero test. Don't change!
+ process class == SmallInteger ifTrue:[
+ %{
+#ifdef THINLOCKING
+ unsigned INT _pid = stxLockwordGetPid( *stxGetLockwordPtr(self) );
+ unsigned INT _cnt = stxLockwordGetCnt( *stxGetLockwordPtr(self) );
-!RecursionLock methodsFor:'private-initialization'!
+ if (_pid == INV_PROCESS_ID) {
+ pid = nil;
+ cnt = __MKINT(0);
+ } else {
+ pid = __MKINT(_pid);
+ cnt = __MKINT(_cnt);
+ }
+#endif
+ %}.
+ pid notNil ifTrue:[
+ proc := ObjectMemory processesKnownInVM detect:[:p|p id == pid] ifNone:[nil].
+ ].
+ ] ifFalse:[
+ proc := process.
+ cnt := count.
+ ].
+ anArray at: 1 put: proc.
+ anArray at: 2 put: cnt.
-initialize
- sema := Semaphore forMutualExclusion name:'recursionLock'
-
- "Modified: 25.1.1997 / 00:19:15 / cg"
! !
!RecursionLock methodsFor:'queries'!
@@ -160,12 +329,6 @@
"Created: 18.4.1996 / 17:18:08 / cg"
!
-owner
- "return the owning processes (or nil)"
-
- ^ process
-!
-
wouldBlock
"Check if the resource represented by the receiver is
already in use by another process.
@@ -174,180 +337,70 @@
|p|
- ^ (p := process) notNil and:[Processor activeProcess ~~ p and:[p isDead not]]
+ ^ (p := self owner) notNil and:[Processor activeProcess ~~ p and:[p isDead not]]
! !
!RecursionLock methodsFor:'signaling'!
signal
- |wasBlocked|
+ self breakPoint: #jv.
+ self release ifFalse:[
+ self error: 'Attempt to release a (recursion) lock by process the does not own it!!'
+ ]
+
+ "Modified: / 25-08-2017 / 08:41:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!RecursionLock methodsFor:'synchronized evaluation'!
- Logger warn: 'RecursionLock >> #signal called'.
+critical:aBlock
+ "Evaluate aBlock as a critical region. Same process may
+ enter critical region again, i.e., nesting allowed.
+
+ Returns the (return) value of `aBlock`
+ "
+
+ <exception: #unwind>
+
+ | acquired retval |
- process ~~ Processor activeProcess ifTrue:[
- self error:'RecursionLock - signaling process doesn''t own the lock'.
+ acquired := self acquireWithTimeoutMs: nil.
+ acquired == true ifTrue:[
+ retval := aBlock value
].
+ thisContext unmarkForUnwind.
+ acquired == true ifTrue:[
+ self release.
+ ].
+ ^ retval
+
+ "Created: / 31-08-2017 / 10:12:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
- wasBlocked := OperatingSystem blockInterrupts.
- process := nil.
- sema signal.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+!RecursionLock methodsFor:'unwinding'!
+
+unwindHandlerInContext:aContext
+ aContext selector == #critical: ifTrue:[
+ | acquired |
+ acquired := aContext varAt: 1.
+ acquired == true ifTrue:[
+ ^ [ aContext varAt: 1 put: nil. self release ]
+ ] ifFalse:[
+ ^ nil.
+ ].
+ ].
+ self shouldNeverBeReached.
+
+ "Created: / 31-08-2017 / 10:11:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!RecursionLock methodsFor:'waiting'!
-critical:aBlock
- "evaluate aBlock as a critical region, but do not block
- if this lock is already held by the current process."
-
- |active retVal wasBlocked gotSema|
-
- active := Processor activeProcess.
- process == active ifTrue:[
- "I have already got the lock"
- ^ aBlock value
- ].
-
- "/
- "/ sema wait & process := active
- "/ and:
- "/ proces := nil & sema signal
- "/ must both be done atomic
- "/ Scenario:
- "/ ... recLock critical
- "/ got lock
- "/ evaluated
- "/ set process to nil
- "/ -> timer interrupt
- "/ recLock critical in timeOut action
- "/ process isNil
- "/ sema wait !!!!!! DEADLOCK
- "/
- wasBlocked := OperatingSystem blockInterrupts.
- [
- (process notNil and:[process isDead]) ifTrue:[
- process := nil.
- 'RecursionLock [warning]: cleanup lock from dead process' infoPrintCR.
- sema signal.
- ].
- gotSema := sema wait.
- process := active.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- retVal := aBlock value.
- ] ifCurtailed:[
- "be careful - the unwind may occur both while waiting
- AND while evaluating the block"
- gotSema notNil ifTrue:[
- OperatingSystem blockInterrupts.
- process := nil.
- sema signal.
- ].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ].
- OperatingSystem blockInterrupts.
- process := nil.
- sema signal.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ retVal.
-!
-
-critical:aBlock ifBlocking:blockingBlock
- "like critical:, but do not block if the lock cannot be acquired.
- Instead, return the value of the second argument, blockingBlock."
-
- ^ self critical:aBlock timeoutMs:0 ifBlocking:blockingBlock.
-!
-
-critical:aBlock timeoutMs:timeoutMs ifBlocking:blockingBlock
- "like critical:, but do not block if the lock cannot be acquired
- within timeoutMs milliseconds.
- Instead, return the value of blockingBlock."
-
- |active retVal wasBlocked gotSema|
-
- active := Processor activeProcess.
- process == active ifTrue:[
- "I have already got the lock"
- ^ aBlock value
- ].
+wait
+ self breakPoint: #jv.
+ self acquire.
- "/
- "/ sema wait & process := active
- "/ and:
- "/ proces := nil & sema signal
- "/ must both be done atomic
- "/ Scenario:
- "/ ... recLock critical
- "/ got lock
- "/ evaluated
- "/ set process to nil
- "/ -> timer interrupt
- "/ recLock critical in timeOut action
- "/ process isNil
- "/ sema wait !!!!!! DEADLOCK
- "/
- wasBlocked := OperatingSystem blockInterrupts.
- [
- (process notNil and:[process isDead]) ifTrue:[
- process := nil.
- 'RecursionLock [warning]: cleanup lock from dead process' infoPrintCR.
- sema signal.
- ].
- gotSema := sema waitWithTimeoutMs:timeoutMs.
- gotSema notNil ifTrue:[
- process := active.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- retVal := aBlock value.
- ].
- ] ifCurtailed:[
- "be careful - the unwind may occur both while waiting
- AND while evaluating the block"
- gotSema notNil ifTrue:[
- OperatingSystem blockInterrupts.
- process := nil.
- sema signal.
- ].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ].
- gotSema notNil ifTrue:[
- OperatingSystem blockInterrupts.
- process := nil.
- sema signal.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ] ifFalse:[
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- retVal := blockingBlock value.
- ].
-
- ^ retVal.
-!
-
-wait
- "wait, but do not block,
- if this lock is already held by the current process.
- Answer false, if already locked, true if lock has been just acquired."
-
- |active wasBlocked|
-
- Logger warn: 'RecursionLock >> #wait called'.
-
- active := Processor activeProcess.
- process == active ifTrue:[
- "I have already got the lock"
- ^ false.
- ].
-
- wasBlocked := OperatingSystem blockInterrupts.
- (process notNil and:[process isDead]) ifTrue:[
- "/ a process which had the lock died without a chance to release it (i.e. it was hard terminated)
- process := nil.
- 'RecursionLock [info]: cleanup leftover lock from dead process' infoPrintCR.
- sema signal.
- ].
- sema wait.
- process := active.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^ true.
+ "Modified: / 25-08-2017 / 08:40:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!RecursionLock class methodsFor:'documentation'!
@@ -358,5 +411,10 @@
version_CVS
^ '$Header$'
+!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
! !