"

 COPYRIGHT (c) 1991 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' }"

"{ NameSpace: Smalltalk }"

View subclass:#MemoryMonitorView

	instanceVariableNames:'updateInterval updateBlock myProcess oldData newData freeData

		updateIndex org maxTotal minTotal dX newColor freeColor oldColor

		prevTotal prevLimit prevFree prevFree2 prevOld scale drawLock

		prevMemUsed prevCodeUsed prevNumWeak prevNumRem prevNumLifoRem

		prevTenureAge prevIGCPhase prevLastScavengeReclamation

		prevMinScavengeReclamation prevScavengeCount mallocColor

		drawAction'

	classVariableNames:''

	poolDictionaries:''

	category:'Monitors-ST/X'

!

!MemoryMonitorView class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1991 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

"

    Shows memory usage (oldspace + newspace). Simple, but useful.

    The numbers shown are:

        tot     total memory usage (i.e. allocated oldSpace + allocated newSpace)

                (does not include the second semispace and other help-areas,

                 such as the remembered set etc.)

        all     current oldSpace in use + newSpace in use

        new     current newSpace in use

        frl     free space in (fragmented) free lists

        fre     compact free area above the used oldSpace

        old     current oldSpace in use

        mal     memory used by malloc (netto)

        mto     total memory that has been reserved by the malloc subsystem

                (may contained mem that has been freed or not yet allocated)

        cod     dynamic compiled code space size (just in time compiler)

        max,    extreme values of 'tot' since the monitor started

        min     (can be reset by typing 'r' in the view)

        t       tenure threshold (1 .. 30)

        I       incremental GC state (2 = idle)

        weak    number of weak objects

        rem     size of rememberedSet

        minsc:  percent of newspace remaining after scavenge (worst case)

                (i.e. the minimum %% of scavenged objects)

        count   number of scavenges since system started

        %       percentage of live objects in newSpace after last scavenge

                (i.e. this is the garbage vs. living objects ratio of

                 newSpace objects after the last scavenge)

    the graphic shows:

        orange  newSpace used

        green   free memory in freeLists

        white   oldSpace used

    the popupMenu offers GC functions; keyboard options are:

        'f' -> faster; 's' -> slower; 'r' -> reset min/max

    Disclaimer:

        this was one of the first tools written for ST/X (around 1989/90);

        today, it would probably be written differently...

    [author:]

        Claus Gittinger

    [start with:]

        MemoryMonitor open

        MemoryMonitorView open

    [see also:]

        ObjectMemory MemoryMonitor

        MemoryUsageMonitor ProcessMonitor

"

! !

!MemoryMonitorView methodsFor:'drawing'!

