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