- Fixing the C implementation of ComposedImage format

- Adding a migration process

smalltalksrc/Melchor/CCodeGeneratorGlobalStructure.class.st

@@ -202,9 +202,12 @@ CCodeGeneratorGlobalStructure >> generateCASTSetFieldTo: aTSendNode [
 		| comparison |
 
 		comparison := TSendNode 
-			receiver: (TConstantNode value: slot name asString) 
-			selector: 'strcmp:' 
-			arguments: { fieldName }.
+									receiver: (TSendNode 
+											receiver: (TConstantNode value: slot name asString) 
+											selector: 'strcmp:' 
+											arguments: { fieldName })
+									selector: '='
+									arguments: { TConstantNode value: 0 }.
 
 		TSendNode 
 			receiver: comparison
@@ -246,10 +249,12 @@ CCodeGeneratorGlobalStructure >> generateCASTWithFieldsDoSeparatedBy: aTSendNode
 		}
 	].
 
-	allRewrittenStatements := allFieldArguments collect: [ :fieldArgs |
-		(self bindBlock: fieldBlock withArgs: fieldArgs) , blockSeparatorStatements ].
+	allRewrittenStatements := OrderedCollection new.
 
-	^ CCompoundStatementNode statements: (allRewrittenStatements flattened collect: [ :e | e asCASTIn: self]).
+	allFieldArguments do: [ :fieldArgs | allRewrittenStatements addAll: (self bindBlock: fieldBlock withArgs: fieldArgs) ]
+		separatedBy: [ allRewrittenStatements addAll: blockSeparatorStatements ].
+
+	^ CCompoundStatementNode statements: (allRewrittenStatements collect: [ :e | e asCASTIn: self]).
 
 ]
 

smalltalksrc/Printf/PrintfFormatDescriptor.class.st

@@ -57,6 +57,8 @@ PrintfFormatDescriptor class >> scanFrom: stream [
 	stream peek isDigit ifTrue: [desc width: (Integer readFrom: stream)].
 	stream peek == $. ifTrue: [stream next. desc precision: (Integer readFrom: stream)].
 	stream peek == $l ifTrue: [stream next].
+	stream peek == $l ifTrue: [stream next].
+
 	desc := desc operator: stream next.
 	^ desc
 ]

smalltalksrc/VMMaker/AbstractComposedImageAccess.class.st

@@ -1,10 +1,6 @@
 Class {
 	#name : #AbstractComposedImageAccess,
 	#superclass : #AbstractImageAccess,
-	#instVars : [
-		'fieldFormat',
-		'headFormat'
-	],
 	#category : #'VMMaker-ImageFormat'
 }
 
@@ -46,15 +42,22 @@ AbstractComposedImageAccess >> existSegment: segmentIndex inImage: imageFileName
 		            bufferSize: 255.
 
 	^ self
-		  cCode: [ self stat: fileName _: (self addressOf: sb) ]
+		  cCode: [ (self stat: fileName _: (self addressOf: sb)) = 0]
 		  inSmalltalk: [ fileName asFileReference exists ]
 ]
 
