C translation: Segments metadata STON write

smalltalksrc/Melchor/CCodeGeneratorGlobalStructure.class.st

@@ -191,11 +191,11 @@ CCodeGeneratorGlobalStructure >> generateCASTWithFieldsDo: aTSendNode [
 	self assert: aTSendNode arguments first args size = 2.
 	self assert: aTSendNode arguments second args size = 0.
 
-
 	fieldBlock := aTSendNode arguments first.
 	blockSeparatorStatements := aTSendNode arguments second statements.
 
-	structType := self typeOfVariable: aTSendNode receiver name.
+	structType := self structTypeFor: aTSendNode receiver.
+
 	allFieldArguments := structType asClass allSlots collect: [ :slot |
 		{
 			TConstantNode value: slot name asString. 
@@ -218,7 +218,7 @@ CCodeGeneratorGlobalStructure >> generateCASTWithStructNameDo: aTSendNode [
 	self assert: aTSendNode arguments size = 1.
 	self assert: aTSendNode arguments first args size = 1.
 
-	structType := self typeOfVariable: aTSendNode receiver name.
+	structType := self structTypeFor: aTSendNode receiver.
 
 	aBlock := aTSendNode arguments first.
 	argumentName := aTSendNode arguments first args first.
@@ -293,3 +293,16 @@ CCodeGeneratorGlobalStructure >> structDefDefine: aString [
 '1' - which would mean always do it"
 	structDefDefine := aString
 ]
+
+{ #category : #'CAST translation' }
+CCodeGeneratorGlobalStructure >> structTypeFor: structNode [
+
+	structNode isVariable ifTrue: [ 
+		^ self typeOfVariable: structNode name ].
+
+	(structNode isSend and: [ structNode selector = #cCoerceSimple:to: ]) ifTrue: [ 
+		^ structNode arguments second value ].
+
+	self error.
+
+]

smalltalksrc/VMMaker/AbstractComposedImageAccess.class.st

@@ -4,6 +4,39 @@ Class {
 	#category : #'VMMaker-ImageFormat'
 }
 
+{ #category : #'file primitives' }
+AbstractComposedImageAccess >> fprintf: aStream _: format [ 
+
+	<doNotGenerate>
+	^ self fprintf: aStream format: format arguments: { }
+]
+
+{ #category : #'file primitives' }
+AbstractComposedImageAccess >> fprintf: aStream _: format _: aValue [ 
+
+	<doNotGenerate>
+	^ self fprintf: aStream format: format arguments: { aValue }
+]
+
+{ #category : #'file primitives' }
+AbstractComposedImageAccess >> fprintf: aStream _: format _: aValue _: otherValue [
+
+	<doNotGenerate>
+	^ self fprintf: aStream format: format arguments: { aValue. otherValue }
+]
+
+{ #category : #'file primitives' }
+AbstractComposedImageAccess >> fprintf: aStream format: aFormat arguments: arguments [
+
+	<doNotGenerate>
+	| printf |
+	printf := PrintfFormatString new setFormat: aFormat.
+
+	aStream nextPutAll: (printf
+			 printf: arguments;
+			 string)
+]
+
 { #category : #'file operations' }
 AbstractComposedImageAccess >> headerFile: imageFileName [
 
@@ -120,10 +153,3 @@ AbstractComposedImageAccess >> vmConcatPath: dirPath File: fileName [
 	self free: prefix.
 	^ fullPath
 ]
-
-{ #category : #'accessing - files' }
-AbstractComposedImageAccess >> vmImageSTONFile: file Open: fileMode [
-
-	<doNotGenerate>
-	^file asFileReference writeStream
-]

smalltalksrc/VMMaker/AbstractImageAccess.class.st

@@ -237,7 +237,10 @@ AbstractImageAccess >> sq: segStart Image: n File: segSize Write: file [
 AbstractImageAccess >> sqImageFile: imageName Open: fileMode [
 
 	<doNotGenerate>
-	^imageName asFileReference binaryWriteStream
+	^ (fileMode includesSubstring: 'b')
+		ifTrue: [ imageName asFileReference binaryWriteStream ]
+		ifFalse: [ imageName asFileReference writeStream ]
+
 ]
 
 { #category : #'accessing - files' }

smalltalksrc/VMMaker/ComposedImageWriter.class.st

@@ -1,59 +1,16 @@
 Class {
 	#name : #ComposedImageWriter,
 	#superclass : #AbstractComposedImageAccess,
-	#instVars : [
-		'stonWriter'
-	],
 	#category : #'VMMaker-ImageFormat'
 }
 
-{ #category : #'file primitives' }
-ComposedImageWriter >> fprintf: aStream _: format [ 
-
-	<doNotGenerate>
-	^ self fprintf: aStream format: format arguments: { }
-]
-
-{ #category : #'file primitives' }
-ComposedImageWriter >> fprintf: aStream _: format _: aValue [ 
-
-	<doNotGenerate>
-	^ self fprintf: aStream format: format arguments: { aValue }
-]
-
-{ #category : #'file primitives' }
-ComposedImageWriter >> fprintf: aStream _: format _: aValue _: otherValue [
-
-	<doNotGenerate>
-	^ self fprintf: aStream format: format arguments: { aValue. otherValue }
-]
-
-{ #category : #'file primitives' }
-ComposedImageWriter >> fprintf: aStream format: aFormat arguments: arguments [
-
-	<doNotGenerate>
-	| printf |
-	printf := PrintfFormatString new setFormat: aFormat.
-
-	aStream nextPutAll: (printf
-			 printf: arguments;
-			 string)
-]
-
-{ #category : #writing }
-ComposedImageWriter >> initialize [ 
-
-	super initialize .
-	stonWriter := STON writer.
-]
-
 { #category : #writing }
 ComposedImageWriter >> writeHeaderFile: imageFileName fromHeader: header [
 
-	<var: #file type: #sqImageFile> "ImageFile ?"
+	<var: #file type: #sqImageFile>
 	| file |
 
-	file := self vmImageSTONFile: (self headerFile: imageFileName) Open: 'wb'.
+	file := self sqImageFile: (self headerFile: imageFileName) Open: 'w'.
 	file ifNil: [ "could not open the file for writing" 
 		^ self primitiveFail ].
 
@@ -64,20 +21,9 @@ ComposedImageWriter >> writeHeaderFile: imageFileName fromHeader: header [
 ]
 
 { #category : #writing }
-ComposedImageWriter >> writeHeaderSTON: header toFile: f [
+ComposedImageWriter >> writeHeaderSTON: header toFile: f [ 
 
-	| fieldHasNilValue |
-
-	header withStructNameDo: [ :name | self fprintf: f _: '%s {\n' _: name ].
-	header withFieldsDo: [ :fieldName :fieldValue |
-		fieldValue 
-			ifNil: [ 	fieldHasNilValue := true ]
-			ifNotNil: [  
-				fieldHasNilValue := false.			
-				self fprintf: f _: '\t#%s : %ld' _: fieldName _: fieldValue ]]
-		separatedBy: [ fieldHasNilValue ifFalse: [self fprintf: f _: ',\n'] ].
-
-	self fprintf: f _: '\n}'. 
+	self writeSTON: header toFile: f
 ]
 
 { #category : #api }
@@ -119,17 +65,27 @@ ComposedImageWriter >> writeImageSegments: imageFileName [
 { #category : #writing }
 ComposedImageWriter >> writeSTON: struct toFile: f [
 
-	stonWriter
-		on: f;
-		nextPut: struct
+	<inline: true>
+	| fieldHasNilValue |
+
+	struct withStructNameDo: [ :name | self fprintf: f _: '%s {\n' _: name ].
+	struct withFieldsDo: [ :fieldName :fieldValue |
+		fieldValue 
+			ifNil: [ 	fieldHasNilValue := true ]
+			ifNotNil: [  
+				fieldHasNilValue := false.			
+				self fprintf: f _: '\t#%s : %ld' _: fieldName _: fieldValue ]]
+		separatedBy: [ fieldHasNilValue ifFalse: [self fprintf: f _: ',\n'] ].
+
+	self fprintf: f _: '\n}'. 
 ]
 
 { #category : #writing }
 ComposedImageWriter >> writeSegment: segment nextIndex: segmentIndex inImage: imageFileName [
 
 	| metadataFile dataFile nWritten |
 
-	metadataFile := self vmImageSTONFile: (self segmentMetadataFile: segmentIndex inImage: imageFileName) Open: 'wb'.
+	metadataFile := self sqImageFile: (self segmentMetadataFile: segmentIndex inImage: imageFileName) Open: 'w'.
 	metadataFile ifNil: [ "could not open the file for writing" 
 		^ self primitiveFail ].
 
@@ -164,7 +120,16 @@ ComposedImageWriter >> writeSegmentMetadata: segment toFile: file [
 	metadata segStart: segment segStart.
 	metadata segSize: segment segSize.
 
-	self writeSTON: metadata toFile: file 	
+	self writeSegmentSTON: metadata toFile: file 	
+
+
+]
+
+{ #category : #writing }
+ComposedImageWriter >> writeSegmentSTON: segmentMetadata toFile: f [ 
 
+	<var: #f type: #sqImageFile>
+	<var: #segmentMetadata type: #ComposedSegmentMetadataStruct>
 
+	self writeSTON: segmentMetadata toFile: f
 ]

smalltalksrc/VMMaker/StackInterpreter.class.st

@@ -640,7 +640,8 @@ If ffi is put as a separate header, slang will sort the header and put it outsid
 		"this variable is not used in the exported code, so it has to be removed.
 		If it is changed, it should be marked with type implicit"
 		removeVariable: 'imageReader'; 
-		var: 'imageWriter' type: #implicit. 
+		removeVariable: 'imageWriter'.
+
 ]
 
 { #category : #'as yet unclassified' }