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

commits at source.squeak.org commits at source.squeak.org
Sun Feb 15 20:10:18 UTC 2015


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

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

Name: VMMaker.oscog-eem.1065
Author: eem
Time: 15 February 2015, 12:08:49.599 pm
UUID: 128de3ba-1195-4a3e-af85-eae5d25b1410
Ancestors: VMMaker.oscog-eem.1064

Make sure that integral comparisons against zero
are signed, casting the receiver as necessary.
Refactor the typeOf:in: machinery to allow the
TMethod and the CCodeGenerator to dance together.

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

Item was added:
+ ----- Method: CCodeGenerator>>emitSignedComparison:for:on:indent: (in category 'C translation support') -----
+ emitSignedComparison: operator for: msgNode on: aStream indent: level
+ 	"Emit a signed comparison.
+ 	 Make sure the receiver expression is signed if comparing against zero."
+ 
+ 	| arg rcvrType |
+ 	((arg := msgNode args first) isConstant
+ 	and: [arg value isInteger
+ 	and: [arg value = 0
+ 	and: [(self typeFor: msgNode receiver in: currentMethod)
+ 			ifNil: [false]
+ 			ifNotNil: [:t| (rcvrType := t) first = $u]]]]) ifTrue:
+ 		[aStream nextPut: $(; nextPutAll: (self signedTypeForIntegralType: rcvrType); nextPut: $)].
+ 	self emitCExpression: msgNode receiver on: aStream.
+ 	aStream space; nextPutAll: operator; space.
+ 	self emitCExpression: arg on: aStream!

Item was changed:
  ----- Method: CCodeGenerator>>generateGreaterThan:on:indent: (in category 'C translation') -----
  generateGreaterThan: msgNode on: aStream indent: level
  	"Generate the C code for this message onto the given stream."
  
+ 	self emitSignedComparison: #> for: msgNode on: aStream indent: level!
- 	self emitCExpression: msgNode receiver on: aStream.
- 	aStream nextPutAll: ' > '.
- 	self emitCExpression: msgNode args first on: aStream.!

Item was changed:
  ----- Method: CCodeGenerator>>generateGreaterThanOrEqual:on:indent: (in category 'C translation') -----
  generateGreaterThanOrEqual: msgNode on: aStream indent: level
  	"Generate the C code for this message onto the given stream."
  
+ 	self emitSignedComparison: #>= for: msgNode on: aStream indent: level!
- 	self emitCExpression: msgNode receiver on: aStream.
- 	aStream nextPutAll: ' >= '.
- 	self emitCExpression: msgNode args first on: aStream.!

Item was changed:
  ----- Method: CCodeGenerator>>generateLessThan:on:indent: (in category 'C translation') -----
  generateLessThan: msgNode on: aStream indent: level
  	"Generate the C code for this message onto the given stream."
  
+ 	self emitSignedComparison: #< for: msgNode on: aStream indent: level!
- 	self emitCExpression: msgNode receiver on: aStream.
- 	aStream nextPutAll: ' < '.
- 	self emitCExpression: msgNode args first on: aStream.!

Item was changed:
  ----- Method: CCodeGenerator>>generateLessThanOrEqual:on:indent: (in category 'C translation') -----
  generateLessThanOrEqual: msgNode on: aStream indent: level
  	"Generate the C code for this message onto the given stream."
  
+ 	self emitSignedComparison: #<= for: msgNode on: aStream indent: level!
- 	self emitCExpression: msgNode receiver on: aStream.
- 	aStream nextPutAll: ' <= '.
- 	self emitCExpression: msgNode args first on: aStream.!

Item was changed:
  ----- Method: CCodeGenerator>>inferTypesForImplicitlyTypedVariablesAndMethods (in category 'type inference') -----
  inferTypesForImplicitlyTypedVariablesAndMethods
  	"Infer the return tupe and the types of untyped variables.
  	 As far as variables go, for now we try only to infer variables
  	 assigned the result of #longLongAt:, but much more could be
  	 done here."
  
  	"Iterate over all methods, inferring #void return types, until we reach a fixed point."
  	| firstTime allMethods |
  	firstTime := true.
  	allMethods := apiMethods
  					ifNil: [methods]
  					ifNotNil: [(Set withAll: methods)
  								addAll: apiMethods;
  								yourself].
