MemUsageV.st
author Claus Gittinger <cg@exept.de>
Tue, 05 Aug 1997 16:30:22 +0200
changeset 1273 3a8a91e6c5fa
parent 1053 9b1b15ef1e34
child 1348 f958dbefe269
permissions -rw-r--r--
give my listView a fixed font.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
     1
"
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
     2
 COPYRIGHT (c) 1992 by Claus Gittinger
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
     3
	      All Rights Reserved
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
     4
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
     5
 This software is furnished under a license and may be used
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
     6
 only in accordance with the terms of that license and with the
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
     8
 be provided or otherwise made available to, or used by, any
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
     9
 other person.  No title to or ownership of the software is
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    10
 hereby transferred.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    11
"
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    12
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    13
StandardSystemView subclass:#MemoryUsageView
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    14
	instanceVariableNames:'rawInfo info list sortBlock'
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    15
	classVariableNames:''
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    16
	poolDictionaries:''
1053
9b1b15ef1e34 category change
Claus Gittinger <cg@exept.de>
parents: 1052
diff changeset
    17
	category:'Monitors-ST/X'
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    18
!
4cde336c0794 Initial revision
claus
parents:
diff changeset
    19
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
    20
!MemoryUsageView class methodsFor:'documentation'!
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    21
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    22
copyright
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    23
"
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    24
 COPYRIGHT (c) 1992 by Claus Gittinger
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    25
	      All Rights Reserved
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    26
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    27
 This software is furnished under a license and may be used
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    28
 only in accordance with the terms of that license and with the
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    29
 inclusion of the above copyright notice.   This software may not
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    30
 be provided or otherwise made available to, or used by, any
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    31
 other person.  No title to or ownership of the software is
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    32
 hereby transferred.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    33
"
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    34
!
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    35
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    36
documentation
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    37
"
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    38
    this view shows an overview over the memory usage of the system.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    39
    usage:
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    40
	MemoryUsageView new open
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    41
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    42
    Since scanning all memory takes some time, this is not done
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    43
    automatically, but upon request. See the middlebuttonmenu-'update'
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    44
    function.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    45
"
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    46
! !
4cde336c0794 Initial revision
claus
parents:
diff changeset
    47
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    48
!MemoryUsageView methodsFor:'initialization'!
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    49
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    50
initialize
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    51
    |l helpView headLine|
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    52
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    53
    super initialize.
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    54
    self label:'Memory usage'.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    55
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    56
    headLine := ' class                           # of insts  avg sz   max sz    bytes   %mem '.
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    57
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    58
    l := Label in:self.
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    59
    l origin:(0.0 @ 0.0) corner:(1.0 @ l height).
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    60
    l borderWidth:0.
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    61
    l label:headLine.
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    62
    l adjust:#left.
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    63
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    64
    self extent:((font widthOf:headLine) + (device horizontalPixelPerMillimeter * 15) rounded) @ self height.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    65
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    66
    helpView := ScrollableView for:SelectionInListView in:self.
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    67
    helpView origin:(0.0 @ l height) corner:1.0 @ 1.0.
92
claus
parents: 69
diff changeset
    68
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    69
    list := helpView scrolledView.
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    70
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    71
    l origin:(list originRelativeTo:self) x @ 0.0.
92
claus
parents: 69
diff changeset
    72
1273
3a8a91e6c5fa give my listView a fixed font.
Claus Gittinger <cg@exept.de>
parents: 1053
diff changeset
    73
    list font:(EditTextView defaultFont).
3a8a91e6c5fa give my listView a fixed font.
Claus Gittinger <cg@exept.de>
parents: 1053
diff changeset
    74
    l font:(EditTextView defaultFont).
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    75
    list menuHolder:self; menuPerformer:self; menuMessage:#usageMenu.
92
claus
parents: 69
diff changeset
    76
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    77
    "
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    78
     MemoryUsageView open
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    79
    "
1273
3a8a91e6c5fa give my listView a fixed font.
Claus Gittinger <cg@exept.de>
parents: 1053
diff changeset
    80
3a8a91e6c5fa give my listView a fixed font.
Claus Gittinger <cg@exept.de>
parents: 1053
diff changeset
    81
    "Modified: 4.8.1997 / 01:45:20 / cg"
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    82
! !
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    83
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
    84
