MemoryMonitorView.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Wed, 19 Jul 2017 09:42:32 +0200
branchjv
changeset 17619 edb119820fcb
parent 17136 cb908d2ba02e
permissions -rw-r--r--
Issue #154: Set window style using `#beToolWindow` to indicate that the minirunner window is kind of support tool rather than some X11 specific code (which does not work on Windows of course) See https://swing.fit.cvut.cz/projects/stx-jv/ticket/154
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
 COPYRIGHT (c) 1991 by Claus Gittinger
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
	      All Rights Reserved
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
 This software is furnished under a license and may be used
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
 hereby transferred.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
"
3173
Claus Gittinger <cg@exept.de>
parents: 2370
diff changeset
    12
"{ Package: 'stx:libtool' }"
Claus Gittinger <cg@exept.de>
parents: 2370
diff changeset
    13
16091
mawalch
parents: 13960
diff changeset
    14
"{ NameSpace: Smalltalk }"
mawalch
parents: 13960
diff changeset
    15
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
View subclass:#MemoryMonitorView
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
	instanceVariableNames:'updateInterval updateBlock myProcess oldData newData freeData
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
		updateIndex org maxTotal minTotal dX newColor freeColor oldColor
12408
c54a692c5e1f class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12407
diff changeset
    19
		prevTotal prevLimit prevFree prevFree2 prevOld scale drawLock
c54a692c5e1f class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12407
diff changeset
    20
		prevMemUsed prevCodeUsed prevNumWeak prevNumRem prevNumLifoRem
c54a692c5e1f class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12407
diff changeset
    21
		prevTenureAge prevIGCPhase prevLastScavengeReclamation
17013
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
    22
		prevMinScavengeReclamation prevScavengeCount mallocColor
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
    23
		drawAction'
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
	classVariableNames:''
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
	poolDictionaries:''
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
	category:'Monitors-ST/X'
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
!MemoryMonitorView class methodsFor:'documentation'!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
copyright
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
 COPYRIGHT (c) 1991 by Claus Gittinger
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
	      All Rights Reserved
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
 This software is furnished under a license and may be used
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
 only in accordance with the terms of that license and with the
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
 inclusion of the above copyright notice.   This software may not
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
 be provided or otherwise made available to, or used by, any
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
 other person.  No title to or ownership of the software is
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
 hereby transferred.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
documentation
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
    Shows memory usage (oldspace + newspace). Simple, but useful.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
    The numbers shown are:
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
        tot     total memory usage (i.e. allocated oldSpace + allocated newSpace)
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
                (does not include the second semispace and other help-areas,
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
                 such as the remembered set etc.)
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
        all     current oldSpace in use + newSpace in use
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
        new     current newSpace in use
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
        frl     free space in (fragmented) free lists
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
        fre     compact free area above the used oldSpace
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
        old     current oldSpace in use
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
10574
c1b3570b7823 changed: #documentation
Stefan Vogel <sv@exept.de>
parents: 10573
diff changeset
    63
        mal     memory used by malloc (netto)
c1b3570b7823 changed: #documentation
Stefan Vogel <sv@exept.de>
parents: 10573
diff changeset
    64
c1b3570b7823 changed: #documentation
Stefan Vogel <sv@exept.de>
parents: 10573
diff changeset
    65
        mto     total memory that has been reserved by the malloc subsystem
c1b3570b7823 changed: #documentation
Stefan Vogel <sv@exept.de>
parents: 10573
diff changeset
    66
                (may contained mem that has been freed or not yet allocated)
c1b3570b7823 changed: #documentation
Stefan Vogel <sv@exept.de>
parents: 10573
diff changeset
    67
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
        cod     dynamic compiled code space size (just in time compiler)
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
        max,    extreme values of 'tot' since the monitor started
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
        min     (can be reset by typing 'r' in the view)
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
        t       tenure threshold (1 .. 30)
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
        I       incremental GC state (2 = idle)
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
        weak    number of weak objects
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
        rem     size of rememberedSet
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
        minsc:  percent of newspace remaining after scavenge (worst case)
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
                (i.e. the minimum %% of scavenged objects)
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
        count   number of scavenges since system started
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
        %       percentage of live objects in newSpace after last scavenge
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
                (i.e. this is the garbage vs. living objects ratio of
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
                 newSpace objects after the last scavenge)
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
    the graphic shows:
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
        orange  newSpace used
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92
        green   free memory in freeLists
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
        white   oldSpace used
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
    the popupMenu offers GC functions; keyboard options are:
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
        'f' -> faster; 's' -> slower; 'r' -> reset min/max
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    98
17013
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
    99
    Disclaimer:
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   100
        this was one of the first tools written for ST/X (around 1989/90);
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   101
        today, it would probably be written differently...
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   102
        
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
    [author:]
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   104
        Claus Gittinger
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   106
    [start with:]
2367
51653f206d55 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2363
diff changeset
   107
        MemoryMonitor open
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
        MemoryMonitorView open
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   110
    [see also:]
2367
51653f206d55 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2363
diff changeset
   111
        ObjectMemory MemoryMonitor
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   112
        MemoryUsageMonitor ProcessMonitor
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   113
"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   114
! !
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   116
!MemoryMonitorView methodsFor:'drawing'!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   117
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118
displayKilo:aNumber name:nm y:y
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   119
    |s|
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
12731
8613dbe2831f class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12408
diff changeset
   121
