MemoryMonitor.st
author Claus Gittinger <cg@exept.de>
Sat, 23 Dec 1995 18:43:25 +0100
changeset 323 f443d7e5bab0
parent 311 c118ce1f8afd
child 350 68c5fed6c9bc
permissions -rw-r--r--
special menu published
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
     1
"
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
     2
 COPYRIGHT (c) 1991 by Claus Gittinger
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
     3
	      All Rights Reserved
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
     4
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
     5
 This software is furnished under a license and may be used
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
     6
 only in accordance with the terms of that license and with the
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
     8
 be provided or otherwise made available to, or used by, any
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
     9
 other person.  No title to or ownership of the software is
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    10
 hereby transferred.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    11
"
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    12
4cde336c0794 Initial revision
claus
parents:
diff changeset
    13
StandardSystemView subclass:#MemoryMonitor
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
    14
	instanceVariableNames:'updateInterval updateBlock myProcess oldData newData freeData
93
claus
parents: 91
diff changeset
    15
		updateIndex org maxTotal minTotal dX newColor freeColor oldColor
claus
parents: 91
diff changeset
    16
		prevTotal prevFree prevFree2 prevOld scale'
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
    17
	classVariableNames:''
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
    18
	poolDictionaries:''
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
    19
	category:'Interface-Tools'
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    20
!
4cde336c0794 Initial revision
claus
parents:
diff changeset
    21
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    22
!MemoryMonitor class methodsFor:'documentation'!
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    23
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    24
copyright
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    25
"
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    26
 COPYRIGHT (c) 1991 by Claus Gittinger
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    27
	      All Rights Reserved
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    28
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    29
 This software is furnished under a license and may be used
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    30
 only in accordance with the terms of that license and with the
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    31
 inclusion of the above copyright notice.   This software may not
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    32
 be provided or otherwise made available to, or used by, any
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    33
 other person.  No title to or ownership of the software is
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    34
 hereby transferred.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    35
"
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    36
!
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    37
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    38
documentation
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    39
"
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    40
    Shows memory usage (oldspace + newspace). Simple, but useful.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    41
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    42
    The numbers shown are:
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    43
	tot     total memory usage (i.e. allocated oldSpace + allocated newSpace)
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    44
		(does not include the second semispace and other help-areas,
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    45
		 such as the remembered set etc.)
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    46
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    47
	all     current oldSpace in use + newSpace in use
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    48
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    49
	new     current newSpace in use
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    50
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    51
	frl     free space in (fragmented) free lists
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    52
	fre     compact free area above the used oldSpace
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    53
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    54
	old     current oldSpace in use
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    55
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    56
	max,    extreme values of 'tot' since the monitor started
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    57
	min     (can be reset by typing 'r' in the view)
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    58
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    59
	t       tenure threshold
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    60
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    61
	I       incremental GC state
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    62
109
claus
parents: 108
diff changeset
    63
	weak    number of weak objects
claus
parents: 108
diff changeset
    64
108
claus
parents: 107
diff changeset
    65
	rem     size of rememberedSet
claus
parents: 107
diff changeset
    66
claus
parents: 107
diff changeset
    67
	minsc:  percent of newspace remaining after scavenge (worst case)
claus
parents: 107
diff changeset
    68
		(i.e. the minimum %% of scavenged objects)
claus
parents: 107
diff changeset
    69
claus
parents: 107
diff changeset
    70
	count   number of scavenges since system started
claus
parents: 107
diff changeset
    71
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    72
	%       percentage of live objects in newSpace after last scavenge
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    73
		(i.e. this is the garbage vs. living objects ratio of
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    74
		 newSpace objects after the last scavenge)
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    75
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    76
    the graphic shows:
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    77
	yellow  newSpace used
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    78
	green   free memory in freeLists
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    79
	white   oldSpace used
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    80
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    81
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    82
    the popupMenu offers GC functions; keyboard options are:
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    83
	'f' -> faster; 's' -> slower; 'r' -> reset min/max
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    84
"
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    85
! !
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    86
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    87
!MemoryMonitor class methodsFor:'defaults'!
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    88
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    89
defaultExtent
109
claus
parents: 108
diff changeset
    90
    ^ (200 @ 280)
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    91
!
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    92
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    93
defaultIcon
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    94
    |i|
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    95
93
claus
parents: 91
diff changeset
    96
    i := Image fromFile:'MemMonitor.xbm'.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    97
    i notNil ifTrue:[^ i].
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    98
    ^ super defaultIcon
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
    99
