"

 COPYRIGHT (c) 1992 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libtool' }"

StandardSystemView subclass:#MemoryUsageView

	classVariableNames:''

	poolDictionaries:''

	category:'Monitors-ST/X'

!

!MemoryUsageView class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1992 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    this view shows an overview over the memory usage of the system.

    usage:

    Since scanning all memory takes some time, this is not done

    automatically, but upon request. See the middlebuttonmenu-'update'

    function.

"

! !

!MemoryUsageView class methodsFor:'startup'!

isVisualStartable

    ^ true

    "Created: / 10.8.1998 / 16:02:59 / cg"

! !

!MemoryUsageView methodsFor:'initialization'!

initialize

    |helpView headLine|

    super initialize.

    self label:'Memory Usage'.

    titleLabel := Label in:self.

    titleLabel origin:(0.0 @ 0.0) corner:(1.0 @ titleLabel height).

    titleLabel borderWidth:0.

    titleLabel label:headLine.

    titleLabel adjust:#left.

    helpView := ScrollableView for:SelectionInListView in:self.

    helpView origin:(0.0 @ titleLabel height) corner:1.0 @ 1.0.

    list := helpView scrolledView.

    titleLabel origin:(list originRelativeTo:self) x @ 0.0.

    list font:(EditTextView defaultFont).

    titleLabel font:(EditTextView defaultFont).

    list menuHolder:self; menuPerformer:self; menuMessage:#usageMenu.

    "

     MemoryUsageView open

    "

! !

browseClass

    |class|

    list selection notNil ifTrue:[

        class := (info at:(list selection)) at:1.

        UserPreferences current systemBrowserClass openInClass:class.

    ]

!

collectGarbageAndUpdate

    self withWaitCursorDo:[

	ObjectMemory tenure.

	ObjectMemory compressingGarbageCollect.

    ].

    self update.

    "Created: 14.10.1997 / 21:36:38 / cg"

    "Modified: 14.10.1997 / 21:41:11 / cg"

!

displayGlobalRefChainsToInsts

    |class|

    list selection notNil ifTrue:[

        class := (info at:(list selection)) at:1.

        self withCursor:(Cursor questionMark) do:[

            |insts limit answer|

            "

             special kludge

            "

            class isSymbol ifTrue:[

                class == #NameSpace ifFalse:[

                    self information:'classes are directly refered to by Smalltalk'.

                    ^ self.

                ].

                class := (Smalltalk at:class) class.

                insts := class allSubInstances.

                insts remove:class soleInstance ifAbsent:nil

            ] ifFalse:[

                insts := class allInstances.

            ].

            insts size > 10 ifTrue:[

                answer := Dialog 

                    request:('There are ' , insts size printString , ' instances.\Do you really want to follow them all ?\\(Give number to follow or cancel)' withCRs)

                    initialAnswer:insts size printString.

                limit := Integer readFrom:answer onError:nil.

                limit isNil ifTrue:[^ self].

                insts := (insts asArray copyTo:limit)

            ].

            insts := insts asArray.

            ObjectMemory displayRefChainToAny:insts limitNumberOfSearchedReferences:(limit ? 1000).

        ]

    ]

    "Modified: / 15.10.1996 / 22:09:29 / cg"

    "Created: / 3.2.1998 / 00:03:22 / cg"

!

inspectInstances

    |class|

    list selection notNil ifTrue:[

        class := (info at:(list selection)) at:1.

        self withCursor:(Cursor questionMark) do:[

            |insts|

            "

             special kludge

            "

            class isSymbol ifTrue:[

                class == #NameSpace ifFalse:[

                    ^ UserPreferences current systemBrowserClass open

                ].

                class := (Smalltalk at:class) class.

                insts := class allSubInstances.

                insts remove:class soleInstance ifAbsent:nil

            ] ifFalse:[

                insts := class allInstances.

            ].

            insts size > 500 ifTrue:[

                (self confirm:'there are ' , insts size printString , ' instances.\\Do you really want to see them all ?' withCRs)

                ifFalse:[^ self]

            ].

            insts inspect

        ]

    ]

    "Modified: 15.10.1996 / 22:09:29 / cg"

!

inspectInstancesWithSearch

    |filter filterBlock class|

    filter := '[:inst | "<some condition for inst>" ]'.

    [filterBlock isNil] whileTrue:[

        filter := Dialog request:'filter block:' initialAnswer:filter.

        filter size == 0 ifTrue:[^ self].

        filterBlock := Compiler evaluate:filter.

        filterBlock isBlock ifFalse:[

            self information:'bad syntax in block'.

            filterBlock := nil.

        ].

    ].

    list selection notNil ifTrue:[

        class := (info at:(list selection)) at:1.

        self withCursor:(Cursor questionMark) do:[

            |insts|

            "

             special kludge

            "

            class isSymbol ifTrue:[

                class == #NameSpace ifFalse:[

                    ^ UserPreferences current systemBrowserClass open

                ].

                class := (Smalltalk at:class) class.

                insts := class allSubInstances.

                insts remove:class soleInstance ifAbsent:nil

            ] ifFalse:[

                insts := class allInstances.

            ].

            insts := insts select:filterBlock.

            insts size > 500 ifTrue:[

                (self confirm:'there are ' , insts size printString , ' instances.\\Do you really want to see them all ?' withCRs)

                ifFalse:[^ self]

            ].

            insts inspect

        ]

    ]

    "Modified: 15.10.1996 / 22:09:29 / cg"

