Registry.st
author Claus Gittinger <cg@exept.de>
Fri, 14 Jun 1996 16:07:25 +0200
changeset 1467 564c8b54aa98
parent 1466 dc55982da0b8
child 1471 a85f3257ae88
permissions -rw-r--r--
checkin from browser
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     1
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
     2
 COPYRIGHT (c) 1993 by Claus Gittinger
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
     3
	      All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     4
a27a279701f8 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    12
a27a279701f8 Initial revision
claus
parents:
diff changeset
    13
Object subclass:#Registry
1286
4270a0b4917d documentation
Claus Gittinger <cg@exept.de>
parents: 1145
diff changeset
    14
	instanceVariableNames:'registeredObjects handleArray cleanState'
4270a0b4917d documentation
Claus Gittinger <cg@exept.de>
parents: 1145
diff changeset
    15
	classVariableNames:''
4270a0b4917d documentation
Claus Gittinger <cg@exept.de>
parents: 1145
diff changeset
    16
	poolDictionaries:''
4270a0b4917d documentation
Claus Gittinger <cg@exept.de>
parents: 1145
diff changeset
    17
	category:'System-Support'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    18
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    19
a27a279701f8 Initial revision
claus
parents:
diff changeset
    20
!Registry class methodsFor:'documentation'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    21
88
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    22
copyright
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    23
"
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    24
 COPYRIGHT (c) 1993 by Claus Gittinger
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
    25
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    26
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    27
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    28
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    29
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    30
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    31
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    32
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    33
"
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    34
!
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    35
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    36
documentation
a27a279701f8 Initial revision
claus
parents:
diff changeset
    37
"
69
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    38
    Registries provide an easy interface to using WeakArrays. 
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    39
    A class, which wants to be informed of instance-death, can put a created object
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    40
    into a registry. The registry will create a (shallow-)copy of the object, and
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    41
    watch out for death of the original object. When it dies, the copy will
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    42
    be sent the #disposed-message.
69
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    43
    The trick with the shallow copy is especially nice, you can think of it as
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    44
    being the original object which died.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    45
69
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    46
    All objects, which keep external resources (such as fileDescriptors, fonts, 
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    47
    colormap-entries etc.) should be registered, so that the underlying resource
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    48
    can be freed when the object goes away.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    49
69
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    50
    Of course, you too can use it to do whatever you need to do in case of the
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    51
    death of an object.
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    52
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    53
    Registries use #shallowCopyForFinalization to aquire the copy of the original,
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    54
    this can be redefined in registered classes for faster copying 
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    55
    (typically, not all internal state but only some device handles are needed for 
317
2b8a0a5354cb *** empty log message ***
claus
parents: 302
diff changeset
    56
    finalization). I if the to-be-registered object is large, this method may also
2b8a0a5354cb *** empty log message ***
claus
parents: 302
diff changeset
    57
    return a stub (placeHolder) object. (i.e. there is no need for the copy to be
2b8a0a5354cb *** empty log message ***
claus
parents: 302
diff changeset
    58
    of the same class as the original, as long as it implements disposed and frees
2b8a0a5354cb *** empty log message ***
claus
parents: 302
diff changeset
    59
    the relevant OS resources ...)
1286
4270a0b4917d documentation
Claus Gittinger <cg@exept.de>
parents: 1145
diff changeset
    60
    Example uses are found in Form, Color, ExternalStream and Font
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    61
1286
4270a0b4917d documentation
Claus Gittinger <cg@exept.de>
parents: 1145
diff changeset
    62
    [author:]
4270a0b4917d documentation
Claus Gittinger <cg@exept.de>
parents: 1145
diff changeset
    63
        Claus Gittinger
4270a0b4917d documentation
Claus Gittinger <cg@exept.de>
parents: 1145
diff changeset
    64
4270a0b4917d documentation
Claus Gittinger <cg@exept.de>
parents: 1145
diff changeset
    65
    [see also:]
4270a0b4917d documentation
Claus Gittinger <cg@exept.de>
parents: 1145
diff changeset
    66
        WeakArray WeakIdentityDictionary WeakIdentitySet
4270a0b4917d documentation
Claus Gittinger <cg@exept.de>
parents: 1145
diff changeset
    67
        Font Form Color Cursor ExternalStream
4270a0b4917d documentation
Claus Gittinger <cg@exept.de>
parents: 1145
diff changeset
    68
        
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    69
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    70
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
    71
a27a279701f8 Initial revision
claus
parents:
diff changeset
    72
!Registry methodsFor:'accessing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    73
a27a279701f8 Initial revision
claus
parents:
diff changeset
    74
