[Vm-dev] VM Maker: VMMaker.oscog-eem.3228.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Jul 31 00:09:05 UTC 2022


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3228.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.3228
Author: eem
Time: 30 July 2022, 5:08:52.212867 pm
UUID: 02cd75d5-0049-4b27-a5b9-3451af576384
Ancestors: VMMaker.oscog-eem.3227

Slang:
Improve inferTypesForImplicitlyTypedVariablesIn:, reducing the special casing and simply deferring to each kind of parse node to determine its own type.  hence allow typing of TSwitchStmtNode, especially when some cases return.  This allows
	var := expr caseOf: { [v1] -> ['a string].  [v2] -> ['b string] }
				otherwise: [^interpreterProxy primitiveFailFor: PrimErrNoMatch].
to type correctly var as char *.

Hence don't prepend assignments to TSwitchStmtNode cases which return.

Hence extract the type merging in CCodeGenerator>>#mergeTypeOf:in:with:method: into CCodeGenerator>>#mergeType:with:.

=============== Diff against VMMaker.oscog-eem.3227 ===============

Item was added:
+ ----- Method: CCodeGenerator>>mergeType:with: (in category 'type inference') -----
+ mergeType: existingType with: newType
+ 	"Attempt to merge the two types. If they're the same type, merge.
+ 	 If they're both pointer types, and one is void *, merge.
+ 	 If they're both integral types, merge. If they're both floating point types, merge.
+ 	 If the existing type is floating point and the new type is integral, merge (allow assignments of integers to floats).
+ 	 Otherewise fail to merge, indicated by answering nil."
+ 	existingType = newType ifTrue:
+ 		[^existingType].
+ 	((self isPointerCType: existingType)
+ 	  or: [self isPointerCType: newType]) ifTrue:
+ 			[existingType = #'void *' ifTrue: [^newType].
+ 			 newType = #'void *' ifTrue: [^existingType].
+ 			 ^nil].
+ 	((self isIntegralCType: existingType)
+ 	  and: [self isIntegralCType: newType]) ifTrue:
+ 		[^self promoteIntegerArithmeticTypes: existingType and: newType].
+ 	((self isFloatingPointCType: existingType)
+ 	  and: [(self isFloatingPointCType: newType) or: [self isIntegralCType: newType]]) ifTrue:
+ 		[^self promoteArithmeticTypes: existingType and: newType].
+ 	^nil!

Item was changed:
  ----- Method: CCodeGenerator>>mergeTypeOf:in:with:method: (in category 'type inference') -----
  mergeTypeOf: var in: aDictionary with: newType method: tMethod
  	"var is a variable that has been assigned an expression of type  newType.
  	 Either assign its type, if it is as yet untyped, or merge newType with its existing type.
  	 N.B. We refuse to promote a variable that already has integral type to a floating point
  	 type.  The existing plugins depend on this; one can always use an explicit type in future."
+ 	| existingType |
- 	| existingType mergedType |
  	existingType := self
  						extractTypeFor: var
  						fromDeclaration: (aDictionary at: var ifAbsentPut: [newType, ' ', var]).
