# HG changeset patch
# User Claus Gittinger <cg@exept.de>
# Date 854143896 -3600
# Node ID 4c4d810f006fb2301d11ff0c9309e9ebb6b92d5c
# Parent  61096f935f764de787cbe2b2f5a9a9bb8f21c376
semaphore names

diff -r 61096f935f76 -r 4c4d810f006f Class.st
--- 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!
diff -r 61096f935f76 -r 4c4d810f006f Delay.st
--- 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 $'
 ! !
diff -r 61096f935f76 -r 4c4d810f006f ExtStream.st
--- 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!
diff -r 61096f935f76 -r 4c4d810f006f ExternalStream.st
--- 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!
diff -r 61096f935f76 -r 4c4d810f006f Method.st
--- 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!
diff -r 61096f935f76 -r 4c4d810f006f ObjMem.st
--- 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!
diff -r 61096f935f76 -r 4c4d810f006f ObjectMemory.st
--- 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!
diff -r 61096f935f76 -r 4c4d810f006f ProcSched.st
--- 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!
diff -r 61096f935f76 -r 4c4d810f006f Process.st
--- 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!
diff -r 61096f935f76 -r 4c4d810f006f ProcessorScheduler.st
--- 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!
diff -r 61096f935f76 -r 4c4d810f006f Semaphore.st
--- 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 $'
 ! !
diff -r 61096f935f76 -r 4c4d810f006f Set.st
--- 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!
diff -r 61096f935f76 -r 4c4d810f006f Unix.st
--- 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!