!

inspectOwners

    |class inspector|

    list selection notNil ifTrue:[

        class := (info at:(list selection)) at:1.

        "

         special kludge

        "

        class isSymbol ifTrue:[^self].

        self withCursor:(Cursor questionMark) do:[

            |owners dict|

            owners := (ObjectMemory whoReferencesInstancesOf:class).

            owners isEmptyOrNil ifTrue:[

                self information:'No owners found - next GC should remove it'.

                ^ self

            ].

            owners := owners asOrderedCollection.

            owners size > 500 ifTrue:[

                (self confirm:'there are ' , owners size printString , ' owners.\\Do you really want to see them all ?' withCRs)

                ifFalse:[^ self]

            ].

            dict := IdentityDictionary new.

            owners do:[:owner |

                |set names oClass s nMore|

                "

                 skip weakArrays ... (they dont count)

                "

                (owner isMemberOf:WeakArray) ifFalse:[

                    nMore := nil.    

                    set := Set new.

                    owner == Smalltalk ifTrue:[

                        owner keysAndValuesDo:[:key :val |

                            (val isMemberOf:class) ifTrue:[

                                set add:key

                            ]

                        ]

                    ] ifFalse:[

                        names := owner class allInstVarNames.

                        oClass := owner class.

                        1 to:oClass instSize do:[:i |

                            ((owner instVarAt:i) isMemberOf:class) ifTrue:[

                                set add:(names at:i).

                            ].

                        ].

                        oClass isVariable ifTrue:[

                            oClass isPointers ifTrue:[

                                1 to:owner basicSize do:[:i |

                                    ((owner basicAt:i) isMemberOf:class) ifTrue:[

                                        nMore isNil ifTrue:[    

                                            set add:i.

                                            set size > 500 ifTrue:[

                                                nMore := 0.

                                            ]

                                        ] ifFalse:[

                                            nMore := nMore + 1.

                                        ]

                                    ]

                                ]

                            ]

                        ].

                    ].

                    "

                     put a describing string into the dictionary

                    "

                    s := WriteStream on:String new.    

                    s nextPutAll:'references in: '.

                    set do:[:name | 

                         name isString ifTrue:[

                             s nextPutAll:name; nextPutAll:' '

                         ] ifFalse:[

                             s nextPutAll:'[';  nextPutAll:name printString;  nextPutAll:'] '

                         ]

                    ].

                    nMore notNil ifTrue:[

                        s nextPutAll:'... (', nMore printString,' more)'

                    ].

                    dict at:owner put:(s contents).

"/                            dict at:owner put:set

                ]

            ].

            inspector := DictionaryInspectorView openOn:dict.

            inspector listView doubleClickAction:[:lineNr | inspector doInspectKey].

        ]

    ]

    "Modified: 15.10.1996 / 22:09:38 / cg"

!

nilInstances

    |class|

    list selection notNil ifTrue:[

        class := (info at:(list selection)) at:1.

        self withCursor:(Cursor questionMark) do:[

            |insts|

            insts := class allInstances.

            insts notEmpty ifTrue:[    

                (self confirm:'there are ' , insts size printString , ' instances.\\Do you really want to nil them all ?' withCRs)

                ifTrue:[

                    insts do:[:each |

                        each becomeNil

                    ]

                ]

            ].

        ]

    ]

    "Modified: 15.10.1996 / 22:09:29 / cg"

!

update

    self updateInfo.

    self updateDisplay

!

usageMenu

    <resource: #programMenu>

    |m|

    m := PopUpMenu

                itemList:#(

                     ('Sort by Class Name'              sortByClass                             )

                     ('Sort by Classes Basename'        sortByClassNameWithoutPrefix            )

                     ('Sort by Inst Count'              sortByInstCount                         )

                     ('Sort by Memory Usage'            sortByMemoryUsage                       )

                     ('Sort by Average Size'            sortByAverageSize                       )

                     ('Sort by Maximum Size'            sortByMaxSize                           )

                     ('-')

                     ('Inspect Instances'               inspectInstances                        )

                     ('Inspect with Search'             inspectInstancesWithSearch              )

                     ('Inspect Owners'                  inspectOwners                           )

                     ('Ref Chains'                      displayGlobalRefChainsToInsts           )

                     ('Clear (nil) Instances'           nilInstances                            )

                     ('-')

                     ('-')

                     ('Update'                          update                                  )

                     ('Collect Garbage & Update'        collectGarbageAndUpdate                 )

                 )

                resources:resources.

        m disableAll:#(inspectInstances inspectInstancesWithSearch

                       inspectOwners 

    ].

    ^ m