hg/stx-libbasic: comparison Registry.st

equal deleted inserted replaced

-:fbfd2d411738
+:a74d669db937
 "
 !
 documentation
 "
 Registries provide an easy interface to using WeakArrays.
 A class, which wants to be informed of instance-death, can put a created object
 into a registry. The registry will create an executor, which is a (shallow-)copy
 of the object, and watch out for death of the original object. When it dies,
 the executor will be sent a #finalize message.
 The trick with the shallow copy is especially nice, you can think of it as
 being the original object which died.
 All objects, which keep external resources (such as fileDescriptors, fonts,
 colormap-entries etc.) should be registered, so that the underlying resource
 can be freed when the object goes away.
 Of course, you too can use it to do whatever you need to do in case of the
 death of an object.
 Registries use #executor to aquire the copy of the original,
 this can be redefined in individual classes for faster copying
 (typically, not all internal state, but only some device handles are needed for
 finalization). If the to-be-registered object is large, this method may also
 return a stub (placeHolder) object. (i.e. there is no need for the copy to be
 of the same class as the original, as long as it implements #finalize and frees
 the relevant OS resources. Some classes return a specialized private-class instance,
 which only holds on the handle and implements #finalize.)
 Example uses are found in Form, Color, ExternalStream and Font
 [author:]
-Claus Gittinger
+	Claus Gittinger
 [see also:]
-WeakArray WeakIdentityDictionary WeakIdentitySet
+	WeakArray WeakIdentityDictionary WeakIdentitySet
-Font Form Color Cursor ExternalStream
+	Font Form Color Cursor ExternalStream
 "
 ! !
 !Registry methodsFor:'accessing'!
 index  "{ Class: SmallInteger }"
 sz     "{ Class: SmallInteger }"
 o myHandleArray wasBlocked|
 something == #ElementExpired ifTrue:[
-wasBlocked := OperatingSystem blockInterrupts.
+	wasBlocked := OperatingSystem blockInterrupts.
-[
+	[
-myHandleArray := handleArray.
+	    myHandleArray := handleArray.
-sz := myHandleArray size.
+	    sz := myHandleArray size.
-index := 1.
+	    index := 1.
-[index <= sz] whileTrue:[
+	    [index <= sz] whileTrue:[
-o := registeredObjects at:index.
+		o := registeredObjects at:index.
-o == 0 ifTrue:[
+		o class == SmallInteger ifTrue:[
-executor := myHandleArray at:index.
+		    executor := myHandleArray at:index.
-"remove the executor from the handle array before informing the executor.
+		    "remove the executor from the handle array before informing the executor.
-This is critical in case of errors while executing the executor.
+		     This is critical in case of errors while executing the executor.
-See ObjectMemory>>finalize"
+		     See ObjectMemory>>finalize"
-registeredObjects at:index put:nil.
+		    registeredObjects at:index put:nil.
-tally := tally - 1.
+		    tally := tally - 1.
-executor notNil ifTrue:[
+		    executor notNil ifTrue:[
-myHandleArray at:index put:nil.
+			myHandleArray at:index put:nil.
-"/
+			"/
-"/ allow interrupts for a while ...
+			"/ allow interrupts for a while ...
-"/
+			"/
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+			wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-self informDispose:executor.
+			self informDispose:executor.
-OperatingSystem blockInterrupts.
+			OperatingSystem blockInterrupts.
-"/
+			"/
-"/ any change in an interrupt or dispose handling ?
+			"/ any change in an interrupt or dispose handling ?
-"/
+			"/
-handleArray ~~ myHandleArray ifTrue:[
+			handleArray ~~ myHandleArray ifTrue:[
-myHandleArray := handleArray.
+			    myHandleArray := handleArray.
-sz := myHandleArray size.
+			    sz := myHandleArray size.
-"/ start again
+			    "/ start again
-index := 0.
+			    index := 0.
-]
+			]
-]
+		    ]
-].
+		].
-index := index + 1.
+		index := index + 1.
-]
+	    ]
-] ensure:[
+	] ensure:[
-wasBlocked ifFalse:[
+	    wasBlocked ifFalse:[
-OperatingSystem unblockInterrupts
+		OperatingSystem unblockInterrupts
-]
+	    ]
-].
+	].
-(sz > 50 and:[tally < (sz // 2)]) ifTrue:[
+	(sz > 50 and:[tally < (sz // 2)]) ifTrue:[
-"/ shrink
+	    "/ shrink
-self resize
+	    self resize
-]
+	]
 ] ifFalse:[
-something == #earlyRestart ifTrue:[
+	something == #earlyRestart ifTrue:[
-handleArray notNil ifTrue:[
+	    handleArray notNil ifTrue:[
-handleArray atAllPut:nil.
+		handleArray atAllPut:nil.
-]
+	    ]
-]
+	]
 ].
 "Created: 15.6.1996 / 15:24:41 / cg"
 "Modified: 8.1.1997 / 14:05:02 / stefan"
 "Modified: 2.6.1997 / 18:15:23 / cg"
 !Registry methodsFor:'enumerating'!
 detect:aBlock ifNone:exceptionValue
 registeredObjects notNil ifTrue:[
-registeredObjects validElementsDo:[:obj |
+	registeredObjects validElementsDo:[:obj |
-(aBlock value:obj) ifTrue:[^ obj].
+	    (aBlock value:obj) ifTrue:[^ obj].
-].
+	].
 ].
 ^ exceptionValue value
 !
 do:aBlock
 sz := registeredObjects size.
 cnt := 0.
 1 to:sz do:[:index |
-((executor := registeredObjects at:index) notNil
+	((executor := registeredObjects at:index) notNil
-and:[executor ~~ 0]) ifTrue:[
+	and:[executor class ~~ SmallInteger]) ifTrue:[
-indexTable at:executor put:index.
+	    indexTable at:executor put:index.
-cnt := cnt + 1.
+	    cnt := cnt + 1.
-] ifFalse:[
+	] ifFalse:[
-handleArray at:index put:nil.
+	    handleArray at:index put:nil.
-registeredObjects at:index put:nil.
+	    registeredObjects at:index put:nil.
-]
+	]
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Created: 6.3.1997 / 22:31:09 / cg"
 resize
 |sz          "{ Class: SmallInteger }"
 dstIndex    "{ Class: SmallInteger }"
 realNewSize "{ Class: SmallInteger }"
 newObjects newHandles wasBlocked
 executor|
 sz := registeredObjects size.
 (sz > 50 and:[tally < (sz // 2)]) ifTrue:[
-"/ shrink
+	"/ shrink
-wasBlocked := OperatingSystem blockInterrupts.
+	wasBlocked := OperatingSystem blockInterrupts.
-sz := registeredObjects size.
+	sz := registeredObjects size.
-realNewSize := tally * 3 // 2.
+	realNewSize := tally * 3 // 2.
-newObjects := WeakArray new:realNewSize.
+	newObjects := WeakArray new:realNewSize.
-newHandles := Array new:realNewSize.
+	newHandles := Array new:realNewSize.
-indexTable := WeakIdentityDictionary new.
+	indexTable := WeakIdentityDictionary new.
-dstIndex := 1.
+	dstIndex := 1.
-1 to:sz do:[:index |
+	1 to:sz do:[:index |
-(executor := registeredObjects at:index) notNil ifTrue:[
+	    (executor := registeredObjects at:index) notNil ifTrue:[
-dstIndex > realNewSize ifTrue:[
+		dstIndex > realNewSize ifTrue:[
-'Registry [error]: size given is too small in resize' errorPrintCR.
+		    'Registry [error]: size given is too small in resize' errorPrintCR.
-self repairTally.
+		    self repairTally.
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+		    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-^ self
+		    ^ self
-].
+		].
-newObjects at:dstIndex put:executor.
+		newObjects at:dstIndex put:executor.
-newHandles at:dstIndex put:(handleArray at:index).
+		newHandles at:dstIndex put:(handleArray at:index).
-indexTable at:executor put:dstIndex.
+		indexTable at:executor put:dstIndex.
-dstIndex := dstIndex + 1
+		dstIndex := dstIndex + 1
-]
+	    ]
-].
+	].
-registeredObjects removeDependent:self.
+	registeredObjects removeDependent:self.
-newObjects addDependent:self.
+	newObjects addDependent:self.
-registeredObjects := newObjects.
+	registeredObjects := newObjects.
-handleArray := newHandles.
+	handleArray := newHandles.
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ]
 "Created: 16.1.1997 / 18:08:00 / cg"
 "Modified: 6.3.1997 / 22:29:58 / cg"
 !
 unregister:anObject atIndex:index
 "strictly private"
 handleArray at:index put:nil.
 registeredObjects at:index put:nil.
 (anObject notNil and:[anObject ~~ 0]) ifTrue:[
-indexTable removeKey:anObject ifAbsent:[]
+	indexTable removeKey:anObject ifAbsent:[]
 ].
 tally := tally - 1.
 ! !
 !Registry methodsFor:'queries'!
 |executor|
 executor := anObject executor.
 executor notNil ifTrue:[
-self register:anObject as:executor.
+	self register:anObject as:executor.
 ].
 !
 register:anObject as:aHandle
 "register anObject, so that I later receive informDispose: with aHandle
 p wasBlocked idx0|
 wasBlocked := OperatingSystem blockInterrupts.
 registeredObjects size == 0 "isNil" ifTrue:[
-registeredObjects := WeakArray new:10.
+	registeredObjects := WeakArray new:10.
-registeredObjects addDependent:self.
+	registeredObjects addDependent:self.
-handleArray := Array basicNew:10.
+	handleArray := Array basicNew:10.
-indexTable := WeakIdentityDictionary new.
+	indexTable := WeakIdentityDictionary new.
-registeredObjects at:1 put:anObject.
+	registeredObjects at:1 put:anObject.
-handleArray at:1 put:aHandle.
+	handleArray at:1 put:aHandle.
-indexTable at:anObject put:1.
+	indexTable at:anObject put:1.
-tally := 1.
+	tally := 1.
-ObjectMemory addDependent:self.
+	ObjectMemory addDependent:self.
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-^ self
+	^ self
 ].
 "/
 "/ allow interrupts to be handled here
 "/ (but continue with interrupts disabled)
 "/
 wasBlocked ifFalse:[
-OperatingSystem unblockInterrupts.
+	OperatingSystem unblockInterrupts.
-OperatingSystem blockInterrupts.
+	OperatingSystem blockInterrupts.
 ].
 "/ index := registeredObjects identityIndexOf:anObject ifAbsent:0.
 index := indexTable at:anObject ifAbsent:0.
 index ~~ 0 ifTrue:[
-"/ double check ...
+	"/ double check ...
-(registeredObjects at:index) ~~ anObject ifTrue:[
+	(registeredObjects at:index) ~~ anObject ifTrue:[
-('Registry [warning]: index table clobbered') errorPrintCR.
+	    ('Registry [warning]: index table clobbered') errorPrintCR.
-].
+	].
-"already registered"
+	"already registered"
-handleArray at:index put:aHandle.
+	handleArray at:index put:aHandle.
 "/        ('Registry [info]: object (' , (registeredObjects at:index) printString , ') is already registered') infoPrintCR.
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-^ self
+	^ self
 ].
 "/
 "/ allow interrupts to be handled here
 "/ (but continue with interrupts disabled)
 "/
 wasBlocked ifFalse:[
-OperatingSystem unblockInterrupts.
+	OperatingSystem unblockInterrupts.
-OperatingSystem blockInterrupts.
+	OperatingSystem blockInterrupts.
 ].
 "/
 "/ search for a free slot ...
 "/ on the fly look for leftovers (should no longer happen)
 "/
 idx0 := 1.
 index := registeredObjects identityIndexOf:nil startingAt:idx0.
 [index ~~ 0] whileTrue:[
-"is there a leftover ?"
+	"is there a leftover ?"
-p := handleArray at:index.
+	p := handleArray at:index.
-p isNil ifTrue:[
+	p isNil ifTrue:[
-registeredObjects at:index put:anObject.
+	    registeredObjects at:index put:anObject.
-handleArray at:index put:aHandle.
+	    handleArray at:index put:aHandle.
-indexTable at:anObject put:index.
+	    indexTable at:anObject put:index.
-tally := tally + 1.
+	    tally := tally + 1.
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-^ self
+	    ^ self
-].
+	].
-"/ mhmh - a registeredObject vanished, but its
+	"/ mhmh - a registeredObject vanished, but its
-"/ executor is still there ...
+	"/ executor is still there ...
-"/
+	"/
-"/ this may happen, if the registries dispose handling is
+	"/ this may happen, if the registries dispose handling is
-"/ currently being executed by a lower priority process,
+	"/ currently being executed by a lower priority process,
-"/ and the registeredObject has already been nilled,
+	"/ and the registeredObject has already been nilled,
-"/ but the executor is being notified (in the other process).
+	"/ but the executor is being notified (in the other process).
 "/        'Registry [info]: leftOver executor: ' infoPrint. p infoPrintCR.
 "/        "tell the executor"
 "/        handleArray at:index put:nil.
 "/        tally := tally - 1.
 "/        self informDispose:p.
 "/        p := nil.
-idx0 := index + 1.
+	idx0 := index + 1.
-index := registeredObjects identityIndexOf:nil startingAt:idx0.
+	index := registeredObjects identityIndexOf:nil startingAt:idx0.
 ].
 "no free slot, add at the end"
 size := registeredObjects size.
 |index wasBlocked executor|
 executor := anObject executor.
 executor isNil ifTrue:[
-self unregister:anObject.
+	self unregister:anObject.
-^ self.
+	^ self.
 ].
 wasBlocked := OperatingSystem blockInterrupts.
 registeredObjects isNil ifTrue:[
-index := 0
+	index := 0
 ] ifFalse:[
-"/ index := registeredObjects identityIndexOf:anObject ifAbsent:0.
+	"/ index := registeredObjects identityIndexOf:anObject ifAbsent:0.
-index := indexTable at:anObject ifAbsent:0.
+	index := indexTable at:anObject ifAbsent:0.
 ].
 index ~~ 0 ifTrue:[
-handleArray at:index put:executor.
+	handleArray at:index put:executor.
 ] ifFalse:[
-self register:anObject as:executor
+	self register:anObject as:executor
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: 6.3.1997 / 22:24:15 / cg"
 !
 anObject (i.e. it no longer holds external resources)."
 |index wasBlocked|
 registeredObjects notNil ifTrue:[
-wasBlocked := OperatingSystem blockInterrupts.
+	wasBlocked := OperatingSystem blockInterrupts.
-"/ index := registeredObjects identityIndexOf:anObject ifAbsent:0.
+	"/ index := registeredObjects identityIndexOf:anObject ifAbsent:0.
-index := indexTable at:anObject ifAbsent:0.
+	index := indexTable at:anObject ifAbsent:0.
-index ~~ 0 ifTrue:[
+	index ~~ 0 ifTrue:[
-self unregister:anObject atIndex:index.
+	    self unregister:anObject atIndex:index.
-].
+	].
-wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-self resize
+	self resize
 ]
 "Modified: 16.1.1997 / 18:08:42 / cg"
 !
 	wasBlocked := OperatingSystem blockInterrupts.
 	n := registeredObjects size.
 	1 to:n do:[:index |
 	    obj := registeredObjects at:index.
-	    (obj notNil and:[obj ~~ 0]) ifTrue:[
+	    (obj notNil and:[obj class ~~ SmallInteger]) ifTrue:[
 		(aBlock value:obj) ifTrue:[
 		    self unregister:obj atIndex:index.
 		    any := true.
 		]
 	    ]
 ! !
 !Registry class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/Registry.st,v 1.64 2013-06-03 18:02:40 cg Exp $'
+^ '$Header$'
 !
 version_CVS
-^ '$Header: /cvs/stx/stx/libbasic/Registry.st,v 1.64 2013-06-03 18:02:40 cg Exp $'
+^ '$Header$'
 ! !

branch	jv
changeset 18630	a74d669db937
parent 18066	89d51443ba6f
parent 18620	b4e9f25d6ce6
child 18800	02724cc719b6