!MemoryUsageView methodsFor:'menu actions'!
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    85
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    86
inspectInstances
57
36e13831b62d *** empty log message ***
claus
parents: 52
diff changeset
    87
    |class|
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    88
57
36e13831b62d *** empty log message ***
claus
parents: 52
diff changeset
    89
    list selection notNil ifTrue:[
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
    90
        class := (info at:(list selection)) at:1.
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
    91
        self withCursor:(Cursor questionMark) do:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
    92
            |insts|
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    93
849
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
    94
            "
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
    95
             special kludge
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
    96
            "
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
    97
            class isSymbol ifTrue:[
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
    98
                class == #Namespace ifFalse:[
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
    99
                    ^ SystemBrowser open
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
   100
                ].
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
   101
                class := (Smalltalk at:class) class.
850
b7fab4026db0 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 849
diff changeset
   102
                insts := class allSubInstances.
849
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
   103
                insts remove:class soleInstance ifAbsent:nil
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
   104
            ] ifFalse:[
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
   105
                insts := class allInstances.
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
   106
            ].
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   107
            insts size > 500 ifTrue:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   108
                (self confirm:'there are ' , insts size printString , ' instances.\\Do you really want to see them all ?' withCRs)
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   109
                ifFalse:[^ self]
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   110
            ].
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   111
            insts inspect
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   112
        ]
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   113
    ]
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   114
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   115
    "Modified: 15.10.1996 / 22:09:29 / cg"
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   116
!
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   117
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   118
inspectOwners
69
0d6acfdae045 *** empty log message ***
claus
parents: 57
diff changeset
   119
    |class inspector|
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   120
57
36e13831b62d *** empty log message ***
claus
parents: 52
diff changeset
   121
    list selection notNil ifTrue:[
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   122
        class := (info at:(list selection)) at:1.
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   123
        "
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   124
         special kludge
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   125
        "
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   126
        class isSymbol ifTrue:[^self].
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   127
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   128
        self withCursor:(Cursor questionMark) do:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   129
            |owners dict|
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   130
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   131
            owners := (ObjectMemory whoReferencesInstancesOf:class).
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   132
            owners isNil ifTrue:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   133
                self information:'no owners found - next GC should remove it'.
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   134
                ^ self
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   135
            ].
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   136
            owners := owners asOrderedCollection.
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   137
            owners size > 500 ifTrue:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   138
                (self confirm:'there are ' , owners size printString , ' owners.\\Do you really want to see them all ?' withCRs)
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   139
                ifFalse:[^ self]
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   140
            ].
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   141
            dict := IdentityDictionary new.
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   142
            owners do:[:owner |
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   143
                |set names oClass s|
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   144
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   145
                "
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   146
                 skip weakArrays ... (they dont count)
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   147
                "
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   148
                (owner isMemberOf:WeakArray) ifFalse:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   149
                    set := Set new.
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   150
                    owner == Smalltalk ifTrue:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   151
                        owner keysAndValuesDo:[:key :val |
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   152
                            (val isMemberOf:class) ifTrue:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   153
                                set add:key
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   154
                            ]
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   155
                        ]
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   156
                    ] ifFalse:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   157
                        names := owner class allInstVarNames.
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   158
                        oClass := owner class.
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   159
                        1 to:oClass instSize do:[:i |
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   160
                            ((owner instVarAt:i) isMemberOf:class) ifTrue:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   161
                                set add:(names at:i).
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   162
                            ].
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   163
                        ].
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   164
                        oClass isVariable ifTrue:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   165
                            oClass isPointers ifTrue:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   166
                                1 to:owner basicSize do:[:i |
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   167
                                    ((owner basicAt:i) isMemberOf:class) ifTrue:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   168
                                        set add:i
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   169
                                    ]
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   170
                                ]
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   171
                            ]
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   172
                        ].
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   173
                    ].
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   174
                    "
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   175
                     put a describing string into the dictionary
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   176
                    "
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   177
                    s := 'references in: '.
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   178
                    set do:[:name | 
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   179
                                name isString ifTrue:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   180
                                    s := s , name , ' '
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   181
                                ] ifFalse:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   182
                                    s := s , '[' , name printString , '] '
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   183
                                ]
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   184
                           ].
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   185
                    dict at:owner put:s.
57
36e13831b62d *** empty log message ***
claus
parents: 52
diff changeset
   186
"/                            dict at:owner put:set
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   187
                ]
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   188
            ].
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   189
            inspector := DictionaryInspectorView openOn:dict.
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   190
            inspector listView doubleClickAction:[:lineNr | inspector doInspectKey].
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   191
        ]
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   192
    ]
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   193
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   194
    "Modified: 15.10.1996 / 22:09:38 / cg"
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   195
!
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   196
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   197
sortByAverageSize
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   198
    self label:'Memory usage; by average size'.
