hg/stx-libbasic: comparison Registry.st

equal deleted inserted replaced

-:ab70ff46b982
+:788bba151e8a
 ]
 ! !
 !Registry methodsFor:'private'!
+repairTally
+|sz          "{ Class: SmallInteger }"
+cnt         "{ Class: SmallInteger }"
+phantom wasBlocked|
+wasBlocked := OperatingSystem blockInterrupts.
+indexTable := WeakIdentityDictionary new.
+sz := registeredObjects size.
+cnt := 0.
+1 to:sz do:[:index |
+((phantom := registeredObjects at:index) notNil
+and:[phantom ~~ 0]) ifTrue:[
+indexTable at:phantom put:index.
+cnt := cnt + 1.
+] ifFalse:[
+handleArray 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
 sz := registeredObjects size.
 (sz > 50 and:[tally < (sz // 2)]) ifTrue:[
 "/ shrink
+wasBlocked := OperatingSystem blockInterrupts.
+sz := registeredObjects size.
 realNewSize := tally * 3 // 2.
 newObjects := WeakArray new:realNewSize.
 newHandles := Array new:realNewSize.
-	indexTable := WeakIdentityDictionary new.
+indexTable := WeakIdentityDictionary new.
-wasBlocked := OperatingSystem blockInterrupts.
 dstIndex := 1.
 1 to:sz do:[:index |
 (phantom := registeredObjects at:index) notNil ifTrue:[
 dstIndex > realNewSize ifTrue:[
-'Registry [info]: size given is too small in resize' infoPrintCR.
+'Registry [error]: size given is too small in resize' errorPrintCR.
+self repairTally.
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ^ self
 ].
 newObjects at:dstIndex put:phantom.
 newHandles at:dstIndex put:(handleArray at:index).
-		indexTable at:phantom put:dstIndex.
+indexTable at:phantom put:dstIndex.
 dstIndex := dstIndex + 1
 ]
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ]
 "Created: 16.1.1997 / 18:08:00 / cg"
-"Modified: 27.1.1997 / 15:04:40 / cg"
+"Modified: 6.3.1997 / 22:29:58 / cg"
 ! !
 !Registry methodsFor:'registering objects'!
 register:anObject
 size  "{ Class: SmallInteger }"
 index "{ Class: SmallInteger }"
 p wasBlocked|
 wasBlocked := OperatingSystem blockInterrupts.
 registeredObjects size == 0 "isNil" ifTrue:[
 registeredObjects := WeakArray new:10.
 registeredObjects addDependent:self.
 handleArray := Array basicNew:10.
-	indexTable := WeakIdentityDictionary new.
+indexTable := WeakIdentityDictionary new.
 registeredObjects at:1 put:anObject.
 handleArray at:1 put:aHandle.
 indexTable at:anObject put:1.
 ].
 "/ index := registeredObjects identityIndexOf:anObject ifAbsent:0.
 index := indexTable at:anObject ifAbsent:0.
 index ~~ 0 ifTrue:[
+"/ double check ...
+(registeredObjects at:index) ~~ anObject ifTrue:[
+('Registry [warning]: index table clobbered') errorPrintCR.
+].
 "already registered"
 handleArray at:index put:aHandle.
 ('Registry [info]: object (' , (registeredObjects at:index) printString , ' is already registered') infoPrintCR.
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ^ self
 ].
 index := registeredObjects identityIndexOf:nil startingAt:1.
 index ~~ 0 ifTrue:[
 "is there a leftover ?"
 p := handleArray at:index.
 p notNil ifTrue:[
-'Registry [info]: there should be no leftOvers' infoPrintCR.
+'Registry [warning]: there should be no leftOvers' errorPrintCR.
 "tell the phantom"
 handleArray at:index put:nil.
 tally := tally - 1.
 self informDispose:p.
 p := nil.
 ].
 registeredObjects at:index put:anObject.
 handleArray at:index put:aHandle.
-	indexTable at:anObject put:index.
+indexTable at:anObject put:index.
 tally := tally + 1.
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 ^ self
 ].
 tally := tally + 1.
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
 "Modified: 7.1.1997 / 16:56:03 / stefan"
-"Modified: 27.1.1997 / 15:18:07 / cg"
+"Modified: 6.3.1997 / 22:23:23 / cg"
 !
 registerChange:anObject
 "a registered object has changed, create a new phantom"
-|index wasBlocked|
+|index wasBlocked copy|
 wasBlocked := OperatingSystem blockInterrupts.
 registeredObjects isNil ifTrue:[
 index := 0
 ] ifFalse:[
 "/ index := registeredObjects identityIndexOf:anObject ifAbsent:0.
-	index := indexTable at:anObject ifAbsent:0.
+index := indexTable at:anObject ifAbsent:0.
 ].
+copy := anObject shallowCopyForFinalization.
 index ~~ 0 ifTrue:[
-handleArray at:index put:anObject shallowCopyForFinalization.
+handleArray at:index put:copy.
 ] ifFalse:[
-self register:anObject
+self register:anObject as:copy
 ].
 wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-"Modified: 22.6.1996 / 14:27:52 / cg"
+"Modified: 6.3.1997 / 22:24:15 / cg"
 !
 unregister:anObject
 "remove registration of anObject, without telling the phantom;
 should be sent, if we are no more interested in destruction of
 ! !
 !Registry class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/Registry.st,v 1.40 1997-02-24 20:24:44 cg Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/Registry.st,v 1.41 1997-03-06 21:35:05 cg Exp $'
 ! !

changeset 2449	788bba151e8a
parent 2414	215e58d26a05
child 2507	8824b9953b54