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

[commits at source.squeak.org]

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

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

Name: VMMaker.oscog-eem.1072
Author: eem
Time: 20 February 2015, 7:30:18.738 pm
UUID: bd9d8dd5-dea0-49da-8be7-cb246f49f554
Ancestors: VMMaker.oscog-eem.1071

Fix typing multiple assignments to a variable
- promote the type to the largest integral type of
  all assignments
	(primitiveDecompressFromByteArray)
- do /not/ promote a variable typed with an integral
  type to a floating point type (transformColor:)

Provide size of short int.

Fix weird regression for Objectmemory>>baseHeaderSize

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

Item was changed:
  ----- Method: CCodeGenerator>>isActualType:compatibleWithFormalType: (in category 'inlining') -----
  isActualType: actualTypeOrNil compatibleWithFormalType: formalTypeOrNil 
  	| actualType formalType |
  	actualType := actualTypeOrNil ifNil: [#sqInt].
  	formalType := formalTypeOrNil ifNil: [#sqInt].
  	((self isIntegralCType: actualType)
  	 and: [self isIntegralCType: formalType]) ifFalse:
  		[^actualType = formalType
+ 		 or: [formalType = #double and: [actualType = #float]]].
+ 	"For now, insist that the signedness agrees.  If the actual's type is unknown allow inlining.
+ 	 A formal defaults to #sqInt. Allowing inlining an unsigned type within a sqInt formal is wrong;
+ 	 snd for testing, it breaks e.g. the BitBltPlugin."
- 		 or: [formalType = 'double' and: [actualType = 'float']]].
- 	"For now, insist that the signedness agrees."
  	^(actualType first = $u) = (formalType first = $u)
+ 	  or: [actualTypeOrNil isNil] !
- 	  or: [actualTypeOrNil isNil] "a nil formal defaults to #sqInt"!

Item was added:
+ ----- Method: CCodeGenerator>>mergeTypeOf:in:with: (in category 'type inference') -----
+ mergeTypeOf: var in: aDictionary with: newType
+ 	"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 mergedType |
+ 	existingType := self
+ 						extractTypeFor: var
+ 						fromDeclaration: (aDictionary at: var ifAbsentPut: [newType, ' ', var]).
+ 	existingType ~= newType ifTrue:
+ 		[((self isIntegralCType: existingType)
+ 		  and: [self isFloatingPointCType: newType]) ifFalse:
+ 			[mergedType := self promoteArithmeticTypes: existingType and: newType.
+ 			 aDictionary at: var put: mergedType, ' ', var]]!

Item was added:
+ ----- Method: CCodeGenerator>>promoteArithmeticTypes:and: (in category 'type inference') -----
+ promoteArithmeticTypes: firstType and: secondType
+ 	"Answer the return type for an arithmetic sendThis is so that the inliner can still
+ 	 inline simple expressions.  Deal with pointer arithmetic, floating point arithmetic
+ 	 and promotion."
+ 	((#(#double float) includes: firstType)
+ 	 or: [#(#double float) includes: secondType]) ifTrue:
+ 		[^(firstType = #float and: [secondType = #float])
+ 			ifTrue: [#float]
+ 			ifFalse: [#double]].
+ 	"deal with unknowns, answering nil."
+ 	(firstType isNil or: [secondType isNil]) ifTrue:
+ 		[^nil].
+ 	"deal with promotion; answer the longest type, defaulting to the recever if they're the same"
+ 	^(self sizeOfIntegralCType: firstType) >= (self sizeOfIntegralCType: secondType)
+ 		ifTrue: [firstType]
+ 		ifFalse: [secondType]!

Item was changed:
  ----- Method: CCodeGenerator>>sizeOfIntegralCType: (in category 'inlining') -----
  sizeOfIntegralCType: anIntegralCType "<String>"
  	"N.B. Only works for values for which isIntegralCType: answers true."
  	| prunedCType index |
  	(anIntegralCType beginsWith: 'register ') ifTrue:
  		[^self sizeOfIntegralCType: (anIntegralCType allButFirst: 9)].
  	prunedCType := (anIntegralCType beginsWith: 'unsigned ')
  						ifTrue: [(anIntegralCType allButFirst: 9) withBlanksTrimmed]
  						ifFalse: [(anIntegralCType beginsWith: 'signed ')
  									ifTrue: [(anIntegralCType allButFirst: 7) withBlanksTrimmed]
  									ifFalse: [anIntegralCType]].
  	^prunedCType asString caseOf: {
  		['sqLong']	->	[8].
  		['usqLong']	->	[8].
  		['sqInt']		->	[BytesPerWord].
  		['usqInt']	->	[BytesPerWord].
  		['int']		->	[4].
  		['short']		->	[2].
+ 		['short int']	->	[2].
  		['char']		->	[1].
  		['long']		->	[BytesPerWord].
  		['size_t']		->	[BytesPerWord].
  		['pid_t']		->	[BytesPerWord].
  	}
  	otherwise:
  		[((anIntegralCType beginsWith: 'unsigned') "e.g. 'unsigned  : 8'"
  		  and: [(anIntegralCType includesAnyOf: '[*]') not
  		  and: [(index := anIntegralCType indexOf: $:) > 0]])
  			ifTrue: [(Integer readFrom: (anIntegralCType copyFrom: index + 1 to: anIntegralCType size) withBlanksTrimmed readStream) + 7 // 8]
  			ifFalse: [self error: 'unrecognized integral type']]!

Item was changed:
  ----- Method: CCodeGenerator>>typeForArithmetic:in: (in category 'type inference') -----
  typeForArithmetic: sendNode in: aTMethod
  	"Answer the return type for an arithmetic sendThis is so that the inliner can still
  	 inline simple expressions.  Deal with pointer arithmetic, floating point arithmetic
  	 and promotion."
  	| rcvrType argType |
- 	argType := self typeFor: sendNode args first in: aTMethod.
- 	argType = #double ifTrue:
- 		[^#double].
  	rcvrType := self typeFor: sendNode receiver in: aTMethod.
+ 	argType := self typeFor: sendNode args first in: aTMethod.
- 	"deal with unknowns, answering nil."
- 	(rcvrType isNil or: [argType isNil]) ifTrue:
- 		[^nil].
  	"deal with pointer arithmetic"
+ 	((rcvrType notNil and: [rcvrType last = $*]) or: [argType notNil and: [argType last = $*]]) ifTrue:
+ 		[(rcvrType isNil or: [argType isNil]) ifTrue:
+ 			[^nil].
+ 		 (rcvrType last = $* and: [argType last = $*]) ifTrue:
+ 			[sendNode selector == #- ifTrue:
+ 				[^#int].
+ 			 self error: 'invalid pointer arithmetic'].
+ 		 ^rcvrType last = $*
- 	(rcvrType last = $* or: [argType last = $*]) ifTrue:
- 		[(sendNode selector == #-
- 		  and: [rcvrType last = $* and: [argType last = $*]]) ifTrue:
- 			[^#int].
- 		 ^rcvrType last = $
  			ifTrue: [rcvrType]
  			ifFalse: [argType]].
+ 	^self promoteArithmeticTypes: rcvrType and: argType!
- 	"deal with promotion; answer the longest type, defaulting to the recever if they're the same"
- 	^(self sizeOfIntegralCType: rcvrType) >= (self sizeOfIntegralCType: argType)
- 		ifTrue: [rcvrType]
- 		ifFalse: [argType]!

Item was changed:
  ----- Method: ObjectMemory>>baseHeaderSize (in category 'interpreter access') -----
  baseHeaderSize
+ 	"N.B. This would appear to hard-code the header size for 32-bit images.  But if generating
+ 	 a 64-bit image, this method could be removed and the relevant one substituted.  We can't
+ 	 mark this method as <doNotGenerate> as we need an actual method to guide code gen."
+ 	^4!
- "To support SmartSyntaxPluginCodeGenerator"
- 	^self baseHeaderSize!

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)"
  	| alreadyExplicitlyTyped effectiveNodes |
+ 	"selector = #transformColor: ifTrue:
- 	"selector = #blockDispatchTargetsFor:perform:arg: ifTrue:
  		[self halt]."
  	alreadyExplicitlyTyped := declarations keys asSet.
  	effectiveNodes := Dictionary new. "this for debugging"
  	parseTree nodesDo:
  		[: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: [(alreadyExplicitlyTyped includes: var) not "don't be fooled by inferred unsigned types"
  		 and: [(#(<= < >= >) includes: node selector)
  		 and: [node args first isConstant
  		 and: [node args first value = 0
  		 and: [(type := self typeFor: var in: aCodeGen) notNil
  		 and: [type first == $u]]]]]]]) ifTrue:
  			[declarations at: var put: (aCodeGen signedTypeForIntegralType: type), ' ', var.
  			 effectiveNodes at: var put: { declarations at: var. node }].
  		"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: [(alreadyExplicitlyTyped includes: var) not "don't be fooled by previously inferred types"
- 		 and: [(declarations includesKey: var) not
  		 and: [(type := node expression isSend
  						ifTrue: [aCodeGen returnTypeForSend: node expression in: self]
  						ifFalse: [self typeFor: node expression in: aCodeGen]) notNil
  		 and: [type ~= #void]]]]) ifTrue:
+ 			[aCodeGen mergeTypeOf: var in: declarations with: type.
+ 			 effectiveNodes at: var put: { declarations at: var. node }, (effectiveNodes at: var ifAbsent: [#()])]].
- 			[declarations at: var put: type, ' ', var.
- 			 effectiveNodes at: var put: { declarations at: var. node }]].
  	^effectiveNodes!