contents
a27a279701f8 Initial revision
claus
parents:
diff changeset
    75
    "return the collection of registered objects"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    76
a27a279701f8 Initial revision
claus
parents:
diff changeset
    77
    ^ registeredObjects
a27a279701f8 Initial revision
claus
parents:
diff changeset
    78
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    79
a27a279701f8 Initial revision
claus
parents:
diff changeset
    80
register:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
    81
    "register anObject, so that a copy of it gets the disposed message
2
claus
parents: 1
diff changeset
    82
     when anObject dies (some time in the future)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    83
375
claus
parents: 359
diff changeset
    84
    ^ self register:anObject as:(anObject shallowCopyForFinalization)
claus
parents: 359
diff changeset
    85
!
claus
parents: 359
diff changeset
    86
claus
parents: 359
diff changeset
    87
register:anObject as:aHandle
claus
parents: 359
diff changeset
    88
    "register anObject, so that I later receive informDispose: with aHandle
claus
parents: 359
diff changeset
    89
     (some time in the future)"
claus
parents: 359
diff changeset
    90
claus
parents: 359
diff changeset
    91
    |newColl newPhantoms
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    92
     size  "{ Class: SmallInteger }"
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    93
     index "{ Class: SmallInteger }"
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    94
     p|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    95
a27a279701f8 Initial revision
claus
parents:
diff changeset
    96
    registeredObjects isNil ifTrue:[
1466
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
    97
        registeredObjects := WeakArray new:10.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
    98
        registeredObjects watcher:self.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
    99
        handleArray := Array basicNew:10.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   100
        registeredObjects at:1 put:anObject.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   101
        handleArray at:1 put:aHandle.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   102
        ObjectMemory addDependent:self.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   103
        ^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   104
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   105
1145
a094d90e11bf dont use [0] blocks - use 0 constant instead
Claus Gittinger <cg@exept.de>
parents: 759
diff changeset
   106
    index := registeredObjects identityIndexOf:anObject ifAbsent:0.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   107
    index ~~ 0 ifTrue:[
1466
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   108
        "already registered"
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   109
        handleArray at:index put:aHandle.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   110
        self error:'object is already registered'.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   111
        ^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   112
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   113
a27a279701f8 Initial revision
claus
parents:
diff changeset
   114
    "search for a free slot, on the fly look for leftovers"
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   115
    index := registeredObjects identityIndexOf:nil startingAt:1.
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   116
    index ~~ 0 ifTrue:[
1466
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   117
        "is there a leftover ?"
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   118
        p := handleArray at:index.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   119
        p notNil ifTrue:[
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   120
            "tell the phantom"
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   121
            handleArray at:index put:nil.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   122
            self informDispose:p.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   123
            p := nil.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   124
        ].
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   125
        registeredObjects at:index put:anObject.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   126
        handleArray at:index put:aHandle.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   127
        ^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   128
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   129
a27a279701f8 Initial revision
claus
parents:
diff changeset
   130
    "no free slot, add at the end"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   131
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   132
    size := registeredObjects size.
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   133
    index := size + 1.
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   134
    newColl := WeakArray new:(size * 2).
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   135
    newColl replaceFrom:1 to:size with:registeredObjects.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   136
    registeredObjects := newColl.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   137
    registeredObjects watcher:self.
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   138
    registeredObjects at:index put:anObject.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   139
359
claus
parents: 317
diff changeset
   140
    newPhantoms := Array basicNew:(size * 2).
375
claus
parents: 359
diff changeset
   141
    newPhantoms replaceFrom:1 to:size with:handleArray.
claus
parents: 359
diff changeset
   142
    handleArray := newPhantoms.
claus
parents: 359
diff changeset
   143
    handleArray at:index put:aHandle.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   144
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   145
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   146
registerChange:anObject
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   147
    "a registered object has changed, create a new phantom"
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   148
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   149
    |index|
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   150
1467
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   151
    registeredObjects isNil ifTrue:[
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   152
        index := 0
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   153
    ] ifFalse:[
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   154
        index := registeredObjects identityIndexOf:anObject ifAbsent:0.
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   155
    ].
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   156
    index ~~ 0 ifTrue:[
1467
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   157
        handleArray at:index put:anObject shallowCopyForFinalization.
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   158
    ] ifFalse:[
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   159
        self register:anObject
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   160
    ]
1467
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   161
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   162
    "Modified: 14.6.1996 / 15:06:07 / cg"
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   163
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   164
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   165
unregister:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   166
    "remove registration of anObject, without telling the phantom;
759
908363ce8a32 interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents: 630
diff changeset
   167
     should be sent, if we are no more interested in destruction of
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   168
     anObject (i.e. it no longer holds external resources)."
a27a279701f8 Initial revision
claus
parents:
diff changeset
   169
a27a279701f8 Initial revision
claus
parents:
diff changeset
   170
    |index|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   171
1338
72dc10fbe8fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
   172
    registeredObjects notNil ifTrue:[
72dc10fbe8fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
   173
        index := registeredObjects identityIndexOf:anObject ifAbsent:0.
72dc10fbe8fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
   174
        index ~~ 0 ifTrue:[
72dc10fbe8fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
   175
            handleArray at:index put:nil.
72dc10fbe8fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
   176
            registeredObjects at:index put:nil
72dc10fbe8fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
   177
        ]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   178
    ]
1338
72dc10fbe8fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
   179
72dc10fbe8fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
   180
    "Modified: 7.5.1996 / 10:45:32 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   181
! !
2
claus
parents: 1
diff changeset
   182
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   183
!Registry methodsFor:'dispose handling'!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   184
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   185
informDispose
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   186
    "an instance has been destroyed - look which one it was"
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   187
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   188
    |phantom
1466
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   189
     dstIdx "{ Class: SmallInteger }"
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   190
     sz     "{ Class: SmallInteger }"
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   191
     tally  "{ Class: SmallInteger }"
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   192
     newObjects newHandles|
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   193
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   194
    sz := handleArray size.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   195
    tally := 0.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   196
    1 to:sz do:[:index |
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   197
        (registeredObjects at:index) isNil ifTrue:[
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   198
            phantom := handleArray at:index.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   199
            phantom notNil ifTrue:[
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   200
                handleArray at:index put:nil.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   201
                self informDispose:phantom
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   202
            ]
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   203
        ] ifFalse:[
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   204
            tally := tally + 1
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   205
        ]
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   206
    ].
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   207
1466
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   208
    sz > 50 ifTrue:[
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   209
        tally < (sz // 2) ifTrue:[
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   210
            "/ shrink
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   211
            newObjects := WeakArray new:(tally * 3 // 2).
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   212
            newHandles := Array new:(newObjects size).
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   213
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   214
            dstIdx := 1.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   215
            1 to:sz do:[:index |
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   216
                (phantom := registeredObjects at:index) notNil ifTrue:[
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   217
                    newObjects at:dstIdx put:phantom.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   218
                    newHandles at:dstIdx put:(handleArray at:index).
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   219
                    dstIdx := dstIdx + 1
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   220
                ]
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   221
            ].
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   222
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   223
            newObjects watcher:self.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   224
            registeredObjects := newObjects.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   225
            handleArray := newHandles.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   226
        ]
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   227
    ].
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   228
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   229
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   230
informDispose:someHandle
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   231
    someHandle disposed
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   232
! !
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   233
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   234
!Registry methodsFor:'enumerating'!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   235
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   236
do:aBlock
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   237
    "evaluate aBlock for each registered object"
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   238
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   239
    registeredObjects notNil ifTrue:[
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   240
	registeredObjects nonNilElementsDo:aBlock
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   241
    ]
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   242
! !
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   243
2
claus
parents: 1
diff changeset
   244
!Registry methodsFor:'restart handling'!
claus
parents: 1
diff changeset
   245
claus
parents: 1
diff changeset
   246
update:aParameter
10
claus
parents: 3
diff changeset
   247
    aParameter == #earlyRestart ifTrue:[
1466
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   248
        handleArray notNil ifTrue:[
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   249
            handleArray atAllPut:nil
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   250
        ]
10
claus
parents: 3
diff changeset
   251
    ].
1466
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   252
"/    aParameter == #returnFromSnapshot ifTrue:[
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   253
"/        cleanState := true
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   254
"/    ]
2
claus
parents: 1
diff changeset
   255
! !
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   256
630
b785d23d7c5b version at the end
Claus Gittinger <cg@exept.de>
parents: 617
diff changeset
   257
!Registry class methodsFor:'documentation'!
b785d23d7c5b version at the end
Claus Gittinger <cg@exept.de>
parents: 617
diff changeset
   258
b785d23d7c5b version at the end
Claus Gittinger <cg@exept.de>
parents: 617
diff changeset
   259
version
1467
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   260
    ^ '$Header: /cvs/stx/stx/libbasic/Registry.st,v 1.27 1996-06-14 14:07:25 cg Exp $'
630
b785d23d7c5b version at the end
Claus Gittinger <cg@exept.de>
parents: 617
diff changeset
   261
! !