Refactor: Preparing ComposedImageWriter for C translation

hernanmd · Feb 1, 2022 · 95bca0b · 95bca0b
1 parent 2cf68dc
commit 95bca0b
Show file tree

Hide file tree

Showing 5 changed files with 135 additions and 85 deletions.
diff --git a/smalltalksrc/VMMaker/AbstractComposedImageAccess.class.st b/smalltalksrc/VMMaker/AbstractComposedImageAccess.class.st
@@ -64,3 +64,10 @@ AbstractComposedImageAccess >> segmentMetadataFile: segmentIndex inImage: imageF
 
 	^ self segmentMetadataFile: segmentIndex fromFile: imageFile 
 ]
+
+{ #category : #'accessing - files' }
+AbstractComposedImageAccess >> sqImageSTONFile: file Open: fileMode [
+
+	<doNotGenerate>
+	^file asFileReference writeStream
+]
diff --git a/smalltalksrc/VMMaker/AbstractImageAccess.class.st b/smalltalksrc/VMMaker/AbstractImageAccess.class.st
@@ -37,6 +37,17 @@ AbstractImageAccess class >> newWithMemory: memory andInterpreter: anInterpreter
 	^ newInstance
 ]
 
+{ #category : #'accessing - files' }
+AbstractImageAccess >> beginWriteImageSegments [
+
+	self assert:
+		(objectMemory getMemoryMap oldSpaceEnd = segmentManager lastSegment segLimit 
+		or: [ objectMemory getMemoryMap oldSpaceEnd + objectMemory bridgeSize = segmentManager lastSegment segLimit ]).
+
+	self assert: segmentManager firstSegmentBytes > 0.
+
+]
+
 { #category : #reading }
 AbstractImageAccess >> extractImageVersionFrom: fileVersion into: header [
 	"Read and verify the image file version number and return true if the the given image file needs to be byte-swapped. As a side effect, position the file stream just after the version number of the image header. This code prints a warning and does a hard-exit if it cannot find a valid version number."
@@ -206,3 +217,32 @@ AbstractImageAccess >> segmentManager: anObject [
 	<doNotGenerate>
 	segmentManager := anObject
 ]
+
+{ #category : #'accessing - files' }
+AbstractImageAccess >> sq: segStart Image: n File: segSize Write: file [
+
+	<doNotGenerate>
+	| region |
+	region := objectMemory memoryManager regionForAddress: segStart.
+
+	file
+		next: segSize
+		putAll: region memory
+		startingAt: segStart - region start + 1.
+
+	^ segSize
+]
+
+{ #category : #'accessing - files' }
+AbstractImageAccess >> sqImageFile: imageName Open: fileMode [
+
+	<doNotGenerate>
+	^imageName asFileReference binaryWriteStream
+]
+
+{ #category : #'accessing - files' }
+AbstractImageAccess >> sqImageFileClose: file [
+
+	<doNotGenerate>
+	file close
+]
diff --git a/smalltalksrc/VMMaker/ComposedImageWriter.class.st b/smalltalksrc/VMMaker/ComposedImageWriter.class.st
@@ -4,41 +4,57 @@ Class {
 	#category : #'VMMaker-ImageFormat'
 }
 
+{ #category : #writing }
+ComposedImageWriter >> writeHeaderFile: imageFileName fromHeader: header [
+
+	<var: #file type: #sqImageFile> "ImageFile ?"
+	| file |
+
+	file := self sqImageSTONFile: (self headerFile: imageFileName) Open: 'wb'.
+	file ifNil: [ "could not open the file for writing" 
+		^ self primitiveFail ].
+
+	self writeSTON: header toFile: file.
+
+	self sqImageFileClose: file.
+
+]
+
 { #category : #api }
 ComposedImageWriter >> writeImageFile: imageFileName fromHeader: header [
 
+	"Write one image header file + many segments files (metadata & data per segment)"
+
+	<var: #imageFileName declareC: 'char *imageFileName'>
+	<var: #header type: #SpurImageHeaderStruct> "TODO: Rename this class"
 	| bytesWritten |
 
-	(self headerFile: imageFileName) writeStreamDo: [ :file | 
-		self writeSTON: header toFile: file ].
+	self logDebug: 'Writing snapshot %s' _: imageFileName.
 
-	bytesWritten := self writeImageSegments: imageFileName.
+	self writeHeaderFile: imageFileName fromHeader: header.
 
-	interpreter success: bytesWritten = header dataSize "Is it neccessary?"
+	self flag: #TODO. "success: header imageHeaderSize "
 
+	bytesWritten := self writeImageSegments: imageFileName.
+
+	interpreter success: bytesWritten = header dataSize 
 ]
 
 { #category : #writing }
 ComposedImageWriter >> writeImageSegments: imageFileName [
 
-	"Almost duplicated from SpurImageWriter >> writeImageSegmentsToFile:"
-
-	| total |
-	self assert:
-		(objectMemory getMemoryMap oldSpaceEnd = segmentManager lastSegment segLimit 
-		or: [ objectMemory getMemoryMap oldSpaceEnd + objectMemory bridgeSize = segmentManager lastSegment segLimit ]).
+	<var: 'aBinaryStream' type: #sqImageFile>
+	<var: 'aSegment' type:#'SpurSegmentInfo *'>
 
-	self assert: segmentManager firstSegmentBytes > 0.
+	self beginWriteImageSegments.
 
-	total := 0.
+	^ segmentManager withNonEmptySegmentsDo: [ :aSegment :segmentIndex | 
+		self
+          writeSegment: aSegment
+          nextIndex: segmentIndex
+			 inImage: imageFileName ].
 
-	segmentManager withNonEmptySegmentsDo: [ :aSegment :segmentIndex | 
-		total := total + (self
-			          writeSegment: aSegment
-			          nextIndex: segmentIndex
-						 inImage: imageFileName)].
 
-	^ total
 ]
 
 { #category : #writing }
@@ -52,33 +68,44 @@ ComposedImageWriter >> writeSTON: ston toFile: f [
 { #category : #writing }
 ComposedImageWriter >> writeSegment: segment nextIndex: segmentIndex inImage: imageFileName [
 
+	| metadataFile dataFile nWritten |
+
+	metadataFile := self sqImageSTONFile: (self segmentMetadataFile: segmentIndex inImage: imageFileName) Open: 'wb'.
+	metadataFile ifNil: [ "could not open the file for writing" 
+		^ self primitiveFail ].
+
+	self writeSegmentMetadata: segment toFile: metadataFile.
+
+	self sqImageFileClose: metadataFile.
+
+
+	dataFile := self sqImageFile: (self segmentDataFile: segmentIndex inImage: imageFileName) Open: 'wb'.
+	dataFile ifNil: [ "could not open the file for writing" 
+		^ self primitiveFail ].
+
+	nWritten := self
+						sq: segment segStart asVoidPointer
+						Image: 1
+						File: segment segSize
+						Write: dataFile.
+
+	self sqImageFileClose: dataFile.
+
+
+	^ nWritten
+]
+
+{ #category : #writing }
+ComposedImageWriter >> writeSegmentMetadata: segment toFile: file [
+
+	<var: #metadata type: #ComposedSegmentMetadataStruct>
 	| metadata |
 
-	metadata := ComposedSegmentMetadataStruct new.
+	self simulationOnly: [ metadata := ComposedSegmentMetadataStruct new. ].
 	metadata segStart: segment segStart.
 	metadata segSize: segment segSize.
 
-	self 	cCode: [ "TODO" ] 
-			inSmalltalk: [ 
-				(self segmentMetadataFile: segmentIndex inImage: imageFileName) writeStreamDo: [ :file |
-					self writeSTON: metadata toFile: file 
-				]	
-			].
-
-
-	self 	cCode: [ "TODO" ] 
-			inSmalltalk: [ 
-				| region |
-				region := objectMemory memoryManager regionForAddress: segment segStart.
-
-				(self segmentDataFile: segmentIndex inImage: imageFileName) binaryWriteStreamDo: [ :file |
-					file
-						next: segment segSize
-						putAll: region memory
-						startingAt: segment segStart - region start + 1
-				]
-
-			].
-
-	^ segment segSize
+	self writeSTON: metadata toFile: file 	
+
+
 ]
diff --git a/smalltalksrc/VMMaker/SpurImageWriter.class.st b/smalltalksrc/VMMaker/SpurImageWriter.class.st
@@ -85,20 +85,6 @@ SpurImageWriter >> sqImage: file File: imageName StartLocation: location [
 	^0
 ]
 
-{ #category : #'accessing - files' }
-SpurImageWriter >> sqImageFile: imageName Open: fileMode [
-
-	<doNotGenerate>
-	^imageName asFileReference binaryWriteStream
-]
-
-{ #category : #'accessing - files' }
-SpurImageWriter >> sqImageFileClose: file [
-
-	<doNotGenerate>
-	file close
-]
-
 { #category : #'accessing - files' }
 SpurImageWriter >> sqImageFilePosition: file [
 
@@ -190,21 +176,14 @@ SpurImageWriter >> writeImageSegmentsToFile: aBinaryStream [
 	<var: 'aBinaryStream' type: #sqImageFile>
 	<var: 'aSegment' type:#'SpurSegmentInfo *'>
 
-	| total |
-
-	self assert: (objectMemory getMemoryMap oldSpaceEnd  = segmentManager lastSegment segLimit
-				 or: [objectMemory getMemoryMap oldSpaceEnd  + objectMemory bridgeSize = segmentManager lastSegment segLimit]).
+	self beginWriteImageSegments.
 
-	self assert: segmentManager firstSegmentBytes > 0.
-
-	total := 0.
+	^ segmentManager withNonEmptySegmentsDo: [ :aSegment :segmentIndex | 
+		self 
+			writeSegment: aSegment
+			nextSegment: (segmentManager nextNonEmptySegmentAfter: segmentIndex)
+			toFile: aBinaryStream ].
 
-	segmentManager withNonEmptySegmentsDo: [ :aSegment :segmentIndex | 
-		total := total + (self writeSegment: aSegment
-								nextSegment: (segmentManager nextNonEmptySegmentAfter: segmentIndex)
-								toFile: aBinaryStream) ].
-
-	^total
 ]
 
 { #category : #writing }
@@ -240,20 +219,11 @@ SpurImageWriter >> writeSegment: segment nextSegment: nextSegment toFile: aBinar
 		long64At: pier2
 		put: (nextSegment ifNil: [0] ifNotNil: [nextSegment segSize]).
 
-	nWritten := self cCode:
-						[self
-							sq: segment segStart asVoidPointer
-							Image: 1
-							File: segment segSize
-							Write: aBinaryStream]
-					inSmalltalk: [ | region |
-						region := (objectMemory memoryManager regionForAddress: segment segStart).
-
-						aBinaryStream
-							next: segment segSize
-							putAll: region memory
-							startingAt: segment segStart - region start + 1.
-						segment segSize].
+	nWritten := self
+						sq: segment segStart asVoidPointer
+						Image: 1
+						File: segment segSize
+						Write: aBinaryStream.
 
 	objectMemory
 		long64At: pier1 put: firstSavedBridgeWord;

diff --git a/smalltalksrc/VMMaker/SpurSegmentManager.class.st b/smalltalksrc/VMMaker/SpurSegmentManager.class.st
@@ -711,9 +711,15 @@ SpurSegmentManager >> withNewSegmentDo: aClosure [
 { #category : #snapshot }
 SpurSegmentManager >> withNonEmptySegmentsDo: aBlockClosure [
 
+	| total |
+	total := 0.
+
 	0 to: self numSegments - 1 do:
-		[:i|
+		[ :i |
 		(segments at: i) segSize > manager bridgeSize 
-			ifTrue: [ aBlockClosure value: (self addressOf: (segments at: i)) value: i]].
+			ifTrue: [ 
+				total := total + (aBlockClosure value: (self addressOf: (segments at: i)) value: i)]
+		].
 
+	^ total
 ]