924
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   199
"/    sortBlock := [:a :b | ((a at:3)/(a at:2)) > ((b at:3)/(b at:2))].
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   200
    sortBlock := [:a :b | |n1 n2 m1 m2|
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   201
                           n1 := ((a at:3)/(a at:2)).
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   202
                           n2 := ((b at:3)/(b at:2)).
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   203
                           n1 > n2 
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   204
                           or:[n1 == n2
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   205
                               and:[(a at:1) displayString < (b at:1) displayString]]].
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   206
    self updateDisplay
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   207
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   208
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   209
!
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   210
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   211
sortByClass
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   212
    self label:'Memory usage; by class'.
924
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   213
    sortBlock := [:a :b | (a at:1) displayString < (b at:1) displayString].
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   214
    self updateDisplay
643
837eeb5cf043 sort by displayString
Claus Gittinger <cg@exept.de>
parents: 437
diff changeset
   215
837eeb5cf043 sort by displayString
Claus Gittinger <cg@exept.de>
parents: 437
diff changeset
   216
    "Modified: 28.6.1996 / 14:32:38 / cg"
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   217
!
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   218
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   219
sortByInstCount
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   220
    self label:'Memory usage; by instance count'.
924
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   221
"/    sortBlock := [:a :b | (a at:2) > (b at:2) ].
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   222
    sortBlock := [:a :b | |n1 n2|
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   223
                           n1 := (a at:2).
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   224
                           n2 := (b at:2).
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   225
                           n1 > n2 
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   226
                           or:[n1 == n2
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   227
                               and:[(a at:1) displayString < (b at:1) displayString]]].
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   228
    self updateDisplay
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   229
!
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   230
924
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   231
sortByMaxSize
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   232
    self label:'Memory usage; by maximum size'.
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   233
"/    sortBlock := [:a :b | (a at:4) > (b at:4)].
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   234
    sortBlock := [:a :b | |n1 n2 m1 m2|
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   235
                           n1 := (a at:4).
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   236
                           n2 := (b at:4).
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   237
                           n1 > n2 
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   238
                           or:[n1 == n2
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   239
                               and:[(a at:1) displayString < (b at:1) displayString]]].
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   240
    self updateDisplay
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   241
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   242
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   243
!
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   244
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   245
sortByMemoryUsage
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   246
    self label:'Memory usage; by memory usage'.
924
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   247
"/    sortBlock := [:a :b | (a at:3) > (b at:3)].
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   248
    sortBlock := [:a :b | |n1 n2|
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   249
                           n1 := (a at:3).
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   250
                           n2 := (b at:3).
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   251
                           n1 > n2 
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   252
                           or:[n1 == n2
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   253
                               and:[(a at:1) displayString < (b at:1) displayString]]].
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   254
    self updateDisplay
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   255
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   256
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   257
!
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   258
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   259
update
4cde336c0794 Initial revision
claus
parents:
diff changeset
   260
    self updateInfo.
4cde336c0794 Initial revision
claus
parents:
diff changeset
   261
    self updateDisplay
92
claus
parents: 69
diff changeset
   262
!
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   263
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   264
usageMenu
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   265
    ^ PopUpMenu
924
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   266
         labels:(resources array:#(
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   267
                     'sort by class'
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   268
                     'sort by inst count'
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   269
                     'sort by memory usage'
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   270
                     'sort by average size'
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   271
                     'sort by maximum size'
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   272
                     '-'
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   273
                     'inspect instances'
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   274
                     'owners'
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   275
                     '-'
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   276
                     'update'
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   277
                 ))
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   278
924
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   279
         selectors:#(sortByClass
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   280
                     sortByInstCount
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   281
                     sortByMemoryUsage
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   282
                     sortByAverageSize
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   283
                     sortByMaxSize
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   284
                     nil
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   285
                     inspectInstances
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   286
                     inspectOwners
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   287
                     nil
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   288
                     update
8bd0c37affdf better sorting
Claus Gittinger <cg@exept.de>
parents: 850
diff changeset
   289
                    ).
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   290
92
claus
parents: 69
diff changeset
   291
