Registry.st
author Claus Gittinger <cg@exept.de>
Tue, 31 Oct 1995 15:36:06 +0100
changeset 463 447ead9f870c
parent 384 cc3d110ea879
child 530 07d0bce293c9
permissions -rw-r--r--
be silent on transcript when parsing for args, vars and primitiveCode
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
375
claus
parents: 359
diff changeset
    14
       instanceVariableNames:'registeredObjects handleArray cleanState'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    15
       classVariableNames:''
a27a279701f8 Initial revision
claus
parents:
diff changeset
    16
       poolDictionaries:''
a27a279701f8 Initial revision
claus
parents:
diff changeset
    17
       category:'System-Support'
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 comment:'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    21
COPYRIGHT (c) 1993 by Claus Gittinger
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
    22
	      All Rights Reserved
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
    23
384
claus
parents: 379
diff changeset
    24
$Header: /cvs/stx/stx/libbasic/Registry.st,v 1.18 1995-08-11 03:03:24 claus Exp $
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    25
'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    26
a27a279701f8 Initial revision
claus
parents:
diff changeset
    27
!Registry class methodsFor:'documentation'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    28
88
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    29
copyright
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    30
"
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    31
 COPYRIGHT (c) 1993 by Claus Gittinger
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
    32
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    33
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    34
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    35
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    36
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    37
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    38
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    39
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    40
"
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    41
!
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    42
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    43
version
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    44
"
384
claus
parents: 379
diff changeset
    45
$Header: /cvs/stx/stx/libbasic/Registry.st,v 1.18 1995-08-11 03:03:24 claus Exp $
88
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    46
"
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    47
!
81dacba7a63a *** empty log message ***
claus
parents: 69
diff changeset
    48
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    49
documentation
a27a279701f8 Initial revision
claus
parents:
diff changeset
    50
"
69
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    51
    Registries provide an easy interface to using WeakArrays. 
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    52
    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
    53
    into a registry. The registry will create a (shallow-)copy of the object, and
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    54
    watch out for death of the original object. When it dies, the copy will
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    55
    be sent the #disposed-message.
69
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    56
    The trick with the shallow copy is especially nice, you can think of it as
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    57
    being the original object which died.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    58
69
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    59
    All objects, which keep external resources (such as fileDescriptors, fonts, 
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    60
    colormap-entries etc.) should be registered, so that the underlying resource
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    61
    can be freed when the object goes away.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    62
69
4564b6328136 *** empty log message ***
claus
parents: 60
diff changeset
    63
    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
    64
    death of an object.
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    65
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    66
    Registries use #shallowCopyForFinalization to aquire the copy of the original,
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    67
    this can be redefined in registered classes for faster copying 
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    68
    (typically, not all internal state but only some device handles are needed for 
317
2b8a0a5354cb *** empty log message ***
claus
parents: 302
diff changeset
    69
    finalization). I if the to-be-registered object is large, this method may also
2b8a0a5354cb *** empty log message ***
claus
parents: 302
diff changeset
    70
    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
    71
    of the same class as the original, as long as it implements disposed and frees
2b8a0a5354cb *** empty log message ***
claus
parents: 302
diff changeset
    72
    the relevant OS resources ...)
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    73
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    74
    See axample uses in Form, Color, ExternalStream and Font
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    75
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    76
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
    77
a27a279701f8 Initial revision
claus
parents:
diff changeset
    78
!Registry methodsFor:'dispose handling'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    79
375
claus
parents: 359
diff changeset
    80
informDispose:someHandle
claus
parents: 359
diff changeset
    81
    someHandle disposed
claus
parents: 359
diff changeset
    82
!
claus
parents: 359
diff changeset
    83
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    84
informDispose
a27a279701f8 Initial revision
claus
parents:
diff changeset
    85
    "an instance has been destroyed - look which one it was"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    86
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    87
    |phantom
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
    88
     sz "{ Class: SmallInteger }"|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    89
