Registry.st
author Claus Gittinger <cg@exept.de>
Tue, 18 Jun 1996 17:14:55 +0200
changeset 1479 396c633aee65
parent 1471 a85f3257ae88
child 1484 3f4a4e5c5eb7
permissions -rw-r--r--
allow registering some object twice (handle as registerChange:)
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.
1479
396c633aee65 allow registering some object twice (handle as registerChange:)
Claus Gittinger <cg@exept.de>
parents: 1471
diff changeset
   110
        ('REGISTRY: object (' , (registeredObjects at:index) printString , ' is already registered') infoPrintCR.
1466
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.
1479
396c633aee65 allow registering some object twice (handle as registerChange:)
Claus Gittinger <cg@exept.de>
parents: 1471
diff changeset
   144
396c633aee65 allow registering some object twice (handle as registerChange:)
Claus Gittinger <cg@exept.de>
parents: 1471
diff changeset
   145
    "Modified: 18.6.1996 / 13:22:13 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   146
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   147
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   148
registerChange:anObject
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   149
    "a registered object has changed, create a new phantom"
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   150
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   151
    |index|
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   152
1467
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   153
    registeredObjects isNil ifTrue:[
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   154
        index := 0
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   155
    ] ifFalse:[
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   156
        index := registeredObjects identityIndexOf:anObject ifAbsent:0.
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   157
    ].
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   158
    index ~~ 0 ifTrue:[
1467
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   159
        handleArray at:index put:anObject shallowCopyForFinalization.
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   160
    ] ifFalse:[
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   161
        self register:anObject
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   162
    ]
1467
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   163
564c8b54aa98 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1466
diff changeset
   164
    "Modified: 14.6.1996 / 15:06:07 / cg"
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   165
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   166
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   167
unregister:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   168
    "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
   169
     should be sent, if we are no more interested in destruction of
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   170
     anObject (i.e. it no longer holds external resources)."
a27a279701f8 Initial revision
claus
parents:
diff changeset
   171
a27a279701f8 Initial revision
claus
parents:
diff changeset
   172
    |index|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   173
1338
72dc10fbe8fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
   174
    registeredObjects notNil ifTrue:[
72dc10fbe8fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
   175
        index := registeredObjects identityIndexOf:anObject ifAbsent:0.
72dc10fbe8fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
   176
        index ~~ 0 ifTrue:[
72dc10fbe8fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
   177
            handleArray at:index put:nil.
72dc10fbe8fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
   178
            registeredObjects at:index put:nil
72dc10fbe8fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
   179
        ]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   180
    ]
1338
72dc10fbe8fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
   181
72dc10fbe8fd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1286
diff changeset
   182
    "Modified: 7.5.1996 / 10:45:32 / cg"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   183
! !
2
claus
parents: 1
diff changeset
   184
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   185
!Registry methodsFor:'dispose handling'!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   186
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   187
informDispose
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   188
    "an instance has been destroyed - look which one it was"
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   189
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   190
    |phantom
1466
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   191
     dstIdx "{ Class: SmallInteger }"
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   192
     sz     "{ Class: SmallInteger }"
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   193
     tally  "{ Class: SmallInteger }"
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   194
     newObjects newHandles|
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   195
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   196
    sz := handleArray size.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   197
    tally := 0.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   198
    1 to:sz do:[:index |
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   199
        (registeredObjects at:index) isNil ifTrue:[
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   200
            phantom := handleArray at:index.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   201
            phantom notNil ifTrue:[
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   202
                handleArray at:index put:nil.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   203
                self informDispose:phantom
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   204
            ]
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   205
        ] ifFalse:[
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   206
            tally := tally + 1
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   207
        ]
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   208
    ].
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   209
1466
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   210
    sz > 50 ifTrue:[
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   211
        tally < (sz // 2) ifTrue:[
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   212
            "/ shrink
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   213
            newObjects := WeakArray new:(tally * 3 // 2).
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   214
            newHandles := Array new:(newObjects size).
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   215
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   216
            dstIdx := 1.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   217
            1 to:sz do:[:index |
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   218
                (phantom := registeredObjects at:index) notNil ifTrue:[
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   219
                    newObjects at:dstIdx put:phantom.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   220
                    newHandles at:dstIdx put:(handleArray at:index).
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   221
                    dstIdx := dstIdx + 1
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
            ].
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   224
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   225
            newObjects watcher:self.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   226
            registeredObjects := newObjects.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   227
            handleArray := newHandles.
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   228
        ]
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   229
    ].
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   230
!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   231
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   232
informDispose:someHandle
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   233
    someHandle disposed
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   234
! !
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
!Registry methodsFor:'enumerating'!
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   237
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   238
do:aBlock
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   239
    "evaluate aBlock for each registered object"
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   240
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   241
    registeredObjects notNil ifTrue:[
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   242
	registeredObjects nonNilElementsDo:aBlock
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   243
    ]
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   244
! !
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   245
2
claus
parents: 1
diff changeset
   246
!Registry methodsFor:'restart handling'!
claus
parents: 1
diff changeset
   247
1471
a85f3257ae88 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1467
diff changeset
   248
update:something with:aParameter from:changedObject
a85f3257ae88 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1467
diff changeset
   249
    something == #earlyRestart ifTrue:[
1466
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   250
        handleArray notNil ifTrue:[
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   251
            handleArray atAllPut:nil
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   252
        ]
10
claus
parents: 3
diff changeset
   253
    ].
1471
a85f3257ae88 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1467
diff changeset
   254
"/    something == #returnFromSnapshot ifTrue:[
1466
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   255
"/        cleanState := true
dc55982da0b8 shrink weakArray when too sparsely filled
Claus Gittinger <cg@exept.de>
parents: 1338
diff changeset
   256
"/    ]
1471
a85f3257ae88 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1467
diff changeset
   257
a85f3257ae88 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1467
diff changeset
   258
    "Created: 15.6.1996 / 15:24:41 / cg"
2
claus
parents: 1
diff changeset
   259
! !
617
427245e28240 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   260
630
b785d23d7c5b version at the end
Claus Gittinger <cg@exept.de>
parents: 617
diff changeset
   261
!Registry class methodsFor:'documentation'!
b785d23d7c5b version at the end
Claus Gittinger <cg@exept.de>
parents: 617
diff changeset
   262
b785d23d7c5b version at the end
Claus Gittinger <cg@exept.de>
parents: 617
diff changeset
   263
version
1479
396c633aee65 allow registering some object twice (handle as registerChange:)
Claus Gittinger <cg@exept.de>
parents: 1471
diff changeset
   264
    ^ '$Header: /cvs/stx/stx/libbasic/Registry.st,v 1.29 1996-06-18 15:14:55 cg Exp $'
630
b785d23d7c5b version at the end
Claus Gittinger <cg@exept.de>
parents: 617
diff changeset
   265
! !