- Removing ScreenSize that was unused

- Adding Image version to the header
- Adding primitives to access it as VMParameter 79
- Reading / Saving it on image Read / Save

smalltalksrc/VMMaker/SpurImageHeaderStruct.class.st

@@ -17,7 +17,8 @@ Class {
 		'hdrLastHash',
 		'imageFormat',
 		'screenSize',
-		'imageHeaderSize'
+		'imageHeaderSize',
+		'imageVersion'
 	],
 	#category : #'VMMaker-ImageFormat'
 }
@@ -194,39 +195,39 @@ SpurImageHeaderStruct >> imageHeaderSize: anObject [
 ]
 
 { #category : #accessing }
-SpurImageHeaderStruct >> initialSpecialObjectsOop [
+SpurImageHeaderStruct >> imageVersion [
 
-	^ initialSpecialObjectsOop
+	^ imageVersion
 ]
 
 { #category : #accessing }
-SpurImageHeaderStruct >> initialSpecialObjectsOop: anObject [
+SpurImageHeaderStruct >> imageVersion: anObject [
 
-	initialSpecialObjectsOop := anObject
+	imageVersion := anObject
 ]
 
 { #category : #accessing }
-SpurImageHeaderStruct >> oldBaseAddr [
+SpurImageHeaderStruct >> initialSpecialObjectsOop [
 
-	^ oldBaseAddr
+	^ initialSpecialObjectsOop
 ]
 
 { #category : #accessing }
-SpurImageHeaderStruct >> oldBaseAddr: anObject [
+SpurImageHeaderStruct >> initialSpecialObjectsOop: anObject [
 
-	oldBaseAddr := anObject
+	initialSpecialObjectsOop := anObject
 ]
 
 { #category : #accessing }
-SpurImageHeaderStruct >> screenSize [
+SpurImageHeaderStruct >> oldBaseAddr [
 
-	^ screenSize
+	^ oldBaseAddr
 ]
 
 { #category : #accessing }
-SpurImageHeaderStruct >> screenSize: anObject [
+SpurImageHeaderStruct >> oldBaseAddr: anObject [
 
-	screenSize := anObject
+	oldBaseAddr := anObject
 ]
 
 { #category : #accessing }

smalltalksrc/VMMaker/SpurImageReader.class.st

@@ -154,8 +154,9 @@ SpurImageReader >> readHeaderFrom: f startingAt: headerStart [
 
 	header hdrLastHash: (self getLongFromFile: f swap: header swapBytes).
 
-	"savedWindowSize :="
+	"Unused, it was ScreenSize, used until Pharo9 Images"
 	self getLongFromFile: f swap: header swapBytes.
+
 	header headerFlags: (self getLongFromFile: f swap: header swapBytes).
 
 	header extraVMMemory:
@@ -170,14 +171,11 @@ SpurImageReader >> readHeaderFrom: f startingAt: headerStart [
 
 	header hdrMaxExtSemTabSize:
 		(self getShortFromFile: f swap: header swapBytes).
-	"pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
-	 Preserve it to be polite to other VMs."
-	"the2ndUnknownShort :="
-	self getShortFromFile: f swap: header swapBytes.
-	header firstSegSize: (self getLongFromFile: f swap: header swapBytes).
 
-	header freeOldSpaceInImage:
-		(self getLongFromFile: f swap: header swapBytes).
+	header imageVersion: (self getShortFromFile: f swap: header swapBytes).
+
+	header firstSegSize: (self getLongFromFile: f swap: header swapBytes).
+	header freeOldSpaceInImage: (self getLongFromFile: f swap: header swapBytes).
 
 	"position file after the header"
 	self sqImageFile: f Seek: headerStart + header imageHeaderSize.
@@ -216,6 +214,8 @@ SpurImageReader >> readImageFromFile: f StartingAt: headerStart [
 	objectMemory specialObjectsOop: header initialSpecialObjectsOop.
 	objectMemory lastHash: header hdrLastHash.
 
+	interpreter setImageVersion: header imageVersion.
+
 	interpreter setImageHeaderFlagsFrom: header headerFlags.
 	interpreter setExtraVMMemory: header extraVMMemory.
 

smalltalksrc/VMMaker/SpurImageWriter.class.st

@@ -115,14 +115,14 @@ SpurImageWriter >> writeHeader: header toFile: f [
 	self putLong: header oldBaseAddr toFile: f.
 	self putLong: header initialSpecialObjectsOop toFile: f.
 	self putLong: header hdrLastHash toFile: f.
-	self putLong: header screenSize toFile: f.
+	self putLong: 0 toFile: f. "It was ScreenSize, used until Pharo9, now unused"
 	self putLong: header headerFlags toFile: f.
 	self putWord32: header extraVMMemory toFile: f.
 	self putShort: header hdrNumStackPages toFile: f.
 	self putShort: header hdrCogCodeSize toFile: f.
 	self putWord32: header hdrEdenBytes toFile: f.
 	self putShort: header hdrMaxExtSemTabSize toFile: f.
-	self putShort: 0 toFile: f. "the2ndUnknownShort"
+	self putShort: header imageVersion toFile: f. 
 
 ]
 

smalltalksrc/VMMaker/StackInterpreter.class.st

@@ -405,7 +405,8 @@ Class {
 		'messageCount',
 		'imageReader',
 		'imageWriter',
-		'pendingFinalizationSignals'
+		'pendingFinalizationSignals',
+		'imageVersion'
 	],
 	#classVars : [
 		'AlternateHeaderHasPrimFlag',
@@ -7181,6 +7182,12 @@ StackInterpreter >> getImageHeaderFlags [
 	+ (imageHeaderFlags bitClear: 16rD3) "these are any flags we do not recognize"
 ]
 
+{ #category : #accessing }
+StackInterpreter >> getImageVersion [
+
+	^ imageVersion
+]
+
 { #category : #accessing }
 StackInterpreter >> getMaxExtSemTabSizeSet [
 
@@ -7665,6 +7672,7 @@ StackInterpreter >> initialize [
 	statProcessSwitch := statStackPageDivorce :=
 	statIdleUsecs := 0.
 	messageCount := 0.
+	imageVersion := 0.
 ]
 
 { #category : #initialization }
@@ -10517,12 +10525,12 @@ StackInterpreter >> newHeader [
 	header oldBaseAddr: objectMemory oldSpaceStart.
 	header initialSpecialObjectsOop: objectMemory specialObjectsOop.
 	header hdrLastHash: objectMemory lastHash.
-	header screenSize: 0.
 	header headerFlags: self getImageHeaderFlags.
 	header extraVMMemory: (self getExtraVMMemory ifNil: [ 0 ]).
 	header hdrNumStackPages: self getDesiredNumStackPages.
 	header hdrCogCodeSize: self unknownShortOrCodeSizeInKs.
 	header hdrEdenBytes: self getDesiredEdenBytes.
+	header imageVersion: self getImageVersion.
 
 	header hdrMaxExtSemTabSize: (
 		self getMaxExtSemTabSizeSet
@@ -13590,6 +13598,13 @@ StackInterpreter >> setImageName: aString [
 	self shouldNotImplement 
 ]
 
+{ #category : #accessing }
+StackInterpreter >> setImageVersion: aValue [
+
+	"It is a short value"
+	imageVersion := aValue bitAnd: 16rFFFF
+]
+
 { #category : #'process primitive support' }
 StackInterpreter >> setMaxExtSemSizeTo: maxExtSemTabSize [
 	maxExtSemTabSizeSet := true.

smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st

@@ -1681,7 +1681,8 @@ StackInterpreterPrimitives >> primitiveGetVMParameter: index [
 			[75] ->	[^self getMethodCompilationCount]. 
 			[76] ->	[^self getMethodCompilationMSecs]. 
 			[77] ->	[^self getBlockCompilationCount]. 
-			[78] ->	[^self getBlockCompilationMSecs] }
+			[78] ->	[^self getBlockCompilationMSecs].
+			[79] ->  [^objectMemory integerObjectOf: self getImageVersion ] }
 		otherwise: [^nil]
 ]
 
@@ -2726,7 +2727,11 @@ StackInterpreterPrimitives >> primitiveSetVMParameter: index arg: argOop [
 			arg >= 0 ifTrue: [
 				result := objectMemory integerObjectOf: objectMemory statMaxAllocSegmentTime + 500 // 1000.
 				stackPages statMaxAllocSegmentTime: arg. "usually 0"
-				self initPrimCall ]] }
+				self initPrimCall ]].
+		[79] -> [ (arg between: 0 and: 65535) ifTrue:
+					[result := objectMemory integerObjectOf: self getImageVersion.
+					 self setImageVersion: arg.
+					 self initPrimCall] ] }
 		otherwise: [].
 
 	self successful
@@ -3910,15 +3915,15 @@ StackInterpreterPrimitives >> primitiveTerminateTo [
 StackInterpreterPrimitives >> primitiveVMParameter [
 	"Behaviour depends on argument count:
 		0 args:	return an Array of VM parameter values;
-		1 arg:	return the indicated VM parameter;
+		1 arg:	   return the indicated VM parameter;
 		2 args:	set the VM indicated parameter.
 
 	The description of each parameter is available in the Image (`VirtualMachine>>#parameterLabels`)
 	Do not forget to update it when new parameters are added.
 	Otherwise the *real* list is in the code: `StackInterpreterPrimitives>>#primitiveGetVMParameter:`"
 
 	| paramsArraySize index |
-	paramsArraySize := 78.
+	paramsArraySize := 79.
 	argumentCount = 0 ifTrue: [^self primitiveAllVMParameters: paramsArraySize].
 	argumentCount > 2 ifTrue: [^self primitiveFailFor: PrimErrBadNumArgs].
 

smalltalksrc/VMMakerTests/VMPrimitiveTest.class.st

@@ -5069,6 +5069,21 @@ VMPrimitiveTest >> testPrimitiveSubtractWithOverflowPreservesStack [
 
 ]
 
+{ #category : #'tests - primitiveVMParameter' }
+VMPrimitiveTest >> testPrimitiveVMParameterGetsImageVersion [
+
+	interpreter setImageVersion: 110.
+
+	interpreter push: memory nilObject.
+	interpreter push: (memory integerObjectOf: 79).
+
+	interpreter argumentCount: 1.
+	interpreter primitiveVMParameter.
+
+	self assert: interpreter successful.
+	self assert: interpreter stackTop equals: (memory integerObjectOf: 110).
+]
+
 { #category : #'tests - primitiveVMParameter' }
 VMPrimitiveTest >> testPrimitiveVMParameterReturnsArrayOfOops [
 
@@ -5086,11 +5101,25 @@ VMPrimitiveTest >> testPrimitiveVMParameterReturnsArrayOfOops [
 	interpreter preemptionYields: true.
 	interpreter primitiveVMParameter.
 
-	"Check this is an array that has 78 OOP entries"
+	"Check this is an array that has 79 OOP entries"
 	self assert: (memory isArray: interpreter stackTop).
 	slots := memory numSlotsOf: interpreter stackTop.
-	self assert: slots equals: 78.
+	self assert: slots equals: 79.
 
 	0 to: slots - 1 do: [ :i |
 		memory okayOop: (memory fetchPointer: i ofObject: interpreter stackTop) ]
 ]
+
+{ #category : #'tests - primitiveVMParameter' }
+VMPrimitiveTest >> testPrimitiveVMParameterSetsImageVersion [
+
+	interpreter push: memory nilObject.
+	interpreter push: (memory integerObjectOf: 79).
+	interpreter push: (memory integerObjectOf: 110).
+
+	interpreter argumentCount: 2.
+	interpreter primitiveVMParameter.
+
+	self assert: interpreter successful.
+	self assert: interpreter getImageVersion equals: 110.
+]

smalltalksrc/VMMakerTests/VMSpurImageHeaderWritingTest.class.st

@@ -8,6 +8,8 @@ Class {
 VMSpurImageHeaderWritingTest >> setUp [
 
 	super setUp.
+
+	interpreter setImageVersion: 110.
 
 	memory garbageCollectForSnapshot.
 
@@ -138,6 +140,16 @@ VMSpurImageHeaderWritingTest >> testWritingImageWritesCorrectImageFormat [
 	self assert: header imageFormat equals: interpreter imageFormatVersion
 ]
 
+{ #category : #tests }
+VMSpurImageHeaderWritingTest >> testWritingImageWritesCorrectImageVersion [
+
+	| header |
+
+	header := self readHeader.
+
+	self assert: header imageVersion equals: interpreter getImageVersion
+]
+
 { #category : #tests }
 VMSpurImageHeaderWritingTest >> testWritingImageWritesCorrectNextObjectHash [