+ 	"Make an initial pass to assign the return types of all simple mehtods that return constants."						
+ 	allMethods do:
+ 		[:m|
+ 		m isReturnConstant ifTrue:
+ 			[m inferReturnTypeIn: self]].
  	[| changedReturnType |
  	 changedReturnType := false.
  	 allMethods do:
  		[:m|
  		 firstTime ifTrue:
  			[m removeFinalSelfReturnIn: self. "must preceed recordDeclarationsIn: because it may set returnType"
  			 m recordDeclarationsIn: self].
  		 m inferTypesForImplicitlyTypedVariablesIn: self.
  		 (m inferReturnTypeIn: self) ifTrue:
  			[changedReturnType := true]].
  	 firstTime := false.
  	 changedReturnType] whileTrue.
  
  	"Type all as-yet-untyped methods as the default"
  	methods do:
  		[:m|
  		m returnType ifNil:
  			[m returnType: (self implicitReturnTypeFor: m selector)]]!

Item was removed:
- ----- Method: CCodeGenerator>>returnTypeForSend: (in category 'type inference') -----
- returnTypeForSend: aTSendNode
- 	"Answer the return type for a send.  Absent sends default to #sqInt."
- 	| sel |
- 	^(self anyMethodNamed: (sel := aTSendNode selector))
- 		ifNil: [kernelReturnTypes
- 				at: sel
- 				ifAbsent:
- 					[^sel
- 						caseOf: {
- 						[#asVoidPointer]		->	[#'void *'].
- 						[#asUnsignedInteger]	->	[#usqInt].
- 						[#asLong]				->	[#long].
- 						[#asUnsignedLong]		->	[#'unsigned long'].
- 						[#signedIntToLong]		->	[#usqInt]. "c.f. generateSignedIntToLong:on:indent:"
- 						[#signedIntToShort]	->	[#usqInt]. "c.f. generateSignedIntToShort:on:indent:"
- 						[#cCoerce:to:]			->	[aTSendNode args last value].
- 						[#cCoerceSimple:to:]	->	[aTSendNode args last value] }
- 						otherwise: [#sqInt]]]
- 		ifNotNil:
- 			[:m|
- 			m returnType ifNotNil:
- 				[:type| "map fields to #usqInt"
- 				((type beginsWith: 'unsigned')
- 				 and: [(type includes: $:)
- 				 and: [type last isDigit]])
- 					ifTrue: [#usqInt]
- 					ifFalse: [type]]]!

Item was added:
+ ----- Method: CCodeGenerator>>returnTypeForSend:in: (in category 'type inference') -----
+ returnTypeForSend: aTSendNode in: aTMethod
+ 	"Answer the return type for a send.  Absent sends default to #sqInt.
+ 	 The bitwise operators answer unsigned versions of their argument types, at least in gcc
+ 	 although this author can't find that in the C99 spec.  If you can find this, please let me know."
+ 	| sel |
+ 	^(self anyMethodNamed: (sel := aTSendNode selector))
+ 		ifNil: [kernelReturnTypes
+ 				at: sel
+ 				ifAbsent:
+ 					[^sel
+ 						caseOf: {
+ 						[#bitAnd:]				->	[self unsignedTypeForBitwiseSend: aTSendNode in: aTMethod].
+ 						[#bitOr:]				->	[self unsignedTypeForBitwiseSend: aTSendNode in: aTMethod].
+ 						[#bitXor:]				->	[self unsignedTypeForBitwiseSend: aTSendNode in: aTMethod].
+ 						[#asVoidPointer]		->	[#'void *'].
+ 						[#asVoidPointer]		->	[#'void *'].
+ 						[#asUnsignedInteger]	->	[#usqInt].
+ 						[#asLong]				->	[#long].
+ 						[#asUnsignedLong]		->	[#'unsigned long'].
+ 						[#signedIntToLong]		->	[#usqInt]. "c.f. generateSignedIntToLong:on:indent:"
+ 						[#signedIntToShort]	->	[#usqInt]. "c.f. generateSignedIntToShort:on:indent:"
+ 						[#cCoerce:to:]			->	[aTSendNode args last value].
+ 						[#cCoerceSimple:to:]	->	[aTSendNode args last value] }
+ 						otherwise: [#sqInt]]]
+ 		ifNotNil:
+ 			[:m|
+ 			m returnType ifNotNil:
+ 				[:type| "map fields to #usqInt"
+ 				((type beginsWith: 'unsigned')
+ 				 and: [(type includes: $:)
+ 				 and: [type last isDigit]])
+ 					ifTrue: [#usqInt]
+ 					ifFalse: [type]]]!

Item was added:
+ ----- Method: CCodeGenerator>>signedTypeForIntegralType: (in category 'type inference') -----
+ signedTypeForIntegralType: aCTypeString
+ 	(aCTypeString beginsWith: 'unsigned ') ifTrue:
+ 		[^aCTypeString allButFirst: 8].
+ 	
+ 	(aCTypeString beginsWith: 'usq') ifTrue:
+ 		[^aCTypeString allButFirst].
+ 
+ 	self error: 'unknown type'.
+ 	^#long!

Item was added:
+ ----- Method: CCodeGenerator>>typeFor:in: (in category 'type inference') -----
+ typeFor: aNode in: aTMethod
+ 	aNode isVariable ifTrue:
+ 		[^aTMethod typeFor: aNode in: self].
+ 	aNode isSend ifTrue:
+ 		[^self returnTypeForSend: aNode in: currentMethod].
+ 	^#sqInt!

Item was added:
+ ----- Method: CCodeGenerator>>unsignedTypeForBitwiseSend:in: (in category 'type inference') -----
+ unsignedTypeForBitwiseSend: aTSendNode in: aTMethod
+ 	"The result of the bitwise operators in C is unsigned."
+ 	| t1 t2 type |
+ 	t1 := (self typeFor: aTSendNode receiver in: aTMethod) ifNil: [^nil].
+ 	t2 := (self typeFor: aTSendNode args first in: aTMethod) ifNil: [^nil].
+ 	type := (self sizeOfIntegralCType: t1) >= (self sizeOfIntegralCType: t1)
+ 				ifTrue: [t1]
+ 				ifFalse: [t2].
+ 	^type first = $u
+ 		ifTrue: [type]
+ 		ifFalse:
+ 			[(type beginsWith: 'sq')
+ 				ifTrue: ['u', type]
+ 				ifFalse: ['unsigned ', type]]!

Item was changed:
  ----- Method: TMethod>>addTypesFor:to:in: (in category 'type inference') -----
  addTypesFor: node to: typeSet in: aCodeGen
  	| expr |
  	expr := node.
  	[expr isAssignment or: [expr isStmtList]] whileTrue:
  		[expr isAssignment ifTrue:
  			[expr := expr variable].
  		 expr isStmtList ifTrue:
  			[expr := expr statements last]].
  	expr isSend ifTrue:
  		[(#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:) includes: expr selector) ifTrue:
  			[^expr args do:
  				[:block|
  				self addTypesFor: block to: typeSet in: aCodeGen]].
  		 (#(= ~= == ~~ < > <= >= anyMask: noMask:) includes: expr selector) ifTrue:
  			[^typeSet add: #sqInt].
  		 (#(+ - * / // \\ mod: quo: bitAnd: bitClear: bitOr: bitXor: bitShift:) includes: expr selector) ifTrue:
  			[| types |
  			 types := Set new.
  			 self addTypesFor: expr receiver to: types in: aCodeGen.
  			 (types size = 1 and: [types anyOne last = $*]) ifTrue: "pointer arithmetic"
  				[^typeSet add: types anyOne].
  			 self addTypesFor: expr args first to: types in: aCodeGen.
  			 types := aCodeGen harmonizeReturnTypesIn: types.
  			 types size = 2 ifTrue:
  				[(types includes: #double) ifTrue:
  					[^typeSet add: #double].
  				 (types includes: #float) ifTrue:
  					[^typeSet add: #float].
  				^self]. "don't know; leave unspecified."
  			^types notEmpty ifTrue:
  				[typeSet add: types anyOne]].
+ 		 ^(aCodeGen returnTypeForSend: expr in: self) ifNotNil:
- 		 ^(aCodeGen returnTypeForSend: expr) ifNotNil:
  			[:type| typeSet add: type]].
  	expr isVariable ifTrue:
  		[(aCodeGen typeOfVariable: expr name)
  			ifNotNil: [:type| typeSet add: type]
  			ifNil: [typeSet add: (expr name = 'self'
  										ifTrue: [#void]
  										ifFalse: [#sqInt])]].
  	expr isConstant ifTrue:
  		[| val |
  		 val := expr value.
  		 val isInteger ifTrue:
  			[typeSet add: ((val >= 0 ifTrue: [val] ifFalse: [-1 - val]) highBit <= 32
  									ifTrue: [#sqInt]
  									ifFalse: [#sqLong])].
  		 (#(nil true false) includes: val) ifTrue:
  			[typeSet add: #sqInt].
  		 val isFloat ifTrue:
  			[typeSet add: #float]]!

Item was changed:
  ----- Method: TMethod>>inferTypesForImplicitlyTypedVariablesIn: (in category 'type inference') -----
  inferTypesForImplicitlyTypedVariablesIn: aCodeGen
  	"infer types for untyped variables form assignments and arithmetic uses.
  	 This for debugging:
  		(self copy inferTypesForImplicitlyTypedVariablesIn: aCodeGen)"
  	| explicitlyTyped effectiveNodes |
  	explicitlyTyped := 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: [(explicitlyTyped includes: var) not
  		 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: (declarations at: var) allButFirst.
  			 effectiveNodes at: var put: { declarations at: var. node }].
  		"if an assignment of a known send, set the variable's type to the return type of the send."
  		(node isAssignment
  		 and: [(locals includes: (var := node variable name))
  		 and: [(declarations includesKey: var) not
  		 and: [node expression isSend
+ 		 and: [(type := aCodeGen returnTypeForSend: node expression in: self) notNil]]]]) ifTrue:
- 		 and: [(type := aCodeGen returnTypeForSend: node expression) notNil]]]]) ifTrue:
  			[(#(sqInt void) includes: type) ifFalse:
  				["the $: is to map things like unsigned field : 3 to usqInt"
  				 declarations
  					at: var
  					put: ((type includes: $:) ifTrue: [#usqInt] ifFalse: [type]), ' ', var.
  				 effectiveNodes at: var put: { declarations at: var. node }]]].
  	^effectiveNodes!

Item was changed:
  ----- Method: TMethod>>isNode:substitutableFor:inMethod:in: (in category 'inlining') -----
  isNode: aNode substitutableFor: argName inMethod: targetMeth in: aCodeGen
  	"Answer if the given parameter node may be substituted directly into the body of
  	 the method during inlining, instead of being bound to the actual parameter variable.
  	 We allow a constant, a local variable, or a formal parameter, or simple expressions
  	 involving only these to to be directly substituted. Note that global variables cannot
  	 be subsituted into methods with possible side effects (i.e., methods that may assign
  	 to global variables) because the inlined method might depend on having the value of
  	 the global variable captured when it is passed in as an argument."
  
  	| madeNonTrivialCall count constantExpression usageCount |
  	aNode isConstant ifTrue: [^true].
  
  	aNode isVariable ifTrue:
  		[((locals includes: aNode name)
  		 or: [(args includes: aNode name)
  		 or: [#('self' 'true' 'false' 'nil') includes: aNode name]]) ifTrue: [^true].
  		"We can substitute any variable provided it is only read in the method being inlined,
  		 and if it is not read after any non-trivial call (which may update the variable)."
  		madeNonTrivialCall := false.
  		(targetMeth isComplete
  		 and: [targetMeth parseTree
  				noneSatisfy:
  					[:node|
  					 (node isSend
  					  and: [(aCodeGen isBuiltinSelector: node selector) not]) ifTrue:
  						[madeNonTrivialCall := true].
  					 (madeNonTrivialCall and: [node isVariable and: [node name = argName]])
  					 or: [node isAssignment
  						  and: [node variable name = argName]]]
  				unless:
  					[:node|
  					node isSend and: [aCodeGen isAssertSelector: node selector]]]) ifTrue:
  			[^true].
  		^targetMeth maySubstituteGlobal: aNode name in: aCodeGen].
  
  	"For now allow literal blocks to be substituted.  They better be accessed only
  	 with value[:value:*] messages though!!"
  	aNode isStmtList ifTrue: [^true].
  
  	count := 0.
  	constantExpression := true.
  	"scan expression tree; must contain only constants, builtin ops, and inlineable vars"
  	aNode nodesDo:
  		[:node|
  		node isConstant
  			ifTrue: [] ifFalse:
  		[node isSend
  			ifTrue:
  				[((VMBasicConstants mostBasicConstantSelectors includes: node selector)
  				  or: [node isBuiltinOperator]) ifFalse: [^false].
  				 count := count + 1] ifFalse:
  		[node isVariable ifTrue:
  			[(aCodeGen isNonArgumentImplicitReceiverVariableName: node name) ifFalse:
  				[constantExpression := false.
  				((locals includes: node name)
  				 or: [(args includes: node name)
  				 or: [(#('self' 'true' 'false' 'nil') includes: node name)
  				 or: [targetMeth maySubstituteGlobal: node name in: aCodeGen]]]) ifFalse: [^false]]] ifFalse:
  		[^false]]]].
  	"inline constant expressions"
  	constantExpression ifNil: [^true].
  
  	"scan target to find usage count"
  	usageCount := 0.
  	targetMeth parseTree nodesDo:
  		[:node|
  		(node isVariable and: [node name = argName]) ifTrue:
  			[usageCount := usageCount + 1]].
+ 	"(usageCount > 1 and: [count <= usageCount]) ifTrue:
+ 		[[UsageCounts := Dictionary new.
+ 		  self removeClassVarName: #UsageCounts].
+ 		 (UsageCounts at: usageCount ifAbsentPut: [Set new]) add: ({targetMeth. argName. aNode})]."
  	"Now only inline expressions if they are used only once or are simple
+ 	 w.r.t. the usage count, and the usage count is not large; a heuristic that seems to work well enough."
+ 	^usageCount = 1 or: [usageCount <= 7 and: [count <= usageCount]]!
- 	 w.r.t. the usage count; a heuristic that seems to work well enough."
- 	^usageCount = 1 or: [count <= usageCount]!

Item was added:
+ ----- Method: TMethod>>isReturnConstant (in category 'testing') -----
+ isReturnConstant
+ 	^parseTree statements size = 1
+ 	 and: [parseTree statements last isReturn
+ 	 and: [parseTree statements last expression isLeaf]]!

Item was changed:
  ----- Method: TMethod>>typeFor:in: (in category 'utilities') -----
  typeFor: aVariable in: aCodeGen
  	"Answer the type for aVariable, deferring to aCodeGen (which defers to the vmClass)
  	 if no type is found and the variable is global (not an arg or a local).  Expect the
  	 cCodeGen to answer nil for variables without types. nil for typelessness is required
  	 by the type propagation logic in inlineSend:directReturn:exitVar:in:."
  	^(declarations
  			at: aVariable asString
  			ifAbsent: [((locals includes: aVariable) or: [args includes: aVariable]) ifFalse:
  						[aCodeGen typeOfVariable: aVariable]]) ifNotNil:
  		[:decl|
+ 		aCodeGen extractTypeFor: aVariable asString fromDeclaration: decl]!
- 		aCodeGen extractTypeFor: aVariable fromDeclaration: decl]!



More information about the Vm-dev mailing list