Registry.st
changeset 2449 788bba151e8a
parent 2414 215e58d26a05
child 2507 8824b9953b54
--- a/Registry.st	Thu Mar 06 15:47:35 1997 +0100
+++ b/Registry.st	Thu Mar 06 22:35:05 1997 +0100
@@ -156,6 +156,34 @@
 
 !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 }"
@@ -168,24 +196,26 @@
     (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.
-
-        wasBlocked := OperatingSystem blockInterrupts.
+        indexTable := WeakIdentityDictionary new.
 
         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
             ]
@@ -200,7 +230,7 @@
     ]
 
     "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'!
@@ -222,11 +252,12 @@
      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.
@@ -246,7 +277,13 @@
     "/ 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].
@@ -264,7 +301,7 @@
         "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.
@@ -274,7 +311,7 @@
         ].
         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].
@@ -303,29 +340,30 @@
     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
@@ -388,5 +426,5 @@
 !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 $'
 ! !