MemoryMonitor.st
author claus
Tue, 06 Jun 1995 06:21:18 +0200
changeset 105 520f37755229
parent 93 dda97353e775
child 107 db1b370632d7
permissions -rw-r--r--
.
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
85
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
    13
'From Smalltalk/X, Version:2.10.5 on 22-mar-1995 at 7:43:35 am'!
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
    14
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    15
StandardSystemView subclass:#MemoryMonitor
85
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
    16
	 instanceVariableNames:'updateInterval updateBlock myProcess oldData newData freeData
93
claus
parents: 91
diff changeset
    17
		updateIndex org maxTotal minTotal dX newColor freeColor oldColor
claus
parents: 91
diff changeset
    18
		prevTotal prevFree prevFree2 prevOld scale'
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    19
	 classVariableNames:''
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    20
	 poolDictionaries:''
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
    21
	 category:'Interface-Tools'
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    22
!
4cde336c0794 Initial revision
claus
parents:
diff changeset
    23
4cde336c0794 Initial revision
claus
parents:
diff changeset
    24
MemoryMonitor comment:'
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    25
 COPYRIGHT (c) 1991 by Claus Gittinger
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    26
	      All Rights Reserved
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    27
105
claus
parents: 93
diff changeset
    28
$Header: /cvs/stx/stx/libtool/MemoryMonitor.st,v 1.15 1995-06-06 04:20:44 claus Exp $
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    29
'!
4cde336c0794 Initial revision
claus
parents:
diff changeset
    30
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    31
!MemoryMonitor class methodsFor:'documentation'!
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    32
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    33
copyright
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    34
"
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    35
 COPYRIGHT (c) 1991 by Claus Gittinger
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    36
	      All Rights Reserved
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    37
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    38
 This software is furnished under a license and may be used
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    39
 only in accordance with the terms of that license and with the
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    40
 inclusion of the above copyright notice.   This software may not
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    41
 be provided or otherwise made available to, or used by, any
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    42
 other person.  No title to or ownership of the software is
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    43
 hereby transferred.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    44
"
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    45
!
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    46
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    47
version
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    48
"
105
claus
parents: 93
diff changeset
    49
$Header: /cvs/stx/stx/libtool/MemoryMonitor.st,v 1.15 1995-06-06 04:20:44 claus Exp $
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    50
"
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    51
!
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    52
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    53
documentation
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    54
"
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    55
    Shows memory usage (oldspace + newspace). Simple, but useful.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    56
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    57
    The numbers shown are:
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    58
	tot     total memory usage (i.e. allocated oldSpace + allocated newSpace)
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    59
		(does not include the second semispace and other help-areas,
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    60
		 such as the remembered set etc.)
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    61
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    62
	all     current oldSpace in use + newSpace in use
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    63
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    64
	new     current newSpace in use
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    65
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    66
	frl     free space in (fragmented) free lists
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    67
	fre     compact free area above the used oldSpace
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    68
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    69
	old     current oldSpace in use
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    70
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    71
	max,    extreme values of 'tot' since the monitor started
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    72
	min     (can be reset by typing 'r' in the view)
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    73
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    74
	t       tenure threshold
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    75
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    76
	I       incremental GC state
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    77
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    78
	%       percentage of live objects in newSpace after last scavenge
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    79
		(i.e. this is the garbage vs. living objects ratio of
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    80
		 newSpace objects after the last scavenge)
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    81
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    82
    the graphic shows:
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    83
	yellow  newSpace used
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    84
	green   free memory in freeLists
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    85
	white   oldSpace used
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    86
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    87
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    88
    the popupMenu offers GC functions; keyboard options are:
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    89
	'f' -> faster; 's' -> slower; 'r' -> reset min/max
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    90
"
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    91
! !
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    92
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    93
!MemoryMonitor class methodsFor:'defaults'!
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    94
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    95
defaultExtent
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
    96
    ^ (200 @ 200)
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    97
!
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
    98
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
    99
defaultLabel
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   100
    ^ 'Memory Monitor'
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   101
!
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   102
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   103
defaultIcon
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   104
    |i|
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   105
93
claus
parents: 91
diff changeset
   106
    i := Image fromFile:'MemMonitor.xbm'.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   107
    i notNil ifTrue:[^ i].
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   108
    ^ super defaultIcon
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   109
! !
4cde336c0794 Initial revision
claus
parents:
diff changeset
   110
4cde336c0794 Initial revision
claus
parents:
diff changeset
   111