claus
parents: 69
diff changeset
   292
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   293
! !
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   294
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   295
!MemoryUsageView methodsFor:'private'!
4cde336c0794 Initial revision
claus
parents:
diff changeset
   296
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   297
updateDisplay
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   298
    "update the displayed list"
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   299
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   300
    windowGroup withCursor:Cursor wait do:[
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   301
        |classNames counts sumSizes maxSizes percents avgSizes 
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   302
         l line allMemory 
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   303
         overAllCount overAllAvgSize overAllMaxSize|
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   304
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   305
        info := rawInfo asSortedCollection:sortBlock.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   306
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   307
        classNames := info collect:[:infoArray | 
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   308
            |cls|
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   309
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   310
            cls := infoArray at:1.
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   311
            cls == #Class ifTrue:[
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   312
                '<all classes>'
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   313
            ] ifFalse:[
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   314
                cls == #Metaclass ifTrue:[
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   315
                    '<all metaclasses>'
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   316
                ] ifFalse:[
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   317
                    cls == #PrivateMetaclass ifTrue:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   318
                        '<all private meta classes>'
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   319
                    ] ifFalse:[
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   320
                        cls == #PrivateClass ifTrue:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   321
                            '<all private classes>'
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   322
                        ] ifFalse:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   323
                            cls == #ObsoleteClass ifTrue:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   324
                                '<all obsolete classes>'
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   325
                            ] ifFalse:[
849
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
   326
                                cls == #Namespace ifTrue:[
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
   327
                                    '<all namespaces>'
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
   328
                                ] ifFalse:[
1017
e4d02fa22dca show name - not displayString
Claus Gittinger <cg@exept.de>
parents: 924
diff changeset
   329
                                    cls "displayString" name
849
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
   330
                                ]
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   331
                            ]
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   332
                        ]
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   333
                    ]
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   334
                ] 
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   335
            ] 
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   336
        ].
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   337
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   338
        counts := info collect:[:infoArray | (infoArray at:2) ].
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   339
        sumSizes := info collect:[:infoArray | (infoArray at:3) ].
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   340
        maxSizes := info collect:[:infoArray | (infoArray at:4) ].
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   341
        allMemory := sumSizes inject:0 into:[:sum :this | sum + this].
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   342
        "/ allMemory := ObjectMemory bytesUsed.
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   343
        percents := sumSizes collect:[:sz | (sz asFloat / allMemory * 1000) rounded / 10.0].
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   344
        avgSizes := (1 to:sumSizes size) collect:[:i | (((sumSizes at:i) / (counts at:i)) * 10) rounded / 10.0].
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   345
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   346
        l := OrderedCollection new.
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   347
        1 to:classNames size do:[:i |
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   348
            |line avgSz maxSz|
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   349
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   350
            avgSz := avgSizes at:i.
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   351
            maxSz := maxSizes at:i.
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   352
            avgSz = maxSz ifTrue:[
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   353
                avgSz := avgSz asInteger printString , '  '.
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   354
            ].
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   355
            line := (classNames at:i) printStringPaddedTo:33 with:Character space.
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   356
            line := line , ((counts at:i) printStringLeftPaddedTo:7).
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   357
            line := line , (avgSz printStringLeftPaddedTo:10).
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   358
            line := line , (maxSz printStringLeftPaddedTo:8).
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   359
            line := line , ((sumSizes at:i) printStringLeftPaddedTo:10).
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   360
            line := line , ((percents at:i) printStringLeftPaddedTo:7).
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   361
            l add:line
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   362
        ].
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   363
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   364
        "add summary line"
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   365
        overAllCount := counts inject:0 into:[:sum :this | sum + this].
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   366
        overAllAvgSize := ((allMemory / overAllCount) * 10) rounded / 10.0.
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   367
        overAllMaxSize := maxSizes max.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   368
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   369
        l add:''.
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   370
        line := 'all objects' printStringPaddedTo:33 with:Character space.
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   371
        line := line , (overAllCount printStringLeftPaddedTo:7).
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   372
        line := line , (overAllAvgSize printStringLeftPaddedTo:10).
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   373
        line := line , (overAllMaxSize printStringLeftPaddedTo:8).
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   374
        line := line , (allMemory printStringLeftPaddedTo:10).
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   375
        line := line , (100.0 printStringLeftPaddedTo:7).
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   376
        l add:line.
92
claus
parents: 69
diff changeset
   377
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   378
        list list:l.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   379
    ]
142
claus
parents: 128
diff changeset
   380
claus
parents: 128
diff changeset
   381
    "Created: 19.9.1995 / 15:30:47 / claus"
