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

commits at source.squeak.org commits at source.squeak.org
Sun Dec 27 12:59:02 UTC 2015


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

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

Name: VMMaker.oscog-eem.1614
Author: eem
Time: 27 December 2015, 12:57:04.521 pm
UUID: 5ffe4d04-1144-4cc2-9b4d-4ab242e2217b
Ancestors: VMMaker.oscog-eem.1613

Cogit:
Eliminate some obsolete assignments to maxSize in computeFooSize methods.

Fix slips in genPrimitiveSmallFloatSquareRoot, generateInstructionsAt: & genJumpNotSmallFooInScratchReg:.

Slang:
Avoid computing variable and return typres prematurely i.e. don't derive types from as-yet-untyped methods.

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

Item was added:
+ ----- Method: CCodeGenerator>>returnTypeOrNilForSend:in: (in category 'type inference') -----
+ returnTypeOrNilForSend: sendNode in: aTMethod
+ 	"Answer the return type for a send.  Sends of known but as-yet-untyped methods answer nil."
+ 	| sel |
+ 	(self anyMethodNamed: (sel := sendNode selector)) ifNotNil:
+ 		[:m|
+ 		^m returnType ifNotNil: [:type| ^self baseTypeForType: type]].
+ 	^self returnTypeForSend: sendNode in: aTMethod!

Item was changed:
  ----- Method: CogIA32Compiler>>computeShiftRRSize (in category 'generate machine code') -----
  computeShiftRRSize
  	"On the x86 the only instructions that shift by the value of a
  	 register require the shift count to be  in %ecx.  So we may
  	 have to use swap instructions to get the count into ecx."
  	| shiftCountReg |
  	shiftCountReg := operands at: 0.
+ 	^shiftCountReg = ECX
+ 		ifTrue: [2]
+ 		ifFalse:
+ 			[shiftCountReg = EAX
+ 				ifTrue: [1 "XCHG EAX,r2" + 2 "Sxx" + 1 "XCHG EAX,r2"]
+ 				ifFalse: [2 "XCHG r1,r2" + 2 "Sxx" + 2 "XCHG r1,r2"]]!
- 	shiftCountReg = ECX ifTrue:
- 		[^maxSize := 2].
- 	^maxSize := shiftCountReg = EAX
- 					ifTrue: [1 "XCHG EAX,r2" + 2 "Sxx" + 1 "XCHG EAX,r2"]
- 					ifFalse: [2 "XCHG r1,r2" + 2 "Sxx" + 2 "XCHG r1,r2"]!

Item was changed:
  ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotSmallFloat:scratchReg: (in category 'compile abstract instructions') -----
  genJumpNotSmallFloat: reg scratchReg: scratch
  	"Generate a compare and branch to test if aRegister contains other than a SmallFloat.
  	 Answer the jump."
+ 	^cogit
+ 		AndCq: objectMemory tagMask R: reg R: scratch;
+ 		CmpCq: objectMemory smallFloatTag R: scratch;
+ 		JumpNonZero: 0!
- 	cogit AndCq: objectMemory tagMask R: reg R: scratch.
- 	cogit CmpCq: objectMemory smallFloatTag R: scratch.
- 	^cogit JumpNonZero: 0!

Item was changed:
  ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotSmallFloatInScratchReg: (in category 'compile abstract instructions') -----
  genJumpNotSmallFloatInScratchReg: aRegister
+ 	<inline: true>
+ 	^self genJumpNotSmallFloat: aRegister scratchReg: aRegister!
- 	^self genJumpNotSmallFloat: aRegister scratchReg: TempReg!

Item was changed:
  ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotSmallIntegerInScratchReg: (in category 'compile abstract instructions') -----
  genJumpNotSmallIntegerInScratchReg: aRegister
+ 	<inline: true>
+ 	^self genJumpNotSmallInteger: aRegister scratchReg: aRegister!
- 	^self genJumpNotSmallInteger: aRegister scratchReg: TempReg!