!MemoryMonitor methodsFor:'drawing'!
4cde336c0794 Initial revision
claus
parents:
diff changeset
   112
85
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   113
updateDisplay
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   114
    "update picture; trigger next update"
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   115
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   116
    |total oldSpaceUsed newSpaceUsed freeMem 
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   117
     gWidth shift scaleChange margin mustWait|
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   118
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   119
    shown ifTrue:[
91
claus
parents: 85
diff changeset
   120
	oldSpaceUsed := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed.
85
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   121
	newSpaceUsed := ObjectMemory newSpaceUsed.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   122
	freeMem := ObjectMemory freeListSpace.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   123
	total := oldSpaceUsed + newSpaceUsed.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   124
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   125
	scaleChange := false.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   126
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   127
	((total - freeMem) < minTotal) ifTrue:[
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   128
	    minTotal := total - freeMem.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   129
	    scaleChange := true
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   130
	].
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   131
	(total > maxTotal) ifTrue:[
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   132
	    maxTotal := total.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   133
	    scaleChange := true
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   134
	].
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   135
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   136
	oldData at:updateIndex put:oldSpaceUsed.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   137
	newData at:updateIndex put:newSpaceUsed.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   138
	freeData at:updateIndex put:freeMem.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   139
	updateIndex := updateIndex + 1.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   140
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   141
	scaleChange ifTrue:[
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   142
	    scale := height asFloat / (maxTotal + 100000).
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   143
	    self redraw
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   144
	].
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   145
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   146
	gWidth := width - org.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   147
	margin := 1.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   148
85
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   149
	mustWait := false.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   150
	((updateIndex-1) >= (gWidth - margin)) ifTrue:[
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   151
"on slow displays, use:"
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   152
"/            shift := gWidth // 4.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   153
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   154
"for smooth display, use:"
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   155
	    shift := 1.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   156
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   157
	    oldData replaceFrom:1 with:oldData startingAt:shift+1.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   158
	    newData replaceFrom:1 with:newData startingAt:shift+1.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   159
	    freeData replaceFrom:1 with:freeData startingAt:shift+1.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   160
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   161
	    updateIndex := updateIndex - shift.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   162
	    dX := dX + shift.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   163
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   164
	    self catchExpose.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   165
	    self copyFrom:self 
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   166
			x:(org + shift) y:0
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   167
		      toX:org y:0
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   168
		    width:(gWidth - shift - margin)
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   169
		   height:height.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   170
	    self clearRectangleX:(width - margin - shift) y:0 
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   171
			   width:shift height:height.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   172
	    mustWait := true.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   173
	].
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   174
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   175
	self updateLineX:(updateIndex - 1 + org - 1)
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   176
		   total:total 
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   177
		   old:oldSpaceUsed 
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   178
		   new:newSpaceUsed 
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   179
		   free:freeMem.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   180
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   181
	self updateNumbers.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   182
	mustWait ifTrue:[
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   183
	    self waitForExpose.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   184
	]
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   185
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   186
    ].
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   187
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   188
    updateBlock notNil ifTrue:[
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   189
	Processor addTimedBlock:updateBlock afterSeconds:updateInterval
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   190
    ].
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   191
!
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   192
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   193
redrawX:x y:y width:w height:h
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   194
    "redraw data"
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   195
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   196
    |total oldSpaceUsed newSpaceUsed freeMem lx s startIdx endIdx
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   197
     right|
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   198
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   199
    shown ifFalse:[^ self].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   200
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   201
    right := x + w - 1.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   202
    right >= org ifTrue:[
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   203
	lx := x.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   204
	lx < org ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   205
	    lx := org
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   206
	].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   207
91
claus
parents: 85
diff changeset
   208
	total := ObjectMemory symSpaceSize 
57
36e13831b62d *** empty log message ***
claus
parents: 56
diff changeset
   209
		 + ObjectMemory oldSpaceSize 