!
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   100
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   101
defaultLabel
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   102
    ^ 'Memory Monitor'
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   103
! !
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   104
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   105
!MemoryMonitor methodsFor:'destroying'!
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   106
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   107
destroy
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   108
    updateBlock notNil ifTrue:[
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   109
	Processor removeTimedBlock:updateBlock.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   110
    ] ifFalse:[
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   111
	myProcess terminate.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   112
	myProcess := nil
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   113
    ].
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   114
    oldData := newData := freeData := nil.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   115
    super destroy
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   116
! !
4cde336c0794 Initial revision
claus
parents:
diff changeset
   117
4cde336c0794 Initial revision
claus
parents:
diff changeset
   118
!MemoryMonitor methodsFor:'drawing'!
4cde336c0794 Initial revision
claus
parents:
diff changeset
   119
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   120
redraw
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   121
    "redraw all"
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   122
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   123
    self clear.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   124
    self redrawX:0 y:0 width:width height:height
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   125
!
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   126
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   127
redrawX:x y:y width:w height:h
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   128
    "redraw data"
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   129
107
claus
parents: 105
diff changeset
   130
    |total oldSpaceUsed newSpaceUsed freeMem lx startIdx endIdx
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   131
     right|
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   132
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   133
    shown ifFalse:[^ self].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   134
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   135
    right := x + w - 1.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   136
    right >= org ifTrue:[
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   137
	lx := x.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   138
	lx < org ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   139
	    lx := org
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   140
	].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   141
91
claus
parents: 85
diff changeset
   142
	total := ObjectMemory symSpaceSize 
57
36e13831b62d *** empty log message ***
claus
parents: 56
diff changeset
   143
		 + ObjectMemory oldSpaceSize 
36e13831b62d *** empty log message ***
claus
parents: 56
diff changeset
   144
		 + ObjectMemory newSpaceSize.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   145
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   146
	startIdx := (lx-org+1).
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   147
	startIdx < 1 ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   148
	    startIdx := 1
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   149
	].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   150
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   151
	endIdx := right-org+1.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   152
	endIdx >= updateIndex ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   153
	    endIdx := updateIndex-1.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   154
	].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   155
	dX := 0.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   156
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   157
	startIdx to:endIdx do:[:i |
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   158
	    newSpaceUsed := newData at:i.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   159
	    newSpaceUsed notNil ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   160
		oldSpaceUsed := oldData at:i.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   161
		freeMem := freeData at:i.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   162
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   163
		self updateLineX:lx - dX
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   164
		       total:total 
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   165
		       old:oldSpaceUsed 
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   166
		       new:newSpaceUsed 
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   167
		       free:freeMem.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   168
	    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   169
	    lx := lx + 1
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   170
	]
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   171
    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   172
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   173
    x < org ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   174
	prevFree := prevFree2 := prevOld := prevTotal := nil.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   175
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   176
	self updateNumbers.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   177
    ]
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   178
!
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   179
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   180
updateDisplay
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   181
    "update picture; trigger next update"
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   182
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   183
    |total oldSpaceUsed newSpaceUsed freeMem oldSpaceSize
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   184
     gWidth shift scaleChange margin mustWait|
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   185
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   186
    shown ifTrue:[
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   187
        oldSpaceUsed := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   188
        newSpaceUsed := ObjectMemory newSpaceUsed.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   189
        freeMem := ObjectMemory freeListSpace + (ObjectMemory oldSpaceSize - ObjectMemory oldSpaceUsed).
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   190
        oldSpaceSize := ObjectMemory oldSpaceSize + ObjectMemory symSpaceSize.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   191
        total := oldSpaceSize + ObjectMemory newSpaceSize.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   192
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   193
        scaleChange := false.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   194
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   195
        ((total - freeMem) < minTotal) ifTrue:[
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   196
            minTotal := total - freeMem.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   197
            scaleChange := true
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   198
        ].
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   199
        (total > maxTotal) ifTrue:[
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   200
            maxTotal := total.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   201
            scaleChange := true
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   202
        ].
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   203
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   204
        oldData at:updateIndex put:oldSpaceSize. "/ oldSpaceUsed.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   205
        newData at:updateIndex put:newSpaceUsed.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   206
        freeData at:updateIndex put:freeMem.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   207
        updateIndex := updateIndex + 1.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   208
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   209
        scaleChange ifTrue:[
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   210
            scale := height asFloat / (maxTotal + 100000).
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   211
            self redraw
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   212
        ].
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   213
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   214
        gWidth := width - org.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   215
        margin := 1.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   216
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   217
        mustWait := false.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   218
        ((updateIndex-1) >= (gWidth - margin)) ifTrue:[
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   219
"on slow displays, use:"
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   220
"/            shift := gWidth // 4.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   221
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   222
"for smooth display, use:"
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   223
            shift := 1.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   224
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   225
            oldData replaceFrom:1 with:oldData startingAt:shift+1.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   226
            newData replaceFrom:1 with:newData startingAt:shift+1.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   227
            freeData replaceFrom:1 with:freeData startingAt:shift+1.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   228
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   229
            updateIndex := updateIndex - shift.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   230
            dX := dX + shift.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   231
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   232
            self catchExpose.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   233
            self copyFrom:self 
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   234
                        x:(org + shift) y:0
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   235
                      toX:org y:0
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   236
                    width:(gWidth - shift - margin)
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   237
                   height:height.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   238
            self clearRectangleX:(width - margin - shift) y:0 
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   239
                           width:shift height:height.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   240
            mustWait := true.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   241
        ].
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   242
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   243
        self updateLineX:(updateIndex - 1 + org - 1)
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   244
                   total:total 
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   245
                   old:oldSpaceSize "/ oldSpaceUsed
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   246
                   new:newSpaceUsed 
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   247
                   free:freeMem.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   248
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   249
        self updateNumbers.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   250
        self flush.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   251
        mustWait ifTrue:[
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   252
            self waitForExpose.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   253
        ]
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   254
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   255
    ].
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   256
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   257
    updateBlock notNil ifTrue:[
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   258
        Processor addTimedBlock:updateBlock afterSeconds:updateInterval
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   259
    ].
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   260
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   261
    "Modified: 18.12.1995 / 15:21:10 / cg"
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   262
!
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   263
109
claus
parents: 108
diff changeset
   264