Item was changed:
  ----- Method: CogX64Compiler>>computeShiftRRSize (in category 'generate machine code') -----
  computeShiftRRSize
  	"On the x86 the only instructions that shift by the value of a
  	 register require the shift count to be  in %ecx.  So we may
  	 have to use swap instructions to get the count into ecx."
  	| shiftCountReg |
  	shiftCountReg := operands at: 0.
+ 	^shiftCountReg = RCX
+ 		ifTrue: [3]
+ 		ifFalse:
+ 			[shiftCountReg = RAX
+ 				ifTrue: [2 "XCHG RAX,r2" + 3 "Sxx" + 2 "XCHG RAX,r2"]
+ 				ifFalse: [3 "XCHG r1,r2" + 3 "Sxx" + 3 "XCHG r1,r2"]]!
- 	shiftCountReg = RCX ifTrue:
- 		[^maxSize := 3].
- 	^maxSize := shiftCountReg = RAX
- 					ifTrue: [2 "XCHG RAX,r2" + 3 "Sxx" + 2 "XCHG RAX,r2"]
- 					ifFalse: [3 "XCHG r1,r2" + 3 "Sxx" + 3 "XCHG r1,r2"]!

Item was changed:
  ----- Method: Cogit>>generateInstructionsAt: (in category 'generate machine code') -----
  generateInstructionsAt: eventualAbsoluteAddress
  	"Size pc-dependent instructions and assign eventual addresses to all instructions.
  	 Answer the size of the code.
  	 Compute forward branches based on virtual address (abstract code starts at 0),
  	 assuming that any branches branched over are long.
  	 Compute backward branches based on actual address.
  	 Reuse the fixups array to record the pc-dependent instructions that need to have
  	 their code generation postponed until after the others."
  	| absoluteAddress pcDependentIndex abstractInstruction fixup |
  	<var: #abstractInstruction type: #'AbstractInstruction *'>
  	<var: #fixup type: #'BytecodeFixup *'>
  	absoluteAddress := eventualAbsoluteAddress.
  	pcDependentIndex := 0.
  	0 to: opcodeIndex - 1 do:
  		[:i|
+ 		self cCode: [] inSmalltalk: [self maybeBreakAt: absoluteAddress].
- 		self maybeBreakAt: absoluteAddress.
  		abstractInstruction := self abstractInstructionAt: i.
  		abstractInstruction isPCDependent
  			ifTrue:
  				[abstractInstruction sizePCDependentInstructionAt: absoluteAddress.
  				 fixup := self fixupAt: pcDependentIndex.
  				 pcDependentIndex := pcDependentIndex + 1.
  				 fixup instructionIndex: i.
  				 absoluteAddress := absoluteAddress + abstractInstruction machineCodeSize]
  			ifFalse:
  				[absoluteAddress := abstractInstruction concretizeAt: absoluteAddress]].
  	0 to: pcDependentIndex - 1 do:
  		[:j|
  		fixup := self fixupAt: j.
  		abstractInstruction := self abstractInstructionAt: fixup instructionIndex.
+ 		self cCode: [] inSmalltalk: [self maybeBreakAt: abstractInstruction address].
- 		self maybeBreakAt: abstractInstruction address.
  		abstractInstruction concretizeAt: abstractInstruction address].
  	^absoluteAddress - eventualAbsoluteAddress!

Item was changed:
  ----- Method: Cogit>>maybeBreakAt: (in category 'simulation only') -----
  maybeBreakAt: address
+ 	<doNotGenerate>
  	((breakPC isBreakpointFor: address)
  	 and: [breakBlock shouldStopIfAtPC: address]) ifTrue:
  		[coInterpreter changed: #byteCountText.
  		 self halt: 'machine code breakpoint at ', address hex, ' in ', thisContext sender selector]!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveSmallFloatSquareRoot (in category 'primitive generators') -----
  genPrimitiveSmallFloatSquareRoot
  	<option: #Spur64BitMemoryManager>
  	"Stack looks like
  		receiver (also in ResultReceiverReg)
  		return address"
  	| jumpFailAlloc |
  	<var: #jumpFailAlloc type: #'AbstractInstruction *'>
