MemoryMonitor.st
author claus
Thu, 09 Mar 1995 04:31:23 +0100
changeset 79 d78f92a07d5d
parent 75 f6310cbc93b6
child 85 d9713a3ca092
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
79
d78f92a07d5d *** empty log message ***
claus
parents: 75
diff changeset
    27
$Header: /cvs/stx/stx/libtool/MemoryMonitor.st,v 1.11 1995-03-09 03:31:23 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
"
79
d78f92a07d5d *** empty log message ***
claus
parents: 75
diff changeset
    48
$Header: /cvs/stx/stx/libtool/MemoryMonitor.st,v 1.11 1995-03-09 03:31:23 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
57
36e13831b62d *** empty log message ***
claus
parents: 56
diff changeset
   134
	total := ObjectMemory fixSpaceSize 
36e13831b62d *** empty log message ***
claus
parents: 56
diff changeset
   135
		 + ObjectMemory oldSpaceSize 
36e13831b62d *** empty log message ***
claus
parents: 56
diff changeset
   136
		 + ObjectMemory newSpaceSize.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   137
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   138
	startIdx := (lx-org+1).
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   139
	startIdx < 1 ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   140
	    startIdx := 1
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   141
	].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   142
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   143
	endIdx := right-org+1.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   144
	endIdx >= updateIndex ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   145
	    endIdx := updateIndex-1.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   146
	].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   147
	dX := 0.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   148
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   149
	startIdx to:endIdx do:[:i |
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   150
	    newSpaceUsed := newData at:i.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   151
	    newSpaceUsed notNil ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   152
		oldSpaceUsed := oldData at:i.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   153
		freeMem := freeData at:i.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   154
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   155
		self updateLineX:lx - dX
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   156
		       total:total 
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   157
		       old:oldSpaceUsed 
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   158
		       new:newSpaceUsed 
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   159
		       free:freeMem.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   160
	    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   161
	    lx := lx + 1
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   162
	]
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   163
    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   164
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   165
    x < org ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   166
	prevFree := prevFree2 := prevOld := prevTotal := nil.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   167
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   168
	self updateNumbers.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   169
    ]
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   170
!
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   171
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   172
updateLineX:x total:total old:oldSpaceUsed new:newSpaceUsed free:freeMem
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   173
    |hNew hOld hFree y1 y2|
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   174
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   175
    hNew := (newSpaceUsed * scale) asInteger.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   176
    hOld := (oldSpaceUsed * scale) // 2.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   177
    hFree := (freeMem * scale) asInteger.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   178
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   179
    y1 := height - 1.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   180
    y2 := y1 - hOld.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   181
    self paint:oldColor.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   182
    self displayLineFromX:x y:y1 toX:x y:y2.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   183
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   184
    y1 := y2.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   185
    y2 := y1 - hFree.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   186
    self paint:freeColor.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   187
    self displayLineFromX:x y:y1 toX:x y:y2.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   188
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   189
    y1 := y2.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   190
    y2 := y1 - hNew.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   191
    self paint:newColor.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   192
    self displayLineFromX:x y:y1 toX:x y:y2.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   193
!
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   194
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   195
updateNumbers
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   196
    "redraw numbers.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   197
     The values shown are:
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   198
	max:    maximum memory used since monitor started
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   199
	min:    minimum memory used since monitor started
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   200
	tot:    total memory used (overall oldSpace + overall newSpace)
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   201
	all:    current memory in use (oldSpace + newSpace)
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   202
	new:    current newSpace in use
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   203
	free:   current size of freelist in oldSpace
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   204
	old:    current oldSpace in use
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   205
    "
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   206
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   207
    |oldSpaceSize newSpaceSize memUsed oldMemUsed newMemUsed freeMem free2 
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   208
     x y half s thisStringLen fontHeight total n|
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   209
57
36e13831b62d *** empty log message ***
claus
parents: 56
diff changeset
   210
    oldMemUsed := ObjectMemory oldSpaceUsed + ObjectMemory fixSpaceUsed.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   211
    newMemUsed := ObjectMemory newSpaceUsed.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   212
    freeMem := ObjectMemory freeListSpace.
