Add SemaphoreSet.
authorStefan Vogel <sv@exept.de>
Thu, 14 Dec 1995 23:42:02 +0100
changeset 757 93d5f6b86e98
parent 756 f3f56229c300
child 758 3607930678a8
Add SemaphoreSet.
Make.proto
SemaSet.st
Semaphore.st
SemaphoreSet.st
--- a/Make.proto	Thu Dec 14 23:31:43 1995 +0100
+++ b/Make.proto	Thu Dec 14 23:42:02 1995 +0100
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libbasic/Make.proto,v 1.47 1995-11-04 21:10:16 cg Exp $
+# $Header: /cvs/stx/stx/libbasic/Make.proto,v 1.48 1995-12-14 22:42:00 stefan Exp $
 #
 # -------------- no need to change anything below ----------
 
@@ -57,6 +57,7 @@
 		  IdSet.$(O)                              \
 		    WeakIdSet.$(O)                        \
 		    SignalSet.$(O)                        \
+		    SemaSet.$(O)                          \
 	      Context.$(O)                                \
 		BContext.$(O)                             \
 	      Delay.$(O)                                  \
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/SemaSet.st	Thu Dec 14 23:42:02 1995 +0100
@@ -0,0 +1,99 @@
+'From Smalltalk/X, Version:2.10.8 on 14-dec-1995 at 18:58:53'                   !
+
+IdentitySet subclass:#SemaphoreSet
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Kernel-Processes'
+!
+
+!SemaphoreSet class methodsFor:'documentation'!
+
+documentation
+"
+    SemaphoreSet allow waiting until one of several semaphores become available.
+"
+!
+
+examples
+"
+    |sema1 sema2 semaSet proc|
+
+    sema1 := Semaphore new.
+    sema2 := Semaphore new.
+    semaSet := SemaphoreSet with:sema1 with:sema2.
+
+    proc := [
+        [
+            |ret name|
+
+            ret := semaSet wait.
+            ret == sema1 ifTrue:[
+                name := 'sema1'
+            ] ifFalse:[ 
+                ret == sema2 ifTrue:[
+                    name := 'sema2'
+                ]
+            ].
+            Transcript showCr: name, ' raised'.
+            ret == sema2 ifTrue:[
+                proc terminate
+            ]
+        ] loop
+    ] fork.
+
+    (Delay forSeconds:3) wait.
+    sema1 signal.
+    (Delay forSeconds:3) wait.
+    sema2 signal.
+"
+!
+
+history
+    "Created: 14.12.1995 / 12:23:21 / stefan"
+! !
+
+!SemaphoreSet methodsFor:'wait'!
+
+wait
+    |currentProcess gotSema wasBlocked|
+
+    currentProcess := Processor activeProcess.
+
+    wasBlocked := OperatingSystem blockInterrupts.
+    [
+        gotSema := self detect:[:sema|
+            sema checkAndRegisterProcess:currentProcess
+        ] ifNone:[
+            currentProcess suspendWithState:#wait.
+            nil
+        ].
+    ] doWhile:[gotSema isNil].
+
+    "
+      we finaly got one of our semaphores.
+      Now unregister from any semaphore, we are registered on.
+    "
+    gotSema notNil ifTrue:[
+        self detect:[:sema|
+            sema == gotSema ifTrue:[
+                true
+            ] ifFalse:[
+                sema unregisterProcess:currentProcess.
+                false
+            ]
+        ] ifNone:[]
+    ].
+    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+    ^ gotSema
+
+    "Modified: 14.12.1995 / 13:16:57 / stefan"
+! !
+
+!SemaphoreSet class methodsFor:'documentation'!
+
+version
+"
+$Header: /cvs/stx/stx/libbasic/Attic/SemaSet.st,v 1.1 1995-12-14 22:42:02 stefan Exp $
+"
+! !
--- a/Semaphore.st	Thu Dec 14 23:31:43 1995 +0100
+++ b/Semaphore.st	Thu Dec 14 23:42:02 1995 +0100
@@ -10,11 +10,13 @@
  hereby transferred.
 "
 
+'From Smalltalk/X, Version:2.10.8 on 14-dec-1995 at 18:58:50'                   !
+
 Object subclass:#Semaphore