1017
e4d02fa22dca show name - not displayString
Claus Gittinger <cg@exept.de>
parents: 924
diff changeset
   382
    "Modified: 29.1.1997 / 23:55:17 / cg"
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   383
!
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   384
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   385
updateInfo
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   386
    "scan all memory and collect the information"
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   387
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   388
    windowGroup withCursor:Cursor questionMark do:[
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   389
        |myProcess myPriority|
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   390
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   391
        "find all objects, collect stuff in info"
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   392
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   393
        "
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   394
         this is a time consuming operation; therefore lower my priority ...
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   395
        "
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   396
        myProcess := Processor activeProcess.
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   397
        myPriority := myProcess priority.
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   398
        myProcess priority:(Processor userBackgroundPriority).
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   399
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   400
        rawInfo := IdentityDictionary new:600.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   401
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   402
        [   |behaviorFlag|
142
claus
parents: 128
diff changeset
   403
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   404
            behaviorFlag := Behavior flagBehavior.
142
claus
parents: 128
diff changeset
   405
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   406
            ObjectMemory allObjectsDo:[:o |
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   407
                |infoArray class bytes|
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   408
142
claus
parents: 128
diff changeset
   409
"/              o isBehavior ifTrue:[
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   410
                class := o class.
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   411
                (class flags bitAnd:behaviorFlag) ~~ 0 ifTrue:[
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   412
                    o isObsolete ifTrue:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   413
                        class := #ObsoleteClass
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   414
                    ] ifFalse:[
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   415
                        o isMeta ifTrue:[
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   416
                            o isPrivate ifTrue:[
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   417
                                class := #PrivateMetaclass
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   418
                            ] ifFalse:[
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   419
                                class := #Metaclass
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   420
                            ]
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   421
                        ] ifFalse:[
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   422
                            o isPrivate ifTrue:[
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   423
                                class := #PrivateClass
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   424
                            ] ifFalse:[
849
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
   425
                                (o isNamespace
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
   426
                                and:[o ~~ Namespace
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
   427
                                and:[o ~~ Smalltalk]])
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
   428
                                ifTrue:[
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
   429
                                    class := #Namespace
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
   430
                                ] ifFalse:[
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
   431
                                    class := #Class
50de8d192d38 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 770
diff changeset
   432
                                ]
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   433
                            ]    
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   434
                        ]
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   435
                    ]
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   436
                ].
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   437
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   438
                bytes := ObjectMemory sizeOf:o.
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   439
                infoArray := rawInfo at:class ifAbsent:[].
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   440
                infoArray isNil ifTrue:[
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   441
                    infoArray := Array 
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   442
                            with:class 
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   443
                            with:1 
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   444
                            with:bytes
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   445
                            with:bytes.
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   446
                    rawInfo at:class put:infoArray.
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   447
                ] ifFalse:[
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   448
                    infoArray at:2 put:((infoArray at:2) + 1).
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   449
                    infoArray at:3 put:((infoArray at:3) + bytes).
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   450
                    infoArray at:4 put:((infoArray at:4) max: bytes).
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   451
                ]
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   452
            ].
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   453
        ] valueNowOrOnUnwindDo:[
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   454
            myProcess priority:myPriority.
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   455
        ].
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   456
    ]
142
claus
parents: 128
diff changeset
   457
claus
parents: 128
diff changeset
   458
    "Modified: 19.9.1995 / 15:29:10 / claus"
770
3da310ebef8d checkin from browser
Claus Gittinger <cg@exept.de>
parents: 769
diff changeset
   459
    "Modified: 15.10.1996 / 22:13:19 / cg"
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   460
! !
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   461
92
claus
parents: 69
diff changeset
   462
!MemoryUsageView methodsFor:'realization'!
claus
parents: 69
diff changeset
   463
claus
parents: 69
diff changeset
   464
realize
claus
parents: 69
diff changeset
   465
    super realize.
claus
parents: 69
diff changeset
   466
    self updateInfo.
claus
parents: 69
diff changeset
   467
    self sortByClass.
claus
parents: 69
diff changeset
   468
! !
claus
parents: 69
diff changeset
   469
769
56ecc821f8be checkin from browser
Claus Gittinger <cg@exept.de>
parents: 643
diff changeset
   470
!MemoryUsageView class methodsFor:'documentation'!
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   471
437
9526cb043cbc list obsolete & removed classes separately
Claus Gittinger <cg@exept.de>
parents: 165
diff changeset
   472
version
1273
3a8a91e6c5fa give my listView a fixed font.
Claus Gittinger <cg@exept.de>
parents: 1053
diff changeset
   473
    ^ '$Header: /cvs/stx/stx/libtool/Attic/MemUsageV.st,v 1.25 1997-08-05 14:30:22 cg Exp $'
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   474
! !