"/    s := nm , (UnitConverter fileSizeStringFor:aNumber).
8613dbe2831f class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12408
diff changeset
   122
    aNumber >= (1024*1024*1024*8) ifTrue:[
12407
689df530eb3c class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 10574
diff changeset
   123
        s := nm , ((aNumber // (1024*1024*1024)) printStringLeftPaddedTo:5) , 'G '.
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
    ] ifFalse:[
12407
689df530eb3c class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 10574
diff changeset
   125
        aNumber >= (1024*1024*16) ifTrue:[
689df530eb3c class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 10574
diff changeset
   126
            s := nm , ((aNumber // (1024*1024)) printStringLeftPaddedTo:5) , 'M '.
689df530eb3c class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 10574
diff changeset
   127
        ] ifFalse:[
689df530eb3c class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 10574
diff changeset
   128
            s := nm , ((aNumber // 1024) printStringLeftPaddedTo:5) , 'k '.
689df530eb3c class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 10574
diff changeset
   129
        ].
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   130
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
    self displayOpaqueString:s x:0 y:y.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
    "Modified: / 23.9.1998 / 13:19:04 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
17013
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   136
initializeDrawAction
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   137
    "extracted into a separate block to avoid memory allocation in updateDisplay"
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   138
    
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   139
    drawAction :=
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   140
        [    
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   141
            |total oldSpaceUsed newSpaceUsed freeMem oldSpaceSize
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   142
             realOldSpaceSize symSpaceSize realOldSpaceUsed
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   143
             gWidth shift scaleChange margin|
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   144
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   145
            realOldSpaceSize := ObjectMemory oldSpaceSize.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   146
            symSpaceSize := ObjectMemory symSpaceSize.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   147
            realOldSpaceUsed := ObjectMemory oldSpaceUsed.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   148
            
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   149
            oldSpaceUsed := realOldSpaceUsed + ObjectMemory symSpaceUsed.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   150
            newSpaceUsed := ObjectMemory newSpaceUsed.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   151
            freeMem := ObjectMemory freeListSpace + (realOldSpaceSize - realOldSpaceUsed).
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   152
            oldSpaceSize := realOldSpaceSize + symSpaceSize.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   153
            total := oldSpaceSize + ObjectMemory newSpaceSize.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   154
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   155
            scaleChange := false.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   156
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   157
            ((total - freeMem) < minTotal) ifTrue:[
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   158
                minTotal := total - freeMem.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   159
                scaleChange := true
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   160
            ].
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   161
            (total > maxTotal) ifTrue:[
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   162
                maxTotal := total.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   163
                scaleChange := true
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   164
            ].
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   165
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   166
            oldData at:updateIndex put:oldSpaceSize. "/ oldSpaceUsed.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   167
            newData at:updateIndex put:newSpaceUsed.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   168
            freeData at:updateIndex put:freeMem.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   169
            updateIndex := updateIndex + 1.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   170
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   171
            scaleChange ifTrue:[
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   172
                scale := height asFloat / (maxTotal + 100000).
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   173
                self redraw
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   174
            ].
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   175
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   176
            gWidth := width - org.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   177
            margin := 1.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   178
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   179
            ((updateIndex-1) >= (gWidth - margin)) ifTrue:[
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   180
                "on slow displays, use:"
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   181
                "/            shift := gWidth // 4.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   182
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   183
                "for smooth display, use:"
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   184
                shift := 1.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   185
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   186
                oldData replaceFrom:1 with:oldData startingAt:shift+1.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   187
                newData replaceFrom:1 with:newData startingAt:shift+1.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   188
                freeData replaceFrom:1 with:freeData startingAt:shift+1.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   189
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   190
                updateIndex := updateIndex - shift.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   191
                dX := (dX ? 0) + shift.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   192
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   193
                "/ before copying, handle any outstanding exposes ...
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   194
                self repairDamage.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   195
                "/ self catchExpose.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   196
                self 
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   197
                    copyFrom:self 
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   198
                    x:(org + shift) y:0 toX:org y:0
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   199
                    width:(gWidth - shift - margin) height:height
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   200
                    async:false.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   201
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   202
                self 
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   203
                    clearRectangleX:(width - margin - shift) y:0 
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   204
                    width:shift height:height.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   205
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   206
                "/ self waitForExpose.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   207
            ].
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   208
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   209
            self 
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   210
                updateLineX:(updateIndex - 1 + org - 1)
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   211
                total:total 
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   212
                old:oldSpaceSize "/ oldSpaceUsed
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   213
                new:newSpaceUsed 
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   214
                free:freeMem.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   215
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   216
            self updateNumbers.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   217
            self flush.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   218
        ].
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   219
!
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   220
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   221
redraw
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   222
    "redraw all"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   223
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   224
    self clear.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   225
    self redrawX:0 y:0 width:width height:height
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   226
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   227
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   228
redrawX:x y:y width:w height:h
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   229
    "redraw data"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   230
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   231
    |total oldSpaceUsed newSpaceUsed freeMem lx startIdx endIdx
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   232
     right|
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   233
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   234
    shown ifFalse:[^ self].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   235
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   236
    right := x + w - 1.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   237
    right >= org ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   238
        lx := x.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   239
        lx < org ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   240
            lx := org
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   241
        ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   242
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   243
        total := ObjectMemory symSpaceSize 
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   244
                 + ObjectMemory oldSpaceSize 
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   245
                 + ObjectMemory newSpaceSize.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   246
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   247
        startIdx := (lx-org+1).
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   248
        startIdx < 1 ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   249
            startIdx := 1
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   250
        ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   251
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   252
        endIdx := right-org+1.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   253
        endIdx >= updateIndex ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   254
            endIdx := updateIndex-1.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   255
        ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   256
        dX := 0.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   257
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   258
        startIdx to:endIdx do:[:i |
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   259
            newSpaceUsed := newData at:i.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   260
            newSpaceUsed notNil ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   261
                oldSpaceUsed := oldData at:i.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   262
                freeMem := freeData at:i.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   263
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   264
                self updateLineX:lx - dX
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   265
                       total:total 
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   266
                       old:oldSpaceUsed 
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   267
                       new:newSpaceUsed 
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   268
                       free:freeMem.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   269
            ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   270
            lx := lx + 1
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   271
        ]
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   272
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   273
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   274
    x < org ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   275
        "/ force redraw.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   276
12408
c54a692c5e1f class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12407
diff changeset
   277
        prevFree := prevFree2 := prevOld := prevTotal := prevLimit := nil.
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   278
        prevMemUsed := prevCodeUsed := prevNumWeak := prevNumRem := nil.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   279
        prevNumLifoRem := prevTenureAge := prevIGCPhase := nil.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   280
        prevLastScavengeReclamation := prevMinScavengeReclamation := nil.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   281
        prevScavengeCount := nil.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   282
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   283
        self updateNumbers.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   284
    ]
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   285
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   286
    "Modified: / 14.7.1998 / 23:33:47 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   287
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   288
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   289
updateDisplay
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   290
    "update picture; trigger next update"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   291
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   292
    shown ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   293
        drawLock wouldBlock ifFalse:[
17013
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   294
            drawLock critical:drawAction.
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   295
        ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   296
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   297
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   298
    updateBlock notNil ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   299
        Processor addTimedBlock:updateBlock afterSeconds:updateInterval
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   300
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   301
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   302
    "Modified: / 5.8.1998 / 13:13:18 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   303
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   304
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   305
updateLineX:x total:total old:oldSpaceSize new:newSpaceUsed free:freeMem
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   306
    |hNew hOld hFree y1 y2 y3|
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   307
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   308
    hNew := (newSpaceUsed * scale) asInteger.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   309
    hOld := (oldSpaceSize * scale) // 2.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   310
    hFree := (freeMem * scale) // 2.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   311
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   312
    y1 := height - 1.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   313
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   314
    y2 := y1 - hOld.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   315
    self paint:oldColor.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   316
    self displayLineFromX:x y:y1 toX:x y:y2.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   317
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   318
    y3 := y1 - hFree.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   319
    self paint:freeColor.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   320
    self displayLineFromX:x y:y1 toX:x y:y3.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   321
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   322
    y1 := y2 - hNew.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   323
    y1 ~= y2 ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   324
       self paint:newColor.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   325
       self displayLineFromX:x y:y1 toX:x y:y2.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   326
    ]
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   327
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   328
    "Modified: / 29.1.1999 / 20:45:07 / stefan"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   329
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   330
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   331
updateNumbers
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   332
    "redraw numbers.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   333
     The values shown are:
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   334
        max:    maximum memory used since monitor started
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   335
        min:    minimum memory used since monitor started
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   336
        tot:    total memory used (overall oldSpace + overall newSpace)
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   337
        all:    current memory in use (oldSpace + newSpace)
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   338
        new:    current newSpace in use
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   339
        fre:    current size of freelist in oldSpace
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   340
        old:    current oldSpace in use
12731
8613dbe2831f class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12408
diff changeset
   341
        mal:    net allocated by malloc
10570
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   342
        mto:    brutto memory reserved by malloc
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   343
        code:   current just-in-time compiled code cache size
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   344
        t:      current tenure age
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   345
        I:      IGC state
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   346
        weak:   number of weak arrays in the system
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   347
        rem     remembered set size
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   348
        lrem    lifo remembered set size
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   349
        minsc:  percent of newspace remaining after scavenge (worst case)
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   350
        irq:    max. interrupt delay
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   351
        count of scavenges / last scavenge survivor rate
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   352
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   353
    "
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   354
10570
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   355
    |oldSpaceSize newSpaceSize memUsed oldMemUsed newMemUsed freeMem free2
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   356
     mallocAllocated mallocTotal
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   357
     codeUsed numWeak numRem numLifoRem tenureAge igcPhase 
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   358
     minScavengeReclamation lastScavengeReclamation scavengeCount
17013
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   359
     y half s font fontHeight fontAscent fontDescent 
12407
689df530eb3c class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 10574
diff changeset
   360
     limit total n prevMallocAllocated prevMallocTotal|
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   361
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   362
    oldMemUsed := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   363
    newMemUsed := ObjectMemory newSpaceUsed.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   364
    freeMem := ObjectMemory freeListSpace.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   365
    oldSpaceSize := ObjectMemory oldSpaceSize + ObjectMemory symSpaceSize.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   366
    newSpaceSize := ObjectMemory newSpaceSize.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   367
10570
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   368
    mallocAllocated := ObjectMemory mallocAllocated.
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   369
    mallocTotal := ObjectMemory mallocTotal.
12407
689df530eb3c class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 10574
diff changeset
   370
    limit := ObjectMemory maxOldSpace.
10570
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   371
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   372
    memUsed := oldMemUsed + newMemUsed "- freeMem".
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   373
    total := oldSpaceSize + newSpaceSize.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   374
    free2 := ObjectMemory freeSpace.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   375
13959
a1126eb2fcfd class: MemoryMonitorView
Stefan Vogel <sv@exept.de>
parents: 13957
diff changeset
   376
    self paint:self whiteColor on:self blackColor.
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   377
17013
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   378
    font := gc font.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   379
    fontDescent := font descent.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   380
    fontAscent := font ascent.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   381
    fontHeight := font height + fontDescent.
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   382
    half := height // 2 + fontDescent.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   383
10573
afd99a8655e8 changed: #updateNumbers
Stefan Vogel <sv@exept.de>
parents: 10570
diff changeset
   384
    y := half - (fontHeight * 8).
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   385
12408
c54a692c5e1f class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12407
diff changeset
   386
    limit ~~ prevLimit ifTrue:[
c54a692c5e1f class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12407
diff changeset
   387
        self displayKilo:limit    name:'lim ' y:fontAscent.
c54a692c5e1f class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12407
diff changeset
   388
        prevLimit := limit.
c54a692c5e1f class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12407
diff changeset
   389
    ].
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   390
    total ~~ prevTotal ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   391
        ((total - freeMem) < minTotal) ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   392
            minTotal := total - freeMem.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   393
        ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   394
        (total > maxTotal) ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   395
            maxTotal := total.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   396
        ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   397
12407
689df530eb3c class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 10574
diff changeset
   398
        self displayKilo:maxTotal name:'max ' y:fontAscent + fontHeight.
689df530eb3c class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 10574
diff changeset
   399
        self displayKilo:minTotal name:'min ' y:(height - fontDescent).
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   400
        self displayKilo:total    name:'tot ' y:y.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   401
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   402
        prevTotal := total.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   403
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   404
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   405
    y := y + fontHeight.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   406
    memUsed ~~ prevMemUsed ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   407
        self displayKilo:memUsed name:'all ' y:y.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   408
        prevMemUsed := memUsed.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   409
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   410
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   411
    y := y + fontHeight.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   412
    self paint:newColor.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   413
    self displayKilo:newMemUsed name:'new ' y:y.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   414
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   415
    y := y + fontHeight.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   416
    freeMem ~~ prevFree ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   417
        self paint:freeColor.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   418
        self displayKilo:freeMem name:'frl ' y:y.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   419
        prevFree := freeMem.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   420
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   421
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   422
    y := y + fontHeight.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   423
    free2 ~~ prevFree2 ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   424
        self paint:freeColor.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   425
        self displayKilo:free2 name:'fre ' y:y.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   426
        prevFree2 := free2.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   427
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   428
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   429
    y := y + fontHeight.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   430
    (oldMemUsed - freeMem) ~~ prevOld ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   431
        self paint:oldColor.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   432
        self displayKilo:(oldMemUsed - freeMem) name:'old ' y:y.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   433
        prevOld := (oldMemUsed - freeMem).
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   434
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   435
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   436
    y := y + fontHeight.
10570
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   437
    mallocAllocated ~~ prevMallocAllocated ifTrue:[
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   438
        self paint:mallocColor.
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   439
        self displayKilo:mallocAllocated name:'mal ' y:y.
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   440
        prevMallocAllocated := mallocAllocated.
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   441
    ].
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   442
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   443
    y := y + fontHeight.
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   444
    mallocTotal ~~ prevMallocTotal ifTrue:[
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   445
        self paint:mallocColor.
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   446
        self displayKilo:mallocTotal name:'mto ' y:y.
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   447
        prevMallocTotal := mallocTotal.
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   448
    ].
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   449
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   450
    y := y + fontHeight.
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   451
    ObjectMemory supportsJustInTimeCompilation ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   452
        codeUsed := ObjectMemory compiledCodeSpaceUsed.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   453
        prevCodeUsed ~~ codeUsed ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   454
            self paint:oldColor.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   455
            codeUsed > 9999 ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   456
                s := 'code ' , ((codeUsed // 1024) printStringLeftPaddedTo:4) , 'k'.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   457
            ] ifFalse:[
10573
afd99a8655e8 changed: #updateNumbers
Stefan Vogel <sv@exept.de>
parents: 10570
diff changeset
   458
                s := 'code ' , (codeUsed printStringLeftPaddedTo:4) , 'b'.
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   459
            ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   460
            self displayOpaqueString:s x:0 y:y.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   461
            prevCodeUsed := codeUsed.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   462
        ]
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   463
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   464
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   465
    "
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   466
     the following is internal - normally only interesting when debugging the VM
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   467
    "
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   468
    y := y + fontHeight.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   469
    tenureAge := ObjectMemory tenureAge.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   470
    igcPhase := ObjectMemory incrementalGCPhase.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   471
    (prevTenureAge ~~ tenureAge
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   472
    or:[prevIGCPhase ~~ igcPhase]) ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   473
        self paint:oldColor.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   474
        s := 't:' , (tenureAge printStringLeftPaddedTo:2) , ' '.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   475
        s := s , ' I:' , (igcPhase printStringLeftPaddedTo:2) , ' '.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   476
        self displayOpaqueString:s x:0 y:y.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   477
        prevTenureAge := tenureAge.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   478
        prevIGCPhase := igcPhase.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   479
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   480
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   481
    y := y + fontHeight.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   482
    numWeak := ObjectMemory numberOfWeakObjects.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   483
    prevNumWeak ~~ numWeak ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   484
        self paint:oldColor.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   485
        s := 'weak: ' , (numWeak printStringLeftPaddedTo:4).
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   486
        self displayOpaqueString:s x:0 y:y.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   487
        prevNumWeak := numWeak.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   488
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   489
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   490
    y := y + fontHeight.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   491
    numRem := ObjectMemory rememberedSetSize.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   492
    prevNumRem ~~ numRem ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   493
        self paint:oldColor.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   494
        s := 'rem: ' , (numRem printStringLeftPaddedTo:5).
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   495
        self displayOpaqueString:s x:0 y:y.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   496
        prevNumRem := numRem.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   497
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   498
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   499
    y := y + fontHeight.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   500
    numLifoRem := ObjectMemory lifoRememberedSetSize.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   501
    prevNumLifoRem ~~ numLifoRem ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   502
        self paint:oldColor.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   503
        s := 'lrem: ' , (numLifoRem printStringLeftPaddedTo:4 ifLarger:['****']).
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   504
        self displayOpaqueString:s x:0 y:y.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   505
        prevNumLifoRem := numLifoRem.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   506
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   507
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   508
"/ does no longer make sense to show ....
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   509
"/    y := y + fontHeight.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   510
"/    ObjectMemory runsSingleOldSpace ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   511
"/        self displayOpaqueString:'single' x:0 y:(half + (fontHeight*4)).
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   512
"/    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   513
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   514
    y := y + fontHeight.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   515
    minScavengeReclamation := ObjectMemory minScavengeReclamation * 100 // ObjectMemory newSpaceSize.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   516
    prevMinScavengeReclamation ~~ minScavengeReclamation ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   517
        minScavengeReclamation := 100 - minScavengeReclamation asInteger.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   518
        s := 'minSc ', (minScavengeReclamation printStringLeftPaddedTo:3) , '%'.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   519
        self paint:oldColor.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   520
        self displayOpaqueString:s x:0 y:y.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   521
        prevMinScavengeReclamation := minScavengeReclamation.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   522
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   523
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   524
    y := y + fontHeight.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   525
    n := ObjectMemory maxInterruptLatency.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   526
    n notNil ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   527
        s := 'irq ', (n printStringLeftPaddedTo:3) , ' ms'.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   528
    ] ifFalse:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   529
        s := ''
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   530
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   531
    self displayOpaqueString:s x:0 y:y.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   532
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   533
    y := y + fontHeight.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   534
    scavengeCount := ObjectMemory scavengeCount.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   535
    lastScavengeReclamation := ObjectMemory lastScavengeReclamation * 100 // ObjectMemory newSpaceSize.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   536
    (prevScavengeCount ~~ scavengeCount
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   537
    or:[prevLastScavengeReclamation ~~ lastScavengeReclamation]) ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   538
        lastScavengeReclamation := 100 - lastScavengeReclamation asInteger.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   539
        s := (scavengeCount printStringLeftPaddedTo:6)
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   540
             , (lastScavengeReclamation printStringLeftPaddedTo:3) , '%'.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   541
        self displayOpaqueString:s x:0 y:y.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   542
        prevLastScavengeReclamation := lastScavengeReclamation.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   543
        prevScavengeCount := scavengeCount.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   544
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   545
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   546
    "Created: / 7.11.1995 / 14:48:16 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   547
    "Modified: / 14.7.1998 / 23:35:53 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   548
! !
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   549
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   550
!MemoryMonitorView methodsFor:'events'!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   551
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   552
keyPress:key x:x y:y
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   553
    key == $f ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   554
	"faster"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   555
	updateInterval := updateInterval / 2
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   556
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   557
    key == $s ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   558
	"slower"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   559
	updateInterval := updateInterval * 2
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   560
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   561
    key == $r ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   562
	"reset max"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   563
	maxTotal := prevTotal.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   564
	scale := height asFloat / (maxTotal + 100000).
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   565
	self resetStatisticValues.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   566
	self redraw.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   567
    ]
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   568
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   569
    "Modified: 7.11.1995 / 17:45:13 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   570
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   571
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   572
sizeChanged:how
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   573
    |nn no nf delta oldSize newSize|
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   574
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   575
    super sizeChanged:how.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   576
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   577
    (width == 0 or:[height == 0]) ifTrue:[
2369
e0164ab47abd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2367
diff changeset
   578
        ^ self
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   579
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   580
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   581
    oldSize := oldData size.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   582
    newSize := width-org+1.
2369
e0164ab47abd checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2367
diff changeset
   583
    newSize <= 0 ifTrue:[^ self].
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   584
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   585
    (newSize ~~ oldSize) ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   586
        nn := Array new:newSize.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   587
        no := Array new:newSize.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   588
        nf := Array new:newSize.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   589
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   590
        (newSize > oldSize) ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   591
            nn replaceFrom:1 to:oldSize with:newData.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   592
            no replaceFrom:1 to:oldSize with:oldData.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   593
            nf replaceFrom:1 to:oldSize with:freeData
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   594
        ] ifFalse:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   595
            delta := (oldSize - newSize).
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   596
            nn replaceFrom:1 with:newData startingAt:delta+1.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   597
            no replaceFrom:1 with:oldData startingAt:delta+1.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   598
            nf replaceFrom:1 with:freeData startingAt:delta+1.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   599
            updateIndex > newSize ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   600
                updateIndex := updateIndex - delta.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   601
            ]
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   602
        ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   603
        newData := nn.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   604
        oldData := no.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   605
        freeData := nf.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   606
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   607
        scale := height asFloat / (maxTotal + 100000).
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   608
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   609
    self clear.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   610
    self redraw.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   611
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   612
    "Modified: / 7.9.1998 / 21:41:13 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   613
! !
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   614
6297
01b5be803287 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4975
diff changeset
   615
!MemoryMonitorView methodsFor:'initialization & release'!
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   616
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   617
destroy
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   618
    updateBlock notNil ifTrue:[
2370
453caa0c1907 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2369
diff changeset
   619
        Processor removeTimedBlock:updateBlock.
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   620
    ] ifFalse:[
2370
453caa0c1907 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2369
diff changeset
   621
        myProcess notNil ifTrue:[
453caa0c1907 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2369
diff changeset
   622
            myProcess terminate.
453caa0c1907 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2369
diff changeset
   623
            myProcess := nil
453caa0c1907 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2369
diff changeset
   624
        ]
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   625
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   626
    oldData := newData := freeData := nil.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   627
    super destroy
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   628
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   629
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   630
initialize
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   631
    super initialize.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   632
17013
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   633
    self initializeDrawAction.
cf59893a8693 #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 16743
diff changeset
   634
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   635
    drawLock := Semaphore forMutualExclusion name:'drawLock'.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   636
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   637
    updateInterval := 0.5.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   638
    ProcessorScheduler isPureEventDriven ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   639
        updateBlock := [self updateDisplay].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   640
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   641
    oldData := Array new:1000.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   642
    newData := Array new:1000.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   643
    freeData := Array new:1000.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   644
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   645
    updateIndex := 1.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   646
16251
4a0adeeff6df class: Image
Claus Gittinger <cg@exept.de>
parents: 16242
diff changeset
   647
    self font:((Font family:'courier' face:'medium' style:'roman' size:10) onDevice:device).
13957
f7064863060e class: MemoryMonitorView
Stefan Vogel <sv@exept.de>
parents: 13756
diff changeset
   648
    org := gc font widthOf:'max 99999k '.
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   649
    level := 0.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   650
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   651
    maxTotal := minTotal := ObjectMemory oldSpaceSize 
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   652
                            + ObjectMemory symSpaceSize
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   653
                            + ObjectMemory newSpaceSize.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   654
13960
d3e937384107 class: MemoryMonitorView
Stefan Vogel <sv@exept.de>
parents: 13959
diff changeset
   655
    viewBackground := self blackColor.
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   656
16242
b44620e65044 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 16091
diff changeset
   657
    device hasColors ifTrue:[
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   658
        newColor := Color orange. "/ yellow.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   659
        freeColor := Color green.
10570
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   660
        mallocColor := Color yellow.
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   661
    ] ifFalse:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   662
        newColor := Color grey:67.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   663
        freeColor := Color grey:33.
10570
b11a0023bac8 - Add malloc counts
Stefan Vogel <sv@exept.de>
parents: 10384
diff changeset
   664
        mallocColor := Color grey:50.
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   665
    ].
16743
539e6058dba1 #OTHER by stefan
Stefan Vogel <sv@exept.de>
parents: 16251
diff changeset
   666
    oldColor := self whiteColor.
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   667
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   668
    self model:self.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   669
    self menu:#memoryMenu
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   670
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   671
    "
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   672
     MemoryMonitor open
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   673
    "
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   674
10384
a29a99b6ecf8 changed: #initialize
Claus Gittinger <cg@exept.de>
parents: 9542
diff changeset
   675
    "Modified: / 24-07-2011 / 08:28:51 / cg"
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   676
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   677
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   678
realize
13957
f7064863060e class: MemoryMonitorView
Stefan Vogel <sv@exept.de>
parents: 13756
diff changeset
   679
    |graphicsDevice|
f7064863060e class: MemoryMonitorView
Stefan Vogel <sv@exept.de>
parents: 13756
diff changeset
   680
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   681
    super realize.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   682
    updateBlock notNil ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   683
        Processor addTimedBlock:updateBlock afterSeconds:updateInterval.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   684
    ] ifFalse:[
8655
c79fd17ad0a1 check for myProcess not nil
ca
parents: 8650
diff changeset
   685
        (myProcess isNil or:[myProcess isDead]) ifTrue:[
c79fd17ad0a1 check for myProcess not nil
ca
parents: 8650
diff changeset
   686
            myProcess := [
c79fd17ad0a1 check for myProcess not nil
ca
parents: 8650
diff changeset
   687
                [
c79fd17ad0a1 check for myProcess not nil
ca
parents: 8650
diff changeset
   688
                    self updateProcess
c79fd17ad0a1 check for myProcess not nil
ca
parents: 8650
diff changeset
   689
                ] ensure:[
c79fd17ad0a1 check for myProcess not nil
ca
parents: 8650
diff changeset
   690
                    myProcess := nil.
c79fd17ad0a1 check for myProcess not nil
ca
parents: 8650
diff changeset
   691
                ].
c79fd17ad0a1 check for myProcess not nil
ca
parents: 8650
diff changeset
   692
            ] newProcess.
c79fd17ad0a1 check for myProcess not nil
ca
parents: 8650
diff changeset
   693
            myProcess priorityRange:(6 to:8).
c79fd17ad0a1 check for myProcess not nil
ca
parents: 8650
diff changeset
   694
            myProcess name:'monitor [' , 
c79fd17ad0a1 check for myProcess not nil
ca
parents: 8650
diff changeset
   695
                           Processor activeProcessId printString ,
c79fd17ad0a1 check for myProcess not nil
ca
parents: 8650
diff changeset
   696
                           '] update'.
c79fd17ad0a1 check for myProcess not nil
ca
parents: 8650
diff changeset
   697
            myProcess restartable:true.
c79fd17ad0a1 check for myProcess not nil
ca
parents: 8650
diff changeset
   698
            myProcess resume.
c79fd17ad0a1 check for myProcess not nil
ca
parents: 8650
diff changeset
   699
        ].
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   700
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   701
16242
b44620e65044 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 16091
diff changeset
   702
    graphicsDevice := device.
13957
f7064863060e class: MemoryMonitorView
Stefan Vogel <sv@exept.de>
parents: 13756
diff changeset
   703
    newColor := newColor onDevice:graphicsDevice.
f7064863060e class: MemoryMonitorView
Stefan Vogel <sv@exept.de>
parents: 13756
diff changeset
   704
    freeColor := freeColor onDevice:graphicsDevice.
f7064863060e class: MemoryMonitorView
Stefan Vogel <sv@exept.de>
parents: 13756
diff changeset
   705
    oldColor := oldColor onDevice:graphicsDevice.
f7064863060e class: MemoryMonitorView
Stefan Vogel <sv@exept.de>
parents: 13756
diff changeset
   706
    mallocColor := mallocColor onDevice:graphicsDevice.
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   707
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   708
    "Modified: / 23.9.1998 / 12:41:10 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   709
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   710
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   711
reinitStyle
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   712
    "ignore style changes"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   713
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   714
    "Created: / 15.9.1998 / 15:22:46 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   715
! !
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   716
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   717
!MemoryMonitorView methodsFor:'menu functions'!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   718
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   719
backgroundCollect
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   720
    "start a background (non disturbing) incremental GC. 
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   721
     Since the GC is performed at a low priority, it may not make progress if higher
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   722
     prio processes are running"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   723
 
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   724
    [
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   725
	ObjectMemory incrementalGC
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   726
    ] forkAt:5 
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   727
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   728
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   729
backgroundCollectWithDynamicPrio
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   730
    "setup the background collector to run at dynamic priority.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   731
     This is a new experimental feature."
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   732
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   733
    Processor isTimeSlicing ifFalse:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   734
        Processor startTimeSlicing.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   735
        Processor supportDynamicPriorities:true
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   736
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   737
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   738
    ObjectMemory backgroundCollectProcess priorityRange:(5 to:9).
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   739
    ObjectMemory backgroundFinalizationProcess priorityRange:(5 to:9).
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   740
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   741
    "Modified: / 4.8.1998 / 02:16:02 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   742
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   743
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   744
backgroundCollectWithFixPrio
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   745
    "setup the background collector to run at a fix priority.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   746
     This is the default."
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   747
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   748
    ObjectMemory backgroundCollectProcess priorityRange:nil.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   749
    ObjectMemory backgroundFinalizationProcess priorityRange:nil.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   750
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   751
    "Modified: / 4.8.1998 / 02:00:31 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   752
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   753
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   754
cleanupMemory
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   755
    "let all classes release unneeded, cached
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   756
     data ..."
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   757
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   758
    ObjectMemory performLowSpaceCleanup.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   759
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   760
    "
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   761
     then, perform a GC (incl. symbol reclamation)
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   762
    "
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   763
    ObjectMemory reclaimSymbols.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   764
    "
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   765
     finally, compress
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   766
    "
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   767
    ObjectMemory tenure.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   768
    ObjectMemory verboseGarbageCollect.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   769
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   770
    "Modified: 26.6.1997 / 17:12:53 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   771
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   772
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   773
cleanupMethodHistory
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   774
    "release the oldMethod history"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   775
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   776
    (self confirm:'This removes the previous method history,
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   777
which is kept for all changed methods in the system.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   778
After that, the browsers cannot easily switch back to a methods
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   779
previous version.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   780
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   781
However, this is normally not a problem, since
16091
mawalch
parents: 13960
diff changeset
   782
a methods previous code should still be accessible through
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   783
either the changes-file, the sourceCode repository or the classes original
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   784
source file.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   785
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   786
cleanup now ?') ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   787
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   788
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   789
        Class flushMethodHistory.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   790
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   791
        "
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   792
         then, perform a GC (incl. symbol reclamation)
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   793
        "
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   794
        ObjectMemory reclaimSymbols.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   795
        "
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   796
         finally, compress
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   797
        "
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   798
        ObjectMemory verboseGarbageCollect.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   799
   ]
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   800
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   801
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   802
collectGarbage
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   803
    "perform a blocking (non compressing) garbage collect"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   804
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   805
    windowGroup withWaitCursorDo:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   806
        ObjectMemory tenure.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   807
        ObjectMemory markAndSweep
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   808
    ]
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   809
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   810
    "Modified: 30.7.1997 / 21:19:35 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   811
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   812
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   813
collectGarbageAndCompress
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   814
    "perform a blocking compressing garbage collect."
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   815
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   816
    windowGroup withWaitCursorDo:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   817
        ObjectMemory tenure.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   818
        ObjectMemory verboseGarbageCollect
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   819
    ]
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   820
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   821
    "Modified: 30.7.1997 / 21:19:47 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   822
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   823
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   824
collectGarbageAndSymbols
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   825
    "perform a blocking (non compressing) garbage collect
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   826
     and reclaim unreferenced symbols."
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   827
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   828
    windowGroup withWaitCursorDo:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   829
        ObjectMemory tenure.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   830
        ObjectMemory reclaimSymbols
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   831
    ]
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   832
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   833
    "Modified: 30.7.1997 / 21:19:41 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   834
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   835
13755
fd2d7ea464b0 class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12731
diff changeset
   836
compressOldSpace
fd2d7ea464b0 class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12731
diff changeset
   837
    "perform a blocking compress (only useful if freeList is not empty, after M&S)"
fd2d7ea464b0 class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12731
diff changeset
   838
fd2d7ea464b0 class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12731
diff changeset
   839
    windowGroup withWaitCursorDo:[
fd2d7ea464b0 class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12731
diff changeset
   840
        ObjectMemory compressOldSpace.
fd2d7ea464b0 class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12731
diff changeset
   841
    ]
fd2d7ea464b0 class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12731
diff changeset
   842
fd2d7ea464b0 class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12731
diff changeset
   843
    "Modified: 30.7.1997 / 21:19:35 / cg"
fd2d7ea464b0 class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12731
diff changeset
   844
!
fd2d7ea464b0 class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 12731
diff changeset
   845
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   846
compressSources
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   847
    (self confirm:'This saves all in-memory source strings into a file
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   848
and makes methods reference these (file-) strings,
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   849
freeing all in-memory sources.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   850
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   851
If that source file is ever lost or gets out of sync with
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   852
your system, those method sources are lost and the browser
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   853
will show garbage. 
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   854
However, you still have a change file as backup.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   855
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   856
(Be especially careful, if you move images around:
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   857
 the source file must then be the correct one for that image)
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   858
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   859
A compress is only useful, if you added many methods
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   860
and the systems response time suffers from paging.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   861
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   862
Compress anyway ?') ifTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   863
        windowGroup withWaitCursorDo:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   864
            Smalltalk compressSources.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   865
            ObjectMemory markAndSweep
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   866
        ]
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   867
    ]
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   868
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   869
    "Modified: 9.2.1996 / 18:17:22 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   870
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   871
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   872
incrementalCollect
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   873
    "start an incremental GC which does not disturb too much, but is guaranteed to
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   874
     make progress.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   875
     This is done by doing the IGC at a very high priority, but giving up the CPU after
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   876
     every step. Due to the long delays, this may take a while to finish.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   877
     Notice, that this is different from doing a background collect: that one
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   878
     may not make any progress if higher prio processes are runnable."
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   879
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   880
    |done delay|
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   881
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   882
    [
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   883
        done := false.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   884
        delay := Delay new.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   885
        [done] whileFalse:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   886
            10 timesRepeat:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   887
                done ifFalse:[done := ObjectMemory gcStep].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   888
            ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   889
            (delay delay:10) wait
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   890
        ]
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   891
    ] forkAt:Processor highestPriority
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   892
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   893
    "Modified: 23.12.1995 / 17:31:55 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   894
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   895
8650
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   896
memoryMenu
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   897
    <resource: #programMenu>
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   898
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   899
    |hasSpecialMenu m items moreItems specialMenu|
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   900
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   901
    hasSpecialMenu := Smalltalk isStandAloneApp not.
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   902
    hasSpecialMenu ifTrue:[
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   903
        items := #(
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   904
                    ('Background Collect Now'       backgroundCollect)
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   905
                    ('Hi Prio Incremental Collect'  incrementalCollect)
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   906
                    ('-')
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   907
                    ('Scavenge'                     scavenge)
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   908
                    ('Tenure'                       tenure)
13756
0fdbb4b1c1e3 class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 13755
diff changeset
   909
                    ('Compress Only'                compressOldSpace)
8650
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   910
                    ('-')
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   911
                    ('Cleanup Memory'               cleanupMemory)
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   912
                    ('Flush Method History'         cleanupMethodHistory)
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   913
                    ('Unload Autoloaded Classes'    unloadAllAutoloadedClasses)
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   914
                    ('-')
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   915
                    ('Compress Sources'             compressSources)
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   916
                  ).
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   917
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   918
        ObjectMemory backgroundCollectorRunning ifFalse:[
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   919
            moreItems := #(
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   920
                        ('Start Background Collector'   restartBackgroundCollector )
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   921
                     ) 
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   922
        ] ifTrue:[
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   923
            (ObjectMemory backgroundCollectProcess priorityRange notNil)
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   924
            ifTrue:[
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   925
                moreItems := #(
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   926
                        ('Stop Background Collector'             stopBackgroundCollector      )
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   927
                        ('Background Collect with Fix Priority'  backgroundCollectWithFixPrio )
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   928
                         ) 
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   929
            ] ifFalse:[
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   930
                moreItems := #(
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   931
                        ('Stop Background Collector'                stopBackgroundCollector      )
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   932
                        ('Background Collect with Dynamic Priority' backgroundCollectWithDynamicPrio )
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   933
                         ) 
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   934
            ].