36e13831b62d *** empty log message ***
claus
parents: 56
diff changeset
   210
		 + ObjectMemory newSpaceSize.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   211
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   212
	startIdx := (lx-org+1).
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   213
	startIdx < 1 ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   214
	    startIdx := 1
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   215
	].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   216
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   217
	endIdx := right-org+1.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   218
	endIdx >= updateIndex ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   219
	    endIdx := updateIndex-1.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   220
	].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   221
	dX := 0.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   222
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   223
	startIdx to:endIdx do:[:i |
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   224
	    newSpaceUsed := newData at:i.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   225
	    newSpaceUsed notNil ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   226
		oldSpaceUsed := oldData at:i.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   227
		freeMem := freeData at:i.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   228
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   229
		self updateLineX:lx - dX
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   230
		       total:total 
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   231
		       old:oldSpaceUsed 
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   232
		       new:newSpaceUsed 
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   233
		       free:freeMem.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   234
	    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   235
	    lx := lx + 1
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   236
	]
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   237
    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   238
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   239
    x < org ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   240
	prevFree := prevFree2 := prevOld := prevTotal := nil.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   241
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   242
	self updateNumbers.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   243
    ]
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   244
!
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   245
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   246
updateLineX:x total:total old:oldSpaceUsed new:newSpaceUsed free:freeMem
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   247
    |hNew hOld hFree y1 y2|
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   248
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   249
    hNew := (newSpaceUsed * scale) asInteger.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   250
    hOld := (oldSpaceUsed * scale) // 2.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   251
    hFree := (freeMem * scale) asInteger.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   252
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   253
    y1 := height - 1.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   254
    y2 := y1 - hOld.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   255
    self paint:oldColor.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   256
    self displayLineFromX:x y:y1 toX:x y:y2.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   257
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   258
    y1 := y2.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   259
    y2 := y1 - hFree.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   260
    self paint:freeColor.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   261
    self displayLineFromX:x y:y1 toX:x y:y2.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   262
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   263
    y1 := y2.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   264
    y2 := y1 - hNew.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   265
    self paint:newColor.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   266
    self displayLineFromX:x y:y1 toX:x y:y2.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   267
!
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   268
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   269
updateNumbers
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   270
    "redraw numbers.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   271
     The values shown are:
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   272
	max:    maximum memory used since monitor started
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   273
	min:    minimum memory used since monitor started
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   274
	tot:    total memory used (overall oldSpace + overall newSpace)
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   275
	all:    current memory in use (oldSpace + newSpace)
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   276
	new:    current newSpace in use
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   277
	free:   current size of freelist in oldSpace
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   278
	old:    current oldSpace in use
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   279
    "
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   280
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   281
    |oldSpaceSize newSpaceSize memUsed oldMemUsed newMemUsed freeMem free2 
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   282
     x y half s thisStringLen fontHeight total n|
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   283
91
claus
parents: 85
diff changeset
   284
    oldMemUsed := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   285
    newMemUsed := ObjectMemory newSpaceUsed.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   286
    freeMem := ObjectMemory freeListSpace.
91
claus
parents: 85
diff changeset
   287
    oldSpaceSize := ObjectMemory oldSpaceSize + ObjectMemory symSpaceSize.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   288
    newSpaceSize := ObjectMemory newSpaceSize.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   289
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   290
    memUsed := oldMemUsed + newMemUsed "- freeMem".
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   291
    total := oldSpaceSize + newSpaceSize.
