Merge pull request #1339 from marschall/fix-wamemory

Fix WAMemory on Pharo

repository/Seaside-Pharo-Development.package/Behavior.extension/instance/traverseWithMemory.seen..st

@@ -0,0 +1,4 @@
+*Seaside-Pharo-Development
+traverseWithMemory: aMemory seen: anIdentitySet
+	"classes are in the global pool, ignore counting them"
+	anIdentitySet add: self

repository/Seaside-Pharo-Development.package/Behavior.extension/properties.json

@@ -0,0 +1,3 @@
+{
+	"name" : "Behavior"
+}

repository/Seaside-Pharo-Development.package/Boolean.extension/instance/traverseWithMemory.seen..st

@@ -0,0 +1,4 @@
+*Seaside-Pharo-Development
+traverseWithMemory: aMemory seen: anIdentitySet
+	"booleans are singletons, ignore counting them"
+	anIdentitySet add: self

repository/Seaside-Pharo-Development.package/Boolean.extension/properties.json

@@ -0,0 +1,3 @@
+{
+	"name" : "Boolean"
+}

repository/Seaside-Pharo-Development.package/CompiledBlock.extension/instance/traverseWithMemory.seen..st

@@ -0,0 +1,6 @@
+*Seaside-Pharo-Development
+traverseWithMemory: aMemory seen: anIdentitySet
+	"blocks can be stored in collections and instance variables
+	Report but don't intropect them. This may miss reporting catured variables."
+	aMemory accumulate: self.
+	anIdentitySet add: self

repository/Seaside-Pharo-Development.package/CompiledBlock.extension/properties.json

@@ -0,0 +1,3 @@
+{
+	"name" : "CompiledBlock"
+}

repository/Seaside-Pharo-Development.package/CompiledMethod.extension/instance/traverseWithMemory.seen..st

@@ -0,0 +1,4 @@
+*Seaside-Pharo-Development
+traverseWithMemory: aMemory seen: anIdentitySet
+	"methods are stored in classes, ignore counting them"
+	anIdentitySet add: self

repository/Seaside-Pharo-Development.package/CompiledMethod.extension/properties.json

@@ -0,0 +1,3 @@
+{
+	"name" : "CompiledMethod"
+}

repository/Seaside-Pharo-Development.package/InstructionStream.extension/instance/traverseWithMemory.seen..st

@@ -0,0 +1,7 @@
+*Seaside-Pharo-Development
+traverseWithMemory: aMemory seen: anIdentitySet
+	"we only have two instance variables:
+	- sender which we ignore because will always get niled out when the stack unwound so won't be captured but this will not have happened yet for contexts involved in the current request
+	- pc with is a SmallInteger and therefore immediate"
+	aMemory accumulate: self.
+	anIdentitySet add: self

repository/Seaside-Pharo-Development.package/Object.extension/instance/traverseWithMemory.seen..st

@@ -1,13 +1,19 @@
 *Seaside-Pharo-Development
 traverseWithMemory: aMemory seen: anIdentitySet
-	aMemory accumulate: self.
+	| traversableInstVarIndexes traversableIndexableVarIndexes |
 	anIdentitySet add: self.