updateLineX:x total:total old:oldSpaceSize new:newSpaceUsed free:freeMem
claus
parents: 108
diff changeset
   265
    |hNew hOld hFree y1 y2 y3|
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   266
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   267
    hNew := (newSpaceUsed * scale) asInteger.
109
claus
parents: 108
diff changeset
   268
    hOld := (oldSpaceSize * scale) // 2.
claus
parents: 108
diff changeset
   269
    hFree := (freeMem * scale) // 2.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   270
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   271
    y1 := height - 1.
109
claus
parents: 108
diff changeset
   272
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   273
    y2 := y1 - hOld.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   274
    self paint:oldColor.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   275
    self displayLineFromX:x y:y1 toX:x y:y2.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   276
109
claus
parents: 108
diff changeset
   277
    y3 := y1 - hFree.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   278
    self paint:freeColor.
109
claus
parents: 108
diff changeset
   279
    self displayLineFromX:x y:y1 toX:x y:y3.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   280
109
claus
parents: 108
diff changeset
   281
    y1 := y2 - hNew.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   282
    self paint:newColor.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   283
    self displayLineFromX:x y:y1 toX:x y:y2.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   284
!
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   285
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   286
updateNumbers
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   287
    "redraw numbers.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   288
     The values shown are:
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   289
	max:    maximum memory used since monitor started
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   290
	min:    minimum memory used since monitor started
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   291
	tot:    total memory used (overall oldSpace + overall newSpace)
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   292
	all:    current memory in use (oldSpace + newSpace)
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   293
	new:    current newSpace in use
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   294
	free:   current size of freelist in oldSpace
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   295
	old:    current oldSpace in use
156
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   296
	t:      current tenure age
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   297
	I:      IGC state
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   298
	weak:   number of weak arrays in the system
108
claus
parents: 107
diff changeset
   299
	rem     remembered set size
109
claus
parents: 108
diff changeset
   300
	lrem    lifo remembered set size
156
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   301
	minsc:  percent of newspace remaining after scavenge (worst case)
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   302
	irq:    max. interrupt delay
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   303
	count of scavenges / last scavenge survivor rate
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   304
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   305
    "
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   306
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   307
    |oldSpaceSize newSpaceSize memUsed oldMemUsed newMemUsed freeMem free2 