+{ #category : #'as yet unclassified' }
+AbstractComposedImageAccess >> fieldFormat [
+
+	<inline: true>
+	^ '\t#%s : %lld'.
+]
+
 { #category : #'file primitives' }
 AbstractComposedImageAccess >> fscanf: file _: format _: varHolder [
 
 	<doNotGenerate>
-	^ (format = headFormat)
+	^ (format = self headFormat)
 		  ifTrue: [ 
 			  varHolder contents: (file nextLine substrings: ' ') first ];
 		  yourself
@@ -64,7 +67,8 @@ AbstractComposedImageAccess >> fscanf: file _: format _: varHolder [
 AbstractComposedImageAccess >> fscanf: file _: format _: varHolder1 _: varHolder2 [
 
 	<doNotGenerate>
-	^ (format = fieldFormat)
+
+	^ (format = self fieldFormat)
 		  ifTrue: [ 
 			  | line dataArray |
 			  line := file nextLine.
@@ -77,6 +81,13 @@ AbstractComposedImageAccess >> fscanf: file _: format _: varHolder1 _: varHolder
 		  yourself
 ]
 
+{ #category : #'as yet unclassified' }
+AbstractComposedImageAccess >> headFormat [
+
+	<inline: true>
+	^ '%s {\n'.
+]
+
 { #category : #'file operations' }
 AbstractComposedImageAccess >> headerFileNameinImage: imageFileName into: buffer bufferSize: bufferSize [
 
@@ -90,15 +101,6 @@ AbstractComposedImageAccess >> headerFileNameinImage: imageFileName into: buffer
 		inSmalltalk: [ imageFileName , '/', headerFileName ]
 ]
 
-{ #category : #initialization }
-AbstractComposedImageAccess >> initialize [
-
-	super initialize.
-
-	headFormat := '%s {\n'.
-	fieldFormat := '\t#%s : %ld'.
-]
-
 { #category : #'file operations' }
 AbstractComposedImageAccess >> segmentDataFile: segmentIndex inImage: imageFileName [
 

smalltalksrc/VMMaker/ComposedImageReader.class.st

@@ -12,7 +12,8 @@ ComposedImageReader >> endOfSTON: file [
 	| charLeft charRight |
 	charLeft := self fgetc: file.
 	charRight := self fgetc: file.
-	^ (charLeft = self endOfLine) and: [ charRight = $} ]
+
+	^ (self isEndOfLine: charLeft) and: [ charRight = $} ]
 ]
 
 { #category : #reading }
@@ -26,12 +27,17 @@ ComposedImageReader >> readFieldsSTONFrom: file into: aStruct [
 		fieldName := ValueHolder new.
 		fieldValue := ValueHolder new ].
 
-	"This solution does NOT WORK with STON file without fields (empty STON)"
+	"Initialize the Struct with zeros"
+
+	aStruct 
+		withFieldsDo: [ :fn :fv | aStruct setField: fn to: 0 ]
+		separatedBy: [ ].
 
+	"This solution does NOT WORK with STON file without fields (empty STON)"
 	[ 
 		self
 			fscanf: file
-			_: fieldFormat
+			_: self fieldFormat
 			_: fieldName
 			_: (self addressOf: fieldValue).
 
@@ -49,7 +55,7 @@ ComposedImageReader >> readHeadSTONFrom: file into: aStruct [
 	| structName |
 	self simulationOnly: [ structName := ValueHolder new ].
 
-	self fscanf: file _: headFormat _: structName.
+	self fscanf: file _: self headFormat _: structName.
 
 	self simulationOnly: [ 
 		aStruct withStructNameDo: [ :name | 

smalltalksrc/VMMaker/ComposedImageWriter.class.st

@@ -75,13 +75,13 @@ ComposedImageWriter >> writeSTON: struct toFile: f [
 	<inline: true>
 	| fieldHasNilValue |
 
-	struct withStructNameDo: [ :name | self fprintf: f _: headFormat _: name ].
+	struct withStructNameDo: [ :name | self fprintf: f _: self headFormat _: name ].
 	struct withFieldsDo: [ :fieldName :fieldValue |
 		fieldValue 
 			ifNil: [ 	fieldHasNilValue := true ]
 			ifNotNil: [  
 				fieldHasNilValue := false.
-				self fprintf: f _: fieldFormat _: fieldName _: fieldValue ]]
+				self fprintf: f _: self fieldFormat _: fieldName _: fieldValue ]]
 		separatedBy: [ fieldHasNilValue ifFalse: [self fprintf: f _: ',\n'] ].
 
 	self fprintf: f _: '\n}'. 

smalltalksrc/VMMaker/StackInterpreter.class.st

@@ -648,15 +648,15 @@ StackInterpreter class >> imageReaderClass [
 
 	^Smalltalk at: (InitializationOptions
 					at: #ImageReader
-					ifAbsent: [ #SpurImageReader ])
+					ifAbsent: [ #ComposedImageReader ])
 ]
 
 { #category : #accessing }
 StackInterpreter class >> imageWriterClass [
 
 	^Smalltalk at: (InitializationOptions
 					at: #ImageWriter
-					ifAbsent: [ #SpurImageWriter ])
+					ifAbsent: [ #ComposedImageWriter ])
 ]
 
 { #category : #translation }

smalltalksrc/VMMaker/VMClass.class.st

@@ -639,12 +639,6 @@ VMClass >> defined: aSymbol [
 		ifNotNil: [:binding| binding value ~~ #undefined]
 ]
 
-{ #category : #'file primitives' }
-VMClass >> endOfLine [
-
-	^ self cCode: [ 13 ] inSmalltalk: [ Character cr ]
-]
-
 { #category : #'memory access' }
 VMClass >> fetchSingleFloatAtPointer: pointer into: aFloat [
 	"This gets implemented by Macros in C, where its types will also be checked.
@@ -701,9 +695,11 @@ VMClass >> fprintf: aStream format: aFormat arguments: arguments [
 	| printf |
 	printf := PrintfFormatString new setFormat: aFormat.
 
-	aStream nextPutAll: (printf
+	(ZnNewLineWriterStream on: aStream)	
+		nextPutAll: (printf
 			 printf: arguments;
-			 string)
+			 string);
+		flush
 ]
 
 { #category : #'C library simulation' }
@@ -789,6 +785,16 @@ VMClass >> isCurrentImageFacade [
 	^false
 ]
 
+{ #category : #'file primitives' }
+VMClass >> isEndOfLine: aCharacter [
+
+	<inline: true>
+
+	^ self 
+		cCode: [ aCharacter = 13 or: [ aCharacter = 10 ] ] 
+		inSmalltalk: [ Character cr = aCharacter or: [ Character lf = aCharacter ] ]
+]
+
 { #category : #'plugin support' }
 VMClass >> isInterpreterProxy [
 	<doNotGenerate>

smalltalksrc/VMMaker/VMSpurImageToComposedImageMigrationProcess.class.st

@@ -0,0 +1,61 @@
+Class {
+	#name : #VMSpurImageToComposedImageMigrationProcess,
+	#superclass : #Object,
+	#instVars : [
+		'interpreter',
+		'memory'
+	],
+	#category : #'VMMaker-PermSpace'
+}
+
+{ #category : #'as yet unclassified' }
+VMSpurImageToComposedImageMigrationProcess >> createSimulator [
+
+	| environmentBuilder memoryClass |
+	environmentBuilder := VMSimulatedEnvironmentBuilder new.
+	memoryClass := Spur64BitMemoryManager simulatorClass.
+
+	environmentBuilder 
+		interpreterClass: StackInterpreterSimulatorLSB;
+		objectMemoryClass: memoryClass;
+	 	initializationOptions: { 
+			#BytesPerWord. 8.
+			#ObjectMemory. memoryClass name.
+		  	#ImageReader. SpurImageReader name.
+		  	#ImageWriter. ComposedImageWriter name};
+		wordSize: 8;
+		initialCodeSize: 4*1024; 
+		primitiveTraceLogSize: 0.
+
+	environmentBuilder build.
+
+	interpreter := environmentBuilder interpreter.
+	memory := environmentBuilder objectMemory.
+]
+
+{ #category : #'as yet unclassified' }
+VMSpurImageToComposedImageMigrationProcess >> loadImage: originalImage [
+
+	interpreter openOn: originalImage extraMemory: 0.
+
+
+]
+
+{ #category : #'as yet unclassified' }
+VMSpurImageToComposedImageMigrationProcess >> migrate: originalImage to: newImage [
+
+	self createSimulator.
+	self loadImage: originalImage.
+	self saveImage: newImage.
+
+
+]
+
+{ #category : #'as yet unclassified' }
+VMSpurImageToComposedImageMigrationProcess >> saveImage: newImage [
+
+	interpreter imageName: newImage.
+	interpreter writeImageFileIO.
+
+
+]

smalltalksrc/VMMakerTests/VMAbstractImageFormatTest.class.st

@@ -49,6 +49,17 @@ VMAbstractImageFormatTest >> setUp [
 
 ]
 
+{ #category : #ston }
+VMAbstractImageFormatTest >> stonPretty: anObject [ 
+
+	^ String streamContents: [ :s |
+		(STONWriter on: s)
+			prettyPrint: true;
+			newLine: OSPlatform current lineEnding;
+			nextPut: anObject			
+		 ]
+]
+
 { #category : #running }
 VMAbstractImageFormatTest >> tearDown [
 

smalltalksrc/VMMakerTests/VMImageHeaderWritingTest.class.st

@@ -169,7 +169,7 @@ VMImageHeaderWritingTest >> testWritingSTONHeader [
 
 	readHeader := (self imageFileName asFileReference  / 'header.ston') contents.
 
-	self assert: readHeader equals: (STON toStringPretty: header).
+	self assert: readHeader equals: (self stonPretty: header).
 ]
 
 { #category : #tests }
@@ -187,5 +187,5 @@ VMImageHeaderWritingTest >> testWritingSTONSegment [
 	segmentMetadata segStart: header oldBaseAddr.
 	segmentMetadata segSize: header dataSize.
 
-	self assert: writtenHeader equals: (STON toStringPretty: segmentMetadata).
+	self assert: writtenHeader equals: (self stonPretty: segmentMetadata).
 ]

smalltalksrc/VMMakerTests/VMImageReadingTest.class.st

@@ -56,7 +56,7 @@ VMImageReadingTest >> testReadingSTONHeader [
 
 	headerFile position: 0.
 
-	self assert: (STON toStringPretty: headerStruct) equals: headerFile contents.
+	self assert: (self stonPretty: headerStruct) equals: headerFile contents.
 ]
 
 { #category : #tests }