[Vm-dev] VM Maker: VMMaker.oscog-cb.1397.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Jun 29 11:54:01 UTC 2015


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

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

Name: VMMaker.oscog-cb.1397
Author: cb
Time: 29 June 2015, 1:52:05.055 pm
UUID: 2462319b-7f8e-4da4-8507-e6e14177bf44
Ancestors: VMMaker.oscog-cb.1396

separate the case where the specialSelector comparison has two constants as operands and share the code between the two JITs

=============== Diff against VMMaker.oscog-cb.1396 ===============

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>genSpecialSelectorComparison (in category 'bytecode generators') -----
  genSpecialSelectorComparison
  	"Override to count inlined branches if followed by a conditional branch.
  	 We borrow the following conditional branch's counter and when about to
  	 inline the comparison we decrement the counter (without writing it back)
  	 and if it trips simply abort the inlining, falling back to the normal send which
  	 will then continue to the conditional branch which will trip and enter the abort."
  	| nextPC postBranchPC targetBytecodePC primDescriptor branchDescriptor
+ 	  rcvrIsInt argIsInt argInt jumpNotSmallInts inlineCAB annotateInst
- 	  rcvrIsInt argIsInt rcvrInt argInt result jumpNotSmallInts inlineCAB annotateInst
  	  counterAddress countTripped counterReg |
  	<var: #countTripped type: #'AbstractInstruction *'>
  	<var: #primDescriptor type: #'BytecodeDescriptor *'>
  	<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
  	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
  
  	(coInterpreter isOptimizedMethod: methodObj) ifTrue: [ ^ self genSpecialSelectorComparisonWithoutCounters ].
  
  	self ssFlushTo: simStackPtr - 2.
  	primDescriptor := self generatorAt: byte0.
  	argIsInt := self ssTop type = SSConstant
  				 and: [objectMemory isIntegerObject: (argInt := self ssTop constant)].
  	rcvrIsInt := (self ssValue: 1) type = SSConstant
+ 				 and: [objectMemory isIntegerObject: (self ssValue: 1) constant].
- 				 and: [objectMemory isIntegerObject: (rcvrInt := (self ssValue: 1) constant)].
  
  	"short-cut the jump if operands are SmallInteger constants."
  	(argIsInt and: [rcvrIsInt]) ifTrue:
