--- a/CacheDictionaryWithFactory.st Fri Sep 02 06:43:01 2016 +0200
+++ b/CacheDictionaryWithFactory.st Thu Sep 08 06:46:01 2016 +0200
@@ -9,8 +9,9 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+"{ Package: 'stx:libbasic2' }"
-"{ Package: 'stx:libbasic2' }"
+"{ NameSpace: Smalltalk }"
CacheDictionary subclass:#CacheDictionaryWithFactory
instanceVariableNames:'factoryBlock'
@@ -38,7 +39,7 @@
documentation
"
like a Dictionary, but does not grow (i.e. only keeps size items),
- and also keeps a factoryBlock ,to automatically compute missing elements.
+ and also keeps a factoryBlock to automatically compute missing elements.
[author:]
Claus Gittinger (cg@alan)
@@ -58,10 +59,10 @@
[exBegin]
|c|
- c := CacheDictionaryWithFactory
+ c := CacheDictionaryWithFactory
new:100 factory:[:key | key reversed].
- c at:'hello'.
+ c at:'hello'.
c at:'hello'.
1 to:1000 do:[:i | c at:i printString].
c at:'hello'.
@@ -74,10 +75,10 @@
numHalts := 0.
- c := CacheDictionaryWithFactory
+ c := CacheDictionaryWithFactory
new:100 factory:[:key | key = 'hello' ifTrue:[numHalts := numHalts + 1]. key reversed].
- c at:'hello'.
+ c at:'hello'.
c at:'hello'.
1 to:1000 do:[:i | c at:i printString].
c at:'hello'.
@@ -107,5 +108,6 @@
!CacheDictionaryWithFactory class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic2/CacheDictionaryWithFactory.st,v 1.1 2003-05-09 17:15:11 cg Exp $'
+ ^ '$Header$'
! !
+
--- a/Make.proto Fri Sep 02 06:43:01 2016 +0200
+++ b/Make.proto Thu Sep 08 06:46:01 2016 +0200
@@ -294,6 +294,7 @@
$(OUTDIR)HttpURI.$(O) HttpURI.$(C) HttpURI.$(H): HttpURI.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic2/HierarchicalURI.$(H) $(INCLUDE_TOP)/stx/libbasic2/URI.$(H) $(STCHDR)
$(OUTDIR)IPv6SocketAddress.$(O) IPv6SocketAddress.$(C) IPv6SocketAddress.$(H): IPv6SocketAddress.st $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(INCLUDE_TOP)/stx/libbasic2/IPSocketAddress.$(H) $(INCLUDE_TOP)/stx/libbasic2/SocketAddress.$(H) $(STCHDR)
$(OUTDIR)SftpURI.$(O) SftpURI.$(C) SftpURI.$(H): SftpURI.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic2/HierarchicalURI.$(H) $(INCLUDE_TOP)/stx/libbasic2/URI.$(H) $(STCHDR)
+$(OUTDIR)UnlimitedSharedQueue.$(O) UnlimitedSharedQueue.$(C) UnlimitedSharedQueue.$(H): UnlimitedSharedQueue.st $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic2/Queue.$(H) $(INCLUDE_TOP)/stx/libbasic2/SharedQueue.$(H) $(STCHDR)
$(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)/stx/libbasic/ArithmeticValue.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/CharacterArray.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Float.$(H) $(INCLUDE_TOP)/stx/libbasic/LimitedPrecisionReal.$(H) $(INCLUDE_TOP)/stx/libbasic/Magnitude.$(H) $(INCLUDE_TOP)/stx/libbasic/Number.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(STCHDR)
# ENDMAKEDEPEND --- do not remove this line
--- a/Make.spec Fri Sep 02 06:43:01 2016 +0200
+++ b/Make.spec Thu Sep 08 06:46:01 2016 +0200
@@ -22,7 +22,7 @@
# (if removed, they will be created as common
# -Pxxx : defines the package
# -Zxxx : a prefix for variables within the classLib
-# -Dxxx : defines passed to to CC for inline C-code
+# -Dxxx : defines passed to CC for inline C-code
# -Ixxx : include path passed to CC for inline C-code
# +optspace : optimized for space
# +optspace2 : optimized more for space
@@ -218,6 +218,7 @@
HttpURI \
IPv6SocketAddress \
SftpURI \
+ UnlimitedSharedQueue \
@@ -390,6 +391,7 @@
$(OUTDIR_SLASH)HttpURI.$(O) \
$(OUTDIR_SLASH)IPv6SocketAddress.$(O) \
$(OUTDIR_SLASH)SftpURI.$(O) \
+ $(OUTDIR_SLASH)UnlimitedSharedQueue.$(O) \
$(OUTDIR_SLASH)extensions.$(O) \
--- a/Queue.st Fri Sep 02 06:43:01 2016 +0200
+++ b/Queue.st Thu Sep 08 06:46:01 2016 +0200
@@ -38,19 +38,20 @@
documentation
"
- Queues provide a simple implementation of a queue,
+ Queues provide a simple implementation of a collection,
where elements are added at one end and removed at the other.
- Access protocol is somewhat like a streams protocol, i.e. access
- is by #nextPut: and #next.
+ Access protocol is somewhat like a stream's protocol,
+ i.e. access is by #nextPut: and #next.
+
The queue is created with a size argument, defining how many elements
are to be stored. It will report an error if the queue ever becomes full
- and another element is to be added. Likewise, it will report an error
- if it is empty and an element is to be removed.
+ and another element is to be added.
+ Likewise, it will report an error if it is empty and an element is to be removed.
- It is NOT safe when two processes access Queues simultaneously,
+ It is NOT safe when two processes access instances of Queue simultaneously,
since accesses to the internals are not protected against process-switches.
- See SharedQueue for a class which IS safe with processes and blocks
+ See SharedQueue for a class which IS safe w.r.t. processes and which blocks
on write when full or on read when empty.
[Implementation note:]
@@ -62,7 +63,7 @@
would require that many OC methods had to be blocked and/or redefined in
such a subclass, to care for simultaneous access.
Since queue implements a much more lightweight protocol,
- the sharedQueue implementation is much cleaner when based on a more
+ the sharedQueue implementation is much cleaner when based on this more
lightweight Queue class.
[author:]
@@ -191,95 +192,6 @@
"
!
-next
- "return the next value in the queue;
- Return nil, if the queue is empty"
-
- ^ self nextOrNil
-!
-
-nextOrNil
- "return the next value in the queue;
- Return nil, if the queue is empty"
-
- |value pos "{ Class: SmallInteger }"|
-
- (tally == 0) ifTrue:[^ nil].
-
- pos := readPosition.
-
- value := contentsArray at:pos.
- contentsArray at:pos put:nil. "/ to help the garbage collector
- pos := pos + 1.
- pos > contentsArray size ifTrue:[pos := 1].
- readPosition := pos.
- tally := tally - 1.
- ^ value
-!
-
-nextPut:anObject
- "enter anObject into the queue - if the queue is full, report an error"
-
- |sz pos "{ Class: SmallInteger }" |
-
- sz := contentsArray size.
- pos := writePosition.
-
- (tally == sz) ifTrue:[
- self error:'queue is full' mayProceed:true.
- ^ self
- ].
-
- contentsArray at:pos put:anObject.
- pos := pos + 1.
- pos > sz ifTrue:[pos := 1].
- writePosition := pos.
- tally := tally + 1.
-!
-
-nextPutAll:aCollection
- "enter all elements from aCollection into the queue."
-
- aCollection do:[:element | self nextPut:element]
-!
-
-nextPutFirst:anObject
- |sz pos "{ Class: SmallInteger }" |
-
- tally == 0 ifTrue:[
- self nextPut:anObject.
- ^ self
- ].
-
- sz := contentsArray size.
- (tally == sz) ifTrue:[
- self error:'queue is full' mayProceed:true.
- ^ self
- ].
- pos := readPosition - 1.
- pos < 1 ifTrue:[pos := sz].
- contentsArray at:pos put:anObject.
- readPosition := pos.
-
- tally := tally + 1
-!
-
-peek
- "return the next value in the queue without removing it.
- If the queue is empty, return nil."
-
- (tally == 0) ifTrue:[^ nil].
- ^ contentsArray at:readPosition.
-!
-
-peekOrNil
- "return the next value in the queue without removing it.
- If the queue is empty, return nil."
-
- (tally == 0) ifTrue:[^ nil].
- ^ contentsArray at:readPosition.
-!
-
removeAll
"remove all elements in the queue; return the receiver"
@@ -289,6 +201,9 @@
!
removeIdentical:anElement ifAbsent:exceptionalValue
+ "remove and return a particular element from the queue;
+ Return the value from exceptionalValue if the element is not in the queue"
+
|rPos "{ Class: SmallInteger }"
wPos "{ Class: SmallInteger }"
countRemoved
@@ -395,7 +310,7 @@
!
removeLast
- "return the last value in the queue;
+ "remove and return the last value in the queue;
Return nil, if the queue is empty"
|value pos "{ Class: SmallInteger }"|
@@ -435,6 +350,105 @@
"Created: / 27.8.1998 / 11:15:48 / cg"
! !
+!Queue methodsFor:'accessing-reading'!
+
+next
+ "return the next value in the queue;
+ Return nil, if the queue is empty.
+ WARNING: this is an old behavior, which should be changed
+ to raise an error if empty.
+ It is left in here until all queue-users have been changed to
+ call nextOrNil instead, to avoid breaking existing applications."
+
+ ^ self nextOrNil
+!
+
+nextOrNil
+ "return the next value in the queue;
+ Return nil, if the queue is empty"
+
+ |value pos "{ Class: SmallInteger }"|
+
+ (tally == 0) ifTrue:[^ nil].
+
+ pos := readPosition.
+
+ value := contentsArray at:pos.
+ contentsArray at:pos put:nil. "/ to help the garbage collector
+ pos := pos + 1.
+ pos > contentsArray size ifTrue:[pos := 1].
+ readPosition := pos.
+ tally := tally - 1.
+ ^ value
+!
+
+peek
+ "return the next value in the queue without removing it.
+ If the queue is empty, return nil."
+
+ (tally == 0) ifTrue:[^ nil].
+ ^ contentsArray at:readPosition.
+!
+
+peekOrNil
+ "return the next value in the queue without removing it.
+ If the queue is empty, return nil."
+
+ (tally == 0) ifTrue:[^ nil].
+ ^ contentsArray at:readPosition.
+! !
+
+!Queue methodsFor:'accessing-writing'!
+
+nextPut:anObject
+ "enter anObject into the queue - if the queue is full, report an error"
+
+ |sz pos "{ Class: SmallInteger }" |
+
+ sz := contentsArray size.
+ pos := writePosition.
+
+ (tally == sz) ifTrue:[
+ self error:'queue is full' mayProceed:true.
+ ^ self
+ ].
+
+ contentsArray at:pos put:anObject.
+ pos := pos + 1.
+ pos > sz ifTrue:[pos := 1].
+ writePosition := pos.
+ tally := tally + 1.
+ ^ self.
+!
+
+nextPutAll:aCollection
+ "enter all elements from aCollection into the queue."
+
+ aCollection do:[:element | self nextPut:element].
+ ^ self
+!
+
+nextPutFirst:anObject
+ |sz pos "{ Class: SmallInteger }" |
+
+ tally == 0 ifTrue:[
+ self nextPut:anObject.
+ ^ self
+ ].
+
+ sz := contentsArray size.
+ (tally == sz) ifTrue:[
+ self error:'queue is full' mayProceed:true.
+ ^ self
+ ].
+ pos := readPosition - 1.
+ pos < 1 ifTrue:[pos := sz].
+ contentsArray at:pos put:anObject.
+ readPosition := pos.
+
+ tally := tally + 1
+! !
+
!Queue methodsFor:'enumerating'!
do:aBlock
@@ -458,6 +472,49 @@
!Queue methodsFor:'initialization'!
+capacity:newSize
+ "change the capacity of the queue.
+ That is the number of slots it can hold."
+
+ |newContentsArray n1 n2|
+
+ newSize < tally ifTrue:[
+ "/ cannot make me smaller, if I hold at least this number of elements.
+ self error:'queue cannot be resized to this size while holding more elements' mayProceed:true.
+ "/ if proceeded
+ ^ self
+ ].
+ newContentsArray := Array new:newSize.
+ tally ~~ 0 ifTrue:[
+ n1 := contentsArray size - readPosition + 1.
+ n1 > tally ifTrue:[
+ newContentsArray replaceFrom:1 to:tally with:contentsArray startingAt:readPosition.
+ ] ifFalse:[
+ newContentsArray replaceFrom:1 to:n1 with:contentsArray startingAt:readPosition.
+ n2 := writePosition - 1.
+ newContentsArray replaceFrom:n1+1 to:tally with:contentsArray startingAt:1.
+ ].
+ ].
+ contentsArray := newContentsArray.
+ readPosition := 1.
+ writePosition := tally+1.
+
+ "
+ |q|
+ 1 to:10 do:[:fill |
+ 1 to:10 do:[:read |
+ Transcript show:'fill: '; show:fill; show:' read: '; showCR:read.
+ q := Queue new:10.
+ fill timesRepeat:[ q nextPut: #foo ].
+ read timesRepeat:[ q next ].
+ q capacity:12.
+ self assert:(q size == (fill-read)).
+ self assert:((Array streamContents:[:s | q do:[:e |s nextPut:e]]) = (Array new:(fill-read) withAll:#foo)).
+ ].
+ ].
+ "
+!
+
init:size
"initialize the receiver for size entries"
@@ -469,7 +526,11 @@
!Queue methodsFor:'queries'!
capacity
- "return the number of elements the queue can hold"
+ "return the number of elements the queue can hold.
+ Trying to add more will:
+ - raise an error in queue
+ - block the writer in sharedQueue
+ - lead to an automatic resize in UnlimitedSharedQueue"
^ contentsArray size
!
--- a/SharedQueue.st Fri Sep 02 06:43:01 2016 +0200
+++ b/SharedQueue.st Thu Sep 08 06:46:01 2016 +0200
@@ -49,12 +49,23 @@
a writer will be blocked when attempting to write into a full queue.
For nonBlocking read, use #isEmpty; for nonBlocking write, use #isFull.
+ Be warned:
+ if the reader process wants to add elements to the sharedqueue in its
+ read-loop, the reader may block, if the queue is full.
+ The reason is that the sharedQueues size is fixed, and any writer is blocked
+ if the queue is full.
+ For this situations, please use an UnlimitedSharedQueue, which grows in this
+ particular situation.
+
See samples in doc/coding.
[author:]
Claus Gittinger
[see also:]
+ SharedCollection
+ UnlimitedSharedQueue
+ Queue
Semaphore
Process
CodingExamples::SharedQueueExamples
@@ -112,113 +123,6 @@
!SharedQueue methodsFor:'accessing'!
-do:anObject
- "evaluate the argument, aBlock for each element in the queue"
-
- |retVal|
-
- accessLock critical:[
- retVal := super do:anObject.
- ].
- ^ retVal.
-!
-
-next
- "return the next value in the queue; if it its empty, wait 'til
- something is put into the receiver.
- When the datum has been removed, signal space-availability to
- writers"
-
- |retVal|
-
- dataAvailable wait.
- accessLock critical:[
- retVal := super nextOrNil.
- ].
- spaceAvailable signal.
-
- ^ retVal.
-!
-
-nextIfEmpty:exceptionValue
- "return the next value in the queue; if it its empty do not wait, but return
- the value of exceptionValue.
- When a datum has been removed, signal space-availability to writers"
-
- |retVal anyRemoved|
-
- accessLock critical:[
- self isEmpty ifTrue:[
- retVal := exceptionValue value
- ] ifFalse:[
- retVal := super nextOrNil.
- anyRemoved := true.
- ].
- ].
- anyRemoved == true ifTrue:[spaceAvailable signal].
-
- ^ retVal.
-!
-
-nextOrNil
- ^ self nextIfEmpty:nil
-
- "Created: / 31-05-2007 / 15:09:33 / cg"
-!
-
-nextPut:anObject
- "enter anObject into the queue; wait for available space, if
- the queue is full. After the put, signal availablity of a datum
- to readers."
-
- |retVal|
-
- spaceAvailable wait.
- accessLock critical:[
- retVal := super nextPut:anObject.
- dataAvailable signal.
- ].
- ^ retVal.
-!
-
-nextPutFirst:anObject
- |retVal|
-
- spaceAvailable wait.
- accessLock critical:[
- retVal := super nextPutFirst:anObject.
- dataAvailable signal.
- ].
- ^ retVal.
-!
-
-nextWithTimeout:seconds
- "return the next value in the queue; if it its empty, wait until
- something is put into the receiver.
- When the datum has been removed, signal space-availability to
- writers.
- Timeout after secondsIn seconds - answer nil if a timeout occurs."
-
- |retVal|
-
- (dataAvailable waitWithTimeout:seconds) isNil ifTrue:[
- ^ nil
- ].
- accessLock critical:[
- retVal := super nextOrNil.
- ].
- spaceAvailable signal.
-
- ^ retVal.
-!
-
-peek
- self isEmpty ifTrue:[
- dataAvailable waitUncounted.
- ].
- ^ super peek
-!
-
removeAll
"remove all elements in the queue; do not wait, but
synchronize access to the queue.
@@ -292,6 +196,18 @@
^ (dataAvailable waitUncountedWithTimeoutMs:ms) isNil.
!
+superNextPut:anObject
+ "private; to allow subclasses to call the basic nextPut (w.o. synchronization)"
+
+ ^ super nextPut:anObject.
+!
+
+superNextPutFirst:anObject
+ "private; to allow subclasses to call the basic nextPutFirst (w.o. synchronization)"
+
+ ^ super nextPutFirst:anObject.
+!
+
withAccessLockedDo:aBlock
"evaluate aBlock while access via next/nextPut are blocked."
@@ -307,6 +223,112 @@
"Modified: 16.12.1995 / 13:47:07 / cg"
! !
+!SharedQueue methodsFor:'accessing-reading'!
+
+next
+ "return the next value in the queue; if it its empty, wait 'til
+ something is put into the receiver.
+ When the datum has been removed, signal space-availability to
+ writers"
+
+ |retVal|
+
+ dataAvailable wait.
+ accessLock critical:[
+ retVal := super nextOrNil.
+ ].
+ spaceAvailable signal.
+
+ ^ retVal.
+!
+
+nextIfEmpty:exceptionValue
+ "return the next value in the queue; if it its empty do not wait, but return
+ the value of exceptionValue.
+ When a datum has been removed, signal space-availability to writers"
+
+ |retVal anyRemoved|
+
+ accessLock critical:[
+ self isEmpty ifTrue:[
+ retVal := exceptionValue value
+ ] ifFalse:[
+ retVal := super nextOrNil.
+ anyRemoved := true.
+ ].
+ ].
+ anyRemoved == true ifTrue:[spaceAvailable signal].
+
+ ^ retVal.
+!
+
+nextOrNil
+ ^ self nextIfEmpty:nil
+
+ "Created: / 31-05-2007 / 15:09:33 / cg"
+!
+
+nextWithTimeout:seconds
+ "return the next value in the queue; if it its empty, wait until
+ something is put into the receiver.
+ When the datum has been removed, signal space-availability to
+ writers.
+ Timeout after secondsIn seconds - answer nil if a timeout occurs."
+
+ |retVal|
+
+ (dataAvailable waitWithTimeout:seconds) isNil ifTrue:[
+ ^ nil
+ ].
+ accessLock critical:[
+ retVal := super nextOrNil.
+ ].
+ spaceAvailable signal.
+
+ ^ retVal.
+!
+
+peek
+ self isEmpty ifTrue:[
+ dataAvailable waitUncounted.
+ ].
+ ^ super peek
+! !
+
+!SharedQueue methodsFor:'adding'!
+
+nextPut:anObject
+ "enter anObject to the end of the queue;
+ do NOT wait for available space, if the queue is full; instead resize as required.
+ After the put, signal availablity of a datum to readers."
+
+ self commonWriteWith:[self superNextPut:anObject].
+ ^ self.
+!
+
+nextPutFirst:anObject
+ "insert anObject at the beginning of the queue;
+ do NOT wait for available space, if the queue is full, instead resize as required.
+ After the put, signal availablity of a datum to readers.
+ Insertion at the beginning may be useful to add hi-prio elements (for example, in a job-scheduler)"
+
+ self commonWriteWith:[self superNextPutFirst:anObject].
+ ^ self
+! !
+
+!SharedQueue methodsFor:'enumerating'!
+
+do:anObject
+ "evaluate the argument, aBlock for each element in the queue"
+
+ |retVal|
+
+ accessLock critical:[
+ retVal := super do:anObject.
+ ].
+ ^ retVal.
+! !
+
!SharedQueue methodsFor:'initialization'!
init:size
@@ -322,6 +344,20 @@
"Modified: 25.1.1997 / 00:19:45 / cg"
! !
+!SharedQueue methodsFor:'private'!
+
+commonWriteWith:aBlock
+ "common code for nextPut / nextPutFirst;
+ do NOT wait for available space, if the queue is full; instead resize as required.
+ After the put, signal availablity of a datum to readers."
+
+ spaceAvailable wait.
+ accessLock critical:[
+ aBlock value.
+ dataAvailable signal.
+ ].
+! !
+
!SharedQueue class methodsFor:'documentation'!
version
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/UnlimitedSharedQueue.st Thu Sep 08 06:46:01 2016 +0200
@@ -0,0 +1,187 @@
+"
+ COPYRIGHT (c) 2016 by exept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libbasic2' }"
+
+"{ NameSpace: Smalltalk }"
+
+SharedQueue subclass:#UnlimitedSharedQueue
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Kernel-Processes'
+!
+
+!UnlimitedSharedQueue class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2016 by exept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ Like the superclass, SharedQueues, this provide a safe mechanism for processes to communicate.
+ They are basically Queues, with added secure access to the internals,
+ allowing use from multiple processes (i.e. the access methods use
+ critical regions to protect against confusion due to a process
+ switch within a modification).
+
+ In contrast to SharedQueues, which block the writer when the queue is full,
+ instances of me grow the underlying container, so the writer will never block
+ (of course, the reader will still block in #next, if the queue is empty).
+
+ This kind of queue is needed if the reader process itself possibly wants to
+ add more to the queue. For this, a limited sharedQueue may block the reader,
+ if this reader process cannot add a new element.
+
+ [author:]
+ Claus Gittinger
+
+ [see also:]
+ SharedQueue
+ SharedCollection
+ OrderedCollection
+ Queue
+ Semaphore
+ Process
+ CodingExamples::SharedQueueExamples
+"
+!
+
+examples
+"
+ ATTENTION:
+ Using a regular SharedQueue will lead to a deadlock when the reader writes itself.
+ (you'll have to terminate the two processes in the process monitor):
+
+ [exBegin]
+ |reader writer q|
+
+ q := SharedQueue new:10.
+
+ reader :=
+ [
+ [
+ |element|
+
+ element := q next.
+ element == true ifTrue:[
+ q nextPut:#xx.
+ q nextPut:#xx.
+ q nextPut:#xx.
+ ].
+ Transcript showCR:element.
+ ] loop.
+ ] fork.
+
+ writer :=
+ [
+ q nextPut:false.
+ q nextPut:false.
+ q nextPut:false.
+ q nextPut:false.
+ q nextPut:false.
+ q nextPut:true.
+ q nextPut:true.
+ q nextPut:true.
+ q nextPut:true.
+ q nextPut:true.
+ q nextPut:false.
+ q nextPut:false.
+ q nextPut:false.
+ Transcript showCR:'writer finished'.
+ ] fork.
+ [exEnd]
+
+
+ this will not lead to a deadlock
+ (you'll have to terminate the two processes in the process monitor):
+ [exBegin]
+ |reader writer q|
+
+ q := UnlimitedSharedQueue new:10.
+
+ reader :=
+ [
+ [
+ |element|
+
+ element := q next.
+ element == true ifTrue:[
+ q nextPut:#xx.
+ q nextPut:#xx.
+ q nextPut:#xx.
+ ].
+ Transcript showCR:element.
+ ] loop.
+ ] fork.
+
+ writer :=
+ [
+ q nextPut:false.
+ q nextPut:false.
+ q nextPut:false.
+ q nextPut:false.
+ q nextPut:false.
+ q nextPut:true.
+ q nextPut:true.
+ q nextPut:true.
+ q nextPut:true.
+ q nextPut:true.
+ q nextPut:false.
+ q nextPut:false.
+ q nextPut:false.
+ Transcript showCR:'writer finished'.
+ ] fork.
+ [exEnd]
+"
+! !
+
+!UnlimitedSharedQueue methodsFor:'private'!
+
+commonWriteWith:aBlock
+ "common code for nextPut / nextPutFirst;
+ do NOT wait for available space, if the queue is full; instead resize as required.
+ After the put, signal availablity of a datum to readers."
+
+ |myCapacity|
+
+ accessLock critical:[
+ myCapacity := self capacity.
+ self size == myCapacity ifTrue:[
+ self capacity:(myCapacity * 1.5 // 1).
+ ].
+ aBlock value.
+ dataAvailable signal.
+ ].
+ ^ self.
+! !
+
+!UnlimitedSharedQueue class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+!
+
+version_CVS
+ ^ '$Header$'
+! !
+
--- a/abbrev.stc Fri Sep 02 06:43:01 2016 +0200
+++ b/abbrev.stc Thu Sep 08 06:46:01 2016 +0200
@@ -28,7 +28,6 @@
Curve Curve stx:libbasic2 'Graphics-Geometry-Objects' 0
DirectoryContents DirectoryContents stx:libbasic2 'System-Support' 0
DoubleLink DoubleLink stx:libbasic2 'Collections-Support' 0
-DoubleLinkedList DoubleLinkedList stx:libbasic2 'Collections-Linked' 0
EllipticalArc EllipticalArc stx:libbasic2 'Graphics-Geometry-Objects' 0
ExternalLong ExternalLong stx:libbasic2 'System-Support' 0
FileSorter FileSorter stx:libbasic2 'Interface-Tools-File' 0
@@ -169,3 +168,5 @@
HttpURI HttpURI stx:libbasic2 'Net-Resources' 0
IPv6SocketAddress IPv6SocketAddress stx:libbasic2 'OS-Sockets' 2
SftpURI SftpURI stx:libbasic2 'Net-Resources' 0
+UnlimitedSharedQueue UnlimitedSharedQueue stx:libbasic2 'Kernel-Processes' 0
+DoubleLinkedList DoubleLinkedList stx:libbasic2 'Collections-Linked' 0
--- a/bc.mak Fri Sep 02 06:43:01 2016 +0200
+++ b/bc.mak Thu Sep 08 06:46:01 2016 +0200
@@ -34,7 +34,7 @@
LIBNAME=libstx_libbasic2
MODULE_PATH=libbasic2
-RESFILES=libbasic2.$(RES)
+RESFILES=stx_libbasic2WINrc.$(RES)
!ifdef USEBC
@@ -254,6 +254,7 @@
$(OUTDIR)HttpURI.$(O) HttpURI.$(C) HttpURI.$(H): HttpURI.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic2\HierarchicalURI.$(H) $(INCLUDE_TOP)\stx\libbasic2\URI.$(H) $(STCHDR)
$(OUTDIR)IPv6SocketAddress.$(O) IPv6SocketAddress.$(C) IPv6SocketAddress.$(H): IPv6SocketAddress.st $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(INCLUDE_TOP)\stx\libbasic2\IPSocketAddress.$(H) $(INCLUDE_TOP)\stx\libbasic2\SocketAddress.$(H) $(STCHDR)
$(OUTDIR)SftpURI.$(O) SftpURI.$(C) SftpURI.$(H): SftpURI.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic2\HierarchicalURI.$(H) $(INCLUDE_TOP)\stx\libbasic2\URI.$(H) $(STCHDR)
+$(OUTDIR)UnlimitedSharedQueue.$(O) UnlimitedSharedQueue.$(C) UnlimitedSharedQueue.$(H): UnlimitedSharedQueue.st $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic2\Queue.$(H) $(INCLUDE_TOP)\stx\libbasic2\SharedQueue.$(H) $(STCHDR)
$(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)\stx\libbasic\ArithmeticValue.$(H) $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\CharacterArray.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Float.$(H) $(INCLUDE_TOP)\stx\libbasic\LimitedPrecisionReal.$(H) $(INCLUDE_TOP)\stx\libbasic\Magnitude.$(H) $(INCLUDE_TOP)\stx\libbasic\Number.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Stream.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(STCHDR)
# ENDMAKEDEPEND --- do not remove this line
--- a/libInit.cc Fri Sep 02 06:43:01 2016 +0200
+++ b/libInit.cc Thu Sep 08 06:46:01 2016 +0200
@@ -183,6 +183,7 @@
extern void _HttpURI_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _IPv6SocketAddress_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _SftpURI_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
+extern void _UnlimitedSharedQueue_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
extern void _stx_137libbasic2_extensions_Init(int pass, struct __vmData__ *__pRT__, OBJ snd);
@@ -364,6 +365,7 @@
_HttpURI_Init(pass,__pRT__,snd);
_IPv6SocketAddress_Init(pass,__pRT__,snd);
_SftpURI_Init(pass,__pRT__,snd);
+ _UnlimitedSharedQueue_Init(pass,__pRT__,snd);
_stx_137libbasic2_extensions_Init(pass,__pRT__,snd);
__END_PACKAGE__();
--- a/stx_libbasic2.st Fri Sep 02 06:43:01 2016 +0200
+++ b/stx_libbasic2.st Thu Sep 08 06:46:01 2016 +0200
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 2006 by eXept Software AG
All Rights Reserved
@@ -230,7 +228,6 @@
Curve
DirectoryContents
DoubleLink
- (DoubleLinkedList autoload)
EllipticalArc
ExternalLong
FileSorter
@@ -371,6 +368,8 @@
HttpURI
IPv6SocketAddress
SftpURI
+ UnlimitedSharedQueue
+ (DoubleLinkedList autoload)
)
!
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/stx_libbasic2WINrc.rc Thu Sep 08 06:46:01 2016 +0200
@@ -0,0 +1,37 @@
+//
+// DO NOT EDIT
+// automagically generated from the projectDefinition: stx_libbasic2.
+//
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION 7,1,1,144
+ PRODUCTVERSION 7,1,0,0
+#if (__BORLANDC__)
+ FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
+ FILEFLAGS VS_FF_PRERELEASE | VS_FF_SPECIALBUILD
+ FILEOS VOS_NT_WINDOWS32
+ FILETYPE VFT_DLL
+ FILESUBTYPE VS_USER_DEFINED
+#endif
+
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904E4"
+ BEGIN
+ VALUE "CompanyName", "eXept Software AG\0"
+ VALUE "FileDescription", "Smalltalk/X Additional Basic Classes (LIB)\0"
+ VALUE "FileVersion", "7.1.1.144\0"
+ VALUE "InternalName", "stx:libbasic2\0"
+ VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2012\nCopyright eXept Software AG 2012\0"
+ VALUE "ProductName", "Smalltalk/X\0"
+ VALUE "ProductVersion", "7.1.0.0\0"
+ VALUE "ProductDate", "Wed, 07 Sep 2016 13:41:55 GMT\0"
+ END
+
+ END
+
+ BLOCK "VarFileInfo"
+ BEGIN // Language | Translation
+ VALUE "Translation", 0x409, 0x4E4 // U.S. English, Windows Multilingual
+ END
+END