--- a/Class.st Fri Jan 24 21:58:45 1997 +0100
+++ b/Class.st Fri Jan 24 23:11:36 1997 +0100
@@ -187,7 +187,7 @@
FileOutNameSpaceQuerySignal := QuerySignal new.
FileOutNameSpaceQuerySignal defaultAnswer:false.
- ChangeFileAccessLock := Semaphore forMutualExclusion.
+ ChangeFileAccessLock := Semaphore forMutualExclusion name:'ChangeFileAccessLock'.
]
"Modified: 3.1.1997 / 15:16:05 / cg"
@@ -4825,6 +4825,6 @@
!Class class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.249 1997-01-24 18:16:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.250 1997-01-24 22:08:11 cg Exp $'
! !
Class initialize!
--- a/Delay.st Fri Jan 24 21:58:45 1997 +0100
+++ b/Delay.st Fri Jan 24 23:11:36 1997 +0100
@@ -210,7 +210,7 @@
"set the millisecond delta"
millisecondDelta := aNumber.
- delaySemaphore := Semaphore new.
+ delaySemaphore := Semaphore new name:'delaySema'.
!
delaySemaphore
@@ -223,7 +223,7 @@
"set the resumtion time"
resumtionTime := aMillisecondTime.
- delaySemaphore := Semaphore new.
+ delaySemaphore := Semaphore new name:'delaySema'.
! !
!Delay methodsFor:'delaying'!
@@ -268,5 +268,5 @@
!Delay class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Delay.st,v 1.25 1997-01-16 13:15:26 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Delay.st,v 1.26 1997-01-24 22:08:41 cg Exp $'
! !
--- a/ExtStream.st Fri Jan 24 21:58:45 1997 +0100
+++ b/ExtStream.st Fri Jan 24 23:11:36 1997 +0100
@@ -3268,7 +3268,7 @@
wasBlocked := OperatingSystem blockInterrupts.
hasData := OperatingSystem readCheck:fd.
hasData ifFalse:[
- inputSema := Semaphore new.
+ inputSema := Semaphore new name:'inputSema'.
[
timeout notNil ifTrue:[
Processor signal:inputSema afterMilliseconds:timeout
@@ -3328,7 +3328,7 @@
wasBlocked := OperatingSystem blockInterrupts.
canWrite := OperatingSystem writeCheck:fd.
canWrite ifFalse:[
- outputSema := Semaphore new.
+ outputSema := Semaphore new name:'outputSema'.
[
timeout notNil ifTrue:[
Processor signal:outputSema afterMilliseconds:timeout
@@ -3592,6 +3592,6 @@
!ExternalStream class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Attic/ExtStream.st,v 1.118 1997-01-14 14:16:36 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Attic/ExtStream.st,v 1.119 1997-01-24 22:09:06 cg Exp $'
! !
ExternalStream initialize!
--- a/ExternalStream.st Fri Jan 24 21:58:45 1997 +0100
+++ b/ExternalStream.st Fri Jan 24 23:11:36 1997 +0100
@@ -3268,7 +3268,7 @@
wasBlocked := OperatingSystem blockInterrupts.
hasData := OperatingSystem readCheck:fd.
hasData ifFalse:[
- inputSema := Semaphore new.
+ inputSema := Semaphore new name:'inputSema'.
[
timeout notNil ifTrue:[
Processor signal:inputSema afterMilliseconds:timeout
@@ -3328,7 +3328,7 @@
wasBlocked := OperatingSystem blockInterrupts.
canWrite := OperatingSystem writeCheck:fd.
canWrite ifFalse:[
- outputSema := Semaphore new.
+ outputSema := Semaphore new name:'outputSema'.
[
timeout notNil ifTrue:[
Processor signal:outputSema afterMilliseconds:timeout
@@ -3592,6 +3592,6 @@
!ExternalStream class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.118 1997-01-14 14:16:36 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ExternalStream.st,v 1.119 1997-01-24 22:09:06 cg Exp $'
! !
ExternalStream initialize!
--- a/Method.st Fri Jan 24 21:58:45 1997 +0100
+++ b/Method.st Fri Jan 24 23:11:36 1997 +0100
@@ -155,7 +155,7 @@
].
LastFileLock isNil ifTrue:[
- LastFileLock := Semaphore forMutualExclusion.
+ LastFileLock := Semaphore forMutualExclusion name:'LastFileLock'.
LastFileReference := WeakArray new:1.
LastFileReference at:1 put:0.
].
@@ -2769,6 +2769,6 @@
!Method class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.124 1997-01-23 12:42:23 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Method.st,v 1.125 1997-01-24 22:09:40 cg Exp $'
! !
Method initialize!
--- a/ObjMem.st Fri Jan 24 21:58:45 1997 +0100
+++ b/ObjMem.st Fri Jan 24 23:11:36 1997 +0100
@@ -616,7 +616,7 @@
MallocFailureSignal nameClass:self message:#mallocFailureSignal.
MallocFailureSignal notifierString:'(malloc) allocation failure'.
- LowSpaceSemaphore := Semaphore new.
+ LowSpaceSemaphore := Semaphore new name:'LowSpaceSemaphore'
].
DisposeInterruptHandler := self.
IncrementalGCLimit := 500000.
@@ -2960,7 +2960,7 @@
^ self
].
- FinalizationSemaphore := Semaphore new.
+ FinalizationSemaphore := Semaphore new name:'FinalizationSemaphore'.
p :=
[
@@ -3983,6 +3983,6 @@
!ObjectMemory class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Attic/ObjMem.st,v 1.133 1997-01-24 20:44:27 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Attic/ObjMem.st,v 1.134 1997-01-24 22:10:08 cg Exp $'
! !
ObjectMemory initialize!
--- a/ObjectMemory.st Fri Jan 24 21:58:45 1997 +0100
+++ b/ObjectMemory.st Fri Jan 24 23:11:36 1997 +0100
@@ -616,7 +616,7 @@
MallocFailureSignal nameClass:self message:#mallocFailureSignal.
MallocFailureSignal notifierString:'(malloc) allocation failure'.
- LowSpaceSemaphore := Semaphore new.
+ LowSpaceSemaphore := Semaphore new name:'LowSpaceSemaphore'
].
DisposeInterruptHandler := self.
IncrementalGCLimit := 500000.
@@ -2960,7 +2960,7 @@
^ self
].
- FinalizationSemaphore := Semaphore new.
+ FinalizationSemaphore := Semaphore new name:'FinalizationSemaphore'.
p :=
[
@@ -3983,6 +3983,6 @@
!ObjectMemory class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.133 1997-01-24 20:44:27 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.134 1997-01-24 22:10:08 cg Exp $'
! !
ObjectMemory initialize!
--- a/ProcSched.st Fri Jan 24 21:58:45 1997 +0100
+++ b/ProcSched.st Fri Jan 24 23:11:36 1997 +0100
@@ -11,7 +11,7 @@
"
Object subclass:#ProcessorScheduler
- instanceVariableNames:'quiescentProcessLists scheduler zombie activeProcess
+ instanceVariableNames:'quiescentProcessLists scheduler zombie activeProcess activeProcessId
currentPriority readFdArray readSemaphoreArray readCheckArray
writeFdArray writeSemaphoreArray timeoutArray timeoutActionArray
timeoutProcessArray timeoutSemaphoreArray idleActions anyTimeouts
@@ -460,6 +460,14 @@
"Processor activeProcess"
!
+activeProcessId
+ "return the currently running process's ID.
+ The same as returned by 'Processor activeProcess id';
+ added for to avoid another send in semaphores debugging support."
+
+ ^ activeProcessId
+!
+
currentPriority
"return the priority of the currently running process"
@@ -853,13 +861,14 @@
"continue execution in aProcess.
WARNING: this is a low level entry, no process administration is done here"
- |id pri ok oldProcess oldPri p singleStep wasBlocked|
+ |id pri ok oldProcess oldPri oldId p singleStep wasBlocked|
(aProcess isNil or:[aProcess == activeProcess]) ifTrue:[^ self].
wasBlocked := OperatingSystem blockInterrupts.
oldProcess := activeProcess.
+ oldId := activeProcessId.
oldPri := currentPriority.
id := aProcess id.
@@ -873,6 +882,7 @@
(dont add any message sends here)
"
activeProcess := aProcess.
+ activeProcessId := id.
currentPriority := pri.
%{
extern OBJ ___threadSwitch();
@@ -888,6 +898,7 @@
p := activeProcess.
activeProcess := oldProcess.
+ activeProcessId := oldId.
currentPriority := oldProcess priority.
ok ifFalse:[
@@ -1111,6 +1122,7 @@
p name:'scheduler'.
scheduler := activeProcess := p.
+ activeProcessId := 0.
quiescentProcessLists at:currentPriority put:(l := LinkedList new).
l add:p.
@@ -2487,6 +2499,6 @@
!ProcessorScheduler class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Attic/ProcSched.st,v 1.115 1997-01-24 20:45:13 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Attic/ProcSched.st,v 1.116 1997-01-24 22:10:38 cg Exp $'
! !
ProcessorScheduler initialize!
--- a/Process.st Fri Jan 24 21:58:45 1997 +0100
+++ b/Process.st Fri Jan 24 23:11:36 1997 +0100
@@ -993,7 +993,9 @@
[
self isDead ifTrue:[^ self].
- suspendSemaphore isNil ifTrue:[suspendSemaphore := Semaphore new].
+ suspendSemaphore isNil ifTrue:[
+ suspendSemaphore := Semaphore new name:'process suspend'
+ ].
suspendSemaphore wait
] valueUninterruptably
@@ -1009,7 +1011,7 @@
[
self isDead ifTrue:[^ self].
- sema := Semaphore new.
+ sema := Semaphore new name:'process termination'.
self addExitAction:[sema signal].
sema wait.
@@ -1311,6 +1313,6 @@
!Process class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Process.st,v 1.72 1997-01-17 20:57:55 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Process.st,v 1.73 1997-01-24 22:10:56 cg Exp $'
! !
Process initialize!
--- a/ProcessorScheduler.st Fri Jan 24 21:58:45 1997 +0100
+++ b/ProcessorScheduler.st Fri Jan 24 23:11:36 1997 +0100
@@ -11,7 +11,7 @@
"
Object subclass:#ProcessorScheduler
- instanceVariableNames:'quiescentProcessLists scheduler zombie activeProcess
+ instanceVariableNames:'quiescentProcessLists scheduler zombie activeProcess activeProcessId
currentPriority readFdArray readSemaphoreArray readCheckArray
writeFdArray writeSemaphoreArray timeoutArray timeoutActionArray
timeoutProcessArray timeoutSemaphoreArray idleActions anyTimeouts
@@ -460,6 +460,14 @@
"Processor activeProcess"
!
+activeProcessId
+ "return the currently running process's ID.
+ The same as returned by 'Processor activeProcess id';
+ added for to avoid another send in semaphores debugging support."
+
+ ^ activeProcessId
+!
+
currentPriority
"return the priority of the currently running process"
@@ -853,13 +861,14 @@
"continue execution in aProcess.
WARNING: this is a low level entry, no process administration is done here"
- |id pri ok oldProcess oldPri p singleStep wasBlocked|
+ |id pri ok oldProcess oldPri oldId p singleStep wasBlocked|
(aProcess isNil or:[aProcess == activeProcess]) ifTrue:[^ self].
wasBlocked := OperatingSystem blockInterrupts.
oldProcess := activeProcess.
+ oldId := activeProcessId.
oldPri := currentPriority.
id := aProcess id.
@@ -873,6 +882,7 @@
(dont add any message sends here)
"
activeProcess := aProcess.
+ activeProcessId := id.
currentPriority := pri.
%{
extern OBJ ___threadSwitch();
@@ -888,6 +898,7 @@
p := activeProcess.
activeProcess := oldProcess.
+ activeProcessId := oldId.
currentPriority := oldProcess priority.
ok ifFalse:[
@@ -1111,6 +1122,7 @@
p name:'scheduler'.
scheduler := activeProcess := p.
+ activeProcessId := 0.
quiescentProcessLists at:currentPriority put:(l := LinkedList new).
l add:p.
@@ -2487,6 +2499,6 @@
!ProcessorScheduler class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.115 1997-01-24 20:45:13 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.116 1997-01-24 22:10:38 cg Exp $'
! !
ProcessorScheduler initialize!
--- a/Semaphore.st Fri Jan 24 21:58:45 1997 +0100
+++ b/Semaphore.st Fri Jan 24 23:11:36 1997 +0100
@@ -11,7 +11,7 @@
"
Object subclass:#Semaphore
- instanceVariableNames:'count waitingProcesses'
+ instanceVariableNames:'count waitingProcesses lastOwnerID name'
classVariableNames:''
poolDictionaries:''
category:'Kernel-Processes'
@@ -57,6 +57,21 @@
See examples in doc/coding (found in the CodingExamples-nameSpace).
+ [instance variables:]
+ count <SmallInteger> the number of waits, that will go through
+ without blocking.
+ Incremented on #signal; decremented on #wait.
+
+ waitingProcesses <OrderedCollection> waiting processes - will be served first
+ come first served when signalled.
+
+ lastOwnerID <SmallInteger> a debugging aid: set when count drops
+ to zero to the current processes id.
+ Helps in finding deadlocks.
+
+ name <String> a debugging aid: an optional userFriendly
+ name; helps to identify a semaphore easier.
+
[see also:]
SemaphoreSet RecursionLock Monitor
SharedQueue Delay
@@ -97,10 +112,12 @@
checkAndRegisterProcess:process
"interface for SemaphoreSet.
If the semaphore is available, decrement it and return true.
- Otherwise register our process to be wakened up once the semaphore is available.
+ Otherwise register our process to be wakened up once the semaphore is available
+ and return false..
"
"
+ bad ST/X trick (needs change, when multiProcessor support is added):
this works only since interrupts are only serviced at
message send and method-return time ....
If you add a message send into the ifTrue:-block, things will
@@ -108,6 +125,9 @@
"
count ~~ 0 ifTrue:[
count := count - 1.
+ count == 0 ifTrue:[
+ lastOwnerID := Processor activeProcessId.
+ ].
^ true
].
(waitingProcesses identityIndexOf:process) == 0 ifTrue:[
@@ -131,11 +151,31 @@
!Semaphore methodsFor:'printing & storing'!
+name
+ "return the semaphores userFriendly name"
+
+ ^ name
+!
+
+name:aString
+ "set the semaphores userFriendly name"
+
+ name := aString
+!
+
displayString
"return a string to display the receiver - include the
count for your convenience"
- ^ self class name , '(' , count printString , ')'
+ |n|
+
+ name isNil ifTrue:[
+ n := 'unnamed'
+ ] ifFalse:[
+ n := name
+ ].
+
+ ^ self class name , '(' , count printString , ' name: ' , n , ')'
"Modified: 10.1.1997 / 21:43:04 / cg"
! !
@@ -324,13 +364,17 @@
|activeProcess wasBlocked|
"
+ bad ST/X trick (needs change, when multiProcessor support is added):
this works only since interrupts are only serviced at
message send and method-return time ....
- If you add a message send into the ifTrue:-block, things will
- go mad ... (especially be careful when adding a debugPrint-here)
+ If you add a message send between the compare and the decrement,
+ things will go mad ... (especially be careful when adding a debugPrint-here)
"
count ~~ 0 ifTrue:[
count := count - 1.
+ count == 0 ifTrue:[
+ lastOwnerID := Processor activeProcessId.
+ ].
^ self
].
@@ -363,6 +407,9 @@
]
].
count := count - 1.
+ count == 0 ifTrue:[
+ lastOwnerID := Processor activeProcessId.
+ ].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
"Modified: 13.12.1995 / 13:26:33 / stefan"
@@ -376,10 +423,11 @@
|activeProcess wasBlocked|
"
+ bad ST/X trick (needs change, when multiProcessor support is added):
this works only since interrupts are only serviced at
message send and method-return time ....
- If you add a message send into the ifTrue:-block, things will
- go mad ... (especially be careful when adding a debugPrint-here)
+ If you add a message send between the compare and the decrement,
+ things will go mad ... (especially be careful when adding a debugPrint-here)
"
count ~~ 0 ifTrue:[
^ self
@@ -429,13 +477,17 @@
|activeProcess timeoutOccured wasBlocked unblock now endTime|
"
+ bad ST/X trick (needs change, when multiProcessor support is added):
this works only since interrupts are only serviced at
message send and method-return time ....
- If you add a message send into the ifTrue:-block, things will
- go mad ... (especially be careful when adding a debugPrint-here)
+ If you add a message send between the compare and the decrement,
+ things will go mad ... (especially be careful when adding a debugPrint-here)
"
count ~~ 0 ifTrue:[
count := count - 1.
+ count == 0 ifTrue:[
+ lastOwnerID := Processor activeProcessId.
+ ].
^ self
].
@@ -488,6 +540,9 @@
].
Processor removeTimedBlock:unblock.
count := count - 1.
+ count == 0 ifTrue:[
+ lastOwnerID := Processor activeProcessId.
+ ].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ self
@@ -498,5 +553,5 @@
!Semaphore class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Semaphore.st,v 1.41 1997-01-23 02:24:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Semaphore.st,v 1.42 1997-01-24 22:11:02 cg Exp $'
! !
--- a/Set.st Fri Jan 24 21:58:45 1997 +0100
+++ b/Set.st Fri Jan 24 23:11:36 1997 +0100
@@ -17,7 +17,7 @@
category:'Collections-Unordered'
!
-Object subclass:#DeletedEntry
+Object subclass:#DeletedEntryMarker
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
@@ -92,7 +92,7 @@
"initialize the Set class"
DeletedEntry isNil ifTrue:[
- DeletedEntry := DeletedEntry new
+ DeletedEntry := DeletedEntryMarker new
].
"Set initialize"
@@ -681,6 +681,6 @@
!Set class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Set.st,v 1.41 1997-01-24 20:53:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Set.st,v 1.42 1997-01-24 22:11:06 cg Exp $'
! !
Set initialize!
--- a/Unix.st Fri Jan 24 21:58:45 1997 +0100
+++ b/Unix.st Fri Jan 24 23:11:36 1997 +0100
@@ -3022,6 +3022,7 @@
|pid exitStatus sema|
sema := Semaphore new.
+ sema name:'Unix command wait'.
[
pid := self
@@ -3060,6 +3061,7 @@
|pid exitStatus sema|
sema := Semaphore new.
+ sema name:'Unix command wait'.
[
pid := self startProcess:aCommandString.
@@ -8302,6 +8304,6 @@
!OperatingSystem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Attic/Unix.st,v 1.193 1997-01-24 10:33:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Attic/Unix.st,v 1.194 1997-01-24 22:11:36 cg Exp $'
! !
OperatingSystem initialize!