-	 instanceVariableNames:'count waitingProcesses'
-	 classVariableNames:''
-	 poolDictionaries:''
-	 category:'Kernel-Processes'
+	instanceVariableNames:'count waitingProcesses'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Kernel-Processes'
 !
 
 !Semaphore class methodsFor:'documentation'!
@@ -76,6 +78,45 @@
     ^ super new setCount:n
 ! !
 
+!Semaphore methodsFor:'friend-class interface'!
+
+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.
+    "
+
+
+    "
+     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)
+    "
+    count ~~ 0 ifTrue:[
+        count := count - 1.
+        ^ true
+    ].
+    (waitingProcesses identityIndexOf:process) = 0 ifTrue:[
+        waitingProcesses add:process.
+    ].
+    ^ false
+
+    "Modified: 14.12.1995 / 10:32:17 / stefan"
+!
+
+unregisterProcess:process
+    "
+     interface for SemaphoreSet.
+     Unregister our process from the Semaphore
+    "
+
+    waitingProcesses remove:process.
+
+    "Created: 14.12.1995 / 10:31:50 / stefan"
+! !
+
 !Semaphore methodsFor:'printing & storing'!
 
 displayString
@@ -349,5 +390,5 @@
 !Semaphore class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Semaphore.st,v 1.25 1995-12-14 16:55:58 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Semaphore.st,v 1.26 1995-12-14 22:42:02 stefan Exp $'
 ! !
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/SemaphoreSet.st	Thu Dec 14 23:42:02 1995 +0100
@@ -0,0 +1,99 @@
+'From Smalltalk/X, Version:2.10.8 on 14-dec-1995 at 18:58:53'                   !
+
+IdentitySet subclass:#SemaphoreSet
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Kernel-Processes'
+!
+
+!SemaphoreSet class methodsFor:'documentation'!
+
+documentation
+"
+    SemaphoreSet allow waiting until one of several semaphores become available.
+"
+!
+
+examples
+"
+    |sema1 sema2 semaSet proc|
+
+    sema1 := Semaphore new.
+    sema2 := Semaphore new.
+    semaSet := SemaphoreSet with:sema1 with:sema2.
+
+    proc := [
+        [
+            |ret name|
+
+            ret := semaSet wait.
+            ret == sema1 ifTrue:[
+                name := 'sema1'
+            ] ifFalse:[ 
+                ret == sema2 ifTrue:[
+                    name := 'sema2'
+                ]
+            ].
+            Transcript showCr: name, ' raised'.
+            ret == sema2 ifTrue:[
+                proc terminate
+            ]
+        ] loop
+    ] fork.
+
+    (Delay forSeconds:3) wait.
+    sema1 signal.
+    (Delay forSeconds:3) wait.
+    sema2 signal.
+"
+!
+
+history
+    "Created: 14.12.1995 / 12:23:21 / stefan"
+! !
+
+!SemaphoreSet methodsFor:'wait'!
+
+wait
+    |currentProcess gotSema wasBlocked|
+
+    currentProcess := Processor activeProcess.
+
+    wasBlocked := OperatingSystem blockInterrupts.
+    [
+        gotSema := self detect:[:sema|
+            sema checkAndRegisterProcess:currentProcess
+        ] ifNone:[
+            currentProcess suspendWithState:#wait.
+            nil
+        ].
+    ] doWhile:[gotSema isNil].
+
+    "
+      we finaly got one of our semaphores.
+      Now unregister from any semaphore, we are registered on.
+    "
+    gotSema notNil ifTrue:[
+        self detect:[:sema|
+            sema == gotSema ifTrue:[
+                true
+            ] ifFalse:[
+                sema unregisterProcess:currentProcess.
+                false
+            ]
+        ] ifNone:[]
+    ].
+    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+    ^ gotSema
+
+    "Modified: 14.12.1995 / 13:16:57 / stefan"
+! !
+
+!SemaphoreSet class methodsFor:'documentation'!
+
+version
+"
+$Header: /cvs/stx/stx/libbasic/SemaphoreSet.st,v 1.1 1995-12-14 22:42:02 stefan Exp $
+"
+! !