CachingRegistry.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Mon, 19 Sep 2016 08:46:27 +0100
branchjv
changeset 20398 8cb53f870d39
parent 20079 8d884971c2ed
parent 20388 db4b243d97ce
child 20577 a27e7b3031cb
permissions -rw-r--r--
Merge
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
20388
db4b243d97ce #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20043
diff changeset
     1
"{ Encoding: utf8 }"
db4b243d97ce #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20043
diff changeset
     2
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
"
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
 COPYRIGHT (c) 1999 by eXept Software AG
18249
7d686f203624 oops package def was missing
Claus Gittinger <cg@exept.de>
parents: 4434
diff changeset
     5
	      All Rights Reserved
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
 This software is furnished under a license and may be used
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
 only in accordance with the terms of that license and with the
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
 inclusion of the above copyright notice.   This software may not
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
 be provided or otherwise made available to, or used by, any
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
 other person.  No title to or ownership of the software is
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
 hereby transferred.
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
"
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    14
"{ Package: 'stx:libbasic' }"
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    16
"{ NameSpace: Smalltalk }"
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
Registry subclass:#CachingRegistry
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
	instanceVariableNames:'keptReferences cacheSize'
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
	classVariableNames:''
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
	poolDictionaries:''
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
	category:'System-Support'
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
!
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
!CachingRegistry class methodsFor:'documentation'!
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
copyright
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
"
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
 COPYRIGHT (c) 1999 by eXept Software AG
18249
7d686f203624 oops package def was missing
Claus Gittinger <cg@exept.de>
parents: 4434
diff changeset
    30
	      All Rights Reserved
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
 This software is furnished under a license and may be used
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
 only in accordance with the terms of that license and with the
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
 inclusion of the above copyright notice.   This software may not
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
 be provided or otherwise made available to, or used by, any
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
 other person.  No title to or ownership of the software is
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
 hereby transferred.
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
"
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
!
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
documentation
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
"
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
    A CachingRegistry behaves generally like a registry;
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
    However, it keeps hard references to the last n registered objects,
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
    preventing them from being garbage collected (and finalized).
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
    This is useful for resources, which do not cost too much memory,
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    48
    but are expensive to allocate - a special candidate of this kind are
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
    XFonts. With a CachingRegistry, fonts are kept a bit longer alive
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
    and can therefore often be reused - even if temporarily unreferenced.
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
    This is kind of experimental.
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
    [author:]
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    56
        Claus Gittinger (cg@exept)
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
    [see also:]
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
    [instance variables:]
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    61
        keptObjects             Collection      hard referenced objects
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    62
        cacheSize               Integer         number of hard references
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
    [class variables:]
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
"
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
! !
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
20388
db4b243d97ce #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20043
diff changeset
    68
!CachingRegistry methodsFor:'enumerating'!
db4b243d97ce #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20043
diff changeset
    69
db4b243d97ce #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20043
diff changeset
    70
detect:aBlock ifNone:exceptionValue
db4b243d97ce #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20043
diff changeset
    71
    "... additionaly move it to the front of the LRU chain"
db4b243d97ce #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20043
diff changeset
    72
db4b243d97ce #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20043
diff changeset
    73
    keyArray validElementsDo:[:obj |
db4b243d97ce #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20043
diff changeset
    74
        (obj ~~ DeletedEntry and:[aBlock value:obj]) ifTrue:[
db4b243d97ce #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20043
diff changeset
    75
            keptReferences 
db4b243d97ce #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20043
diff changeset
    76
                removeIdentical:obj ifAbsent:[];
db4b243d97ce #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20043
diff changeset
    77
                addLast:obj.
db4b243d97ce #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20043
diff changeset
    78
            ^ obj
db4b243d97ce #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20043
diff changeset
    79
        ].
db4b243d97ce #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20043
diff changeset
    80
    ].
db4b243d97ce #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20043
diff changeset
    81
    ^ exceptionValue value
db4b243d97ce #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20043
diff changeset
    82
! !
db4b243d97ce #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 20043
diff changeset
    83
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
!CachingRegistry methodsFor:'private'!
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
cacheSize:aNumber
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
    keptReferences := OrderedCollection new:aNumber.
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
    cacheSize := aNumber.
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
! !
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
!CachingRegistry methodsFor:'registering objects'!
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
register:anObject as:aHandle
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
    keptReferences removeIdentical:anObject ifAbsent:nil.
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    95
    aHandle notNil ifTrue:[
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    96
        keptReferences addLast:anObject.
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    97
        keptReferences size > cacheSize ifTrue:[
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    98
            keptReferences removeFirst.
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
    99
        ].
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   100
    ].
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
    super register:anObject as:aHandle.
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
!
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
   104
removeKey:anObject ifAbsent:absentBlock
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
   105
    keptReferences removeIdentical:anObject ifAbsent:nil.
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
   106
    super removeKey:anObject ifAbsent:absentBlock.
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
!
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
   109
safeRemoveKey:anObject
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
    keptReferences removeIdentical:anObject ifAbsent:nil.
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
   111
    super safeRemoveKey:anObject.
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
! !
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
!CachingRegistry class methodsFor:'documentation'!
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
version
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
   117
    ^ '$Header$'
17865
598963c6ff8e Recommited from itself
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
   118
!
598963c6ff8e Recommited from itself
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
   119
598963c6ff8e Recommited from itself
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17846
diff changeset
   120
version_SVN
17911
a99f15c5efa5 Updated with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17910
diff changeset
   121
    ^ '$Id: CachingRegistry.st 10761 2012-01-19 11:46:00Z vranyj1 $'
4434
887b60637a1c initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
! !
20043
0be0ccf00b36 #REFACTORING by stefan
Stefan Vogel <sv@exept.de>
parents: 18249
diff changeset
   123
17910
8d796ca8bd1d Merged with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17892
diff changeset
   124
17911
a99f15c5efa5 Updated with /trunk
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 17910
diff changeset
   125