displayKilo:aNumber name:nm y:y

    |s|

    false ifTrue:[

        s := nm , (UnitConverter fileSizeStringFor:aNumber).

    ] ifFalse:[

        aNumber >= (1024*1024*1024*8) ifTrue:[

            s := nm , ((aNumber // (1024*1024*1024)) printStringLeftPaddedTo:5) , 'G '.

        ] ifFalse:[

            aNumber >= (1024*1024*16) ifTrue:[

                s := nm , ((aNumber // (1024*1024)) printStringLeftPaddedTo:5) , 'M '.

            ] ifFalse:[

                s := nm , ((aNumber // 1024) printStringLeftPaddedTo:5) , 'k '.

            ].

        ].

    ].

    self displayOpaqueString:s x:0 y:y.

    "Modified: / 22-11-2017 / 21:44:41 / cg"

!

initializeDrawAction

    "extracted into a separate block to avoid memory allocation in updateDisplay"

    drawAction :=

        [    

            |total oldSpaceUsed newSpaceUsed freeMem oldSpaceSize

             realOldSpaceSize symSpaceSize realOldSpaceUsed

             gWidth shift scaleChange margin|

            realOldSpaceSize := ObjectMemory oldSpaceSize.

            symSpaceSize := ObjectMemory symSpaceSize.

            realOldSpaceUsed := ObjectMemory oldSpaceUsed.

            oldSpaceUsed := realOldSpaceUsed + ObjectMemory symSpaceUsed.

            newSpaceUsed := ObjectMemory newSpaceUsed.

            freeMem := ObjectMemory freeListSpace + (realOldSpaceSize - realOldSpaceUsed).

            oldSpaceSize := realOldSpaceSize + symSpaceSize.

            total := oldSpaceSize + ObjectMemory newSpaceSize.

            scaleChange := false.

            ((total - freeMem) < minTotal) ifTrue:[

                minTotal := total - freeMem.

                scaleChange := true

            ].

            (total > maxTotal) ifTrue:[

                maxTotal := total.

                scaleChange := true

            ].

            oldData at:updateIndex put:oldSpaceSize. "/ oldSpaceUsed.

            newData at:updateIndex put:newSpaceUsed.

            freeData at:updateIndex put:freeMem.

            updateIndex := updateIndex + 1.

            scaleChange ifTrue:[

                scale := height asFloat / (maxTotal + 100000).

                self redraw

            ].

            gWidth := width - org.

            margin := 1.

            ((updateIndex-1) >= (gWidth - margin)) ifTrue:[

                "on slow displays, use:"

                "/            shift := gWidth // 4.

                "for smooth display, use:"

                shift := 1.

                oldData replaceFrom:1 with:oldData startingAt:shift+1.

                newData replaceFrom:1 with:newData startingAt:shift+1.

                freeData replaceFrom:1 with:freeData startingAt:shift+1.

                updateIndex := updateIndex - shift.

                dX := (dX ? 0) + shift.

                "/ before copying, handle any outstanding exposes ...

                self repairDamage.

                "/ self catchExpose.

                self 

                    copyFrom:self 

                    x:(org + shift) y:0 toX:org y:0

                    width:(gWidth - shift - margin) height:height

                    async:false.

                self 

                    clearRectangleX:(width - margin - shift) y:0 

                    width:shift height:height.

                "/ self waitForExpose.

            ].

            self 

                updateLineX:(updateIndex - 1 + org - 1)

                total:total 

                old:oldSpaceSize "/ oldSpaceUsed

                new:newSpaceUsed 

                free:freeMem.

            self updateNumbers.

            self flush.

        ].

!

redraw

    "redraw all"

    self clear.

    self redrawX:0 y:0 width:width height:height

!

redrawX:x y:y width:w height:h

    "redraw data"

    |total oldSpaceUsed newSpaceUsed freeMem lx startIdx endIdx

     right|

    shown ifFalse:[^ self].

    right := x + w - 1.

    right >= org ifTrue:[

        lx := x.

        lx < org ifTrue:[

            lx := org

        ].

        total := ObjectMemory symSpaceSize 

                 + ObjectMemory oldSpaceSize 

                 + ObjectMemory newSpaceSize.

        startIdx := (lx-org+1).

        startIdx < 1 ifTrue:[

            startIdx := 1

        ].

        endIdx := right-org+1.

        endIdx >= updateIndex ifTrue:[

            endIdx := updateIndex-1.

        ].

        dX := 0.

        startIdx to:endIdx do:[:i |

            newSpaceUsed := newData at:i.

            newSpaceUsed notNil ifTrue:[

                oldSpaceUsed := oldData at:i.

                freeMem := freeData at:i.

                self updateLineX:lx - dX

                       total:total 

                       old:oldSpaceUsed 

                       new:newSpaceUsed 

                       free:freeMem.

            ].

            lx := lx + 1

        ]

    ].

    x < org ifTrue:[

        "/ force redraw.

        prevFree := prevFree2 := prevOld := prevTotal := prevLimit := nil.

        prevMemUsed := prevCodeUsed := prevNumWeak := prevNumRem := nil.

        prevNumLifoRem := prevTenureAge := prevIGCPhase := nil.

        prevLastScavengeReclamation := prevMinScavengeReclamation := nil.

        prevScavengeCount := nil.

        self updateNumbers.

    ]

    "Modified: / 14.7.1998 / 23:33:47 / cg"

!

updateDisplay

    "update picture; trigger next update"

    shown ifTrue:[

        drawLock wouldBlock ifFalse:[

            drawLock critical:drawAction.

        ].

    ].

    updateBlock notNil ifTrue:[

        Processor addTimedBlock:updateBlock afterSeconds:updateInterval

    ].

    "Modified: / 5.8.1998 / 13:13:18 / cg"

!

updateLineX:x total:total old:oldSpaceSize new:newSpaceUsed free:freeMem

    |hNew hOld hFree y1 y2 y3|

    hNew := (newSpaceUsed * scale) asInteger.

    hOld := (oldSpaceSize * scale) // 2.

    hFree := (freeMem * scale) // 2.

    y1 := height - 1.

    y2 := y1 - hOld.

    self paint:oldColor.

    self displayLineFromX:x y:y1 toX:x y:y2.

    y3 := y1 - hFree.

    self paint:freeColor.

    self displayLineFromX:x y:y1 toX:x y:y3.

    y1 := y2 - hNew.

    y1 ~= y2 ifTrue:[

       self paint:newColor.

       self displayLineFromX:x y:y1 toX:x y:y2.

    ]

    "Modified: / 29.1.1999 / 20:45:07 / stefan"

!

updateNumbers

    "redraw numbers.

     The values shown are:

        max:    maximum memory used since monitor started

        min:    minimum memory used since monitor started

        tot:    total memory used (overall oldSpace + overall newSpace)

        all:    current memory in use (oldSpace + newSpace)

        new:    current newSpace in use

        fre:    current size of freelist in oldSpace

        old:    current oldSpace in use

        mal:    net allocated by malloc

        mto:    brutto memory reserved by malloc

        code:   current just-in-time compiled code cache size

        t:      current tenure age

        I:      IGC state

        weak:   number of weak arrays in the system

        rem     remembered set size

        lrem    lifo remembered set size

        minsc:  percent of newspace remaining after scavenge (worst case)

        irq:    max. interrupt delay

        count of scavenges / last scavenge survivor rate

    "

    |oldSpaceSize newSpaceSize memUsed oldMemUsed newMemUsed freeMem free2

     mallocAllocated mallocTotal

     codeUsed numWeak numRem numLifoRem tenureAge igcPhase 

     minScavengeReclamation lastScavengeReclamation scavengeCount

     y half s font fontHeight fontAscent fontDescent 

     limit total n prevMallocAllocated prevMallocTotal|

    oldMemUsed := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed.

    newMemUsed := ObjectMemory newSpaceUsed.

    freeMem := ObjectMemory freeListSpace.

    oldSpaceSize := ObjectMemory oldSpaceSize + ObjectMemory symSpaceSize.

    newSpaceSize := ObjectMemory newSpaceSize.

    mallocAllocated := ObjectMemory mallocAllocated.

    mallocTotal := ObjectMemory mallocTotal.

    limit := ObjectMemory maxOldSpace.

    memUsed := oldMemUsed + newMemUsed "- freeMem".

    total := oldSpaceSize + newSpaceSize.

    free2 := ObjectMemory freeSpace.

    self paint:self whiteColor on:self blackColor.

    font := gc font.

    fontDescent := font descent.

    fontAscent := font ascent.

    fontHeight := font height + fontDescent.

    half := height // 2 + fontDescent.

    y := half - (fontHeight * 8).

    limit ~~ prevLimit ifTrue:[

        self displayKilo:limit    name:'lim ' y:fontAscent.

        prevLimit := limit.

    ].

    total ~~ prevTotal ifTrue:[

        ((total - freeMem) < minTotal) ifTrue:[

            minTotal := total - freeMem.

        ].

        (total > maxTotal) ifTrue:[

            maxTotal := total.

        ].

        self displayKilo:maxTotal name:'max ' y:fontAscent + fontHeight.

        self displayKilo:minTotal name:'min ' y:(height - fontDescent).

        self displayKilo:total    name:'tot ' y:y.

        prevTotal := total.

    ].

    y := y + fontHeight.

    memUsed ~~ prevMemUsed ifTrue:[

        self displayKilo:memUsed name:'all ' y:y.

        prevMemUsed := memUsed.

    ].

    y := y + fontHeight.

    self paint:newColor.

    self displayKilo:newMemUsed name:'new ' y:y.

    y := y + fontHeight.

    freeMem ~~ prevFree ifTrue:[

        self paint:freeColor.

        self displayKilo:freeMem name:'frl ' y:y.

        prevFree := freeMem.

    ].

    y := y + fontHeight.

    free2 ~~ prevFree2 ifTrue:[

        self paint:freeColor.

        self displayKilo:free2 name:'fre ' y:y.

        prevFree2 := free2.

    ].

    y := y + fontHeight.

    (oldMemUsed - freeMem) ~~ prevOld ifTrue:[

        self paint:oldColor.

        self displayKilo:(oldMemUsed - freeMem) name:'old ' y:y.

        prevOld := (oldMemUsed - freeMem).

    ].

    y := y + fontHeight.

    mallocAllocated ~~ prevMallocAllocated ifTrue:[

        self paint:mallocColor.

        self displayKilo:mallocAllocated name:'mal ' y:y.

        prevMallocAllocated := mallocAllocated.

    ].

    y := y + fontHeight.

    mallocTotal ~~ prevMallocTotal ifTrue:[

        self paint:mallocColor.

        self displayKilo:mallocTotal name:'mto ' y:y.

        prevMallocTotal := mallocTotal.

    ].

    y := y + fontHeight.

    ObjectMemory supportsJustInTimeCompilation ifTrue:[

        codeUsed := ObjectMemory compiledCodeSpaceUsed.

        prevCodeUsed ~~ codeUsed ifTrue:[

            self paint:oldColor.

            codeUsed > 9999 ifTrue:[

                s := 'code ' , ((codeUsed // 1024) printStringLeftPaddedTo:4) , 'k'.

            ] ifFalse:[

                s := 'code ' , (codeUsed printStringLeftPaddedTo:4) , 'b'.

            ].

            self displayOpaqueString:s x:0 y:y.

            prevCodeUsed := codeUsed.

        ]

    ].

    "

     the following is internal - normally only interesting when debugging the VM

    "

    y := y + fontHeight.

    tenureAge := ObjectMemory tenureAge.

    igcPhase := ObjectMemory incrementalGCPhase.

    (prevTenureAge ~~ tenureAge

    or:[prevIGCPhase ~~ igcPhase]) ifTrue:[

        self paint:oldColor.

        s := 't:' , (tenureAge printStringLeftPaddedTo:2) , ' '.

        s := s , ' I:' , (igcPhase printStringLeftPaddedTo:2) , ' '.

        self displayOpaqueString:s x:0 y:y.

        prevTenureAge := tenureAge.

        prevIGCPhase := igcPhase.

    ].

    y := y + fontHeight.

    numWeak := ObjectMemory numberOfWeakObjects.

    prevNumWeak ~~ numWeak ifTrue:[

        self paint:oldColor.

        s := 'weak: ' , (numWeak printStringLeftPaddedTo:4).

        self displayOpaqueString:s x:0 y:y.

        prevNumWeak := numWeak.

    ].

    y := y + fontHeight.

    numRem := ObjectMemory rememberedSetSize.

    prevNumRem ~~ numRem ifTrue:[

        self paint:oldColor.

        s := 'rem: ' , (numRem printStringLeftPaddedTo:5).

        self displayOpaqueString:s x:0 y:y.

        prevNumRem := numRem.

    ].

    y := y + fontHeight.

    numLifoRem := ObjectMemory lifoRememberedSetSize.

    prevNumLifoRem ~~ numLifoRem ifTrue:[

        self paint:oldColor.

        s := 'lrem: ' , (numLifoRem printStringLeftPaddedTo:4 ifLarger:['****']).

        self displayOpaqueString:s x:0 y:y.

        prevNumLifoRem := numLifoRem.

    ].

"/ does no longer make sense to show ....

"/    y := y + fontHeight.

"/    ObjectMemory runsSingleOldSpace ifTrue:[

"/        self displayOpaqueString:'single' x:0 y:(half + (fontHeight*4)).