9542
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
   935
            ObjectMemory backgroundFinalizationProcess isNil ifTrue:[
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
   936
                moreItems := moreItems , #(
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
   937
                            ('Start Background Finalizer'   restartBackgroundFinalizer )
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
   938
                         )
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
   939
            ].
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
   940
8650
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   941
        ].
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   942
        items := moreItems , items.
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   943
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   944
        specialMenu := PopUpMenu
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   945
                            itemList:items
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   946
                            resources:resources.
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   947
13957
f7064863060e class: MemoryMonitorView
Stefan Vogel <sv@exept.de>
parents: 13756
diff changeset
   948
        self sensor ctrlDown ifTrue:[
8650
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   949
            ^ specialMenu
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   950
        ].
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   951
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   952
        items := #(
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   953
                    ('Collect Garbage'              collectGarbage                  )
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   954
                    ('Collect Garbage & Symbols'    collectGarbageAndSymbols        )
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   955
                    ('Collect Garbage & Compress'   collectGarbageAndCompress       )
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   956
                    ('-')                                                           
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   957
                    ('Reset Statistic Values'       resetStatisticValues            )
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   958
                    ('-')
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   959
                    ('Others'                       otherMenu                       Ctrl)
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   960
                  ).
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   961
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   962
        m := PopUpMenu itemList:items resources:resources.
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   963
        m subMenuAt:#otherMenu put:specialMenu.
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   964
    ] ifFalse:[
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   965
        items := #(
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   966
                    ('Collect Garbage'              collectGarbage                  )
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   967
                    ('Collect Garbage & Symbols'    collectGarbageAndSymbols        )
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   968
                    ('Collect Garbage & Compress'   collectGarbageAndCompress       )
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   969
                    ('-')                                                           
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   970
                    ('Reset Statistic Values'       resetStatisticValues            )
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   971
                  ).
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   972
        m := PopUpMenu itemList:items resources:resources.
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   973
    ].
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   974
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   975
    ^ m
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   976
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   977
    "Modified: / 5.8.1998 / 15:35:14 / cg"
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   978
!
9c4626c21c7b do not show source-code related menu items if in a standalon app.
Claus Gittinger <cg@exept.de>
parents: 6297
diff changeset
   979
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   980
resetStatisticValues 
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   981
    ObjectMemory resetMaxInterruptLatency.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   982
    ObjectMemory resetMinScavengeReclamation.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   983
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   984
    "Created: 7.11.1995 / 17:44:59 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   985
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   986
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   987
restartBackgroundCollector
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   988
    "(re)start a background (non disturbing) incremental GC. 
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   989
     Since the GC is performed at a low priority, it may not make progress if higher
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   990
     prio processes are running"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   991
 
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   992
    ObjectMemory backgroundCollectorRunning
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   993
    ifFalse:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   994
        ObjectMemory startBackgroundCollectorAt:5.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   995
        ObjectMemory startBackgroundFinalizationAt:5
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   996
    ]
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   997
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   998
    "Created: / 21.1.1997 / 00:09:30 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   999
    "Modified: / 5.8.1998 / 14:30:17 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1000
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1001
9542
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
  1002
