Refactor image writer/reader for polymorphic use

smalltalksrc/VMMaker/AbstractImageAccess.class.st

@@ -37,6 +37,22 @@ AbstractImageAccess class >> newWithMemory: memory andInterpreter: anInterpreter
 	^ newInstance
 ]
 
+{ #category : #reading }
+AbstractImageAccess >> initializeInterpreterFromHeader: header withBytes: bytesRead [
+
+	| bytesToShift |
+
+	bytesRead ~= header dataSize ifTrue: [ 
+		interpreter unableToReadImageError ].
+
+	interpreter ensureImageFormatIsUpToDate: header swapBytes.
+
+	"compute difference between old and new memory base addresses"
+	bytesToShift := objectMemory getMemoryMap oldSpaceStart - header oldBaseAddr.
+
+	interpreter initializeInterpreter: bytesToShift "adjusts all oops to new location"
+]
+
 { #category : #accessing }
 AbstractImageAccess >> interpreter [
 
@@ -53,6 +69,26 @@ AbstractImageAccess >> interpreter: anObject [
 	interpreter := anObject
 ]
 
+{ #category : #reading }
+AbstractImageAccess >> loadHeaderToMemory: header [
+
+	objectMemory initializeMemoryMap.
+
+	objectMemory specialObjectsOop: header initialSpecialObjectsOop.
+	objectMemory lastHash: header hdrLastHash.
+
+	interpreter setImageHeaderFlagsFrom: header headerFlags.
+	interpreter setExtraVMMemory: header extraVMMemory.
+
+	interpreter setNumStackPages: header hdrNumStackPages.
+
+	interpreter initializeObjectMemoryWithEdenBytes: header hdrEdenBytes.
+
+	header hdrMaxExtSemTabSize ~= 0 ifTrue: [ 
+		interpreter setMaxExtSemSizeTo: header hdrMaxExtSemTabSize ].
+
+]
+
 { #category : #accessing }
 AbstractImageAccess >> objectMemory: memory [
 

smalltalksrc/VMMaker/AbstractSTONImageAccess.class.st

@@ -0,0 +1,12 @@
+Class {
+	#name : #AbstractSTONImageAccess,
+	#superclass : #AbstractImageAccess,
+	#category : #'VMMaker-ImageFormat'
+}
+
+{ #category : #'file operations' }
+AbstractSTONImageAccess >> headerFileName: imageFileName [
+
+	self flag: #TODO.
+	^ imageFileName", '/header.ston'"
+]

smalltalksrc/VMMaker/CogVMSimulator.class.st

@@ -41,6 +41,8 @@ cos
 Class {
 	#name : #CogVMSimulator,
 	#superclass : #CoInterpreterPrimitives,
+	#traits : 'TVMSimulator',
+	#classTraits : 'TVMSimulator classTrait',
 	#instVars : [
 		'parent',
 		'enableCog',
@@ -2140,34 +2142,6 @@ CogVMSimulator >> openAsMorphNoTranscript [
 								* (1@(1/0.95))) rounded
 ]
 
-{ #category : #initialization }
-CogVMSimulator >> openOn: fileName extraMemory: extraBytes [
-
-	"CogVMSimulator new openOn: 'clone.im' extraMemory: 100000"
-
-	| f |
-
-	"We set the memory manager if it is not already set"	
-	memoryManager ifNil: [	
-		memoryManager := MachineSimulatorMemoryManager new.
-		objectMemory memoryManager: memoryManager.
-		memoryManager wordSize: objectMemory wordSize.
-	].
-
-	"open image file and read the header"
-	(f := self openImageFileNamed: fileName) ifNil: [ ^ self ].
-
-	"Set the image name and the first argument; there are
-	 no arguments during simulation unless set explicitly."
-	systemAttributes
-		at: 1 put: fileName;
-		at: 2 put: nil.
-
-	[ imageReader readImageFromFile: f StartingAt: 0 ] 
-		ensure: [ f close ].
-
-]
-
 { #category : #'stack pages' }
 CogVMSimulator >> osCogStackPageHeadroom [
 	"Notional headroom for the simulator.  The platform provides this in the real VM."

smalltalksrc/VMMaker/STONImageReader.class.st

@@ -1,11 +1,19 @@
 Class {
 	#name : #STONImageReader,
-	#superclass : #AbstractImageAccess,
+	#superclass : #AbstractSTONImageAccess,
 	#category : #'VMMaker-ImageFormat'
 }
 
+{ #category : #api }
+STONImageReader >> loadImageFromFile: f withHeader: header [
+
+	self flag: #TODO. "We have many files"
+	self flag: #TODO. "Read segments"
+	self initializeInterpreterFromHeader: header withBytes: 0 "bytesToShift"
+]
+
 { #category : #reading }
-STONImageReader >> readHeaderFrom: f startingAt: headerStart [ "Unnecesary"
+STONImageReader >> readHeaderFrom: f [
 
 	<var: #f type: #sqImageFile>
 	<var: #headerStart type: #squeakFileOffsetType>
@@ -14,3 +22,30 @@ STONImageReader >> readHeaderFrom: f startingAt: headerStart [ "Unnecesary"
 
 	^ STON reader on: f; next
 ]
+
+{ #category : #api }
+STONImageReader >> readHeaderFromImage: anImageFileName [
+
+	| header |
+	header := (self headerFileName: anImageFileName) asFileReference readStreamDo: [ :f | 
+		          self readHeaderFrom: f ].
+
+	^ header
+]
+
+{ #category : #api }
+STONImageReader >> readImageNamed: anImageName [
+
+	| header f |
+
+	self flag: #TODO. "We have many files"
+	f := anImageName asFileReference readStream.
+
+	header := self readHeaderFromImage: anImageName.
+
+	self loadHeaderToMemory: header.
+
+	interpreter allocateMemoryForImage: f withHeader: header.
+
+	^ header dataSize
+]

smalltalksrc/VMMaker/STONImageWriter.class.st

@@ -1,6 +1,6 @@
 Class {
 	#name : #STONImageWriter,
-	#superclass : #AbstractImageAccess,
+	#superclass : #AbstractSTONImageAccess,
 	#category : #'VMMaker-ImageFormat'
 }
 
@@ -11,3 +11,12 @@ STONImageWriter >> writeHeader: header toFile: f [
 		on: f;
 		nextPut: header
 ]
+
+{ #category : #api }
+STONImageWriter >> writeImageFile: imageFileName fromHeader: header [
+
+	(self headerFileName: imageFileName) asFileReference writeStreamDo: [ :file | 
+		self writeHeader: header toFile: file ].
+
+	self flag: #TODO "Save segments"
+]

smalltalksrc/VMMaker/SpurImageReader.class.st

@@ -112,25 +112,19 @@ SpurImageReader >> imageFormatVersion [
 	^objectMemory imageFormatVersion
 ]
 
-{ #category : #reading }
+{ #category : #api }
 SpurImageReader >> loadImageFromFile: f withHeader: header [
 
 	"read in the image in bulk, then swap the bytes if necessary"
 
 	<var: #f type: #sqImageFile>
 	<var: #header type: #SpurImageHeaderStruct>
-	| bytesRead bytesToShift |
-	bytesRead := self readSegmentsFromImageFile: f header: header.
+	| bytesRead |
 
-	bytesRead ~= header dataSize ifTrue: [ 
-		interpreter unableToReadImageError ].
+	bytesRead := self readSegmentsFromImageFile: f header: header.
 
-	interpreter ensureImageFormatIsUpToDate: header swapBytes.
+	self initializeInterpreterFromHeader: header withBytes: bytesRead
 
-	"compute difference between old and new memory base addresses"
-	bytesToShift := objectMemory getMemoryMap oldSpaceStart - header oldBaseAddr.
-
-	interpreter initializeInterpreter: bytesToShift "adjusts all oops to new location"
 ]
 
 { #category : #reading }
@@ -186,6 +180,15 @@ SpurImageReader >> readHeaderFrom: f startingAt: headerStart [
 	^ header
 ]
 
+{ #category : #api }
+SpurImageReader >> readHeaderFromImage: anImageName [
+
+	| header |
+	header := anImageName asFileReference binaryReadStreamDo: [ :f | 
+		          self readHeaderFrom: f startingAt: 0 ].
+	^ header
+]
+
 { #category : #reading }
 SpurImageReader >> readImageFromFile: f StartingAt: headerStart [
 
@@ -216,28 +219,21 @@ SpurImageReader >> readImageFromFile: f StartingAt: headerStart [
 
 	| header |
 
-	objectMemory initializeMemoryMap.
-
 	header := self readHeaderFrom: f startingAt: headerStart.
 
-	objectMemory specialObjectsOop: header initialSpecialObjectsOop.
-	objectMemory lastHash: header hdrLastHash.
-
-	interpreter setImageHeaderFlagsFrom: header headerFlags.
-	interpreter setExtraVMMemory: header extraVMMemory.
-
-	interpreter setNumStackPages: header hdrNumStackPages.
-
-	interpreter initializeObjectMemoryWithEdenBytes: header hdrEdenBytes.
+	self loadHeaderToMemory: header.
 
-	header hdrMaxExtSemTabSize ~= 0 ifTrue: [ 
-		interpreter setMaxExtSemSizeTo: header hdrMaxExtSemTabSize ].
-
 	interpreter allocateMemoryForImage: f withHeader: header.
 
 	^ header dataSize
 ]
 
+{ #category : #api }
+SpurImageReader >> readImageNamed: anImageName [
+
+	^ self readImageFromFile: anImageName asFileReference binaryReadStream StartingAt: 0  
+]
+
 { #category : #segments }
 SpurImageReader >> readSegmentsFromImageFile: f header: aHeader [
 

smalltalksrc/VMMaker/SpurImageWriter.class.st

@@ -126,7 +126,7 @@ SpurImageWriter >> writeHeader: header toFile: f [
 
 ]
 
-{ #category : #writing }
+{ #category : #api }
 SpurImageWriter >> writeImageFile: imageFileName fromHeader: header [
 
 	"Write the image header and heap contents to imageFile for snapshot. c.f. writeImageFileIOSimulation.

smalltalksrc/VMMaker/StackInterpreter.class.st

@@ -7568,6 +7568,12 @@ StackInterpreter >> imageFormatVersion [
 	^objectMemory imageFormatVersion
 ]
 
+{ #category : #accessing }
+StackInterpreter >> imageReader [
+	<doNotGenerate>
+	^ imageReader
+]
+
 { #category : #'plugin primitive support' }
 StackInterpreter >> includesBehavior: aClass ThatOf: aSuperclass [
 	"Return the equivalent of 
@@ -10814,14 +10820,6 @@ StackInterpreter >> okayInterpreterObjects [
 	self okayStackZone.
 ]
 
-{ #category : #'simulation support' }
-StackInterpreter >> openImageFileNamed: fileName [
-	"Attempt to open fileName or fileName, '.image'"
-	<doNotGenerate>
-	self setImageName: fileName.
-	^ fileName asFileReference binaryReadStream
-]
-
 { #category : #simulation }
 StackInterpreter >> openOn: fileName [
 	"(StackInterpreterSimulator new openOn: 'clonex.image') openAsMorph; run"

smalltalksrc/VMMaker/StackInterpreterSimulator.class.st

@@ -21,6 +21,8 @@ vm openAsMorph; run
 Class {
 	#name : #StackInterpreterSimulator,
 	#superclass : #StackInterpreterPrimitives,
+	#traits : 'TVMSimulator',
+	#classTraits : 'TVMSimulator classTrait',
 	#instVars : [
 		'parent',
 		'bootstrapping',
@@ -1436,34 +1438,6 @@ StackInterpreterSimulator >> nextShortFrom: aStream [
 	^self subclassResponsibility
 ]
 
-{ #category : #initialization }
-StackInterpreterSimulator >> openOn: fileName extraMemory: extraBytes [
-
-	"CogVMSimulator new openOn: 'clone.im' extraMemory: 100000"
-
-	| f |
-
-	"We set the memory manager if it is not already set"	
-	memoryManager ifNil: [	
-		memoryManager := MachineSimulatorMemoryManager new.
-		objectMemory memoryManager: memoryManager.
-		memoryManager wordSize: objectMemory wordSize.
-	].
-
-	"open image file and read the header"
-	(f := self openImageFileNamed: fileName) ifNil: [ ^ self ].
-
-	"Set the image name and the first argument; there are
-	 no arguments during simulation unless set explicitly."
-	systemAttributes
-		at: 1 put: fileName;
-		at: 2 put: nil.
-
-	[ imageReader readImageFromFile: f StartingAt: 0 ] 
-		ensure: [ f close ].
-
-]
-
 { #category : #accessing }
 StackInterpreterSimulator >> parent [
 

smalltalksrc/VMMaker/TVMSimulator.trait.st

@@ -0,0 +1,27 @@
+Trait {
+	#name : #TVMSimulator,
+	#category : #VMMaker
+}
+
+{ #category : #initialization }
+TVMSimulator >> openOn: fileName extraMemory: extraBytes [
+
+	"CogVMSimulator new openOn: 'clone.im' extraMemory: 100000"
+
+	"We set the memory manager if it is not already set"	
+	self memoryManager ifNil: [	
+		self memoryManager: MachineSimulatorMemoryManager new.
+		self objectMemory memoryManager: self memoryManager.
+		self memoryManager wordSize: self objectMemory wordSize.
+	].
+
+	"Set the image name and the first argument; there are
+	 no arguments during simulation unless set explicitly."
+	self systemAttributes
+		at: 1 put: fileName;
+		at: 2 put: nil.
+
+	self simulationOnly: [ self setImageName: fileName  ].
+	^ self imageReader readImageNamed: fileName 
+
+]

smalltalksrc/VMMakerTests/VMAbstractImageFormatTest.class.st

@@ -57,10 +57,7 @@ VMAbstractImageFormatTest >> initializationOptions [
 { #category : #tests }
 VMAbstractImageFormatTest >> readHeader [
 
-	| header |
-	header := self imageFileName asFileReference binaryReadStreamDo: [ :f | 
-		          imageReader readHeaderFrom: f startingAt: 0 ].
-	^ header
+	^ imageReader readHeaderFromImage: self imageFileName
 ]
 
 { #category : #actions }