Reduce segment files size on move objects to PermSpace

hernanmd · Nov 22, 2022 · 11d7305 · 11d7305
1 parent 3f7b3ab
commit 11d7305
Show file tree

Hide file tree

Showing 3 changed files with 56 additions and 2 deletions.
diff --git a/smalltalksrc/VMMaker/AbstractComposedImageAccess.class.st b/smalltalksrc/VMMaker/AbstractComposedImageAccess.class.st
@@ -21,7 +21,9 @@ AbstractComposedImageAccess >> createImageDirectory: imageFileName [
 				cppIf: ((self defined: #_WIN32) or: [(self defined: #_WIN64)])
 				ifTrue: [ self mkdir: imageFileName ]
 				ifFalse: [ self mkdir: imageFileName _: 0777 ] ]
-		inSmalltalk: [ imageFileName asFileReference ensureCreateDirectory ]
+		inSmalltalk: [ 
+			imageFileName asFileReference ensureDeleteAll.
+			imageFileName asFileReference ensureCreateDirectory ]
 ]
 
 { #category : #'file operations' }

diff --git a/smalltalksrc/VMMaker/Spur32BitMMLESimulator.class.st b/smalltalksrc/VMMaker/Spur32BitMMLESimulator.class.st
@@ -83,7 +83,7 @@ Spur32BitMMLESimulator >> fetchFloatAt: floatBitsAddress into: aFloat [
 	aFloat at: 1 put: (self uint32AtPointer: floatBitsAddress+4)
 ]
 
-{ #category : #'as yet unclassified' }
+{ #category : #'object access' }
 Spur32BitMMLESimulator >> fetchPointer: fieldIndex ofObject: objOop [
 	self assert: (self isForwarded: objOop) not.
 	self assert: (fieldIndex >= 0 and: [fieldIndex < (self numSlotsOfAny: objOop)

diff --git a/smalltalksrc/VMMakerTests/VMImageReadingTest.class.st b/smalltalksrc/VMMakerTests/VMImageReadingTest.class.st
@@ -9,6 +9,12 @@ Class {
 	#category : #'VMMakerTests-ImageFormat'
 }
 
+{ #category : #query }
+VMImageReadingTest >> dataFrom: fileName [
+
+	^ self imageFileName asFileReference / fileName
+]
+
 { #category : #accessing }
 VMImageReadingTest >> initializationOptions [
 
@@ -34,6 +40,14 @@ VMImageReadingTest >> loadImage [
 
 ]
 
+{ #category : #query }
+VMImageReadingTest >> metadataFrom: fileName [
+
+	| writtenHeader |
+	writtenHeader := (self imageFileName asFileReference / fileName) contents.
+	^ STON fromString: writtenHeader
+]
+
 { #category : #utilities }
 VMImageReadingTest >> saveImage [
 
@@ -42,6 +56,9 @@ VMImageReadingTest >> saveImage [
 	self assert: interpreter successful.
 
 	super saveImage.
+
+	memory postSnapshot.
+
 ]
 
 { #category : #initialization }
@@ -57,6 +74,41 @@ VMImageReadingTest >> setUp [
 
 ]
 
+{ #category : #tests }
+VMImageReadingTest >> testMovingObjectsToPermSpaceReduceOldSpace [
+
+	| obj |
+	obj := self newOldSpaceArrayWithSlots: 77.
+	memory splObj: 4 put: obj. "Store object in SpecialObjects Array to keep it"
+
+	self saveImage.
+
+	"Remap"
+	memory allOldSpaceObjectsDo: [ :oop | (memory numSlotsOf: oop) = 77 ifTrue: [ obj := oop ] ].
+
+
+	self assert: (self metadataFrom: 'seg0.ston') dataSize equals: 132944.
+	self assert: (self metadataFrom: 'permSpace.ston') dataSize equals: 0.
+
+	self assert: (self dataFrom: 'seg0.data') size equals: 132944.
+	self assert: (self dataFrom: 'permSpace.data') size equals: 0.
+
+	"------------------------------------------------------------------------------"
+
+	self assert: (memory numSlotsOf: obj) equals: 77.
+
+	memory moveToPermSpace: obj.
+
+	self saveImage.
+
+
+	self assert: (self metadataFrom: 'seg0.ston') dataSize equals: 132320.
+	self assert: (self metadataFrom: 'permSpace.ston') dataSize equals: 640.
+
+	self assert: (self dataFrom: 'seg0.data') size equals: 132320.
+	self assert: (self dataFrom: 'permSpace.data') size equals: 640
+]
+
 { #category : #tests }
 VMImageReadingTest >> testReadingSTONHeader [