57
36e13831b62d *** empty log message ***
claus
parents: 56
diff changeset
   213
    oldSpaceSize := ObjectMemory oldSpaceSize + ObjectMemory fixSpaceSize.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   214
    newSpaceSize := ObjectMemory newSpaceSize.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   215
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   216
    memUsed := oldMemUsed + newMemUsed "- freeMem".
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   217
    total := oldSpaceSize + newSpaceSize.
68
b70257a99e48 *** empty log message ***
claus
parents: 61
diff changeset
   218
    free2 := ObjectMemory freeSpace.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   219
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   220
    self paint:White on:Black.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   221
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   222
    fontHeight := font height + font descent.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   223
    half := height // 2 + font descent.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   224
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   225
    y := half - (fontHeight * 3).
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   226
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   227
    total ~~ prevTotal ifTrue:[
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   228
	((total - freeMem) < minTotal) ifTrue:[
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   229
	    minTotal := total - freeMem.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   230
	].
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   231
	(total > maxTotal) ifTrue:[
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   232
	    maxTotal := total.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   233
	].
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   234
60
claus
parents: 57
diff changeset
   235
	s := 'max ' , ((maxTotal // 1024) printStringLeftPaddedTo:5) , 'k '.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   236
	self displayOpaqueString:s x:0 y:font ascent.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   237
60
claus
parents: 57
diff changeset
   238
	s := 'min ' , ((minTotal // 1024) printStringLeftPaddedTo:5) , 'k '.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   239
	self displayOpaqueString:s x:0 y:(height - font descent).
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   240
60
claus
parents: 57
diff changeset
   241
	s := 'tot ' , ((total  // 1024) printStringLeftPaddedTo:5) , 'k '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   242
	self displayOpaqueString:s x:0 y:y.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   243
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   244
	prevTotal := total.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   245
    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   246
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   247
    y := y + fontHeight.
60
claus
parents: 57
diff changeset
   248
    s := 'all ' , ((memUsed // 1024) printStringLeftPaddedTo:5) , 'k '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   249
    self displayOpaqueString:s x:0 y:y.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   250
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   251
    y := y + fontHeight.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   252
    self paint:newColor.
60
claus
parents: 57
diff changeset
   253
    s := 'new ' , ((newMemUsed // 1024) printStringLeftPaddedTo:5) , 'k '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   254
    self displayOpaqueString:s x:0 y:y.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   255
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   256
    y := y + fontHeight.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   257
    freeMem ~~ prevFree ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   258
	self paint:freeColor.
60
claus
parents: 57
diff changeset
   259
	s := 'frl ' , ((freeMem // 1024) printStringLeftPaddedTo:5) , 'k '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   260
	self displayOpaqueString:s x:0 y:y.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   261
	prevFree := freeMem.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   262
    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   263
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   264
    y := y + fontHeight.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   265
    free2 ~~ prevFree2 ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   266
	self paint:freeColor.
60
claus
parents: 57
diff changeset
   267
	s := 'fre ' , ((free2 // 1024) printStringLeftPaddedTo:5) , 'k '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   268
	self displayOpaqueString:s x:0 y:y.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   269
	prevFree2 := free2.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   270
    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   271
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   272
    y := y + fontHeight.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   273
    (oldMemUsed - freeMem) ~~ prevOld ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   274
	self paint:oldColor.
60
claus
parents: 57
diff changeset
   275
	s := 'old ' , (((oldMemUsed - freeMem) // 1024) printStringLeftPaddedTo:5) , 'k '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   276
	self displayOpaqueString:s x:0 y:y.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   277
	prevOld := (oldMemUsed - freeMem).
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   278
    ].
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
     the following is internal - normally only interresting when debugging the VM
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   282
    "
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   283
    y := y + fontHeight.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   284
    self paint:oldColor.
60
claus
parents: 57
diff changeset
   285
    s := 't:' , (ObjectMemory tenureAge printStringLeftPaddedTo:2) , ' '.
claus
parents: 57
diff changeset
   286
    s := s , 'I:' , (ObjectMemory incrementalGCPhase printStringLeftPaddedTo:2) , ' '.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   287
    self displayOpaqueString:s x:0 y:y.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   288
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   289
"/ does no longer make sense to show ....
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   290
"/    y := y + fontHeight.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   291
"/    ObjectMemory runsSingleOldSpace ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   292
"/        self displayOpaqueString:'single' x:0 y:(half + (fontHeight*4)).
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   293
"/    ].
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   294
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   295
    y := y + fontHeight.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   296
    n := ObjectMemory lastScavangeReclamation / ObjectMemory newSpaceSize * 100.0.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   297
    n := 100 - n asInteger.
75
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   298
    s := (ObjectMemory scavengeCount printStringLeftPaddedTo:5)
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   299
	 , (n printStringLeftPaddedTo:3) , '%'.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   300
    self displayOpaqueString:s x:0 y:y.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   301
!
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   302
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   303
updateDisplay
4cde336c0794 Initial revision
claus
parents:
diff changeset
   304
    "update picture; trigger next update"
4cde336c0794 Initial revision
claus
parents:
diff changeset
   305
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   306
    |total oldSpaceUsed newSpaceUsed freeMem 
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   307
     gWidth shift scaleChange margin mustWait|
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   308
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   309
    shown ifTrue:[
57
36e13831b62d *** empty log message ***
claus
parents: 56
diff changeset
   310
	oldSpaceUsed := ObjectMemory oldSpaceUsed + ObjectMemory fixSpaceUsed.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   311
	newSpaceUsed := ObjectMemory newSpaceUsed.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   312
	freeMem := ObjectMemory freeListSpace.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   313
	total := oldSpaceUsed + newSpaceUsed.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   314
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   315
	scaleChange := false.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   316
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   317
	((total - freeMem) < minTotal) ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   318
	    minTotal := total - freeMem.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   319
	    scaleChange := true
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   320
	].
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   321
	(total > maxTotal) ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   322
	    maxTotal := total.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   323
	    scaleChange := true
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   324
	].
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   325
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   326
	oldData at:updateIndex put:oldSpaceUsed.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   327
	newData at:updateIndex put:newSpaceUsed.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   328
	freeData at:updateIndex put:freeMem.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   329
	updateIndex := updateIndex + 1.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   330
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   331
	scaleChange ifTrue:[
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   332
	    scale := height asFloat / (maxTotal + 100000).
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   333
	    self redraw
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   334
	].
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   335
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   336
	gWidth := width - org.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   337
	margin := 1.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   338
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   339
	mustWait := false.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   340
	((updateIndex-1) >= (gWidth - margin)) ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   341
"on slow displays, use:"
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   342
"/            shift := gWidth // 4.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   343
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   344
"for smooth display, use:"
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   345
	    shift := 1.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   346
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   347
	    oldData replaceFrom:1 with:oldData startingAt:shift+1.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   348
	    newData replaceFrom:1 with:newData startingAt:shift+1.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   349
	    freeData replaceFrom:1 with:freeData startingAt:shift+1.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   350
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   351
	    updateIndex := updateIndex - shift.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   352
	    dX := dX + shift.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   353
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   354
	    self catchExpose.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   355
	    self copyFrom:self 
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   356
			x:(org + shift) y:0
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   357
		      toX:org y:0
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   358
		    width:(gWidth - shift - margin)
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   359
		   height:height.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   360
	    self clearRectangleX:(width - margin - shift) y:0 
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   361
			   width:shift height:height.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   362
	    mustWait := true.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   363
	].
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   364
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   365
	self updateLineX:(updateIndex - 1 + org - 1)
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   366
		   total:total 
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   367
		   old:oldSpaceUsed 
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   368
		   new:newSpaceUsed 
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   369
		   free:freeMem.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   370
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   371
	self updateNumbers.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   372
	mustWait ifTrue:[
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   373
	    self waitForExpose.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   374
	]
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   375
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   376
    ].
4cde336c0794 Initial revision
claus
parents:
diff changeset
   377
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   378
    updateBlock notNil ifTrue:[
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   379
	Processor addTimedBlock:updateBlock afterSeconds:updateInterval
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   380
    ].
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   381
! !
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   382
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   383
!MemoryMonitor methodsFor:'destroying'!
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   384
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   385
destroy
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   386
    updateBlock notNil ifTrue:[
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   387
	Processor removeTimedBlock:updateBlock.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   388
    ] ifFalse:[
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   389
	myProcess terminate.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   390
	myProcess := nil
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   391
    ].
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   392
    oldData := newData := freeData := nil.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   393
    super destroy
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   394
! !
4cde336c0794 Initial revision
claus
parents:
diff changeset
   395
4cde336c0794 Initial revision
claus
parents:
diff changeset
   396
!MemoryMonitor methodsFor:'events'!
4cde336c0794 Initial revision
claus
parents:
diff changeset
   397
4cde336c0794 Initial revision
claus
parents:
diff changeset
   398
keyPress:key x:x y:y
4cde336c0794 Initial revision
claus
parents:
diff changeset
   399
    key == $f ifTrue:[
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   400
	"faster"
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   401
	updateInterval := updateInterval / 2
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   402
    ].
4cde336c0794 Initial revision
claus
parents:
diff changeset
   403
    key == $s ifTrue:[
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   404
	"slower"
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   405
	updateInterval := updateInterval * 2
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   406
    ].
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   407
    key == $r ifTrue:[
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   408
	"reset max"
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   409
	maxTotal := prevTotal.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   410
	scale := height asFloat / (maxTotal + 100000).
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   411
	self redraw.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   412
    ]
4cde336c0794 Initial revision
claus
parents:
diff changeset
   413
!
4cde336c0794 Initial revision
claus
parents:
diff changeset
   414
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   415
sizeChanged:how
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   416
    |nn no nf delta oldSize newSize|
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   417
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   418
    super sizeChanged:how.
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   419
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   420
    oldSize := oldData size.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   421
    newSize := width-org+1.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   422
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   423
    (newSize == oldSize) ifTrue:[^ self].
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   424
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   425
    nn := Array new:newSize.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   426
    no := Array new:newSize.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   427
    nf := Array new:newSize.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   428
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   429
    (newSize > oldSize) ifTrue:[
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   430
	nn replaceFrom:1 to:oldSize with:newData.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   431
	no replaceFrom:1 to:oldSize with:oldData.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   432
	nf replaceFrom:1 to:oldSize with:freeData
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   433
    ] ifFalse:[
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   434
	delta := (oldSize - newSize).
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   435
	nn replaceFrom:1 with:newData startingAt:delta+1.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   436
	no replaceFrom:1 with:oldData startingAt:delta+1.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   437
	nf replaceFrom:1 with:freeData startingAt:delta+1.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   438
	updateIndex > newSize ifTrue:[
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   439
	    updateIndex := updateIndex - delta.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   440
	]
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   441
    ].
4cde336c0794 Initial revision
claus
parents:
diff changeset
   442
    newData := nn.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   443
    oldData := no.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   444
    freeData := nf.
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   445
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   446
    scale := height asFloat / (maxTotal + 100000).
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   447
    self clear.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   448
    self redraw
19
4cde336c0794 Initial revision
claus
parents:
diff changeset
   449
! !
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   450
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   451
!MemoryMonitor methodsFor:'initialization'!
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   452
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   453
realize
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   454
    super realize.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   455
    updateBlock notNil ifTrue:[
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   456
	Processor addTimedBlock:updateBlock afterSeconds:updateInterval.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   457
    ] ifFalse:[
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   458
	myProcess := [
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   459
	    |d|
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   460
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   461
	    [true] whileTrue:[
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   462
		(Delay forSeconds:updateInterval) wait.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   463
		self updateDisplay
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   464
	    ]
79
d78f92a07d5d *** empty log message ***
claus
parents: 75
diff changeset
   465
	] forkAt:6.
61
cb5e3560bd82 *** empty log message ***
claus
parents: 60
diff changeset
   466
	myProcess name:'Memory Monitor [' , 
cb5e3560bd82 *** empty log message ***
claus
parents: 60
diff changeset
   467
			Processor activeProcess id printString , '] update'
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   468
    ].
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   469
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   470
    newColor := newColor on:device.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   471
    freeColor := freeColor on:device.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   472
    oldColor := oldColor on:device.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   473
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   474
    font := font on:device.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   475
!
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   476
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   477
initialize
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   478
    super initialize.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   479
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   480
    updateInterval := 0.5.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   481
    ProcessorScheduler isPureEventDriven ifTrue:[
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   482
	updateBlock := [self updateDisplay].
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   483
    ].
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   484
    oldData := Array new:1000.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   485
    newData := Array new:1000.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   486
    freeData := Array new:1000.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   487
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   488
    updateIndex := 1.
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   489
    org := font widthOf:'max 99999k'.
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   490
    level := 0.
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   491
57
36e13831b62d *** empty log message ***
claus
parents: 56
diff changeset
   492
    maxTotal := minTotal := ObjectMemory oldSpaceSize 
36e13831b62d *** empty log message ***
claus
parents: 56
diff changeset
   493
			    + ObjectMemory fixSpaceSize
36e13831b62d *** empty log message ***
claus
parents: 56
diff changeset
   494
			    + ObjectMemory newSpaceSize.
49
6fe62433cfa3 *** empty log message ***
claus
parents: 45
diff changeset
   495
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   496
    viewBackground := Black.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   497
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   498
    device hasColors ifTrue:[
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   499
	newColor := Color yellow.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   500
	freeColor := Color green.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   501
	oldColor := Color white.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   502
    ] ifFalse:[
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   503
	newColor := Color grey:67.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   504
	freeColor := Color grey:33.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   505
	oldColor := Color white.
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   506
    ].
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   507
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   508
    self font:(Font family:'courier' face:'medium' style:'roman' size:10).
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   509
75
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   510
    self model:self.
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   511
    self menu:#memoryMenu
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   512
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   513
    "
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   514
     MemoryMonitor open
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   515
    "
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   516
!
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   517
75
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   518
memoryMenu
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   519
    |labels selectors|
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   520
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   521
    labels :=    #(
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   522
		    'collect Garbage'
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   523
		    'collect Garbage & compress'
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   524
		    '-'
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   525
		    'background collect'
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   526
		    '-'
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   527
		    'compress sources '
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   528
		  ).
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   529
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   530
    selectors := #(
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   531
		    garbageCollect
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   532
		    compressingGarbageCollect
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   533
		    nil
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   534
		    backgroundCollect
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   535
		    nil
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   536
		    compressSources
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   537
		  ).
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   538
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   539
    ^ PopUpMenu labels:(resources array:labels)
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   540
		 selectors:selectors
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   541
		receiver:self
45
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   542
! !
950b84ba89e6 *** empty log message ***
claus
parents: 19
diff changeset
   543
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   544
!MemoryMonitor methodsFor:'menu functions'!
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   545
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   546
garbageCollect
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   547
    ObjectMemory markAndSweep
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   548
!
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   549
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   550
compressingGarbageCollect
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   551
    ObjectMemory verboseGarbageCollect
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   552
!
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   553
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   554
backgroundCollect
79
d78f92a07d5d *** empty log message ***
claus
parents: 75
diff changeset
   555
    [ObjectMemory incrementalGC] forkAt:5 
75
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   556
!
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   557
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   558
compressSources
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   559
    Smalltalk compressSources.
f6310cbc93b6 *** empty log message ***
claus
parents: 68
diff changeset
   560
    ObjectMemory markAndSweep
52
7b48409ae088 *** empty log message ***
claus
parents: 49
diff changeset
   561
! !