107
claus
parents: 105
diff changeset
   308
     y half s fontHeight total n|
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   309
91
claus
parents: 85
diff changeset
   310
    oldMemUsed := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   311
    newMemUsed := ObjectMemory newSpaceUsed.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   312
    freeMem := ObjectMemory freeListSpace.
91
claus
parents: 85
diff changeset
   313
    oldSpaceSize := ObjectMemory oldSpaceSize + ObjectMemory symSpaceSize.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   314
    newSpaceSize := ObjectMemory newSpaceSize.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   315
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   316
    memUsed := oldMemUsed + newMemUsed "- freeMem".
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   317
    total := oldSpaceSize + newSpaceSize.
68
b70257a99e48 *** empty log message ***
claus
parents: 61
diff changeset
   318
    free2 := ObjectMemory freeSpace.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   319
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   320
    self paint:White on:Black.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   321
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   322
    fontHeight := font height + font descent.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   323
    half := height // 2 + font descent.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   324
109
claus
parents: 108
diff changeset
   325
    y := half - (fontHeight * 5).
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   326
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   327
    total ~~ prevTotal ifTrue:[
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   328
	((total - freeMem) < minTotal) ifTrue:[
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   329
	    minTotal := total - freeMem.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   330
	].
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   331
	(total > maxTotal) ifTrue:[
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   332
	    maxTotal := total.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   333
	].
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   334
60
claus
parents: 57
diff changeset
   335
	s := 'max ' , ((maxTotal // 1024) printStringLeftPaddedTo:5) , 'k '.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   336
	self displayOpaqueString:s x:0 y:font ascent.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   337
60
claus
parents: 57
diff changeset
   338
	s := 'min ' , ((minTotal // 1024) printStringLeftPaddedTo:5) , 'k '.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   339
	self displayOpaqueString:s x:0 y:(height - font descent).
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   340
60
claus
parents: 57
diff changeset
   341
	s := 'tot ' , ((total  // 1024) printStringLeftPaddedTo:5) , 'k '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   342
	self displayOpaqueString:s x:0 y:y.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   343
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   344
	prevTotal := total.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   345
    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   346
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   347
    y := y + fontHeight.
60
claus
parents: 57
diff changeset
   348
    s := 'all ' , ((memUsed // 1024) printStringLeftPaddedTo:5) , 'k '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   349
    self displayOpaqueString:s x:0 y:y.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   350
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   351
    y := y + fontHeight.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   352
    self paint:newColor.
60
claus
parents: 57
diff changeset
   353
    s := 'new ' , ((newMemUsed // 1024) printStringLeftPaddedTo:5) , 'k '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   354
    self displayOpaqueString:s x:0 y:y.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   355
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   356
    y := y + fontHeight.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   357
    freeMem ~~ prevFree ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   358
	self paint:freeColor.
60
claus
parents: 57
diff changeset
   359
	s := 'frl ' , ((freeMem // 1024) printStringLeftPaddedTo:5) , 'k '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   360
	self displayOpaqueString:s x:0 y:y.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   361
	prevFree := freeMem.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   362
    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   363
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   364
    y := y + fontHeight.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   365
    free2 ~~ prevFree2 ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   366
	self paint:freeColor.
60
claus
parents: 57
diff changeset
   367
	s := 'fre ' , ((free2 // 1024) printStringLeftPaddedTo:5) , 'k '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   368
	self displayOpaqueString:s x:0 y:y.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   369
	prevFree2 := free2.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   370
    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   371
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   372
    y := y + fontHeight.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   373
    (oldMemUsed - freeMem) ~~ prevOld ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   374
	self paint:oldColor.
60
claus
parents: 57
diff changeset
   375
	s := 'old ' , (((oldMemUsed - freeMem) // 1024) printStringLeftPaddedTo:5) , 'k '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   376
	self displayOpaqueString:s x:0 y:y.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   377
	prevOld := (oldMemUsed - freeMem).
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   378
    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   379
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   380
    "
303
1d94813f1977 interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents: 168
diff changeset
   381
     the following is internal - normally only interesting when debugging the VM
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   382
    "
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   383
    y := y + fontHeight.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   384
    self paint:oldColor.
60
claus
parents: 57
diff changeset
   385
    s := 't:' , (ObjectMemory tenureAge printStringLeftPaddedTo:2) , ' '.
108
claus
parents: 107
diff changeset
   386
    s := s , ' I:' , (ObjectMemory incrementalGCPhase printStringLeftPaddedTo:2) , ' '.
claus
parents: 107
diff changeset
   387
    self displayOpaqueString:s x:0 y:y.
claus
parents: 107
diff changeset
   388
claus
parents: 107
diff changeset
   389
    y := y + fontHeight.
109
claus
parents: 108
diff changeset
   390
    s := 'weak: ' , (ObjectMemory numberOfWeakObjects printStringLeftPaddedTo:4).
claus
parents: 108
diff changeset
   391
    self displayOpaqueString:s x:0 y:y.
claus
parents: 108
diff changeset
   392
claus
parents: 108
diff changeset
   393
    y := y + fontHeight.
108
claus
parents: 107
diff changeset
   394
    s := 'rem: ' , (ObjectMemory rememberedSetSize printStringLeftPaddedTo:5).
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   395
    self displayOpaqueString:s x:0 y:y.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   396
109
claus
parents: 108
diff changeset
   397
    y := y + fontHeight.
claus
parents: 108
diff changeset
   398
    s := 'lrem: ' , (ObjectMemory lifoRememberedSetSize printStringLeftPaddedTo:4 ifLarger:['****']).
claus
parents: 108
diff changeset
   399
    self displayOpaqueString:s x:0 y:y.
claus
parents: 108
diff changeset
   400
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   401
"/ does no longer make sense to show ....
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   402
"/    y := y + fontHeight.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   403
"/    ObjectMemory runsSingleOldSpace ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   404
"/        self displayOpaqueString:'single' x:0 y:(half + (fontHeight*4)).
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   405
"/    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   406
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   407
    y := y + fontHeight.
108
claus
parents: 107
diff changeset
   408
    n := ObjectMemory minScavengeReclamation / ObjectMemory newSpaceSize * 100.0.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   409
    n := 100 - n asInteger.
108
claus
parents: 107
diff changeset
   410
    s := 'minSc ', (n printStringLeftPaddedTo:3) , '%'.
claus
parents: 107
diff changeset
   411
    self displayOpaqueString:s x:0 y:y.
claus
parents: 107
diff changeset
   412
claus
parents: 107
diff changeset
   413
    y := y + fontHeight.
157
77f56399cc5f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 156
diff changeset
   414
    n := ObjectMemory maxInterruptLatency.
156
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   415
    n notNil ifTrue:[
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   416
	s := 'irq ', (n printStringLeftPaddedTo:3) , ' ms'.
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   417
    ] ifFalse:[
159
159f86b6395a comments added
Claus Gittinger <cg@exept.de>
parents: 158
diff changeset
   418
	s := ''
156
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   419
    ].
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   420
    self displayOpaqueString:s x:0 y:y.
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   421
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   422
    y := y + fontHeight.
108
claus
parents: 107
diff changeset
   423
    n := ObjectMemory lastScavengeReclamation / ObjectMemory newSpaceSize * 100.0.
claus
parents: 107
diff changeset
   424
    n := 100 - n asInteger.
claus
parents: 107
diff changeset
   425
    s := (ObjectMemory scavengeCount printStringLeftPaddedTo:6)
75
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   426
	 , (n printStringLeftPaddedTo:3) , '%'.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   427
    self displayOpaqueString:s x:0 y:y.
156
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   428
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   429
    "Created: 7.11.1995 / 14:48:16 / cg"
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   430
! !
4cde336c0794 Initial revision
claus
parents:
diff changeset
   431
4cde336c0794 Initial revision
claus
parents:
diff changeset
   432
!MemoryMonitor methodsFor:'events'!
4cde336c0794 Initial revision
claus
parents:
diff changeset
   433
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   434
keyPress:key x:x y:y
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   435
    key == $f ifTrue:[
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   436
	"faster"
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   437
	updateInterval := updateInterval / 2
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   438
    ].
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   439
    key == $s ifTrue:[
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   440
	"slower"
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   441
	updateInterval := updateInterval * 2
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   442
    ].
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   443
    key == $r ifTrue:[
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   444
	"reset max"
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   445
	maxTotal := prevTotal.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   446
	scale := height asFloat / (maxTotal + 100000).
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   447
	self resetStatisticValues.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   448
	self redraw.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   449
    ]
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   450
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   451
    "Modified: 7.11.1995 / 17:45:13 / cg"
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   452
!
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   453
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   454
sizeChanged:how
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   455
    |nn no nf delta oldSize newSize|
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   456
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   457
    super sizeChanged:how.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   458
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   459
    oldSize := oldData size.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   460
    newSize := width-org+1.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   461
168
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   462
    (newSize ~~ oldSize) ifTrue:[
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   463
	nn := Array new:newSize.
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   464
	no := Array new:newSize.
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   465
	nf := Array new:newSize.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   466
168
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   467
	(newSize > oldSize) ifTrue:[
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   468
	    nn replaceFrom:1 to:oldSize with:newData.
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   469
	    no replaceFrom:1 to:oldSize with:oldData.
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   470
	    nf replaceFrom:1 to:oldSize with:freeData
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   471
	] ifFalse:[
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   472
	    delta := (oldSize - newSize).
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   473
	    nn replaceFrom:1 with:newData startingAt:delta+1.
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   474
	    no replaceFrom:1 with:oldData startingAt:delta+1.
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   475
	    nf replaceFrom:1 with:freeData startingAt:delta+1.
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   476
	    updateIndex > newSize ifTrue:[
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   477
		updateIndex := updateIndex - delta.
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   478
	    ]
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   479
	].
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   480
	newData := nn.
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   481
	oldData := no.
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   482
	freeData := nf.
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   483
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   484
	scale := height asFloat / (maxTotal + 100000).
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   485
    ].
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   486
    self clear.
168
0ca5ca046b22 Redraw text on vertical window size changes.
Stefan Vogel <sv@exept.de>
parents: 165
diff changeset
   487
    self redraw.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   488
! !
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   489
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   490
!MemoryMonitor methodsFor:'initialization'!
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   491
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   492
initialize
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   493
    super initialize.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   494
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   495
    updateInterval := 0.5.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   496
    ProcessorScheduler isPureEventDriven ifTrue:[
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   497
	updateBlock := [self updateDisplay].
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   498
    ].
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   499
    oldData := Array new:1000.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   500
    newData := Array new:1000.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   501
    freeData := Array new:1000.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   502
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   503
    updateIndex := 1.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   504
    org := font widthOf:'max 99999k'.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   505
    level := 0.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   506
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   507
    maxTotal := minTotal := ObjectMemory oldSpaceSize 
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   508
			    + ObjectMemory symSpaceSize
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   509
			    + ObjectMemory newSpaceSize.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   510
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   511
    viewBackground := Black.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   512
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   513
    device hasColors ifTrue:[
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   514
	newColor := Color orange. "/ yellow.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   515
	freeColor := Color green.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   516
	oldColor := Color white.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   517
    ] ifFalse:[
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   518
	newColor := Color grey:67.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   519
	freeColor := Color grey:33.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   520
	oldColor := Color white.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   521
    ].
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   522
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   523
    self font:(Font family:'courier' face:'medium' style:'roman' size:10).
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   524
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   525
    self model:self.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   526
    self menu:#memoryMenu
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   527
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   528
    "
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   529
     MemoryMonitor open
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   530
    "
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   531
!
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   532
85
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   533
memoryMenu
323
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   534
    |m specialMenu labels selectors|
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   535
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   536
    labels :=    #(
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   537
                    'scavenge'
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   538
                    'tenure'
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   539
                    'incremental collect'
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   540
                    'reset statistic values'
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   541
                    '-'
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   542
                    'cleanup memory'
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   543
                    '-'
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   544
                    'compress sources'
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   545
                  ).
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   546
    selectors := #(
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   547
                    scavenge
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   548
                    tenure
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   549
                    incrementalCollect
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   550
                    resetStatisticValues
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   551
                    nil
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   552
                    cleanupMemory
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   553
                    nil
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   554
                    compressSources
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   555
                  ).
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   556
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   557
    specialMenu := PopUpMenu
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   558
                        labels:(resources array:labels)
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   559
                        selectors:selectors.
85
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   560
105
claus
parents: 93
diff changeset
   561
    device ctrlDown ifTrue:[
323
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   562
        ^ specialMenu
105
claus
parents: 93
diff changeset
   563
    ].
85
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   564
323
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   565
    labels :=    #(
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   566
                    'collect garbage'
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   567
                    'collect garbage & symbols'
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   568
                    'collect garbage & compress'
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   569
                    '-'
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   570
                    'background collect'
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   571
                    '-'
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   572
                    'others'
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   573
                  ).
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   574
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   575
    selectors := #(
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   576
                    garbageCollect
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   577
                    garbageCollectAndSymbols
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   578
                    compressingGarbageCollect
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   579
                    nil
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   580
                    backgroundCollect
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   581
                    nil
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   582
                    otherMenu
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   583
                  ).
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   584
    m := PopUpMenu labels:(resources array:labels)
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   585
                   selectors:selectors.
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   586
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   587
    m subMenuAt:#otherMenu put:specialMenu.
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   588
    ^ m
85
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   589
!
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   590
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   591
realize
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   592
    super realize.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   593
    updateBlock notNil ifTrue:[
93
claus
parents: 91
diff changeset
   594
	Processor addTimedBlock:updateBlock afterSeconds:updateInterval.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   595
    ] ifFalse:[
93
claus
parents: 91
diff changeset
   596
	myProcess := [
claus
parents: 91
diff changeset
   597
	    |d|
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   598
93
claus
parents: 91
diff changeset
   599
	    [true] whileTrue:[
claus
parents: 91
diff changeset
   600
		(Delay forSeconds:updateInterval) wait.
claus
parents: 91
diff changeset
   601
		self updateDisplay
claus
parents: 91
diff changeset
   602
	    ]
claus
parents: 91
diff changeset
   603
	] forkAt:6.
claus
parents: 91
diff changeset
   604
	myProcess name:'monitor [' , 
claus
parents: 91
diff changeset
   605
		       Processor activeProcess id printString ,
claus
parents: 91
diff changeset
   606
		       '] update'
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   607
    ].
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   608
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   609
    newColor := newColor on:device.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   610
    freeColor := freeColor on:device.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   611
    oldColor := oldColor on:device.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   612
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   613
    font := font on:device.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   614
! !
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   615
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   616
!MemoryMonitor methodsFor:'menu functions'!
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   617
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   618
backgroundCollect
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   619
    "start a background (non disturbing) incremental GC. 
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   620
     Since the GC is performed at a low priority, it may not make progress if higher
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   621
     prio processes are running"
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   622
 
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   623
    [
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   624
	ObjectMemory incrementalGC
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   625
    ] forkAt:5 
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   626
!
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   627
105
claus
parents: 93
diff changeset
   628
cleanupMemory
claus
parents: 93
diff changeset
   629
    "let all classes release unneeded, cached
claus
parents: 93
diff changeset
   630
     data ..."
claus
parents: 93
diff changeset
   631
claus
parents: 93
diff changeset
   632
    Smalltalk allBehaviorsDo:[:aClass |
claus
parents: 93
diff changeset
   633
	aClass lowSpaceCleanup
claus
parents: 93
diff changeset
   634
    ].
claus
parents: 93
diff changeset
   635
    "
claus
parents: 93
diff changeset
   636
     then, perform a GC (incl. symbol reclamation)
claus
parents: 93
diff changeset
   637
    "
claus
parents: 93
diff changeset
   638
    ObjectMemory reclaimSymbols.
claus
parents: 93
diff changeset
   639
    "
claus
parents: 93
diff changeset
   640
     finally, compress
claus
parents: 93
diff changeset
   641
    "
claus
parents: 93
diff changeset
   642
    ObjectMemory verboseGarbageCollect.
claus
parents: 93
diff changeset
   643
!
claus
parents: 93
diff changeset
   644
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   645
compressSources
323
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   646
    (self confirm:'This saves all in-memory source strings into a file
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   647
and makes methods reference these (file-) strings.
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   648
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   649
If that source file is ever lost or gets out of sync with
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   650
your system, those method sources are lost and the browser
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   651
will show garbage. 
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   652
However, you still have a change file as backup.
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   653
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   654
(Be especially careful, if you move images around:
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   655
 the source file must then be correct one for that image)
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   656
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   657
A compress is only useful, if you added many methods
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   658
and the systems response time suffers from paging.
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   659
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   660
Compress anyway ?') ifTrue:[
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   661
        Smalltalk compressSources.
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   662
        ObjectMemory markAndSweep
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   663
    ]
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   664
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   665
    "Modified: 23.12.1995 / 17:21:57 / cg"
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   666
!
156
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   667
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   668
compressingGarbageCollect
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   669
    "perform a blocking compressing garbage collect."
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   670
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   671
    ObjectMemory verboseGarbageCollect
156
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   672
!
e6a7f80e2a71 show irq latency
Claus Gittinger <cg@exept.de>
parents: 128
diff changeset
   673
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   674
garbageCollect
159
159f86b6395a comments added
Claus Gittinger <cg@exept.de>
parents: 158
diff changeset
   675
    "perform a blocking (non compressing) garbage collect"
159f86b6395a comments added
Claus Gittinger <cg@exept.de>
parents: 158
diff changeset
   676
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   677
    ObjectMemory markAndSweep
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   678
!
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   679
105
claus
parents: 93
diff changeset
   680
garbageCollectAndSymbols
159
159f86b6395a comments added
Claus Gittinger <cg@exept.de>
parents: 158
diff changeset
   681
    "perform a blocking (non compressing) garbage collect
159f86b6395a comments added
Claus Gittinger <cg@exept.de>
parents: 158
diff changeset
   682
     and reclaim unreferenced symbols."
159f86b6395a comments added
Claus Gittinger <cg@exept.de>
parents: 158
diff changeset
   683
105
claus
parents: 93
diff changeset
   684
    ObjectMemory reclaimSymbols
claus
parents: 93
diff changeset
   685
!
claus
parents: 93
diff changeset
   686
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   687
incrementalCollect
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   688
    "start an incremental GC which does not disturb too much, but is guaranteed to
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   689
     make progress.
323
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   690
     This is done by doing the IGC at a very high priority, but giving up the CPU after
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   691
     every step. Due to the long delays, this may take a while to finish.
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   692
     Notice, that this is different from doing a background collect: that one
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   693
     may not make any progress if higher prio processes are runnable."
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   694
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   695
    |done delay|
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   696
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   697
    [
323
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   698
        done := false.
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   699
        delay := Delay new.
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   700
        [done] whileFalse:[
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   701
            10 timesRepeat:[
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   702
                done ifFalse:[done := ObjectMemory gcStep].
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   703
            ].
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   704
            (delay delay:10) wait
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   705
        ]
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   706
    ] forkAt:Processor highestPriority
323
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   707
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   708
    "Modified: 23.12.1995 / 17:31:55 / cg"
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   709
!
159
159f86b6395a comments added
Claus Gittinger <cg@exept.de>
parents: 158
diff changeset
   710
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   711
resetStatisticValues 
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   712
    ObjectMemory resetMaxInterruptLatency.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   713
    ObjectMemory resetMinScavengeReclamation.
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   714
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   715
    "Created: 7.11.1995 / 17:44:59 / cg"
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   716
!
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   717
105
claus
parents: 93
diff changeset
   718
scavenge 
159
159f86b6395a comments added
Claus Gittinger <cg@exept.de>
parents: 158
diff changeset
   719
    "perform a blocking newspace garbage collect.
159f86b6395a comments added
Claus Gittinger <cg@exept.de>
parents: 158
diff changeset
   720
     (this is for debugging only - the system does this automatically)"
159f86b6395a comments added
Claus Gittinger <cg@exept.de>
parents: 158
diff changeset
   721
105
claus
parents: 93
diff changeset
   722
    ObjectMemory scavenge
claus
parents: 93
diff changeset
   723
!
claus
parents: 93
diff changeset
   724
claus
parents: 93
diff changeset
   725
tenure 
159
159f86b6395a comments added
Claus Gittinger <cg@exept.de>
parents: 158
diff changeset
   726
    "empty the newSpace, by aging all new objects immediately and transfering them
159f86b6395a comments added
Claus Gittinger <cg@exept.de>
parents: 158
diff changeset
   727
     into oldSpace.
159f86b6395a comments added
Claus Gittinger <cg@exept.de>
parents: 158
diff changeset
   728
     (this is for debugging only - the system does this automatically)"
159f86b6395a comments added
Claus Gittinger <cg@exept.de>
parents: 158
diff changeset
   729
105
claus
parents: 93
diff changeset
   730
    ObjectMemory tenure
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   731
! !
105
claus
parents: 93
diff changeset
   732
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   733
!MemoryMonitor class methodsFor:'documentation'!
85
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   734
311
c118ce1f8afd flush in subprocess
Claus Gittinger <cg@exept.de>
parents: 303
diff changeset
   735
version
323
f443d7e5bab0 special menu published
Claus Gittinger <cg@exept.de>
parents: 311
diff changeset
   736
    ^ '$Header: /cvs/stx/stx/libtool/MemoryMonitor.st,v 1.30 1995-12-23 17:43:25 cg Exp $'
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   737
! !