-	self traversableInstVarIndexes do: [ :index |
+	self isImmediateObject ifTrue: [
+		"don't report immediates"
+		^ self ].
+	aMemory accumulate: self.
+	traversableInstVarIndexes := self class instSize.
+	1 to: traversableInstVarIndexes do: [ :index |
 		aMemory 
 			traverse: self
 			value: (self instVarAt: index)
 			seen: anIdentitySet ].
-	self traversableIndexableVarIndexes do: [ :index |
+	traversableIndexableVarIndexes := self basicSize.
+	1 to: traversableIndexableVarIndexes do: [ :index |
 		aMemory 
 			traverse: self 
 			value: (self basicAt: index) 

repository/Seaside-Pharo-Development.package/Process.extension/instance/traverseWithMemory.seen..st

@@ -0,0 +1,5 @@
+*Seaside-Pharo-Development
+traverseWithMemory: aMemory seen: anIdentitySet
+	"Process is excluded because otherwise our Semaphores pull them in and the Process is
+	obviously not held onto by the Semaphore indefinitely."
+	anIdentitySet add: self

repository/Seaside-Pharo-Development.package/Process.extension/properties.json

@@ -0,0 +1,3 @@
+{
+	"name" : "Process"
+}

repository/Seaside-Pharo-Development.package/Symbol.extension/instance/traverseWithMemory.seen..st

@@ -0,0 +1,4 @@
+*Seaside-Pharo-Development
+traverseWithMemory: aMemory seen: anIdentitySet
+	"symbol are in the global table, ignore counting them"
+	anIdentitySet add: self

repository/Seaside-Pharo-Development.package/Symbol.extension/properties.json

@@ -0,0 +1,3 @@
+{
+	"name" : "Symbol"
+}

repository/Seaside-Pharo-Development.package/UndefinedObject.extension/instance/traverseWithMemory.seen..st

@@ -0,0 +1,4 @@
+*Seaside-Pharo-Development
+traverseWithMemory: aMemory seen: anIdentitySet
+	"nil is global, ignore counting it"
+	anIdentitySet add: self

repository/Seaside-Pharo-Development.package/UndefinedObject.extension/properties.json

@@ -0,0 +1,3 @@
+{
+	"name" : "UndefinedObject"
+}

repository/Seaside-Pharo-Development.package/WAMemory.class/instance/buildTable.st

@@ -1,26 +1,31 @@
 private
 buildTable
-	^ WATableReport new
-		rows: instances values;
-		columns: (Array
-			with: (WAReportColumn new
+	| classColumn instanceCountColumn totalSizeColumn |
+	classColumn := WAReportColumn new
 				title: 'Class';
 				selector: #name;
 				sortBlock: [ :a :b | a < b ];
-				yourself)
-			with: (WAReportColumn new
+				yourself.
+	instanceCountColumn := WAReportColumn new
 				title: 'Instances';
 				selector: #count;
 				sortBlock: [ :a :b | a > b ];
 				cssClass: 'right';
 				hasTotal: true;
-				yourself)
-			with: (WAReportColumn new
+				yourself.
+	totalSizeColumn := WAReportColumn new
 				title: 'Total Size';
 				selector: #size;
 				sortBlock: [ :a :b | a > b ];
 				formatBlock: [ :each | formatter print: each ];
 				cssClass: 'right';
 				hasTotal: true;
-				yourself));
+				yourself.
+	^ WATableReport new
+		rows: instances values;
+		columns: (Array
+			with: classColumn
+			with: instanceCountColumn
+			with: totalSizeColumn);
+		sortColumn: totalSizeColumn;
 		yourself

repository/Seaside-Pharo-Development.package/WAMemory.class/instance/traverse.value.seen..st

@@ -1,5 +1,5 @@
 private
 traverse: anObject value: aValue seen: anIdentitySet
-	(aValue isNil or: [ aValue isLiteral or: [ aValue isBehavior or: [ (anIdentitySet includes: aValue) or: [ IgnoredClasses anySatisfy: [ :each | aValue isKindOf: each ] ] ] ] ])
+	(aValue isNil or: [ anIdentitySet includes: aValue ])
 		ifTrue: [ ^ self ].
 	aValue traverseWithMemory: self seen: anIdentitySet

repository/Seaside-Pharo-Development.package/WAMemory.class/instance/traverseWithMemory.seen..st

@@ -0,0 +1,4 @@
+hooks
+traverseWithMemory: aMemory seen: anIdentitySet
+	"don't report self"
+	anIdentitySet add: self

repository/Seaside-Pharo-Development.package/WAMemory.class/properties.json

@@ -4,9 +4,7 @@
 	"category" : "Seaside-Pharo-Development-Core",
 	"classinstvars" : [ ],
 	"pools" : [ ],
-	"classvars" : [
-		"IgnoredClasses"
-	],
+	"classvars" : [ ],
 	"instvars" : [
 		"instances",
 		"table",

repository/Seaside-Pharo-Development.package/WAMemoryItem.class/instance/traverseWithMemory.seen..st

@@ -0,0 +1,4 @@
+hooks
+traverseWithMemory: aMemory seen: anIdentitySet
+	"don't report self"
+	anIdentitySet add: self