10
claus
parents: 3
diff changeset
    90
    cleanState ifTrue:[
375
claus
parents: 359
diff changeset
    91
	sz := handleArray size.
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
    92
	1 to:sz do:[:index |
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
    93
	    (registeredObjects at:index) isNil ifTrue:[
375
claus
parents: 359
diff changeset
    94
		phantom := handleArray at:index.
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
    95
		phantom notNil ifTrue:[
375
claus
parents: 359
diff changeset
    96
		    handleArray at:index put:nil.
claus
parents: 359
diff changeset
    97
		    self informDispose:phantom
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
    98
		]
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
    99
	    ]
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   100
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   101
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   102
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   103
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   104
!Registry methodsFor:'enumerating'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   105
301
35e40a6fc72b *** empty log message ***
claus
parents: 217
diff changeset
   106
do:aBlock
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   107
    "evaluate aBlock for each registered object"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   108
a27a279701f8 Initial revision
claus
parents:
diff changeset
   109
    registeredObjects notNil ifTrue:[
302
1f76060d58a4 *** empty log message ***
claus
parents: 301
diff changeset
   110
	registeredObjects nonNilElementsDo:aBlock
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   111
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   112
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   113
a27a279701f8 Initial revision
claus
parents:
diff changeset
   114
!Registry methodsFor:'accessing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   115
a27a279701f8 Initial revision
claus
parents:
diff changeset
   116
contents
a27a279701f8 Initial revision
claus
parents:
diff changeset
   117
    "return the collection of registered objects"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   118
a27a279701f8 Initial revision
claus
parents:
diff changeset
   119
    ^ registeredObjects
a27a279701f8 Initial revision
claus
parents:
diff changeset
   120
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   121
375
claus
parents: 359
diff changeset
   122
registerChange:anObject
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   123
    "a registered object has changed, create a new phantom"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   124
a27a279701f8 Initial revision
claus
parents:
diff changeset
   125
    |index|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   126
a27a279701f8 Initial revision
claus
parents:
diff changeset
   127
    index := registeredObjects identityIndexOf:anObject ifAbsent:[0].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   128
    index ~~ 0 ifTrue:[
375
claus
parents: 359
diff changeset
   129
	handleArray at:index put:anObject shallowCopyForFinalization.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   130
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   131
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   132
a27a279701f8 Initial revision
claus
parents:
diff changeset
   133
register:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   134
    "register anObject, so that a copy of it gets the disposed message
2
claus
parents: 1
diff changeset
   135
     when anObject dies (some time in the future)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   136
375
claus
parents: 359
diff changeset
   137
    ^ self register:anObject as:(anObject shallowCopyForFinalization)
claus
parents: 359
diff changeset
   138
!
claus
parents: 359
diff changeset
   139
claus
parents: 359
diff changeset
   140
register:anObject as:aHandle
claus
parents: 359
diff changeset
   141
    "register anObject, so that I later receive informDispose: with aHandle
claus
parents: 359
diff changeset
   142
     (some time in the future)"
claus
parents: 359
diff changeset
   143
claus
parents: 359
diff changeset
   144
    |newColl newPhantoms
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   145
     size  "{ Class: SmallInteger }"
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   146
     index "{ Class: SmallInteger }"
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   147
     p|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   148
a27a279701f8 Initial revision
claus
parents:
diff changeset
   149
    registeredObjects isNil ifTrue:[
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   150
	registeredObjects := WeakArray new:10.
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   151
	registeredObjects watcher:self.
375
claus
parents: 359
diff changeset
   152
	handleArray := Array basicNew:10.
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   153
	registeredObjects at:1 put:anObject.
375
claus
parents: 359
diff changeset
   154
	handleArray at:1 put:aHandle.
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   155
	cleanState := true.
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   156
	ObjectMemory addDependent:self.
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   157
	^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   158
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   159
a27a279701f8 Initial revision
claus
parents:
diff changeset
   160
    index := registeredObjects identityIndexOf:anObject ifAbsent:[0].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   161
    index ~~ 0 ifTrue:[
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   162
	"already registered"
375
claus
parents: 359
diff changeset
   163
	handleArray at:index put:aHandle.
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   164
	self error:'object is already registered'.
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   165
	^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   166
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   167
a27a279701f8 Initial revision
claus
parents:
diff changeset
   168
    "search for a free slot, on the fly look for leftovers"
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   169
    index := registeredObjects identityIndexOf:nil startingAt:1.
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   170
    index ~~ 0 ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   171
	"is there a leftover ?"
375
claus
parents: 359
diff changeset
   172
	p := handleArray at:index.
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   173
	p notNil ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   174
	    "tell the phantom"
375
claus
parents: 359
diff changeset
   175
	    handleArray at:index put:nil.
claus
parents: 359
diff changeset
   176
	    self informDispose:p.
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   177
	    p := nil.
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   178
	].
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   179
	registeredObjects at:index put:anObject.
375
claus
parents: 359
diff changeset
   180
	handleArray at:index put:aHandle.
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   181
	^ self
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   182
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   183
a27a279701f8 Initial revision
claus
parents:
diff changeset
   184
    "no free slot, add at the end"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   185
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   186
    size := registeredObjects size.
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   187
    index := size + 1.
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   188
    newColl := WeakArray new:(size * 2).
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   189
    newColl replaceFrom:1 to:size with:registeredObjects.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   190
    registeredObjects := newColl.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   191
    registeredObjects watcher:self.
159
514c749165c3 *** empty log message ***
claus
parents: 117
diff changeset
   192
    registeredObjects at:index put:anObject.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   193
359
claus
parents: 317
diff changeset
   194
    newPhantoms := Array basicNew:(size * 2).
375
claus
parents: 359
diff changeset
   195
    newPhantoms replaceFrom:1 to:size with:handleArray.
claus
parents: 359
diff changeset
   196
    handleArray := newPhantoms.
claus
parents: 359
diff changeset
   197
    handleArray at:index put:aHandle.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   198
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   199
a27a279701f8 Initial revision
claus
parents:
diff changeset
   200
unregister:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   201
    "remove registration of anObject, without telling the phantom;
a27a279701f8 Initial revision
claus
parents:
diff changeset
   202
     should be sent, if we are no more interrested in destruction of
a27a279701f8 Initial revision
claus
parents:
diff changeset
   203
     anObject (i.e. it no longer holds external resources)."
a27a279701f8 Initial revision
claus
parents:
diff changeset
   204
a27a279701f8 Initial revision
claus
parents:
diff changeset
   205
    |index|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   206
a27a279701f8 Initial revision
claus
parents:
diff changeset
   207
    index := registeredObjects identityIndexOf:anObject ifAbsent:[0].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   208
    index ~~ 0 ifTrue:[
375
claus
parents: 359
diff changeset
   209
	handleArray at:index put:nil.
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   210
	registeredObjects at:index put:nil
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   211
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
   212
! !
2
claus
parents: 1
diff changeset
   213
claus
parents: 1
diff changeset
   214
!Registry methodsFor:'restart handling'!
claus
parents: 1
diff changeset
   215
claus
parents: 1
diff changeset
   216
update:aParameter
10
claus
parents: 3
diff changeset
   217
    aParameter == #earlyRestart ifTrue:[
375
claus
parents: 359
diff changeset
   218
	handleArray notNil ifTrue:[
claus
parents: 359
diff changeset
   219
	    handleArray atAllPut:nil
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   220
	]
10
claus
parents: 3
diff changeset
   221
    ].
claus
parents: 3
diff changeset
   222
    aParameter == #returnFromSnapshot ifTrue:[
217
a0400fdbc933 *** empty log message ***
claus
parents: 159
diff changeset
   223
	cleanState := true
2
claus
parents: 1
diff changeset
   224
    ]
claus
parents: 1
diff changeset
   225
! !