MemoryMonitorView.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Thu, 14 Jun 2018 22:19:39 +0100
branchjv
changeset 18227 d25a407ba86d
parent 17136 cb908d2ba02e
permissions -rw-r--r--
Mini testrunner: show "green" if there's at least one pass and rest is pass or skip This is more meaningfull result then showing "gray" if there's at least one skip.
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