68
b70257a99e48 *** empty log message ***
claus
parents: 61
diff changeset
   292
    free2 := ObjectMemory freeSpace.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   293
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   294
    self paint:White on:Black.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   295
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   296
    fontHeight := font height + font descent.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   297
    half := height // 2 + font descent.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   298
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   299
    y := half - (fontHeight * 3).
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   300
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   301
    total ~~ prevTotal ifTrue:[
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   302
	((total - freeMem) < minTotal) ifTrue:[
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   303
	    minTotal := total - freeMem.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   304
	].
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   305
	(total > maxTotal) ifTrue:[
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   306
	    maxTotal := total.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   307
	].
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   308
60
claus
parents: 57
diff changeset
   309
	s := 'max ' , ((maxTotal // 1024) printStringLeftPaddedTo:5) , 'k '.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   310
	self displayOpaqueString:s x:0 y:font ascent.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   311
60
claus
parents: 57
diff changeset
   312
	s := 'min ' , ((minTotal // 1024) printStringLeftPaddedTo:5) , 'k '.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   313
	self displayOpaqueString:s x:0 y:(height - font descent).
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   314
60
claus
parents: 57
diff changeset
   315
	s := 'tot ' , ((total  // 1024) printStringLeftPaddedTo:5) , 'k '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   316
	self displayOpaqueString:s x:0 y:y.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   317
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   318
	prevTotal := total.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   319
    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   320
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   321
    y := y + fontHeight.
60
claus
parents: 57
diff changeset
   322
    s := 'all ' , ((memUsed // 1024) printStringLeftPaddedTo:5) , 'k '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   323
    self displayOpaqueString:s x:0 y:y.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   324
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   325
    y := y + fontHeight.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   326
    self paint:newColor.
60
claus
parents: 57
diff changeset
   327
    s := 'new ' , ((newMemUsed // 1024) printStringLeftPaddedTo:5) , 'k '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   328
    self displayOpaqueString:s x:0 y:y.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   329
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   330
    y := y + fontHeight.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   331
    freeMem ~~ prevFree ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   332
	self paint:freeColor.
60
claus
parents: 57
diff changeset
   333
	s := 'frl ' , ((freeMem // 1024) printStringLeftPaddedTo:5) , 'k '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   334
	self displayOpaqueString:s x:0 y:y.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   335
	prevFree := freeMem.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   336
    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   337
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   338
    y := y + fontHeight.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   339
    free2 ~~ prevFree2 ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   340
	self paint:freeColor.
60
claus
parents: 57
diff changeset
   341
	s := 'fre ' , ((free2 // 1024) printStringLeftPaddedTo:5) , 'k '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   342
	self displayOpaqueString:s x:0 y:y.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   343
	prevFree2 := free2.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   344
    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   345
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   346
    y := y + fontHeight.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   347
    (oldMemUsed - freeMem) ~~ prevOld ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   348
	self paint:oldColor.
60
claus
parents: 57
diff changeset
   349
	s := 'old ' , (((oldMemUsed - freeMem) // 1024) printStringLeftPaddedTo:5) , 'k '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   350
	self displayOpaqueString:s x:0 y:y.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   351
	prevOld := (oldMemUsed - freeMem).
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   352
    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   353
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   354
    "
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   355
     the following is internal - normally only interresting when debugging the VM
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   356
    "
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   357
    y := y + fontHeight.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   358
    self paint:oldColor.
60
claus
parents: 57
diff changeset
   359
    s := 't:' , (ObjectMemory tenureAge printStringLeftPaddedTo:2) , ' '.
claus
parents: 57
diff changeset
   360
    s := s , 'I:' , (ObjectMemory incrementalGCPhase printStringLeftPaddedTo:2) , ' '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   361
    self displayOpaqueString:s x:0 y:y.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   362
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   363
"/ does no longer make sense to show ....
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   364
"/    y := y + fontHeight.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   365
"/    ObjectMemory runsSingleOldSpace ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   366
"/        self displayOpaqueString:'single' x:0 y:(half + (fontHeight*4)).
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   367
"/    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   368
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   369
    y := y + fontHeight.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   370
    n := ObjectMemory lastScavangeReclamation / ObjectMemory newSpaceSize * 100.0.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   371
    n := 100 - n asInteger.
75
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   372
    s := (ObjectMemory scavengeCount printStringLeftPaddedTo:5)
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   373
	 , (n printStringLeftPaddedTo:3) , '%'.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   374
    self displayOpaqueString:s x:0 y:y.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   375
!
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   376
85
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   377
redraw
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   378
    "redraw all"
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   379
85
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   380
    self clear.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   381
    self redrawX:0 y:0 width:width height:height
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   382
! !
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   383
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   384
!MemoryMonitor methodsFor:'destroying'!
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   385
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   386
destroy
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   387
    updateBlock notNil ifTrue:[
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   388
	Processor removeTimedBlock:updateBlock.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   389
    ] ifFalse:[
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   390
	myProcess terminate.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   391
	myProcess := nil
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   392
    ].
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   393
    oldData := newData := freeData := nil.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   394
    super destroy
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   395
! !
4cde336c0794 Initial revision
claus
parents:
diff changeset
   396
4cde336c0794 Initial revision
claus
parents:
diff changeset
   397
!MemoryMonitor methodsFor:'events'!
4cde336c0794 Initial revision
claus
parents:
diff changeset
   398
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   399
sizeChanged:how
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   400
    |nn no nf delta oldSize newSize|
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   401
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   402
    super sizeChanged:how.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   403
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   404
    oldSize := oldData size.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   405
    newSize := width-org+1.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   406
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   407
    (newSize == oldSize) ifTrue:[^ self].
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   408
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   409
    nn := Array new:newSize.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   410
    no := Array new:newSize.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   411
    nf := Array new:newSize.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   412
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   413
    (newSize > oldSize) ifTrue:[
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   414
	nn replaceFrom:1 to:oldSize with:newData.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   415
	no replaceFrom:1 to:oldSize with:oldData.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   416
	nf replaceFrom:1 to:oldSize with:freeData
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   417
    ] ifFalse:[
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   418
	delta := (oldSize - newSize).
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   419
	nn replaceFrom:1 with:newData startingAt:delta+1.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   420
	no replaceFrom:1 with:oldData startingAt:delta+1.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   421
	nf replaceFrom:1 with:freeData startingAt:delta+1.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   422
	updateIndex > newSize ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   423
	    updateIndex := updateIndex - delta.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   424
	]
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   425
    ].
4cde336c0794 Initial revision
claus
parents:
diff changeset
   426
    newData := nn.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   427
    oldData := no.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   428
    freeData := nf.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   429
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   430
    scale := height asFloat / (maxTotal + 100000).
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   431
    self clear.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   432
    self redraw
85
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   433
!
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   434
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   435
keyPress:key x:x y:y
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   436
    key == $f ifTrue:[
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   437
	"faster"
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   438
	updateInterval := updateInterval / 2
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   439
    ].
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   440
    key == $s ifTrue:[
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   441
	"slower"
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   442
	updateInterval := updateInterval * 2
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   443
    ].
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   444
    key == $r ifTrue:[
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   445
	"reset max"
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   446
	maxTotal := prevTotal.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   447
	scale := height asFloat / (maxTotal + 100000).
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   448
	self redraw.
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   449
    ]
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   450
! !
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   451
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   452
!MemoryMonitor methodsFor:'initialization'!
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   453
85
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   454
memoryMenu
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   455
    |labels selectors|
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   456
105
claus
parents: 93
diff changeset
   457
    device ctrlDown ifTrue:[
claus
parents: 93
diff changeset
   458
	labels :=    #(
claus
parents: 93
diff changeset
   459
			'scavenge'
claus
parents: 93
diff changeset
   460
			'tenure'
claus
parents: 93
diff changeset
   461
			'-'
claus
parents: 93
diff changeset
   462
			'cleanup memory'
claus
parents: 93
diff changeset
   463
		      ).
claus
parents: 93
diff changeset
   464
	selectors := #(
claus
parents: 93
diff changeset
   465
			scavenge
claus
parents: 93
diff changeset
   466
			tenure
claus
parents: 93
diff changeset
   467
			nil
claus
parents: 93
diff changeset
   468
			cleanupMemory
claus
parents: 93
diff changeset
   469
		      ).
claus
parents: 93
diff changeset
   470
    ] ifFalse:[
claus
parents: 93
diff changeset
   471
	labels :=    #(
claus
parents: 93
diff changeset
   472
			'collect garbage'
claus
parents: 93
diff changeset
   473
			'collect garbage & symbols'
claus
parents: 93
diff changeset
   474
			'collect garbage & compress'
claus
parents: 93
diff changeset
   475
			'-'
claus
parents: 93
diff changeset
   476
			'background collect'
claus
parents: 93
diff changeset
   477
			'-'
claus
parents: 93
diff changeset
   478
			'compress sources'
claus
parents: 93
diff changeset
   479
		      ).
85
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   480
105
claus
parents: 93
diff changeset
   481
	selectors := #(
claus
parents: 93
diff changeset
   482
			garbageCollect
claus
parents: 93
diff changeset
   483
			garbageCollectAndSymbols
claus
parents: 93
diff changeset
   484
			compressingGarbageCollect
claus
parents: 93
diff changeset
   485
			nil
claus
parents: 93
diff changeset
   486
			backgroundCollect
claus
parents: 93
diff changeset
   487
			nil
claus
parents: 93
diff changeset
   488
			compressSources
claus
parents: 93
diff changeset
   489
		      ).
claus
parents: 93
diff changeset
   490
    ].
85
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   491
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   492
    ^ PopUpMenu labels:(resources array:labels)
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   493
		 selectors:selectors
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   494
		receiver:self
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   495
!
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   496
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   497
realize
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   498
    super realize.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   499
    updateBlock notNil ifTrue:[
93
claus
parents: 91
diff changeset
   500
	Processor addTimedBlock:updateBlock afterSeconds:updateInterval.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   501
    ] ifFalse:[
93
claus
parents: 91
diff changeset
   502
	myProcess := [
claus
parents: 91
diff changeset
   503
	    |d|
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   504
93
claus
parents: 91
diff changeset
   505
	    [true] whileTrue:[
claus
parents: 91
diff changeset
   506
		(Delay forSeconds:updateInterval) wait.
claus
parents: 91
diff changeset
   507
		self updateDisplay
claus
parents: 91
diff changeset
   508
	    ]
claus
parents: 91
diff changeset
   509
	] forkAt:6.
claus
parents: 91
diff changeset
   510
	myProcess name:'monitor [' , 
claus
parents: 91
diff changeset
   511
		       Processor activeProcess id printString ,
claus
parents: 91
diff changeset
   512
		       '] update'
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   513
    ].
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   514
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   515
    newColor := newColor on:device.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   516
    freeColor := freeColor on:device.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   517
    oldColor := oldColor on:device.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   518
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   519
    font := font on:device.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   520
!
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   521
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   522
initialize
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   523
    super initialize.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   524
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   525
    updateInterval := 0.5.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   526
    ProcessorScheduler isPureEventDriven ifTrue:[
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   527
	updateBlock := [self updateDisplay].
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   528
    ].
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   529
    oldData := Array new:1000.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   530
    newData := Array new:1000.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   531
    freeData := Array new:1000.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   532
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   533
    updateIndex := 1.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   534
    org := font widthOf:'max 99999k'.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   535
    level := 0.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   536
57
36e13831b62d *** empty log message ***
claus
parents: 56
diff changeset
   537
    maxTotal := minTotal := ObjectMemory oldSpaceSize 
91
claus
parents: 85
diff changeset
   538
			    + ObjectMemory symSpaceSize
57
36e13831b62d *** empty log message ***
claus
parents: 56
diff changeset
   539
			    + ObjectMemory newSpaceSize.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   540
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   541
    viewBackground := Black.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   542
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   543
    device hasColors ifTrue:[
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   544
	newColor := Color yellow.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   545
	freeColor := Color green.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   546
	oldColor := Color white.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   547
    ] ifFalse:[
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   548
	newColor := Color grey:67.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   549
	freeColor := Color grey:33.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   550
	oldColor := Color white.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   551
    ].
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   552
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   553
    self font:(Font family:'courier' face:'medium' style:'roman' size:10).
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   554
75
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   555
    self model:self.
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   556
    self menu:#memoryMenu
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   557
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   558
    "
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   559
     MemoryMonitor open
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   560
    "
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   561
! !
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   562
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   563
!MemoryMonitor methodsFor:'menu functions'!
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   564
105
claus
parents: 93
diff changeset
   565
cleanupMemory
claus
parents: 93
diff changeset
   566
    "let all classes release unneeded, cached
claus
parents: 93
diff changeset
   567
     data ..."
claus
parents: 93
diff changeset
   568
claus
parents: 93
diff changeset
   569
    Smalltalk allBehaviorsDo:[:aClass |
claus
parents: 93
diff changeset
   570
	aClass lowSpaceCleanup
claus
parents: 93
diff changeset
   571
    ].
claus
parents: 93
diff changeset
   572
    "
claus
parents: 93
diff changeset
   573
     then, perform a GC (incl. symbol reclamation)
claus
parents: 93
diff changeset
   574
    "
claus
parents: 93
diff changeset
   575
    ObjectMemory reclaimSymbols.
claus
parents: 93
diff changeset
   576
    "
claus
parents: 93
diff changeset
   577
     finally, compress
claus
parents: 93
diff changeset
   578
    "
claus
parents: 93
diff changeset
   579
    ObjectMemory verboseGarbageCollect.
claus
parents: 93
diff changeset
   580
!
claus
parents: 93
diff changeset
   581
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   582
garbageCollect
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   583
    ObjectMemory markAndSweep
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   584
!
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   585
105
claus
parents: 93
diff changeset
   586
garbageCollectAndSymbols
claus
parents: 93
diff changeset
   587
    ObjectMemory reclaimSymbols
claus
parents: 93
diff changeset
   588
!
claus
parents: 93
diff changeset
   589
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   590
compressingGarbageCollect
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   591
    ObjectMemory verboseGarbageCollect
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   592
!
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   593
105
claus
parents: 93
diff changeset
   594
scavenge 
claus
parents: 93
diff changeset
   595
    ObjectMemory scavenge
claus
parents: 93
diff changeset
   596
!
claus
parents: 93
diff changeset
   597
claus
parents: 93
diff changeset
   598
tenure 
claus
parents: 93
diff changeset
   599
    ObjectMemory tenure
claus
parents: 93
diff changeset
   600
!
claus
parents: 93
diff changeset
   601
75
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   602
compressSources
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   603
    Smalltalk compressSources.
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   604
    ObjectMemory markAndSweep
85
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   605
!
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   606
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   607
backgroundCollect
d9713a3ca092 *** empty log message ***
claus
parents: 79
diff changeset
   608
    [ObjectMemory incrementalGC] forkAt:5 
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   609
! !