--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/AbstractLock.st Wed Oct 04 21:32:06 2017 +0100
@@ -0,0 +1,294 @@
+"
+ Copyright (c) 2017-now Jan Vrany
+
+ Permission is hereby granted, free of charge, to any person obtaining
+ a copy of this software and associated documentation files (the
+ 'Software'), to deal in the Software without restriction, including
+ without limitation the rights to use, copy, modify, merge, publish,
+ distribute, sublicense, and/or sell copies of the Software, and to
+ permit persons to whom the Software is furnished to do so, subject to
+ the following conditions:
+
+ The above copyright notice and this permission notice shall be
+ included in all copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ MeERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+ IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+ CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+ TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+ SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+"
+"{ Package: 'stx:libbasic' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#AbstractLock
+ instanceVariableNames:'process sema count'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Kernel-Processes'
+!
+
+!AbstractLock class methodsFor:'documentation'!
+
+copyright
+"
+ Copyright (c) 2017-now Jan Vrany
+
+ Permission is hereby granted, free of charge, to any person obtaining
+ a copy of this software and associated documentation files (the
+ 'Software'), to deal in the Software without restriction, including
+ without limitation the rights to use, copy, modify, merge, publish,
+ distribute, sublicense, and/or sell copies of the Software, and to
+ permit persons to whom the Software is furnished to do so, subject to
+ the following conditions:
+
+ The above copyright notice and this permission notice shall be
+ included in all copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ MeERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+ IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+ CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+ TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+ SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+"
+
+!
+
+documentation
+"
+ A base superclass for owned reentrant locks. It provides generic and somewhat
+ slow implementation of:
+
+ * `#acquire` and `#acquireWithTimeoutMs:`
+ * `#release`
+ * `#critical:` and `#critical:timeoutMs:ifBlocking:`
+
+ Subclasses may (an should) override (some) of these with optimized versions
+ and eventually fall back to implementation defined here. See subclasses.
+
+
+ [author:]
+ Jan Vrany <jan.vrany@fit.cvut.cz>
+
+ [instance variables:]
+ process <Process | ni> a process that currently owns the
+ lock or nil (if no process owns it)
+ count <SmallInteger> nesting depth
+ sema <Semaphore> a semaphore to signal waiter in case
+ of contention
+
+ [class variables:]
+
+ [see also:]
+ RecursionLock
+ JavaMonitor
+
+"
+! !
+
+!AbstractLock class methodsFor:'instance creation'!
+
+new
+ ^ self basicNew initialize
+
+! !
+
+!AbstractLock class methodsFor:'queries'!
+
+isAbstract
+ "Return if this class is an abstract class.
+ True is returned here for myself only; false for subclasses.
+ Abstract subclasses must redefine this again."
+
+ ^ self == AbstractLock.
+! !
+
+!AbstractLock methodsFor:'accessing'!
+
+count
+ ^ count
+
+ "Created: / 28-08-2017 / 21:53:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+name
+ ^ sema name
+
+ "Created: / 28-08-2017 / 21:53:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+name:aString
+ sema name:aString
+
+ "Created: / 28-08-2017 / 21:53:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+owner
+ ^ process
+
+ "Created: / 28-08-2017 / 21:53:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!AbstractLock methodsFor:'acquire & release'!
+
+acquire
+ "
+ 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).
+
+ Return `true` (always)
+ "
+ ^self acquireWithTimeoutMs: nil
+
+
+ "Created: / 25-08-2017 / 08:34:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+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)
+ "
+
+ | active wasBlocked acquired |
+ acquired := nil.
+ active := Processor activeProcess.
+ process == active ifTrue:[
+ "/ Process already ackquired the monitor, increase the
+ "/ count and continue...
+ count := count + 1.
+ ^true.
+ ].
+ wasBlocked := OperatingSystem blockInterrupts.
+ [
+ (process notNil and:[ process isDead ]) ifTrue:[
+ "/ Process that acquired the monitor died without releasing it.
+ "/ This should not happen.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ self assert: false description: 'Process that acquired the lock died without releasing it'.
+ process := nil.
+ count := 0.
+ ].
+ "/ We need to know that we already waited on and got semaphore
+ "/ in case the Semaphore >> #wait is prematurely terminated.
+ "/ Q: Can this actually happen? If so, how?
+ acquired := sema waitWithTimeoutMs: timeout.
+ process := active.
+ count := 1.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ] ifCurtailed:[
+ acquired notNil ifTrue:[
+ OperatingSystem blockInterrupts.
+ count := 0.
+ process := nil.
+ sema signal.
+ ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ].
+ ^acquired notNil.
+
+ "Created: / 25-08-2017 / 22:55:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+release
+ "
+ Release the lock. Return true of lock has been released, `false` if
+ not (because calling process does not own it).
+ "
+ | active wasBlocked |
+
+ active := Processor activeProcess.
+ process == active ifFalse:[
+ "/ Oops, calling thread does not own the monitor. return false
+ "/ immediately.
+ ^ false.
+ ].
+ wasBlocked := OperatingSystem blockInterrupts.
+ count == 1 ifTrue:[
+ process := nil.
+ count := 0.
+ sema signal.
+ ] ifFalse:[
+ count := count - 1.
+ ].
+ wasBlocked ifFalse:[ OperatingSystem unblockInterrupts ].
+ ^ true
+
+
+ "Created: / 25-08-2017 / 08:38:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!AbstractLock methodsFor:'initialization'!
+
+initialize
+ process := nil.
+ sema := Semaphore new: 1.
+ sema name:'Lock@' , self identityHash printString.
+ count := 0.
+
+ "Modified: / 29-08-2017 / 09:53:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!AbstractLock methodsFor:'synchronized evaluation'!
+
+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`
+ "
+ ^self critical: aBlock timeoutMs: nil ifBlocking: nil
+
+ "Modified (comment): / 25-08-2017 / 09:47:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+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.`"
+
+ | acquired retval |
+
+ [
+ acquired := self acquireWithTimeoutMs: timeoutMs.
+ acquired ifTrue:[
+ retval := aBlock value
+ ] ifFalse:[
+ retval := blockingBlock value.
+ ]
+ ] ensure:[
+ acquired ifTrue:[
+ self release.
+ ]
+ ].
+ ^retval
+! !
+
+!AbstractLock class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- a/Make.spec Tue Aug 08 16:46:35 2017 +0100
+++ b/Make.spec Wed Oct 04 21:32:06 2017 +0100
@@ -94,6 +94,7 @@
Project \
ProjectDefinition \
ReadEvalPrintLoop \
+ AbstractLock \
RecursionLock \
Semaphore \
SharedPool \
@@ -487,6 +488,7 @@
$(OUTDIR_SLASH)Project.$(O) \
$(OUTDIR_SLASH)ProjectDefinition.$(O) \
$(OUTDIR_SLASH)ReadEvalPrintLoop.$(O) \
+ $(OUTDIR_SLASH)AbstractLock.$(O) \
$(OUTDIR_SLASH)RecursionLock.$(O) \
$(OUTDIR_SLASH)Semaphore.$(O) \
$(OUTDIR_SLASH)SharedPool.$(O) \
@@ -814,7 +816,7 @@
$(OUTDIR_SLASH)UnderflowError.$(O) \
$(OUTDIR_SLASH)ZeroDivide.$(O) \
$(OUTDIR_SLASH)BadRomanNumberFormatError.$(O) \
-
+
WIN32_OBJS= \
$(OUTDIR_SLASH)PCFilename.$(O) \
$(OUTDIR_SLASH)Win32Constants.$(O) \
--- a/Process.st Tue Aug 08 16:46:35 2017 +0100
+++ b/Process.st Wed Oct 04 21:32:06 2017 +0100
@@ -19,7 +19,7 @@
singleStepping emergencySignalHandler suspendActions creatorId
processGroupId interruptsDisabled priorityRange
exceptionHandlerSet processType environment startTimestamp'
- classVariableNames:'TerminateSignal RestartSignal CaughtSignals'
+ classVariableNames:'TerminateSignal RestartSignal CaughtSignals SysProcessId'
poolDictionaries:''
category:'Kernel-Processes'
!
@@ -335,9 +335,22 @@
with:AbortAllOperationRequest
with:TerminateProcessRequest
with:RestartProcessRequest.
- ]
+ ].
+ self initializeVMProcessIdConstants.
"Modified: / 17.11.2001 / 11:07:29 / cg"
+
+!
+
+initializeVMProcessIdConstants
+
+%{
+#ifndef __SCHTEAM__
+ @global(Process:SysProcessId) = __MKSMALLINT(SYS_PROCESS_ID);
+ RETURN (self);
+#endif /* not SCHTEAM */
+%}.
+ self primitiveFailed
! !
!Process class methodsFor:'instance creation'!
@@ -562,7 +575,7 @@
To prevent any daemon processes from preventing this exit,
you should make them systemProcesses"
- processGroupId := 0
+ processGroupId := SysProcessId
"Created: 17.1.1997 / 21:42:46 / cg"
!
@@ -1259,13 +1272,13 @@
].
creatorId := active id.
processGroupId := active processGroupId.
- (processGroupId isNil or:[processGroupId == 0]) ifTrue:[
+ (processGroupId isNil or:[processGroupId == SysProcessId]) ifTrue:[
processGroupId := creatorId.
].
- "/ since groupId is used to detect a systemProcess (0),
+ "/ since groupId is used to detect a systemProcess (SysProcessId),
"/ do not allow a 0 here; need an explicit beSystemProcess.
- processGroupId == 0 ifTrue:[processGroupId := nil].
+ processGroupId == SysProcessId ifTrue:[processGroupId := nil].
"Modified: 25.1.1997 / 01:28:54 / cg"
! !
@@ -1276,7 +1289,7 @@
"set id and state - not for public use"
id := idNumber.
- creatorId := 0.
+ creatorId := SysProcessId.
processGroupId := nil.
state := stateSymbol.
singleStepping isNil ifTrue:[
@@ -1370,8 +1383,8 @@
which should not be suspended/terminated etc.."
^ (Processor isPureEventDriven
- or:[id == 0
- or:[processGroupId == 0
+ or:[id == SysProcessId
+ or:[processGroupId == SysProcessId
or:[(Display notNil and:[Display dispatchProcess == self])
]]])
@@ -1385,7 +1398,7 @@
isUserProcess
"return true if aProcess is a user process."
- ^ processGroupId ~~ 0 and:[id ~~ 0]
+ ^ processGroupId ~~ SysProcessId and:[id ~~ SysProcessId]
!
nameOrId
@@ -2066,7 +2079,7 @@
errorString:'process is already dead - cannot determine child processes'.
^ self
].
- processGroupId == 0 ifTrue:[
+ processGroupId == SysProcessId ifTrue:[
ProcessorScheduler invalidProcessSignal
raiseWith:self errorString:'trying to terminate the system process group'.
].
--- a/ProcessorScheduler.st Tue Aug 08 16:46:35 2017 +0100
+++ b/ProcessorScheduler.st Wed Oct 04 21:32:06 2017 +0100
@@ -31,7 +31,7 @@
UserSchedulingPriority UserInterruptPriority TimingPriority
HighestPriority SchedulingPriority MaxNumberOfProcesses
InvalidProcessSignal TimeSlicingPriorityLimit TimeSliceInterval
- EventPollingInterval MaxProcessId'
+ EventPollingInterval MinProcessId MaxProcessId SysProcessId'
poolDictionaries:''
category:'Kernel-Processes'
!
@@ -263,6 +263,8 @@
HighestPriority := 30.
SchedulingPriority := 31.
+ self initializeVMProcessIdConstants.
+
InvalidProcessSignal isNil ifTrue:[
InvalidProcessSignal := Error newSignalMayProceed:true.
InvalidProcessSignal nameClass:self message:#invalidProcessSignal.
@@ -283,30 +285,27 @@
PureEventDriven ifTrue:[
'Processor [error]: no process support - running event driven' errorPrintCR
].
- self initializeVMMaxProcessId
+
"Modified: / 23-09-1996 / 14:24:50 / stefan"
"Modified: / 10-01-1997 / 18:03:03 / cg"
"Modified: / 19-09-2014 / 12:47:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-initializeVMMaxProcessId
+initializeVMProcessIdConstants
"/ for java locks, the VM may reserve some bits
"/ and reduce the maximum processID to be able to
"/ encode the id in an object's header field.
%{
#ifndef __SCHTEAM__
-
-# ifndef MAX_PROCESS_ID
-# define MAX_PROCESS_ID _MAX_INT
-# endif
-
+ @global(ProcessorScheduler:MinProcessId) = __MKSMALLINT(MIN_PROCESS_ID);
@global(ProcessorScheduler:MaxProcessId) = __MKSMALLINT(MAX_PROCESS_ID);
+ @global(ProcessorScheduler:SysProcessId) = __MKSMALLINT(SYS_PROCESS_ID);
RETURN (self);
#endif /* not SCHTEAM */
%}.
- MaxProcessId := SmallInteger maxVal.
+ self primitiveFailed
! !
!ProcessorScheduler class methodsFor:'instance creation'!
@@ -967,13 +966,13 @@
currentPriority := SchedulingPriority.
p := Process basicNew.
p
- setId:0 state:#run;
+ setId:SysProcessId state:#run;
setPriority:currentPriority;
name:'scheduler';
- beSystemProcess.
+ beSystemProcess.
scheduler := activeProcess := p.
- activeProcessId := 0.
+ activeProcessId := SysProcessId.
quiescentProcessLists at:currentPriority put:(l := LinkedList new).
l add:p.
@@ -1328,7 +1327,7 @@
actions (win32 only)
"
id := p id.
- (id ~~ 0 and:[id notNil]) ifTrue:[
+ (id ~~ SysProcessId and:[id notNil]) ifTrue:[
'Processor [warning]: problem with process ' errorPrint.
id errorPrint.
(nm := p name) notNil ifTrue:[
--- 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> $'
! !
--- a/Semaphore.st Tue Aug 08 16:46:35 2017 +0100
+++ b/Semaphore.st Wed Oct 04 21:32:06 2017 +0100
@@ -75,6 +75,10 @@
to a deadlock.
Use a RecursionLock instead, to avoid this.
+ NOTE:
+ You're encouraged to use `RecursionLock` for guarding a critical section.
+ `RecursionLock` is not only reentrant but also much faster.
+
Hint:
now (Jul2002), Semaphores now allow for a negative count; this allows for
a sync-point to be implemented easily (i.e. to wait for multiple other processes
@@ -355,7 +359,7 @@
"an optional reference to someone who owns this semaphore,
typically a shared queue or a windowgroup or similar.
This has no semantic meaning and is only used to support debugging"
-
+
^ owner
!
--- a/libInit.cc Tue Aug 08 16:46:35 2017 +0100
+++ b/libInit.cc Wed Oct 04 21:32:06 2017 +0100
@@ -59,6 +59,7 @@
extern void _Project_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _ProjectDefinition_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _ReadEvalPrintLoop_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _AbstractLock_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _RecursionLock_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _Semaphore_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _SharedPool_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
@@ -460,6 +461,7 @@
_Project_Init(pass,__pRT__,snd);
_ProjectDefinition_Init(pass,__pRT__,snd);
_ReadEvalPrintLoop_Init(pass,__pRT__,snd);
+ _AbstractLock_Init(pass,__pRT__,snd);
_RecursionLock_Init(pass,__pRT__,snd);
_Semaphore_Init(pass,__pRT__,snd);
_SharedPool_Init(pass,__pRT__,snd);
--- a/stx_libbasic.st Tue Aug 08 16:46:35 2017 +0100
+++ b/stx_libbasic.st Wed Oct 04 21:32:06 2017 +0100
@@ -41,17 +41,17 @@
Package documentation:
This library contains basic (nonGUI) classes.
-
+
These are the fundamental classes which are required for any Smalltalk,
whether scripting, non-GUI, repl, IDE or end user application.
Things you find here are mostly classes as described in the ANSI standard.
- There are no GUI dependencies here
- (some conditional code deals with the non-presence of UI classes;
+ There are no GUI dependencies here
+ (some conditional code deals with the non-presence of UI classes;
for example, debugging, for which a non-UI version is provided here)
- Also no developer support classes are found here
+ Also no developer support classes are found here
(i.e. Change/History support, compiler etc.).
[author:]
@@ -146,7 +146,7 @@
^ '
# for LINUX-32bit we need also librt.so, in order to resolve clock_gettime@GLIBC_2.2 (see linuxIntern.h)
# for LINUX-64bit we need also librt.so, in order to resolve clock_gettime@GLIBC_2.2.5 (see linuxIntern.h)
-ifneq (,$(findstring LINUX,$(CFLAGS)))
+ifneq (,$(findstring LINUX,$(CFLAGS)))
LOCAL_SHARED_LIBS=-lrt
endif
'
@@ -221,6 +221,7 @@
Project
ProjectDefinition
ReadEvalPrintLoop
+ AbstractLock
RecursionLock
Semaphore
SharedPool