34 " |
34 " |
35 ! |
35 ! |
36 |
36 |
37 documentation |
37 documentation |
38 " |
38 " |
39 Registries provide an easy interface to using WeakArrays. |
39 Registries provide an easy interface to using WeakArrays. |
40 A class, which wants to be informed of instance-death, can put a created object |
40 A class, which wants to be informed of instance-death, can put a created object |
41 into a registry. The registry will create an executor, which is a (shallow-)copy |
41 into a registry. The registry will create an executor, which is a (shallow-)copy |
42 of the object, and watch out for death of the original object. When it dies, |
42 of the object, and watch out for death of the original object. When it dies, |
43 the executor will be sent a #finalize message. |
43 the executor will be sent a #finalize message. |
44 The trick with the shallow copy is especially nice, you can think of it as |
44 The trick with the shallow copy is especially nice, you can think of it as |
45 being the original object which died. |
45 being the original object which died. |
46 |
46 |
47 All objects, which keep external resources (such as fileDescriptors, fonts, |
47 All objects, which keep external resources (such as fileDescriptors, fonts, |
48 colormap-entries etc.) should be registered, so that the underlying resource |
48 colormap-entries etc.) should be registered, so that the underlying resource |
49 can be freed when the object goes away. |
49 can be freed when the object goes away. |
50 |
50 |
51 Of course, you too can use it to do whatever you need to do in case of the |
51 Of course, you too can use it to do whatever you need to do in case of the |
52 death of an object. |
52 death of an object. |
53 |
53 |
54 Registries use #executor to aquire the copy of the original, |
54 Registries use #executor to aquire the copy of the original, |
55 this can be redefined in individual classes for faster copying |
55 this can be redefined in individual classes for faster copying |
56 (typically, not all internal state, but only some device handles are needed for |
56 (typically, not all internal state, but only some device handles are needed for |
57 finalization). If the to-be-registered object is large, this method may also |
57 finalization). If the to-be-registered object is large, this method may also |
58 return a stub (placeHolder) object. (i.e. there is no need for the copy to be |
58 return a stub (placeHolder) object. (i.e. there is no need for the copy to be |
59 of the same class as the original, as long as it implements #finalize and frees |
59 of the same class as the original, as long as it implements #finalize and frees |
60 the relevant OS resources. Some classes return a specialized private-class instance, |
60 the relevant OS resources. Some classes return a specialized private-class instance, |
61 which only holds on the handle and implements #finalize.) |
61 which only holds on the handle and implements #finalize.) |
62 Example uses are found in Form, Color, ExternalStream and Font |
62 Example uses are found in Form, Color, ExternalStream and Font |
63 |
63 |
64 [author:] |
64 [author:] |
65 Claus Gittinger |
65 Claus Gittinger |
66 |
66 |
67 [see also:] |
67 [see also:] |
68 WeakArray WeakIdentityDictionary WeakIdentitySet |
68 WeakArray WeakIdentityDictionary WeakIdentitySet |
69 Font Form Color Cursor ExternalStream |
69 Font Form Color Cursor ExternalStream |
70 |
70 |
71 " |
71 " |
72 ! ! |
72 ! ! |
73 |
73 |
74 !Registry methodsFor:'accessing'! |
74 !Registry methodsFor:'accessing'! |
75 |
75 |
100 index "{ Class: SmallInteger }" |
100 index "{ Class: SmallInteger }" |
101 sz "{ Class: SmallInteger }" |
101 sz "{ Class: SmallInteger }" |
102 o myHandleArray wasBlocked| |
102 o myHandleArray wasBlocked| |
103 |
103 |
104 something == #ElementExpired ifTrue:[ |
104 something == #ElementExpired ifTrue:[ |
105 wasBlocked := OperatingSystem blockInterrupts. |
105 wasBlocked := OperatingSystem blockInterrupts. |
106 [ |
106 [ |
107 myHandleArray := handleArray. |
107 myHandleArray := handleArray. |
108 sz := myHandleArray size. |
108 sz := myHandleArray size. |
109 |
109 |
110 index := 1. |
110 index := 1. |
111 [index <= sz] whileTrue:[ |
111 [index <= sz] whileTrue:[ |
112 o := registeredObjects at:index. |
112 o := registeredObjects at:index. |
113 o == 0 ifTrue:[ |
113 o class == SmallInteger ifTrue:[ |
114 executor := myHandleArray at:index. |
114 executor := myHandleArray at:index. |
115 "remove the executor from the handle array before informing the executor. |
115 "remove the executor from the handle array before informing the executor. |
116 This is critical in case of errors while executing the executor. |
116 This is critical in case of errors while executing the executor. |
117 See ObjectMemory>>finalize" |
117 See ObjectMemory>>finalize" |
118 registeredObjects at:index put:nil. |
118 registeredObjects at:index put:nil. |
119 tally := tally - 1. |
119 tally := tally - 1. |
120 executor notNil ifTrue:[ |
120 executor notNil ifTrue:[ |
121 myHandleArray at:index put:nil. |
121 myHandleArray at:index put:nil. |
122 |
122 |
123 "/ |
123 "/ |
124 "/ allow interrupts for a while ... |
124 "/ allow interrupts for a while ... |
125 "/ |
125 "/ |
126 wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. |
126 wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. |
127 self informDispose:executor. |
127 self informDispose:executor. |
128 OperatingSystem blockInterrupts. |
128 OperatingSystem blockInterrupts. |
129 |
129 |
130 "/ |
130 "/ |
131 "/ any change in an interrupt or dispose handling ? |
131 "/ any change in an interrupt or dispose handling ? |
132 "/ |
132 "/ |
133 handleArray ~~ myHandleArray ifTrue:[ |
133 handleArray ~~ myHandleArray ifTrue:[ |
134 myHandleArray := handleArray. |
134 myHandleArray := handleArray. |
135 sz := myHandleArray size. |
135 sz := myHandleArray size. |
136 "/ start again |
136 "/ start again |
137 index := 0. |
137 index := 0. |
138 ] |
138 ] |
139 ] |
139 ] |
140 ]. |
140 ]. |
141 index := index + 1. |
141 index := index + 1. |
142 ] |
142 ] |
143 ] ensure:[ |
143 ] ensure:[ |
144 wasBlocked ifFalse:[ |
144 wasBlocked ifFalse:[ |
145 OperatingSystem unblockInterrupts |
145 OperatingSystem unblockInterrupts |
146 ] |
146 ] |
147 ]. |
147 ]. |
148 |
148 |
149 (sz > 50 and:[tally < (sz // 2)]) ifTrue:[ |
149 (sz > 50 and:[tally < (sz // 2)]) ifTrue:[ |
150 "/ shrink |
150 "/ shrink |
151 self resize |
151 self resize |
152 ] |
152 ] |
153 ] ifFalse:[ |
153 ] ifFalse:[ |
154 something == #earlyRestart ifTrue:[ |
154 something == #earlyRestart ifTrue:[ |
155 handleArray notNil ifTrue:[ |
155 handleArray notNil ifTrue:[ |
156 handleArray atAllPut:nil. |
156 handleArray atAllPut:nil. |
157 ] |
157 ] |
158 ] |
158 ] |
159 ]. |
159 ]. |
160 |
160 |
161 "Created: 15.6.1996 / 15:24:41 / cg" |
161 "Created: 15.6.1996 / 15:24:41 / cg" |
162 "Modified: 8.1.1997 / 14:05:02 / stefan" |
162 "Modified: 8.1.1997 / 14:05:02 / stefan" |
163 "Modified: 2.6.1997 / 18:15:23 / cg" |
163 "Modified: 2.6.1997 / 18:15:23 / cg" |
214 |
214 |
215 resize |
215 resize |
216 |sz "{ Class: SmallInteger }" |
216 |sz "{ Class: SmallInteger }" |
217 dstIndex "{ Class: SmallInteger }" |
217 dstIndex "{ Class: SmallInteger }" |
218 realNewSize "{ Class: SmallInteger }" |
218 realNewSize "{ Class: SmallInteger }" |
219 newObjects newHandles wasBlocked |
219 newObjects newHandles wasBlocked |
220 executor| |
220 executor| |
221 |
221 |
222 sz := registeredObjects size. |
222 sz := registeredObjects size. |
223 |
223 |
224 (sz > 50 and:[tally < (sz // 2)]) ifTrue:[ |
224 (sz > 50 and:[tally < (sz // 2)]) ifTrue:[ |
225 "/ shrink |
225 "/ shrink |
226 |
226 |
227 wasBlocked := OperatingSystem blockInterrupts. |
227 wasBlocked := OperatingSystem blockInterrupts. |
228 |
228 |
229 sz := registeredObjects size. |
229 sz := registeredObjects size. |
230 realNewSize := tally * 3 // 2. |
230 realNewSize := tally * 3 // 2. |
231 newObjects := WeakArray new:realNewSize. |
231 newObjects := WeakArray new:realNewSize. |
232 newHandles := Array new:realNewSize. |
232 newHandles := Array new:realNewSize. |
233 indexTable := WeakIdentityDictionary new. |
233 indexTable := WeakIdentityDictionary new. |
234 |
234 |
235 dstIndex := 1. |
235 dstIndex := 1. |
236 1 to:sz do:[:index | |
236 1 to:sz do:[:index | |
237 (executor := registeredObjects at:index) notNil ifTrue:[ |
237 (executor := registeredObjects at:index) notNil ifTrue:[ |
238 dstIndex > realNewSize ifTrue:[ |
238 dstIndex > realNewSize ifTrue:[ |
239 'Registry [error]: size given is too small in resize' errorPrintCR. |
239 'Registry [error]: size given is too small in resize' errorPrintCR. |
240 self repairTally. |
240 self repairTally. |
241 wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. |
241 wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. |
242 ^ self |
242 ^ self |
243 ]. |
243 ]. |
244 newObjects at:dstIndex put:executor. |
244 newObjects at:dstIndex put:executor. |
245 newHandles at:dstIndex put:(handleArray at:index). |
245 newHandles at:dstIndex put:(handleArray at:index). |
246 indexTable at:executor put:dstIndex. |
246 indexTable at:executor put:dstIndex. |
247 |
247 |
248 dstIndex := dstIndex + 1 |
248 dstIndex := dstIndex + 1 |
249 ] |
249 ] |
250 ]. |
250 ]. |
251 |
251 |
252 registeredObjects removeDependent:self. |
252 registeredObjects removeDependent:self. |
253 newObjects addDependent:self. |
253 newObjects addDependent:self. |
254 registeredObjects := newObjects. |
254 registeredObjects := newObjects. |
255 handleArray := newHandles. |
255 handleArray := newHandles. |
256 |
256 |
257 wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. |
257 wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. |
258 ] |
258 ] |
259 |
259 |
260 "Created: 16.1.1997 / 18:08:00 / cg" |
260 "Created: 16.1.1997 / 18:08:00 / cg" |
261 "Modified: 6.3.1997 / 22:29:58 / cg" |
261 "Modified: 6.3.1997 / 22:29:58 / cg" |
262 ! |
262 ! |
302 p wasBlocked idx0| |
302 p wasBlocked idx0| |
303 |
303 |
304 wasBlocked := OperatingSystem blockInterrupts. |
304 wasBlocked := OperatingSystem blockInterrupts. |
305 |
305 |
306 registeredObjects size == 0 "isNil" ifTrue:[ |
306 registeredObjects size == 0 "isNil" ifTrue:[ |
307 registeredObjects := WeakArray new:10. |
307 registeredObjects := WeakArray new:10. |
308 registeredObjects addDependent:self. |
308 registeredObjects addDependent:self. |
309 handleArray := Array basicNew:10. |
309 handleArray := Array basicNew:10. |
310 indexTable := WeakIdentityDictionary new. |
310 indexTable := WeakIdentityDictionary new. |
311 |
311 |
312 registeredObjects at:1 put:anObject. |
312 registeredObjects at:1 put:anObject. |
313 handleArray at:1 put:aHandle. |
313 handleArray at:1 put:aHandle. |
314 indexTable at:anObject put:1. |
314 indexTable at:anObject put:1. |
315 |
315 |
316 tally := 1. |
316 tally := 1. |
317 ObjectMemory addDependent:self. |
317 ObjectMemory addDependent:self. |
318 wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. |
318 wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. |
319 ^ self |
319 ^ self |
320 ]. |
320 ]. |
321 |
321 |
322 "/ |
322 "/ |
323 "/ allow interrupts to be handled here |
323 "/ allow interrupts to be handled here |
324 "/ (but continue with interrupts disabled) |
324 "/ (but continue with interrupts disabled) |
325 "/ |
325 "/ |
326 wasBlocked ifFalse:[ |
326 wasBlocked ifFalse:[ |
327 OperatingSystem unblockInterrupts. |
327 OperatingSystem unblockInterrupts. |
328 OperatingSystem blockInterrupts. |
328 OperatingSystem blockInterrupts. |
329 ]. |
329 ]. |
330 |
330 |
331 "/ index := registeredObjects identityIndexOf:anObject ifAbsent:0. |
331 "/ index := registeredObjects identityIndexOf:anObject ifAbsent:0. |
332 index := indexTable at:anObject ifAbsent:0. |
332 index := indexTable at:anObject ifAbsent:0. |
333 index ~~ 0 ifTrue:[ |
333 index ~~ 0 ifTrue:[ |
334 "/ double check ... |
334 "/ double check ... |
335 (registeredObjects at:index) ~~ anObject ifTrue:[ |
335 (registeredObjects at:index) ~~ anObject ifTrue:[ |
336 ('Registry [warning]: index table clobbered') errorPrintCR. |
336 ('Registry [warning]: index table clobbered') errorPrintCR. |
337 ]. |
337 ]. |
338 |
338 |
339 "already registered" |
339 "already registered" |
340 |
340 |
341 handleArray at:index put:aHandle. |
341 handleArray at:index put:aHandle. |
342 "/ ('Registry [info]: object (' , (registeredObjects at:index) printString , ') is already registered') infoPrintCR. |
342 "/ ('Registry [info]: object (' , (registeredObjects at:index) printString , ') is already registered') infoPrintCR. |
343 wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. |
343 wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. |
344 ^ self |
344 ^ self |
345 ]. |
345 ]. |
346 |
346 |
347 "/ |
347 "/ |
348 "/ allow interrupts to be handled here |
348 "/ allow interrupts to be handled here |
349 "/ (but continue with interrupts disabled) |
349 "/ (but continue with interrupts disabled) |
350 "/ |
350 "/ |
351 wasBlocked ifFalse:[ |
351 wasBlocked ifFalse:[ |
352 OperatingSystem unblockInterrupts. |
352 OperatingSystem unblockInterrupts. |
353 OperatingSystem blockInterrupts. |
353 OperatingSystem blockInterrupts. |
354 ]. |
354 ]. |
355 |
355 |
356 "/ |
356 "/ |
357 "/ search for a free slot ... |
357 "/ search for a free slot ... |
358 "/ on the fly look for leftovers (should no longer happen) |
358 "/ on the fly look for leftovers (should no longer happen) |
359 "/ |
359 "/ |
360 idx0 := 1. |
360 idx0 := 1. |
361 index := registeredObjects identityIndexOf:nil startingAt:idx0. |
361 index := registeredObjects identityIndexOf:nil startingAt:idx0. |
362 [index ~~ 0] whileTrue:[ |
362 [index ~~ 0] whileTrue:[ |
363 "is there a leftover ?" |
363 "is there a leftover ?" |
364 p := handleArray at:index. |
364 p := handleArray at:index. |
365 p isNil ifTrue:[ |
365 p isNil ifTrue:[ |
366 registeredObjects at:index put:anObject. |
366 registeredObjects at:index put:anObject. |
367 handleArray at:index put:aHandle. |
367 handleArray at:index put:aHandle. |
368 indexTable at:anObject put:index. |
368 indexTable at:anObject put:index. |
369 |
369 |
370 tally := tally + 1. |
370 tally := tally + 1. |
371 wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. |
371 wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. |
372 ^ self |
372 ^ self |
373 ]. |
373 ]. |
374 |
374 |
375 "/ mhmh - a registeredObject vanished, but its |
375 "/ mhmh - a registeredObject vanished, but its |
376 "/ executor is still there ... |
376 "/ executor is still there ... |
377 |
377 |
378 "/ |
378 "/ |
379 "/ this may happen, if the registries dispose handling is |
379 "/ this may happen, if the registries dispose handling is |
380 "/ currently being executed by a lower priority process, |
380 "/ currently being executed by a lower priority process, |
381 "/ and the registeredObject has already been nilled, |
381 "/ and the registeredObject has already been nilled, |
382 "/ but the executor is being notified (in the other process). |
382 "/ but the executor is being notified (in the other process). |
383 |
383 |
384 "/ 'Registry [info]: leftOver executor: ' infoPrint. p infoPrintCR. |
384 "/ 'Registry [info]: leftOver executor: ' infoPrint. p infoPrintCR. |
385 |
385 |
386 "/ "tell the executor" |
386 "/ "tell the executor" |
387 "/ handleArray at:index put:nil. |
387 "/ handleArray at:index put:nil. |
388 "/ tally := tally - 1. |
388 "/ tally := tally - 1. |
389 "/ self informDispose:p. |
389 "/ self informDispose:p. |
390 "/ p := nil. |
390 "/ p := nil. |
391 |
391 |
392 idx0 := index + 1. |
392 idx0 := index + 1. |
393 index := registeredObjects identityIndexOf:nil startingAt:idx0. |
393 index := registeredObjects identityIndexOf:nil startingAt:idx0. |
394 ]. |
394 ]. |
395 |
395 |
396 "no free slot, add at the end" |
396 "no free slot, add at the end" |
397 |
397 |
398 size := registeredObjects size. |
398 size := registeredObjects size. |
423 |
423 |
424 |index wasBlocked executor| |
424 |index wasBlocked executor| |
425 |
425 |
426 executor := anObject executor. |
426 executor := anObject executor. |
427 executor isNil ifTrue:[ |
427 executor isNil ifTrue:[ |
428 self unregister:anObject. |
428 self unregister:anObject. |
429 ^ self. |
429 ^ self. |
430 ]. |
430 ]. |
431 |
431 |
432 wasBlocked := OperatingSystem blockInterrupts. |
432 wasBlocked := OperatingSystem blockInterrupts. |
433 registeredObjects isNil ifTrue:[ |
433 registeredObjects isNil ifTrue:[ |
434 index := 0 |
434 index := 0 |
435 ] ifFalse:[ |
435 ] ifFalse:[ |
436 "/ index := registeredObjects identityIndexOf:anObject ifAbsent:0. |
436 "/ index := registeredObjects identityIndexOf:anObject ifAbsent:0. |
437 index := indexTable at:anObject ifAbsent:0. |
437 index := indexTable at:anObject ifAbsent:0. |
438 ]. |
438 ]. |
439 index ~~ 0 ifTrue:[ |
439 index ~~ 0 ifTrue:[ |
440 handleArray at:index put:executor. |
440 handleArray at:index put:executor. |
441 ] ifFalse:[ |
441 ] ifFalse:[ |
442 self register:anObject as:executor |
442 self register:anObject as:executor |
443 ]. |
443 ]. |
444 wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. |
444 wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. |
445 |
445 |
446 "Modified: 6.3.1997 / 22:24:15 / cg" |
446 "Modified: 6.3.1997 / 22:24:15 / cg" |
447 ! |
447 ! |