Translate to C image header reading code for ComposedImageReader

smalltalksrc/Melchor/CCodeGeneratorGlobalStructure.class.st

@@ -183,7 +183,47 @@ CCodeGeneratorGlobalStructure >> emitGlobalStructFlagOn: aStream [
 ]
 
 { #category : #'CAST translation' }
-CCodeGeneratorGlobalStructure >> generateCASTWithFieldsDo: aTSendNode [ 
+CCodeGeneratorGlobalStructure >> generateCASTSetFieldTo: aTSendNode [ 
+
+	| structType fieldName fieldVale setFieldStatements |
+
+	self assert: aTSendNode arguments size = 2.
+
+	fieldName := aTSendNode arguments first.
+	fieldVale := aTSendNode arguments second.
+
+	structType := self structTypeFor: aTSendNode receiver.
+
+
+	setFieldStatements := structType asClass allSlots collect: [ :slot |
+		| comparison |
+
+		comparison := TSendNode 
+			receiver: (TConstantNode value: slot name asString) 
+			selector: '=' 
+			arguments: { fieldName }.
+
+		TSendNode 
+			receiver: comparison
+			selector: 'ifTrue:' 
+			arguments: { 
+				TStmtListNode 
+					statements: { 
+						TSendNode 
+							receiver: aTSendNode receiver 
+							selector: (slot name, ':') 
+							arguments: { fieldVale } 
+					}
+			}			
+
+	].
+
+	^ CCompoundStatementNode statements: (setFieldStatements collect: [ :e | e asCASTIn: self]).
+
+]
+
+{ #category : #'CAST translation' }
+CCodeGeneratorGlobalStructure >> generateCASTWithFieldsDoSeparatedBy: aTSendNode [ 
 
 	| structType allRewrittenStatements blockSeparatorStatements fieldBlock allFieldArguments |
 
@@ -242,8 +282,8 @@ CCodeGeneratorGlobalStructure >> initializeCASTTranslationDictionary [
 	super initializeCASTTranslationDictionary.
 
 	castTranslationDict at: #withStructNameDo: put: #generateCASTWithStructNameDo:.
-	castTranslationDict at: #withFieldsDo:separatedBy: put: #generateCASTWithFieldsDo:.
-
+	castTranslationDict at: #withFieldsDo:separatedBy: put: #generateCASTWithFieldsDoSeparatedBy:.
+	castTranslationDict at: #setField:to: put: #generateCASTSetFieldTo:.
 ]
 
 { #category : #public }
@@ -297,12 +337,7 @@ CCodeGeneratorGlobalStructure >> 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.
-
+	| nodeType |
+	nodeType := self typeFor: structNode in: currentMethod.
+	^ nodeType trimRight: [ :c | { $* . $ } includes: c ]
 ]

smalltalksrc/Slang/CCodeGenerator.class.st

@@ -4368,7 +4368,7 @@ CCodeGenerator >> returnTypeForSend: sendNode in: aTMethod boundTo: aCalledMetho
 				 The integer promotions are performed on each of the operands. The type of the result is that of the promoted left operand..."
 				[#>>]					->	[sendNode receiver typeFrom: self in: aTMethod].
 				[#<<]					->	[sendNode receiver typeFrom: self in: aTMethod].
-				[#addressOf:]			->	[(sendNode receiver typeFrom: self in: aTMethod)
+				[#addressOf:]			->	[(sendNode arguments first typeFrom: self in: aTMethod)
 												ifNil: [#sqInt]
 												ifNotNil: [:type| type, (type last isLetter ifTrue: [' *'] ifFalse: ['*'])]].
 				[#at:]					->	[self typeForDereference: sendNode in: aTMethod].
@@ -4587,6 +4587,8 @@ CCodeGenerator >> sizeOfIntegralCType: anIntegralCType [ "<String>"
 		"Standard C types"
 		['uint64_t']		->	[8].
 		['uint32_t']		->	[4].
+		['uint16_t']		->	[4].
+		['uint8_t']		->	[4].
 	}
 	otherwise:
 		[((anIntegralCType beginsWith: 'unsigned') "e.g. 'unsigned  : 8'"

smalltalksrc/Slang/SlangStructType.class.st

@@ -211,6 +211,14 @@ SlangStructType class >> voidStructTypeCache [
 	StructTypeNameCache := nil
 ]
 
+{ #category : #macros }
+SlangStructType >> setField: fieldName to: fieldValue [
+
+	| slot |
+	slot := self class slotNamed: fieldName.
+	slot write: fieldValue to: self
+]
+
 { #category : #macros }
 SlangStructType >> withFieldsDo: forEachBlock separatedBy: separatorBlock [ 
 

smalltalksrc/Slang/TMethod.class.st

@@ -1472,7 +1472,7 @@ TMethod >> inlineSend: aSendNode directReturn: directReturn exitVar: exitVar in:
 		with: aSendNode args
 		do: [:formal :actual|
 			(meth declarationAt: formal ifAbsent: nil) ifNil:
-				[(self typeFor: actual in: aCodeGen) ifNotNil:
+				[(aCodeGen typeFor: actual in: self) ifNotNil:
 					[:type|
 					type ~= #sqInt ifTrue:
 						[meth declarationAt: formal put: (type last = $* ifTrue: [type, formal] ifFalse: [type, ' ', formal])]]]].
@@ -3017,9 +3017,9 @@ TMethod >> typeFor: aVariable in: aCodeGen [
 					ifTrue: [aCodeGen defaultType, ' ', varName]
 					ifFalse:
 						[(locals includes: varName) ifFalse: "don't provide type for locals"
-							[aCodeGen typeOfVariable: varName]]]) ifNotNil:
-		[:decl|
-		aCodeGen extractTypeFor: varName fromDeclaration: decl]
+							[aCodeGen typeOfVariable: varName  ]]]) 
+				ifNotNil: [:decl|
+						aCodeGen extractTypeFor: varName fromDeclaration: decl]
 ]
 
 { #category : #utilities }

smalltalksrc/VMMaker/AbstractComposedImageAccess.class.st

@@ -1,6 +1,10 @@
 Class {
 	#name : #AbstractComposedImageAccess,
 	#superclass : #AbstractImageAccess,
+	#instVars : [
+		'fieldFormat',
+		'headFormat'
+	],
 	#category : #'VMMaker-ImageFormat'
 }
 
@@ -53,14 +57,28 @@ AbstractComposedImageAccess >> fprintf: aStream format: aFormat arguments: argum
 			 string)
 ]
 
-{ #category : #'file operations' }
-AbstractComposedImageAccess >> headerFile: imageFileName [
+{ #category : #'file primitives' }
+AbstractComposedImageAccess >> fscanf: file _: format _: varHolder [
 
 	<doNotGenerate>
-	| headerFileName imageFile |
-	headerFileName := 'header.ston'.
-	imageFile := self imageFile: imageFileName.
-	^ imageFile / headerFileName
+	^ (format = headFormat)
+		  ifTrue: [ 
+			  varHolder contents: (file nextLine substrings: ' ') first ];
+		  yourself
+]
+
+{ #category : #'file primitives' }
+AbstractComposedImageAccess >> fscanf: file _: format _: varHolder1 _: varHolder2 [
+
+	<doNotGenerate>
+	^ (format = fieldFormat)
+		  ifTrue: [ 
+			  | dataArray |
+			  dataArray := file nextLine substrings: '#:,'.
+			  (dataArray first = '}') ifTrue: [ ^false ].
+			  varHolder1 contents: dataArray second trimLineSpaces.
+			  varHolder2 contents: dataArray third trimLineSpaces asInteger ];
+		  yourself
 ]
 
 { #category : #'file operations' }
@@ -84,7 +102,16 @@ AbstractComposedImageAccess >> imageFile: imageFileName [
 	imageFile := imageFileName asFileReference.
 	imageFile ensureCreateDirectory.
 
-	^ imageFile
+	^ imageFile 
+]
+
+{ #category : #initialization }
+AbstractComposedImageAccess >> initialize [
+
+	super initialize.
+
+	headFormat := '%s {\n'.
+	fieldFormat := '\t#%s : %ld'.
 ]
 
 { #category : #'file operations' }

smalltalksrc/VMMaker/AbstractImageAccess.class.st

@@ -239,10 +239,11 @@ AbstractImageAccess >> sqImageFile: imageName Open: fileMode [
 	<doNotGenerate>
 	| file |
 	file := imageName asFileReference.
-	^ (fileMode includesSubstring: 'b')
-		ifTrue: [ file binaryWriteStream ]
-		ifFalse: [ file writeStream ]
-
+	(fileMode = 'r') ifTrue: [ ^ file readStream ].
+	(fileMode = 'rb') ifTrue: [ ^ file binaryReadStream ].
+	(fileMode = 'w') ifTrue: [ ^ file writeStream ].
+	(fileMode = 'wb') ifTrue: [ ^ file binaryWriteStream ].
+	self error: 'File mode not supported'
 ]
 
 { #category : #'accessing - files' }

smalltalksrc/VMMaker/ComposedImageReader.class.st

@@ -4,43 +4,102 @@ Class {
 	#category : #'VMMaker-ImageFormat'
 }
 
+{ #category : #reading }
+ComposedImageReader >> readFieldsSTONFrom: file into: aStruct [
+
+	<inline: true>
+	<var: #fieldName declareC: 'char buffer[255]'>
+	<var: #fieldValue type: #sqLong>
+	| fieldName fieldValue |
+	self simulationOnly: [ 
+		fieldName := ValueHolder new.
+		fieldValue := ValueHolder new ].
+
+	[ self
+		fscanf: file
+		_: fieldFormat
+		_: (self addressOf: fieldName)
+		_: (self addressOf: fieldValue) 
+	] whileTrue: [  
+		aStruct setField: fieldName contents to: fieldValue contents.
+	]
+
+]
+
+{ #category : #reading }
+ComposedImageReader >> readHeadSTONFrom: file into: aStruct [
+
+	<inline: true>
+	<var: #structName declareC: 'char buffer[255]'>
+	| structName |
+	self simulationOnly: [ structName := ValueHolder new ].
+
+	self fscanf: file _: headFormat _: (self addressOf: structName).
+
+	aStruct withStructNameDo: [ :name | 
+		self assert: name = structName contents ]
+]
+
 { #category : #api }
-ComposedImageReader >> readHeaderFromImage: anImageFileName [
+ComposedImageReader >> readHeaderFromImage: imageFileName [
 
+	<inline: true>
+	<var: #file type: #sqImageFile>
+	<var: #buffer declareC: 'char buffer[255]'>
 	<var: #header type: #SpurImageHeaderStruct>
-	| header |
-	header := (self headerFile: anImageFileName) readStreamDo: [ :f | 
-		          self readSTONFrom: f ].
+	| header buffer file |
+
+	self simulationOnly: [ 
+		buffer := nil. 
+		header:= SpurImageHeaderStruct new 
+	].
+
+	file := self sqImageFile: (self headerFileNameinImage: imageFileName into: buffer bufferSize: 255) Open: 'r'.
+
+	self readSTONFrom: file into: (self addressOf: header).
 
 	self extractImageVersionFrom: (header imageFormat) into: (self addressOf: header).
+
+	self sqImageFileClose: file.
 
 	^ header
 ]
 
 { #category : #api }
-ComposedImageReader >> readImageNamed: anImageName [
-
-	<var: #header type: #'SpurImageHeaderStruct'>
-	<var: #anImageName declareC: 'char *imageFileName'>
+ComposedImageReader >> readImageNamed: imageName [
+
+	<var: #f type: #sqImageFile>
+	<var: #imageName declareC: 'char *imageName'>
+	<var: #aHeader type: #'SpurImageHeaderStruct'>
+	<api>
 
-	| header imageFile |
+	| aHeader f |
 
-	imageFile := self imageFile: anImageName.
-	header := self readHeaderFromImage: anImageName.
+	f := self imageFile: imageName.
+	aHeader := self readHeaderFromImage: imageName.
 
-	self loadHeaderToMemory: header.
-	interpreter allocateMemoryForImage: imageFile withHeader: header.
+	self loadHeaderToMemory: aHeader.
+	interpreter allocateMemoryForImage: f withHeader: aHeader.
 
-	^ header dataSize
+	self flag: #TODO. "Fix this"
+	^ self sqImageFileClose: f readStream .
 ]
 
 { #category : #reading }
-ComposedImageReader >> readSTONFrom: f [
+ComposedImageReader >> readSTONFrom: file [
 
-	<var: #f type: #sqImageFile>
-	<returnTypeC: #SpurImageHeaderStruct>
+	<doNotGenerate>
+	^ STON reader
+		  on: file;
+		  next
+]
+
+{ #category : #reading }
+ComposedImageReader >> readSTONFrom: file into: aStruct [
 
-	^ STON reader on: f; next
+	<inline: true>
+	self readHeadSTONFrom: file into: aStruct.
+	self readFieldsSTONFrom: file into: aStruct
 ]
 
 { #category : #segments }

smalltalksrc/VMMaker/ComposedImageWriter.class.st

@@ -53,7 +53,7 @@ ComposedImageWriter >> writeImageFile: imageFileName fromHeader: header [
 	interpreter success: bytesWritten = header dataSize 
 ]
 
-{ #category : #writing }
+{ #category : #segments }
 ComposedImageWriter >> writeImageSegments: imageFileName [
 
 	<var: 'aSegment' type:#'SpurSegmentInfo *'>
@@ -75,19 +75,19 @@ ComposedImageWriter >> writeSTON: struct toFile: f [
 	<inline: true>
 	| fieldHasNilValue |
 
-	struct withStructNameDo: [ :name | self fprintf: f _: '%s {\n' _: name ].
+	struct withStructNameDo: [ :name | self fprintf: f _: headFormat _: name ].
 	struct withFieldsDo: [ :fieldName :fieldValue |
 		fieldValue 
 			ifNil: [ 	fieldHasNilValue := true ]
 			ifNotNil: [  
 				fieldHasNilValue := false.
-				self fprintf: f _: '\t#%s : %ld' _: fieldName _: fieldValue ]]
+				self fprintf: f _: fieldFormat _: fieldName _: fieldValue ]]
 		separatedBy: [ fieldHasNilValue ifFalse: [self fprintf: f _: ',\n'] ].
 
 	self fprintf: f _: '\n}'. 
 ]
 
-{ #category : #writing }
+{ #category : #segments }
 ComposedImageWriter >> writeSegment: segment nextIndex: segmentIndex inImage: imageFileName [
 
 	<inline: false>
@@ -99,7 +99,7 @@ ComposedImageWriter >> writeSegment: segment nextIndex: segmentIndex inImage: im
 	^ self writeSegmentData: segment nextIndex: segmentIndex inImage: imageFileName.
 ]
 
-{ #category : #writing }
+{ #category : #segments }
 ComposedImageWriter >> writeSegmentData: segment nextIndex: segmentIndex inImage: imageFileName [
 
 	<var: #dataFile type: #sqImageFile>
@@ -121,7 +121,7 @@ ComposedImageWriter >> writeSegmentData: segment nextIndex: segmentIndex inImage
 	^ nWritten
 ]
 
-{ #category : #writing }
+{ #category : #segments }
 ComposedImageWriter >> writeSegmentMetadata: segment nextIndex: segmentIndex inImage: imageFileName [
 
 	<var: #metadataFile type: #sqImageFile>
@@ -138,7 +138,7 @@ ComposedImageWriter >> writeSegmentMetadata: segment nextIndex: segmentIndex inI
 
 ]
 
-{ #category : #writing }
+{ #category : #segments }
 ComposedImageWriter >> writeSegmentMetadata: segment toFile: file [
 
 	<var: #metadata type: #ComposedSegmentMetadataStruct>