+ 		[^ self genStaticallyResolvedSpecialSelectorComparison].
- 		[self cCode: '' inSmalltalk: "In Simulator ints are unsigned..."
- 				[rcvrInt := objectMemory integerValueOf: rcvrInt.
- 				argInt := objectMemory integerValueOf: argInt].
- 		 primDescriptor opcode caseOf: {
- 			[JumpLess]				-> [result := rcvrInt < argInt].
- 			[JumpLessOrEqual]		-> [result := rcvrInt <= argInt].
- 			[JumpGreater]			-> [result := rcvrInt > argInt].
- 			[JumpGreaterOrEqual]	-> [result := rcvrInt >= argInt].
- 			[JumpZero]				-> [result := rcvrInt = argInt].
- 			[JumpNonZero]			-> [result := rcvrInt ~= argInt] }.
- 		 "Must enter any annotatedConstants into the map"
- 		 self annotateBytecodeIfAnnotated: (self ssValue: 1).
- 		 self annotateBytecodeIfAnnotated: self ssTop.
- 		 "Must annotate the bytecode for correct pc mapping."
- 		 self ssPop: 2.
- 		 ^self ssPushAnnotatedConstant: (result
- 											ifTrue: [objectMemory trueObject]
- 											ifFalse: [objectMemory falseObject])].
  
  	self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target | 
  		branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
  	
  	"Only interested in inlining if followed by a conditional branch."
  	inlineCAB := branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse].
  	"Further, only interested in inlining = and ~= if there's a SmallInteger constant involved.
  	 The relational operators successfully statically predict SmallIntegers; the equality operators do not."
  	(inlineCAB and: [primDescriptor opcode = JumpZero or: [primDescriptor opcode = JumpNonZero]]) ifTrue:
  		[inlineCAB := argIsInt or: [rcvrIsInt]].
  	inlineCAB ifFalse:
  		[^self genSpecialSelectorSend].
  
  	argIsInt
  		ifTrue:
  			[(self ssValue: 1) popToReg: ReceiverResultReg.
  			 annotateInst := self ssTop annotateUse.
  			 self ssPop: 2.
  			 self MoveR: ReceiverResultReg R: TempReg]
  		ifFalse:
  			[self marshallSendArguments: 1.
  			 self MoveR: Arg0Reg R: TempReg.
  			 rcvrIsInt ifFalse:
  				[objectRepresentation isSmallIntegerTagNonZero
  					ifTrue: [self AndR: ReceiverResultReg R: TempReg]
  					ifFalse: [self OrR: ReceiverResultReg R: TempReg]]].
  	jumpNotSmallInts := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  
  	counterReg := self allocateRegNotConflictingWith: (self registerMaskFor: ReceiverResultReg and: Arg0Reg).
  	self 
  		genExecutionCountLogicInto: [ :cAddress :countTripBranch | 
  			counterAddress := cAddress. 
  			countTripped := countTripBranch ] 
  		counterReg: counterReg.
  
  	argIsInt
  		ifTrue: [annotateInst
  					ifTrue: [self annotateBytecode: (self CmpCq: argInt R: ReceiverResultReg)]
  					ifFalse: [self CmpCq: argInt R: ReceiverResultReg]]
  		ifFalse: [self CmpR: Arg0Reg R: ReceiverResultReg].
  	"Cmp is weird/backwards so invert the comparison.  Further since there is a following conditional
  	 jump bytecode define non-merge fixups and leave the cond bytecode to set the mergeness."
  	self gen: (branchDescriptor isBranchTrue
  				ifTrue: [primDescriptor opcode]
  				ifFalse: [self inverseBranchFor: primDescriptor opcode])
  		operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
  		
  	self genFallsThroughCountLogicCounterReg: counterReg counterAddress: counterAddress.
  	
  	self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC).
  	countTripped jmpTarget: (jumpNotSmallInts jmpTarget: self Label).
  	
  	argIsInt ifTrue:
  		[self MoveCq: argInt R: Arg0Reg].
  	^self genMarshalledSend: (coInterpreter specialSelector: byte0 - self firstSpecialSelectorBytecodeOffset)
  		numArgs: 1
  		sendTable: ordinarySendTrampolines!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genSpecialSelectorComparison (in category 'bytecode generators') -----
  genSpecialSelectorComparison
  	| nextPC postBranchPC targetBytecodePC primDescriptor branchDescriptor
+ 	  rcvrIsInt argIsInt argInt jumpNotSmallInts inlineCAB annotateInst |
- 	  rcvrIsInt argIsInt rcvrInt argInt result jumpNotSmallInts inlineCAB annotateInst |
  	<var: #primDescriptor type: #'BytecodeDescriptor *'>
  	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
  	<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
  	self ssFlushTo: simStackPtr - 2.
  	primDescriptor := self generatorAt: byte0.
  	argIsInt := self ssTop type = SSConstant
  				 and: [objectMemory isIntegerObject: (argInt := self ssTop constant)].
  	rcvrIsInt := (self ssValue: 1) type = SSConstant
+ 				 and: [objectMemory isIntegerObject: (self ssValue: 1) constant].
- 				 and: [objectMemory isIntegerObject: (rcvrInt := (self ssValue: 1) constant)].
  
  	(argIsInt and: [rcvrIsInt]) ifTrue:
