MemoryMonitor.st
changeset 109 c23841df3616
parent 108 a936f81cc162
child 110 570a38362ae1
--- a/MemoryMonitor.st	Sun Jul 23 05:19:48 1995 +0200
+++ b/MemoryMonitor.st	Thu Aug 03 03:38:05 1995 +0200
@@ -25,7 +25,7 @@
  COPYRIGHT (c) 1991 by Claus Gittinger
 	      All Rights Reserved
 
-$Header: /cvs/stx/stx/libtool/MemoryMonitor.st,v 1.17 1995-07-23 03:19:24 claus Exp $
+$Header: /cvs/stx/stx/libtool/MemoryMonitor.st,v 1.18 1995-08-03 01:37:52 claus Exp $
 '!
 
 !MemoryMonitor class methodsFor:'documentation'!
@@ -46,7 +46,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libtool/MemoryMonitor.st,v 1.17 1995-07-23 03:19:24 claus Exp $
+$Header: /cvs/stx/stx/libtool/MemoryMonitor.st,v 1.18 1995-08-03 01:37:52 claus Exp $
 "
 !
 
@@ -75,6 +75,8 @@
 
 	I       incremental GC state
 
+	weak    number of weak objects
+
 	rem     size of rememberedSet
 
 	minsc:  percent of newspace remaining after scavenge (worst case)
@@ -100,7 +102,7 @@
 !MemoryMonitor class methodsFor:'defaults'!
 
 defaultExtent
-    ^ (200 @ 250)
+    ^ (200 @ 280)
 !
 
 defaultLabel
@@ -120,14 +122,15 @@
 updateDisplay
     "update picture; trigger next update"
 
-    |total oldSpaceUsed newSpaceUsed freeMem 
+    |total oldSpaceUsed newSpaceUsed freeMem oldSpaceSize
      gWidth shift scaleChange margin mustWait|
 
     shown ifTrue:[
 	oldSpaceUsed := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed.
 	newSpaceUsed := ObjectMemory newSpaceUsed.
-	freeMem := ObjectMemory freeListSpace.
-	total := oldSpaceUsed + newSpaceUsed.
+	freeMem := ObjectMemory freeListSpace + (ObjectMemory oldSpaceSize - ObjectMemory oldSpaceUsed).
+	oldSpaceSize := ObjectMemory oldSpaceSize + ObjectMemory symSpaceSize.
+	total := oldSpaceSize + ObjectMemory newSpaceSize.
 
 	scaleChange := false.
 
@@ -140,7 +143,7 @@
 	    scaleChange := true
 	].
 
-	oldData at:updateIndex put:oldSpaceUsed.
+	oldData at:updateIndex put:oldSpaceSize. "/ oldSpaceUsed.
 	newData at:updateIndex put:newSpaceUsed.
 	freeData at:updateIndex put:freeMem.
 	updateIndex := updateIndex + 1.
@@ -181,7 +184,7 @@
 
 	self updateLineX:(updateIndex - 1 + org - 1)
 		   total:total 
-		   old:oldSpaceUsed 
+		   old:oldSpaceSize "/ oldSpaceUsed
 		   new:newSpaceUsed 
 		   free:freeMem.
 
@@ -250,25 +253,24 @@
     ]
 !
 
-updateLineX:x total:total old:oldSpaceUsed new:newSpaceUsed free:freeMem
-    |hNew hOld hFree y1 y2|
+updateLineX:x total:total old:oldSpaceSize new:newSpaceUsed free:freeMem
+    |hNew hOld hFree y1 y2 y3|
 
     hNew := (newSpaceUsed * scale) asInteger.
-    hOld := (oldSpaceUsed * scale) // 2.
-    hFree := (freeMem * scale) asInteger.
+    hOld := (oldSpaceSize * scale) // 2.
+    hFree := (freeMem * scale) // 2.
 
     y1 := height - 1.
+
     y2 := y1 - hOld.
     self paint:oldColor.
     self displayLineFromX:x y:y1 toX:x y:y2.
 
-    y1 := y2.
-    y2 := y1 - hFree.
+    y3 := y1 - hFree.
     self paint:freeColor.
-    self displayLineFromX:x y:y1 toX:x y:y2.
+    self displayLineFromX:x y:y1 toX:x y:y3.
 
-    y1 := y2.
-    y2 := y1 - hNew.
+    y1 := y2 - hNew.
     self paint:newColor.
     self displayLineFromX:x y:y1 toX:x y:y2.
 !
@@ -287,6 +289,7 @@
 	t       current tenure age
 	I       IGC state
 	rem     remembered set size
+	lrem    lifo remembered set size
 	count of scavenges
 	last scavenge survivor rate
     "
@@ -309,7 +312,7 @@
     fontHeight := font height + font descent.
     half := height // 2 + font descent.
 
-    y := half - (fontHeight * 4).
+    y := half - (fontHeight * 5).
 
     total ~~ prevTotal ifTrue:[
 	((total - freeMem) < minTotal) ifTrue:[
@@ -374,9 +377,17 @@
     self displayOpaqueString:s x:0 y:y.
 
     y := y + fontHeight.
+    s := 'weak: ' , (ObjectMemory numberOfWeakObjects printStringLeftPaddedTo:4).
+    self displayOpaqueString:s x:0 y:y.
+
+    y := y + fontHeight.
     s := 'rem: ' , (ObjectMemory rememberedSetSize printStringLeftPaddedTo:5).
     self displayOpaqueString:s x:0 y:y.
 
+    y := y + fontHeight.
+    s := 'lrem: ' , (ObjectMemory lifoRememberedSetSize printStringLeftPaddedTo:4 ifLarger:['****']).
+    self displayOpaqueString:s x:0 y:y.
+
 "/ does no longer make sense to show ....
 "/    y := y + fontHeight.
 "/    ObjectMemory runsSingleOldSpace ifTrue:[
@@ -482,6 +493,7 @@
 	labels :=    #(
 			'scavenge'
 			'tenure'
+			'incremental collect'
 			'-'
 			'cleanup memory'
 			'-'
@@ -490,6 +502,7 @@
 	selectors := #(
 			scavenge
 			tenure
+			incrementalCollect
 			nil
 			cleanupMemory
 			nil
@@ -565,7 +578,7 @@
     viewBackground := Black.
 
     device hasColors ifTrue:[
-	newColor := Color yellow.
+	newColor := Color orange. "/ yellow.
 	freeColor := Color green.
 	oldColor := Color white.
     ] ifFalse:[
@@ -628,6 +641,12 @@
     ObjectMemory markAndSweep
 !
 
+incrementalCollect
+    [
+	[ObjectMemory gcStep] whileFalse:[(Delay forMilliseconds:1) wait]
+    ] forkAt:Processor highestPriority
+!
+
 backgroundCollect
     [ObjectMemory incrementalGC] forkAt:5 
 ! !