Save & load segments with composed format

smalltalksrc/VMMaker/AbstractImageAccess.class.st

@@ -37,6 +37,58 @@ AbstractImageAccess class >> newWithMemory: memory andInterpreter: anInterpreter
 	^ newInstance
 ]
 
+{ #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."
+	"This code is based on C code by Ian Piumarta."
+
+	<inline: false>
+	| version firstVersion |
+	<var: #file type: #sqImageFile>
+	<var: #imageOffset type: #squeakFileOffsetType>
+	<var: #header type: #'SpurImageHeaderStruct *'>
+
+	"check the version number"
+	version := firstVersion := fileVersion.
+	(self readableFormat: version) ifTrue: [
+		header imageFormat: version.
+		header swapBytes: false.
+		^ self].
+
+	"try with bytes reversed"
+	(self readableFormat: version byteSwap32) 
+		ifTrue: [
+			header imageFormat: version byteSwap32.
+			header swapBytes: true.
+			^ self].
+
+	"hard failure; abort"
+	self logError: 'Invalid image format: detected version %d, expected version %d' 
+		_: firstVersion 
+		_: self imageFormatVersion.
+
+	self ioExitWithErrorCode: 1.
+
+]
+
+{ #category : #reading }
+AbstractImageAccess >> imageFormatCompatibilityVersion [
+	"This VM is backward-compatible with the immediately preceding version."
+
+	^objectMemory wordSize = 4 ifTrue: [6504] ifFalse: [68002]
+]
+
+{ #category : #reading }
+AbstractImageAccess >> imageFormatVersion [
+	"Return a magic constant that changes when the image format changes.
+	 Since the image reading code uses this to detect byte ordering, one
+	 must avoid version numbers that are invariant under byte reversal."
+
+	<doNotGenerate>
+	self assert: (objectMemory imageFormatVersion anyMask: 16) = objectMemory hasSpurMemoryManagerAPI.
+	^objectMemory imageFormatVersion
+]
+
 { #category : #reading }
 AbstractImageAccess >> initializeInterpreterFromHeader: header withBytes: bytesRead [
 
@@ -89,13 +141,44 @@ AbstractImageAccess >> loadHeaderToMemory: header [
 
 ]
 
+{ #category : #api }
+AbstractImageAccess >> loadImageFromFile: imageFile withHeader: header [
+
+	"read in the image in bulk, then swap the bytes if necessary"
+
+	<var: #f type: #sqImageFile>
+	<var: #header type: #SpurImageHeaderStruct>
+	| bytesRead |
+
+	bytesRead := self readSegmentsFromImageFile: imageFile header: header.
+
+	self initializeInterpreterFromHeader: header withBytes: bytesRead
+
+]
+
 { #category : #accessing }
 AbstractImageAccess >> objectMemory: memory [
 
 	<doNotGenerate>
 	objectMemory := memory
 ]
 
+{ #category : #reading }
+AbstractImageAccess >> readSegmentsFromImageFile: imageFile header: header [
+
+	self subclassResponsibility 
+]
+
+{ #category : #reading }
+AbstractImageAccess >> readableFormat: imageVersion [
+	"Anwer true if images of the given format are readable by this interpreter.
+	 Allows a virtual machine to accept selected older image formats."
+
+	^imageVersion = self imageFormatVersion "Float words in platform-order"
+	   or: [objectMemory hasSpurMemoryManagerAPI not "No compatibility version for Spur as yet"
+			and: [imageVersion = self imageFormatCompatibilityVersion]] "Float words in BigEndian order"
+]
+
 { #category : #accessing }
 AbstractImageAccess >> segmentManager: anObject [
 

smalltalksrc/VMMaker/AbstractSTONImageAccess.class.st

@@ -5,8 +5,62 @@ Class {
 }
 
 { #category : #'file operations' }
-AbstractSTONImageAccess >> headerFileName: imageFileName [
+AbstractSTONImageAccess >> headerFile: imageFileName [
 
-	self flag: #TODO.
-	^ imageFileName", '/header.ston'"
+	| imageFile |
+	imageFile := self imageFile: imageFileName.
+
+	^ imageFile / 'header.ston'
+]
+
+{ #category : #'file operations' }
+AbstractSTONImageAccess >> imageFile: imageFileName [
+
+	| imageFile |
+	imageFile := imageFileName asFileReference.
+	imageFile ensureCreateDirectory.
+
+	^ imageFile
+]
+
+{ #category : #'file operations' }
+AbstractSTONImageAccess >> isSegmentMetadata: file [
+
+	^ file extension = 'ston' and: [ file basename beginsWith: 'seg' ]
+]
+
+{ #category : #'file operations' }
+AbstractSTONImageAccess >> segmentDataFile: segmentIndex fromFile: imageFile [
+
+	| segmentDataFileName |
+	segmentDataFileName := 'seg' , segmentIndex asString , '.data'.
+
+	^ imageFile / segmentDataFileName
+]
+
+{ #category : #'file operations' }
+AbstractSTONImageAccess >> segmentDataFile: segmentIndex inImage: imageFileName [
+
+	| imageFile |
+	imageFile := self imageFile: imageFileName.
+
+	^ self segmentDataFile: segmentIndex fromFile: imageFile 
+]
+
+{ #category : #'file operations' }
+AbstractSTONImageAccess >> segmentMetadataFile: segmentIndex fromFile: imageFile [
+
+	| segmentDataFileName |
+	segmentDataFileName := 'seg' , segmentIndex asString , '.ston'.
+
+	^ imageFile / segmentDataFileName
+]
+
+{ #category : #'file operations' }
+AbstractSTONImageAccess >> segmentMetadataFile: segmentIndex inImage: imageFileName [
+
+	| imageFile |
+	imageFile := self imageFile: imageFileName.
+
+	^ self segmentMetadataFile: segmentIndex fromFile: imageFile 
 ]

smalltalksrc/VMMaker/ComposedSegmentMetadataStruct.class.st

@@ -0,0 +1,33 @@
+Class {
+	#name : #ComposedSegmentMetadataStruct,
+	#superclass : #VMStructType,
+	#instVars : [
+		'segStart',
+		'segSize'
+	],
+	#category : #'VMMaker-ImageFormat'
+}
+
+{ #category : #accessing }
+ComposedSegmentMetadataStruct >> segSize [
+
+	^ segSize
+]
+
+{ #category : #accessing }
+ComposedSegmentMetadataStruct >> segSize: anInt [
+
+	segSize := anInt
+]
+
+{ #category : #accessing }
+ComposedSegmentMetadataStruct >> segStart [
+
+	^ segStart
+]
+
+{ #category : #accessing }
+ComposedSegmentMetadataStruct >> segStart: anInt [
+
+	segStart := anInt
+]

smalltalksrc/VMMaker/STONImageReader.class.st

@@ -5,47 +5,129 @@ Class {
 }
 
 { #category : #api }
-STONImageReader >> loadImageFromFile: f withHeader: header [
+STONImageReader >> readHeaderFromImage: anImageFileName [
+
+	| header |
+	header := (self headerFile: anImageFileName) readStreamDo: [ :f | 
+		          self readSTONFrom: f ].
 
-	self flag: #TODO. "We have many files"
-	self flag: #TODO. "Read segments"
-	self initializeInterpreterFromHeader: header withBytes: 0 "bytesToShift"
+	self extractImageVersionFrom: (header imageFormat) into: (self addressOf: header).
+
+	^ header
+]
+
+{ #category : #api }
+STONImageReader >> readImageNamed: anImageName [
+
+	| header imageFile |
+
+	imageFile := self imageFile: anImageName.
+	header := self readHeaderFromImage: anImageName.
+
+	self loadHeaderToMemory: header.
+	interpreter allocateMemoryForImage: imageFile withHeader: header.
+
+	^ header dataSize
 ]
 
 { #category : #reading }
-STONImageReader >> readHeaderFrom: f [
+STONImageReader >> readSTONFrom: f [
 
 	<var: #f type: #sqImageFile>
-	<var: #headerStart type: #squeakFileOffsetType>
-	<var: #header type: #SpurImageHeaderStruct>
 	<returnTypeC: #SpurImageHeaderStruct>
 
 	^ STON reader on: f; next
 ]
 
 { #category : #api }
-STONImageReader >> readHeaderFromImage: anImageFileName [
-
-	| header |
-	header := (self headerFileName: anImageFileName) asFileReference readStreamDo: [ :f | 
-		          self readHeaderFrom: f ].
+STONImageReader >> readSegmentMetadata: segmentIndex fromFile: imageFile [
 
-	^ header
+	^ (self segmentMetadataFile: segmentIndex fromFile: imageFile) 
+		  readStreamDo: [ :f | self readSTONFrom: f ]
 ]
 
-{ #category : #api }
-STONImageReader >> readImageNamed: anImageName [
+{ #category : #reading }
+STONImageReader >> readSegmentsFromImageFile: imageFile header: aHeader [
+
+	"Compare with SpurImageReader >> readSegmentsFromImageFile:header:"
+
+	<var: #imageFile type: #sqImageFile>
+	<inline: false>
+	<var: 'segInfo' type: #'SpurSegmentInfo *'>
+	<var: 'aHeader' type: #SpurImageHeaderStruct>
+	| bytesRead totalBytesRead bridgehead bridge segmentSize oldBase newBase segmentIndex existNextSegment |
+
+	segmentManager clearSegments.
+	segmentManager allocateOrExtendSegmentInfos.
+
+	"segment sizes include the two-header-word bridge at the end of each segment."
+	segmentIndex := 0. 
+	totalBytesRead := 0.
+	oldBase := aHeader oldBaseAddr.
+	newBase := objectMemory getMemoryMap oldSpaceStart.
+	segmentSize := aHeader firstSegSize.
 
-	| header f |
+	[ 
+	segmentManager withNewSegmentDo: [ :segInfo | 
+		segInfo
+			segStart: oldBase;
+			segSize: segmentSize;
+			swizzle: newBase - oldBase ].
 
-	self flag: #TODO. "We have many files"
-	f := anImageName asFileReference readStream.
+	bytesRead := self 
+		sq: (self pointerForOop: newBase)
+		readSegment: segmentIndex
+		File: segmentSize
+		Read: imageFile.
 
-	header := self readHeaderFromImage: anImageName.
+	bytesRead > 0 ifTrue: [ totalBytesRead := totalBytesRead + bytesRead ].
+
+	"Check segment bytes read"
+	bytesRead ~= segmentSize ifTrue: [ interpreter unableToReadImageError ].
 
-	self loadHeaderToMemory: header.
+	"The next segment will override the bridge of this segment"
+	newBase := newBase + segmentSize - objectMemory bridgeSize.
 
-	interpreter allocateMemoryForImage: f withHeader: header.
+	"Check if exist next segment"
+	segmentIndex := segmentIndex + 1. 
+	existNextSegment := (imageFile childrenMatching: 'seg' , segmentIndex asString , '*' ) isNotEmpty.
+
+	existNextSegment ifTrue: [ | nextSegmentMetadata |
+			nextSegmentMetadata := self readSegmentMetadata: segmentIndex fromFile: imageFile.
+			oldBase := nextSegmentMetadata segStart.
+			segmentSize := nextSegmentMetadata segSize.
+		].
+
+	existNextSegment
+	] whileTrue.
 
-	^ header dataSize
+	"newBase should point just past the last bridge. all others should have been eliminated."
+	self assert:
+		newBase - objectMemory getMemoryMap oldSpaceStart = (totalBytesRead
+		 - (segmentManager numSegments * objectMemory bridgeSize)).
+
+	"Segments has correct swizzle values, so it can be used to swizzle objects"
+	segmentManager setCanSwizzle: true.
+
+	"set freeOldSpaceStart now for adjustAllOopsBy:"
+	objectMemory setFreeOldSpaceStart: newBase.
+
+	^ totalBytesRead
+]
+
+{ #category : #reading }
+STONImageReader >> sq: startingAddress readSegment: segmentIndex File: bytesToRead Read: imageFile [
+
+	<doNotGenerate>
+	| region |
+
+	region := objectMemory memoryManager regionForAddress: startingAddress.
+
+	^ (self segmentDataFile: segmentIndex fromFile: imageFile) binaryReadStreamDo: [ :file |
+		file 
+			readInto: region memory
+			startingAt: startingAddress - region start + 1
+			count: bytesToRead
+		 ]
+
 ]