+ 		[^ self genStaticallyResolvedSpecialSelectorComparison].
- 		[self cCode: '' inSmalltalk: "In Simulator ints are unsigned..."
- 				[rcvrInt := objectMemory integerValueOf: rcvrInt.
- 				argInt := objectMemory integerValueOf: argInt].
- 		 primDescriptor opcode caseOf: {
- 			[JumpLess]				-> [result := rcvrInt < argInt].
- 			[JumpLessOrEqual]		-> [result := rcvrInt <= argInt].
- 			[JumpGreater]			-> [result := rcvrInt > argInt].
- 			[JumpGreaterOrEqual]	-> [result := rcvrInt >= argInt].
- 			[JumpZero]				-> [result := rcvrInt = argInt].
- 			[JumpNonZero]			-> [result := rcvrInt ~= argInt] }.
- 		 "Must enter any annotatedConstants into the map"
- 		 self annotateBytecodeIfAnnotated: (self ssValue: 1).
- 		 self annotateBytecodeIfAnnotated: self ssTop.
- 		 "Must annotate the bytecode for correct pc mapping."
- 		 self ssPop: 2.
- 		 ^self ssPushAnnotatedConstant: (result
- 											ifTrue: [objectMemory trueObject]
- 											ifFalse: [objectMemory falseObject])].
  
  	self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target | 
  		branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
  
  	"Only interested in inlining if followed by a conditional branch."
  	inlineCAB := branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse].
  	"Further, only interested in inlining = and ~= if there's a SmallInteger constant involved.
  	 The relational operators successfully statically predict SmallIntegers; the equality operators do not."
  	(inlineCAB and: [primDescriptor opcode = JumpZero or: [primDescriptor opcode = JumpNonZero]]) ifTrue:
  		[inlineCAB := argIsInt or: [rcvrIsInt]].
  	inlineCAB ifFalse:
  		[^self genSpecialSelectorSend].
  
  	argIsInt
  		ifTrue:
  			[(self ssValue: 1) popToReg: ReceiverResultReg.
  			 annotateInst := self ssTop annotateUse.
  			 self ssPop: 2.
  			 self MoveR: ReceiverResultReg R: TempReg]
  		ifFalse:
  			[self marshallSendArguments: 1.
  			 self MoveR: Arg0Reg R: TempReg.
  			 rcvrIsInt ifFalse:
  				[objectRepresentation isSmallIntegerTagNonZero
  					ifTrue: [self AndR: ReceiverResultReg R: TempReg]
  					ifFalse: [self OrR: ReceiverResultReg R: TempReg]]].
  	jumpNotSmallInts := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	argIsInt
  		ifTrue: [annotateInst
  					ifTrue: [self annotateBytecode: (self CmpCq: argInt R: ReceiverResultReg)]
  					ifFalse: [self CmpCq: argInt R: ReceiverResultReg]]
  		ifFalse: [self CmpR: Arg0Reg R: ReceiverResultReg].
  	"Cmp is weird/backwards so invert the comparison.  Further since there is a following conditional
  	 jump bytecode define non-merge fixups and leave the cond bytecode to set the mergeness."
  	self gen: (branchDescriptor isBranchTrue
  				ifTrue: [primDescriptor opcode]
  				ifFalse: [self inverseBranchFor: primDescriptor opcode])
  		operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
  	self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC).
  	jumpNotSmallInts jmpTarget: self Label.
  	argIsInt ifTrue:
  		[self MoveCq: argInt R: Arg0Reg].
  	^self genMarshalledSend: (coInterpreter specialSelector: byte0 - self firstSpecialSelectorBytecodeOffset)
  		numArgs: 1
  		sendTable: ordinarySendTrampolines.!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>genStaticallyResolvedSpecialSelectorComparison (in category 'bytecode generator support') -----
+ genStaticallyResolvedSpecialSelectorComparison
+ 	"Assumes both operands are ints"
+ 	<var: #primDescriptor type: #'BytecodeDescriptor *'>
+ 	| rcvrInt argInt primDescriptor result |
+ 	primDescriptor := self generatorAt: byte0.
+ 	argInt := self ssTop constant.
+ 	rcvrInt := (self ssValue: 1) constant.
+ 	self cCode: '' inSmalltalk: "In Simulator ints are unsigned..."
+ 		[rcvrInt := objectMemory integerValueOf: rcvrInt.
+ 		argInt := objectMemory integerValueOf: argInt].
+ 	 primDescriptor opcode caseOf: {
+ 		[JumpLess]				-> [result := rcvrInt < argInt].
+ 		[JumpLessOrEqual]		-> [result := rcvrInt <= argInt].
+ 		[JumpGreater]			-> [result := rcvrInt > argInt].
+ 		[JumpGreaterOrEqual]	-> [result := rcvrInt >= argInt].
+ 		[JumpZero]				-> [result := rcvrInt = argInt].
+ 		[JumpNonZero]			-> [result := rcvrInt ~= argInt] }.
+ 	 "Must enter any annotatedConstants into the map"
+ 	 self annotateBytecodeIfAnnotated: (self ssValue: 1).
+ 	 self annotateBytecodeIfAnnotated: self ssTop.
+ 	 "Must annotate the bytecode for correct pc mapping."
+ 	 self ssPop: 2.
+ 	 ^self ssPushAnnotatedConstant: (result
+ 			ifTrue: [objectMemory trueObject]
+ 			ifFalse: [objectMemory falseObject])!



More information about the Vm-dev mailing list