restartBackgroundFinalizer
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
  1003
    "(re)start a background (non disturbing) incremental finalizer process."
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
  1004
 
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
  1005
    ObjectMemory backgroundFinalizationProcess isNil
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
  1006
    ifTrue:[
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
  1007
        ObjectMemory startBackgroundFinalizationAt:5
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
  1008
    ]
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
  1009
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
  1010
    "Created: / 21.1.1997 / 00:09:30 / cg"
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
  1011
    "Modified: / 5.8.1998 / 14:30:17 / cg"
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
  1012
!
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
  1013
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1014
scavenge 
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1015
    "perform a blocking newspace garbage collect.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1016
     (this is for debugging only - the system does this automatically)"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1017
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1018
    ObjectMemory scavenge
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1019
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1020
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1021
stopBackgroundCollector
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1022
    "stop the background (non disturbing) incremental GC. 
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1023
     We do not recommend this - but maybe useful for debugging and
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1024
     evaluating the programs behavior in heavy-load situations
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1025
     (background collector cannot keep up with the allocation rate)"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1026
 
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1027
    ObjectMemory stopBackgroundCollector.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1028
    ObjectMemory stopBackgroundFinalization
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1029
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1030
    "Created: / 5.8.1998 / 14:29:40 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1031
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1032
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1033
tenure 
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1034
    "empty the newSpace, by aging all new objects immediately and transfering them
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1035
     into oldSpace.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1036
     (this is for debugging only - the system does this automatically)"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1037
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1038
    ObjectMemory tenure
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1039
!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1040
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1041
unloadAllAutoloadedClasses
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1042
    "unload all classes which were autoloaded and have no instances"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1043
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1044
    Autoload loadedClasses copy do:[:anAutoloadedClass |
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1045
        anAutoloadedClass hasInstances ifFalse:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1046
            anAutoloadedClass unload
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1047
        ]
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1048
    ].
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1049
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1050
    "Created: 27.6.1997 / 14:21:45 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1051
    "Modified: 27.6.1997 / 14:22:47 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1052
! !
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1053
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1054
!MemoryMonitorView methodsFor:'private'!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1055
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1056
updateProcess
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1057
    [true] whileTrue:[
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1058
        Delay waitForSeconds:updateInterval.
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1059
        self updateDisplay
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1060
    ]
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1061
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1062
    "Modified: / 23.9.1998 / 12:40:31 / cg"
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1063
! !
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1064
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1065
!MemoryMonitorView class methodsFor:'documentation'!
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1066
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1067
version
16091
mawalch
parents: 13960
diff changeset
  1068
    ^ '$Header$'
9542
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
  1069
!
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
  1070
279e4be4e515 added: #restartBackgroundFinalizer
sr
parents: 8655
diff changeset
  1071
version_CVS
16091
mawalch
parents: 13960
diff changeset
  1072
    ^ '$Header$'
2363
7b5e7b24ba17 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1073
! !
12407
689df530eb3c class: MemoryMonitorView
Claus Gittinger <cg@exept.de>
parents: 10574
diff changeset
  1074