"

 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

	instanceVariableNames:'rawInfo info list sortBlock titleLabel prevRawInfo

		autoUpdateProcess autoUpdateInterval filter infoLabel'

	classVariableNames:'LastSearchString'

	poolDictionaries:''

	category:'Monitors-ST/X'

!

Object subclass:#StatisticEntry

	instanceVariableNames:'classNameOrSymbol overallByteSize minByteSize maxByteSize

		averageSize instanceCount instanceAllocationRate

		memoryAllocationRate'

	classVariableNames:''

	poolDictionaries:''

	privateIn:MemoryUsageView

!

!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:

        MemoryUsageView new open

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

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

    function.

    This is a very old application - definitely needs some pimping to look better...

    ... any maybe a nice menu, graphical display etc.

"

! !

!MemoryUsageView class methodsFor:'startup'!

isVisualStartable

    ^ true

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

! !

!MemoryUsageView methodsFor:'auto update'!

autoUpdate

    self pushEvent:#update

    "Created: / 05-05-2011 / 17:20:52 / cg"

!

autoUpdateInterval

    ^ autoUpdateInterval ? 30 seconds

    "Created: / 05-05-2011 / 17:20:49 / cg"

!

autoUpdateLoop

    [true] whileTrue:[

        self autoUpdate.

        Delay waitFor:self autoUpdateInterval

    ].

    "Created: / 05-05-2011 / 17:20:44 / cg"

!

openAutoUpdateIntervalDialog

    |s|

    s := Dialog request:'Update interval [smh]:' initialAnswer:self autoUpdateInterval printString.

    s isEmptyOrNil ifTrue:[^ self].

    autoUpdateInterval := TimeDuration readFrom:s.

    "Created: / 05-05-2011 / 17:24:48 / cg"

!

startAutoUpdateProcess

    autoUpdateProcess notNil ifTrue:[

        self stopAutoUpdateProcess.

    ].

    autoUpdateProcess :=

        [

            self autoUpdateLoop

        ] fork

    "Created: / 05-05-2011 / 17:19:00 / cg"

!

stopAutoUpdateProcess

    |p|

    (p := autoUpdateProcess) notNil ifTrue:[

        autoUpdateProcess := nil.

        p terminate.

    ].

    "Created: / 05-05-2011 / 17:19:03 / cg"

! !

!MemoryUsageView methodsFor:'initialization'!

initialize

    |helpView headLine|

    super initialize.

    self label:'Memory Usage'.

    headLine := ' Class' paddedTo:47 with:Character space.

    headLine := headLine , '# of Insts     Bytes   Avg sz   Max sz   %Mem  %Accum. +Insts    +Bytes'.

    titleLabel := Label in:self.

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

    titleLabel borderWidth:0.

    titleLabel label:headLine.

    titleLabel adjust:#left.

    infoLabel := Label in:self.

    infoLabel geometryLayout:(LayoutFrame 

                                leftFraction:0 offset:0

                                rightFraction:1.0 offset:0

                                topFraction:1.0 offset:infoLabel preferredHeight negated

                                bottomFraction:1.0 offset:0).

    infoLabel borderWidth:0.

    infoLabel label:''.

    infoLabel adjust:#left.

    infoLabel level:-1.

    helpView := ScrollableView for:SelectionInListView in:self.

    helpView geometryLayout:(LayoutFrame 

                                leftFraction:0 offset:0

                                rightFraction:1.0 offset:0

                                topFraction:0 offset:titleLabel height

                                bottomFraction:1.0 offset:infoLabel height negated).

    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.

    self extent:((list font widthOf:headLine) + (device horizontalPixelPerMillimeter * 15) rounded) @ self height.

    "

     MemoryUsageView open

    "

    "Modified: / 08-05-2011 / 12:45:06 / cg"

!

release

    self stopAutoUpdateProcess.

    super release.

    "Created: / 05-05-2011 / 17:26:24 / cg"

! !

!MemoryUsageView methodsFor:'menu-actions'!

browseClass

    |class|

    list selection notNil ifTrue:[

    ]

!

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:[

        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).

        ]

    ]

!

inspectInstances

            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

        ]

    ]

!

inspectInstancesWithSearch

    filterString := LastSearchString ? '[:inst | "<some condition for inst>" ]'.

    [filterBlock isNil] whileTrue:[

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

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

        filterBlock := Compiler evaluate:filterString.

        filterBlock isBlock ifFalse:[

            self information:'bad syntax in block'.

            filterBlock := nil.

        ].

    ].

    LastSearchString := filterString.

                ifFalse:[^ self]

            ].

        ]

    ]

!

inspectOwners

    |class inspector|

                        ]

                        ].

                                        ]

                                    ]

                                ]

                            ]

                    ].

"/                            dict at:owner put:set

    ]

!

nilInstances

    |class|

                ]

    ]

!

openNamespaceFilterDialog

    |nsName ns|

    nsName := Dialog requestNameSpace:'Filter Instances by Namespace:' initialAnswer:''.

    nsName isEmptyOrNil ifTrue:[^ self].

    ns := Smalltalk classNamed:nsName.

    ns isNil ifTrue:[^ self].

    filter := [:inst :class | class topNameSpace == ns ].

    prevRawInfo := nil.

    self update.

    infoLabel label:'Filtered by Namespace: ',nsName.

    "Created: / 08-05-2011 / 12:18:21 / cg"

!

removeFilter

    filter := nil.

    prevRawInfo := nil.

    self update.

    infoLabel label:'No Filter.'.

    "Created: / 08-05-2011 / 12:16:43 / cg"

!

update

    self updateInfo.

    self updateDisplay

!

usageMenu

    <resource: #programMenu>

    |m|

    m := PopUpMenu

                itemList:#(

                     ('Filter by Namespace...'          openNamespaceFilterDialog               )

                     ('No Filter'                       removeFilter                            )

                     ('-')

                     ('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                           )

                     ('Sort by Inst Allocation Rate'    sortByInstanceAllocationRate            )

                     ('Sort by Byte Allocation Rate'    sortByMemoryAllocationRate              )

                     ('-')

                     ('Inspect Instances'               inspectInstances                        )

                     ('Inspect with Search'             inspectInstancesWithSearch              )

                     ('Inspect Owners'                  inspectOwners                           )

                     ('-')

                     ('Ref Chains'                      displayGlobalRefChainsToInsts           )

                     ('Clear (nil) Instances'           nilInstances                            )

                     ('-')

                     ('Browse Class'                    browseClass                             )

                     ('-')

                     ('Collect Garbage & Update'        collectGarbageAndUpdate                 )

                     ('Start Autoupdate'                startAutoUpdateProcess                  )

                     ('Autoupdate Interval...'          openAutoUpdateIntervalDialog            )

                     ('Update'                          update                                  )

                 )

                resources:resources.