+ 	objectRepresentation genGetSmallFloatValueOf: ReceiverResultReg scratch: SendNumArgsReg into: DPFPReg0.
- 	objectRepresentation genGetSmallFloatValueOf: ReceiverResultReg into: DPFPReg0.
  	self SqrtRd: DPFPReg0.
  	jumpFailAlloc := objectRepresentation
  					genAllocFloatValue: DPFPReg0
  					into: SendNumArgsReg
  					scratchReg: ClassReg
  					scratchReg: TempReg.
  	self MoveR: SendNumArgsReg R: ReceiverResultReg.
  	self RetN: (self primRetNOffsetFor: 0).
  	jumpFailAlloc jmpTarget: self Label.
  	^self compileFallbackToInterpreterPrimitive: 0!

Item was changed:
  ----- Method: TMethod>>addTypesFor:to:in: (in category 'type inference') -----
  addTypesFor: node to: typeSet in: aCodeGen
+ 	"Add the value tupes for the node to typeSet.
+ 	 Answer if any type was derived from an as-yet-untyped method, which allows us to abort
+ 	 inferReturnTypeFromReturnsIn: if the return type depends on a yet-to-be-typed method."
  	| 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
+ 				inject: false
+ 				into: [:asYetUntyped :block|
+ 					asYetUntyped := asYetUntyped | (self addTypesFor: block to: typeSet in: aCodeGen)]].
- 			[^expr args do:
- 				[:block|
- 				self addTypesFor: block to: typeSet in: aCodeGen]].
  		 (#(= ~= == ~~ < > <= >= anyMask: noMask:) includes: expr selector) ifTrue:
+ 			[typeSet add: #sqInt. ^false].
- 			[^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. ^false].
- 				[^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. ^false].
- 					[^typeSet add: #double].
  				 (types includes: #float) ifTrue:
+ 					[typeSet add: #float. ^false].
+ 				^false]. "don't know; leave unspecified."
+ 			types notEmpty ifTrue:
+ 				[typeSet add: types anyOne].
+ 			^false].
+ 		 ^(aCodeGen returnTypeForSend: expr in: self)
+ 			ifNotNil: [:type| typeSet add: type. false]
+ 			ifNil: [(aCodeGen methodNamed: expr selector) notNil]]. "Abort only for untyped methods that will be typed"
- 					[^typeSet add: #float].
- 				^self]. "don't know; leave unspecified."
- 			^types notEmpty ifTrue:
- 				[typeSet add: types anyOne]].
- 		 ^(aCodeGen returnTypeForSend: expr in: self) 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]].
+ 	^false!
- 			[typeSet add: #float]]!

Item was changed:
  ----- Method: TMethod>>inferReturnTypeFromReturnsIn: (in category 'type inference') -----
  inferReturnTypeFromReturnsIn: aCodeGen
  	"Attempt to infer the return type of the receiver from returns in the parse tree."
  
  	"this for determining which returns have which return types:"
  	"aCodeGen
  		pushScope: declarations
  		while: [parseTree
  				nodesSelect: [:n| n isReturn]
  				thenCollect: [:n| | s |
  					s := Set new.
  					self addTypesFor: n expression to: s in: aCodeGen.
  					{n. s}]]"
  			
  	aCodeGen maybeBreakForTestToInline: selector in: self.
+ 	returnType ifNotNil: [^self].
+ 	aCodeGen
+ 		pushScope: declarations
+ 		while:
+ 			[| hasReturn returnTypes |
+ 			 hasReturn := false.
+ 			 returnTypes := Set new.
+ 			 "Debug:
+ 			 (| rettypes |
+ 			  rettypes := Dictionary new.
+ 			  parseTree nodesDo:
+ 				[:node|
+ 				node isReturn ifTrue:
+ 					[| types |
+ 					 self addTypesFor: node expression to: (types := Set new) in: aCodeGen.
+ 					 rettypes at: node expression put: types]].
+ 			  rettypes)"
+ 			 parseTree nodesDo:
+ 				[:node|
+ 				node isReturn ifTrue:
+ 					[hasReturn := true.
+ 					 "If we encounter a send of an as-yet-untyped method then abort,
+ 					  retrying and computing the type when that method is fully typed."
+ 					 (self addTypesFor: node expression to: returnTypes in: aCodeGen) ifTrue:
+ 						[^self]]].
+ 			returnTypes remove: #implicit ifAbsent: [].
+ 			returnTypes := aCodeGen harmonizeReturnTypesIn: returnTypes.
+ 			hasReturn
+ 				ifTrue:
+ 					[returnTypes size > 1 ifTrue:
+ 						[| message |
+ 						 message := String streamContents:
+ 										[:s|
+ 										 s nextPutAll: 'conflicting return types '.
+ 										 returnTypes
+ 											do: [:t| s nextPutAll: t]
+ 											separatedBy: [s nextPutAll: ', '].
+ 										 s nextPutAll: ' in '; nextPutAll: selector; cr].
+ 						 Notification signal: message.
+ 						 aCodeGen logger show: message].
+ 					 returnTypes size = 1 ifTrue:
+ 						[self returnType: returnTypes anyOne]]
+ 				ifFalse:
+ 					[self returnType: (aCodeGen implicitReturnTypeFor: selector)]]!
- 	returnType ifNil: "the initial default"
- 		[aCodeGen
- 			pushScope: declarations
- 			while:
- 				[| hasReturn returnTypes |
- 				 hasReturn := false.
- 				 returnTypes := Set new.
- 				 "Debug:
- 				 (| rettypes |
- 				  rettypes := Dictionary new.
- 				  parseTree nodesDo:
- 					[:node|
- 					node isReturn ifTrue:
- 						[| types |
- 						 self addTypesFor: node expression to: (types := Set new) in: aCodeGen.
- 						 rettypes at: node expression put: types]].
- 				  rettypes)"
- 				 parseTree nodesDo:
- 					[:node|
- 					node isReturn ifTrue:
- 						[hasReturn := true.
- 						 self addTypesFor: node expression to: returnTypes in: aCodeGen]].
- 				returnTypes remove: #implicit ifAbsent: [].
- 				returnTypes := aCodeGen harmonizeReturnTypesIn: returnTypes.
- 				hasReturn
- 					ifTrue:
- 						[returnTypes size > 1 ifTrue:
- 							[| message |
- 							 message := String streamContents:
- 											[:s|
- 											 s nextPutAll: 'conflicting return types '.
- 											 returnTypes
- 												do: [:t| s nextPutAll: t]
- 												separatedBy: [s nextPutAll: ', '].
- 											 s nextPutAll: ' in '; nextPutAll: selector; cr].
- 							 Notification signal: message.
- 							 aCodeGen logger show: message].
- 						 returnTypes size = 1 ifTrue:
- 							[self returnType: returnTypes anyOne]]
- 					ifFalse:
- 						[self returnType: (aCodeGen implicitReturnTypeFor: selector)]]]!

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 |
  	aCodeGen maybeBreakForTestToInline: selector in: self.
  	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: [(type := node expression isSend
+ 						ifTrue: [aCodeGen returnTypeOrNilForSend: node expression in: self]
- 						ifTrue: [aCodeGen returnTypeForSend: node expression in: self]
  						ifFalse: [self typeFor: node expression in: aCodeGen]) notNil
  		 and: [aCodeGen isSimpleType: type]]]]) ifTrue:
  			[aCodeGen mergeTypeOf: var in: declarations with: type method: self.
  			 effectiveNodes at: var put: { declarations at: var. node }, (effectiveNodes at: var ifAbsent: [#()])]].
  	^effectiveNodes!



More information about the Vm-dev mailing list