+ 	^(self mergeType: existingType with: newType)
+ 		ifNil:
+ 			[self logger show: 'conflicting types ', existingType, ' ', newType, ' for ', var, ' in ', tMethod selector.
+ 			 existingType]
+ 		ifNotNil:
+ 			[:mergedType| | finalType |
+ 			"We prefer sqInt (word sized integer) over int; since maybe sizeof(int) < sizeof(void *)"
+ 			finalType := (existingType ~= newType and: [mergedType = #int])
+ 							ifTrue: [#sqInt]
+ 							ifFalse: [mergedType].
+ 			aDictionary at: var put: (finalType last = $* ifTrue: [finalType] ifFalse: [finalType, ' ']), var.
+ 			finalType]!
- 	existingType ~= newType ifTrue:
- 		[((self isPointerCType: existingType)
- 		  or: [self isPointerCType: newType])
- 			ifTrue:
- 				[existingType = #'void *' ifTrue: [^newType].
- 				 newType = #'void *' ifTrue: [^existingType].
- 				 self logger show: 'conflicting types ', existingType, ' ', newType, ' for ', var, ' in ', tMethod selector.
- 				 ^existingType]
- 			ifFalse:
- 				[((self isIntegralCType: existingType)
- 				  and: [self isFloatingPointCType: newType]) ifFalse:
- 					[mergedType := self promoteArithmeticTypes: existingType and: newType.
- 					 aDictionary at: var put: mergedType, ' ', var]]]!

Item was added:
+ ----- Method: TAssignmentNode>>finalExpression (in category 'accessing') -----
+ finalExpression
+ 	"If this is a chain of assignments, answer the final expression, not the ionterpediate assignment."
+ 
+ 	^expression isAssignment
+ 		ifTrue: [expression finalExpression]
+ 		ifFalse: [expression]!

Item was changed:
  ----- Method: TMethod>>inferTypesForImplicitlyTypedVariablesIn: (in category 'type inference') -----
  inferTypesForImplicitlyTypedVariablesIn: aCodeGen
  	"infer types for untyped variables from assignments and arithmetic uses.
  	 For debugging answer a Dictionary from var to the nodes that determined types
  	 This for debugging:
  		(self copy inferTypesForImplicitlyTypedVariablesIn: aCodeGen)"
  	| alreadyExplicitlyTypedOrNotToBeTyped asYetUntyped mustBeSigned newDeclarations effectiveNodes prependType |
  	aCodeGen maybeBreakForTestToInline: selector in: self.
  	alreadyExplicitlyTypedOrNotToBeTyped := declarations keys asSet.
  	asYetUntyped := locals copyWithoutAll: alreadyExplicitlyTypedOrNotToBeTyped.
  	mustBeSigned := Set new.
  	newDeclarations := Dictionary new.
  	effectiveNodes := Dictionary new. "this for debugging"
  	prependType := [:type :var| type last == $* ifTrue: [type, var] ifFalse: [type, ' ', var]].
  	parseTree nodesDo:
+ 		[:node| | var |
- 		[:node| | type var |
  		"If there is something of the form i >= 0, then i should be signed, not unsigned."
  		(node isSend
  		 and: [(locals includes: (var := node receiver variableNameOrNil))
  		 and: [(#(<= < >= >) includes: node selector)
  		 and: [node args first isConstant
  		 and: [node args first value = 0]]]]) ifTrue:
  			[mustBeSigned add: var.
  			 effectiveNodes at: var put: { #signed. node }, (effectiveNodes at: var ifAbsent: [#()])].
  		"if an assignment to an untyped local of a known type, set the local's type to that type.
  		 Only observe known sends (methods in the current set) and typed local variables."
  		(node isAssignment
  		 and: [(locals includes: (var := node variable name))
  		 and: [(alreadyExplicitlyTypedOrNotToBeTyped includes: var) not]]) ifTrue: "don't be fooled by previously inferred types"
+ 		 	[(node expression typeOrNilFrom: aCodeGen in: self)
+ 				"If untyped, then cannot type the variable yet. A subsequent assignment may assign a subtype of what this type ends up being"
- 		 	[type := node expression isSend
- 						ifTrue: [aCodeGen returnTypeForSend: node expression in: self ifNil: nil]
- 						ifFalse: [self typeFor: (node expression isAssignment
- 													ifTrue: [node expression variable]
- 													ifFalse: [node expression]) in: aCodeGen].
- 			 type "If untyped, then cannot type the variable yet. A subsequent assignment may assign a subtype of what this type ends up being"
  				ifNil: "Further, if the type derives from an as-yet-untyped method, we must defer."
  					[node expression isSend ifTrue:
  						[alreadyExplicitlyTypedOrNotToBeTyped add: var.
  						 (aCodeGen methodNamed: node expression selector) ifNotNil:
  							[newDeclarations removeKey: var ifAbsent: nil]]]
  				ifNotNil: "Merge simple types (but *don't* merge untyped vars); complex types must be defined by the programmer."
+ 					[:type|
+ 					((aCodeGen isSimpleType: type) or: [aCodeGen isFloatingPointCType: type]) ifTrue:
- 					[((aCodeGen isSimpleType: type) or: [aCodeGen isFloatingPointCType: type]) ifTrue:
  						[(asYetUntyped includes: var)
  							ifTrue:
+ 								["N.B. Very important *not* to type from integer constants, to allow better types to be inferred from
+ 								  subsequent usage. e.g. var := 0 tells us very little.  So wait until var is used or assigned to again."
+ 								(node finalExpression isConstant and: [node finalExpression value isInteger]) ifFalse:
+ 									[newDeclarations
+ 										at: var
+ 										put: (prependType "We prefer sqInt (word sized integer) over int for variables initialized from integer constants; since maybe sizeof(int) < sizeof(void *)"
+ 												value: ((node finalExpression isConstant and: [type = #int]) ifTrue: [#sqInt] ifFalse: [type])
+ 												value: var).
+ 									 asYetUntyped remove: var]]
- 								[newDeclarations at: var put: (prependType value: type value: var).
- 								 asYetUntyped remove: var]
  							ifFalse:
  								[aCodeGen mergeTypeOf: var in: newDeclarations with: type method: self].
+ 						 effectiveNodes at: var put: { newDeclarations at: var ifAbsent: nil. node }, (effectiveNodes at: var ifAbsent: [#()])]]]].
- 						 effectiveNodes at: var put: { newDeclarations at: var. node }, (effectiveNodes at: var ifAbsent: [#()])]]]].
  	mustBeSigned do:
  		[:var|
  		 (newDeclarations at: var ifAbsent: nil) ifNotNil:
  			[:decl| | type |
  			 type := aCodeGen extractTypeFor: var fromDeclaration: decl.
  			 type first == $u ifTrue:
  				[newDeclarations at: var put: (prependType value: (aCodeGen signedTypeForIntegralType: type) value: var)]]].
  	newDeclarations keysAndValuesDo:
  		[:var :decl| declarations at: var put: decl].
  	^effectiveNodes!

Item was changed:
  ----- Method: TSwitchStmtNode>>emitCCodeOn:addToEndOfCases:level:generator: (in category 'C code generation') -----
  emitCCodeOn: aStream addToEndOfCases: aNodeOrNil level: level generator: aCodeGen
  
  	aStream nextPutAll: 'switch ('.
  	expression emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen.
  	aStream nextPutAll: ') {'.
  	cases do:
  		[:tuple|
  		 [:labels :case|
  		  labels do:
  			[:label|
  			 aStream
  				crtab: level;
  				nextPutAll: 'case '.
  			label emitCCodeAsArgumentOn: aStream level: level + 1 generator: aCodeGen.
  			aStream nextPut: $:].
  		  aStream crtab: level + 1.
+ 		  case emitCCodeOn: aStream prependToEnd: (case endsWithReturn ifFalse: [aNodeOrNil]) level: level + 1 generator: aCodeGen]
- 		  case emitCCodeOn: aStream prependToEnd: aNodeOrNil level: level + 1 generator: aCodeGen]
  			valueWithArguments: tuple.
  		  (aNodeOrNil notNil and: [aNodeOrNil isReturn])
  			ifTrue: [(self stream: aStream endsWithAnyOf: ';}') ifFalse: [aStream nextPut: $;]]
  			ifFalse: [aStream crtab: level + 1; nextPutAll: 'break;'].
  		  aStream cr].
  	aStream
  		crtab: level;
  		nextPutAll: 'default:';
  		crtab: level + 1.
  	otherwiseOrNil
+ 		ifNotNil: [otherwiseOrNil emitCCodeOn: aStream prependToEnd: (otherwiseOrNil endsWithReturn ifFalse: [aNodeOrNil]) level: level + 1 generator: aCodeGen.
+ 			otherwiseOrNil endsWithReturn ifFalse: [aStream nextPut: $;]]
- 		ifNotNil: [otherwiseOrNil emitCCodeOn: aStream prependToEnd: aNodeOrNil level: level + 1 generator: aCodeGen]
  		ifNil: [aStream nextPutAll: 'error("Case not found and no otherwise clause")'.
  			   aNodeOrNil ifNotNil:
  				[| defaultExpr type |
  				 aStream nextPut: $;; crtab: level + 1.
  				 defaultExpr := TConstantNode new setValue: -1.
  				 (aNodeOrNil isAssignment
  				  and: [(type := aCodeGen typeFor: aNodeOrNil variable in: aCodeGen currentMethod) notNil
  				  and: [aCodeGen isPointerCType: type]]) ifTrue:
  					[defaultExpr := TSendNode new
  										setSelector: #cCoerceSimple:to:
  										receiver: (TVariableNode new setName: 'self')
  										arguments: {defaultExpr. TConstantNode new setValue: type}].
  				 (aNodeOrNil copy setExpression: defaultExpr)
+ 					emitCCodeOn: aStream level: level generator: aCodeGen].
+ 			aStream nextPut: $;].
- 					emitCCodeOn: aStream level: level generator: aCodeGen]].
  	aStream
- 		nextPut: $;;
  		crtab: level;
  		nextPut: $}!

Item was added:
+ ----- Method: TSwitchStmtNode>>typeOrNilFrom:in: (in category 'type inference') -----
+ typeOrNilFrom: aCodeGenerator in: aTMethod
+ 	| overallType |
+ 	cases do:
+ 		[:case| | caseType |
+ 		caseType := case last typeOrNilFrom: aCodeGenerator in: aTMethod.
+ 		overallType
+ 			ifNil: [overallType := caseType]
+ 			ifNotNil:
+ 				[overallType := aCodeGenerator mergeType: overallType with: caseType.
+ 				 overallType ifNil: [^nil]]].
+ 	otherwiseOrNil ifNotNil:
+ 		[otherwiseOrNil endsWithReturn ifFalse:
+ 			[overallType := aCodeGenerator mergeType: overallType with: (otherwiseOrNil typeOrNilFrom: aCodeGenerator in: aTMethod)]].
+ 	^overallType!



More information about the Vm-dev mailing list