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

commits at source.squeak.org commits at source.squeak.org
Thu Feb 25 00:38:52 UTC 2016


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

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

Name: VMMaker.oscog-eem.1700
Author: eem
Time: 24 February 2016, 4:37:07.211949 pm
UUID: 4efaff50-3cc1-4840-8195-df0e306eb5a4
Ancestors: VMMaker.oscog-eem.1699

Fix special selector arithmetic and comparison in the 64-bit Cogit.  My original code for genJumpNotSmallIntegersIn:andScratchReg: merely jumped if the tags differed, hence not jumping if both arguments were SmallFloat64s (or both Characters).  The new code requires an additional scratch register; hence add genJumpNotSmallIntegersIn:andScratch:scratch:.

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

Item was added:
+ ----- Method: CogObjectRepresentation>>genJumpNotSmallIntegersIn:andScratch:scratch: (in category 'compile abstract instructions') -----
+ genJumpNotSmallIntegersIn: aRegister andScratch: scratchA scratch: scratchB
+ 	"Generate a compare and branch to test if aRegister and scratchA contains other than SmallIntegers,
+ 	 i.e. don't branch if both aRegister and scratchA contain SmallIntegers.
+ 	 Answer the jump.  Destroy scratchA and scratchB if required."
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	^self subclassResponsibility!

Item was removed:
- ----- Method: CogObjectRepresentation>>genJumpNotSmallIntegersIn:andScratchReg: (in category 'compile abstract instructions') -----
- genJumpNotSmallIntegersIn: aRegister andScratchReg: scratchReg
- 	"Generate a compare and branch to test if aRegister and scratchReg contains other than SmallIntegers,
- 	 i.e. don't branch if both aRegister and scratchReg contain SmallIntegers.
- 	 Answer the jump.  Destroy scratchReg if required."
- 	<returnTypeC: #'AbstractInstruction *'>
- 	^self subclassResponsibility!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>genJumpNotSmallIntegersIn:andScratch:scratch: (in category 'compile abstract instructions') -----
+ genJumpNotSmallIntegersIn: aRegister andScratch: scratchA scratch: scratchB
+ 	"Generate a compare and branch to test if aRegister and scratchA contains other than SmallIntegers,
+ 	 i.e. don't branch if both aRegister and scratchA contain SmallIntegers.
+ 	 Answer the jump.  Destroy scratchA and scratchB if required."
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	<inline: true>
+ 	cogit AndR: aRegister R: scratchA.
+ 	^self genJumpNotSmallIntegerInScratchReg: scratchA!

Item was removed:
- ----- Method: CogObjectRepresentationFor32BitSpur>>genJumpNotSmallIntegersIn:andScratchReg: (in category 'compile abstract instructions') -----
- genJumpNotSmallIntegersIn: aRegister andScratchReg: scratchReg
- 	"Generate a compare and branch to test if aRegister and scratchReg contains other than SmallIntegers,
- 	 i.e. don't branch if both aRegister and scratchReg contain SmallIntegers.
- 	 Answer the jump.  Destroy scratchReg if required."
- 	<returnTypeC: #'AbstractInstruction *'>
- 	<inline: true>
- 	cogit AndR: aRegister R: scratchReg.
- 	^self genJumpNotSmallIntegerInScratchReg: scratchReg!

Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotSmallIntegersIn:andScratch:scratch: (in category 'compile abstract instructions') -----
+ genJumpNotSmallIntegersIn: aRegister andScratch: scratchA scratch: scratchB
+ 	"Generate a compare and branch to test if aRegister and scratchA contains other than SmallIntegers,
+ 	 i.e. don't branch if both aRegister and scratchA contain SmallIntegers.
+ 	 Answer the jump.  Destroy scratchA and scratchB if required."
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	"Map SmallIntegers to 0 in scratchA & scratchB, add and jump non-zero."
+ 	^cogit
+ 		MoveR: aRegister R: scratchB;
+ 		SubCq: objectMemory smallIntegerTag R: scratchA;
+ 		SubCq: objectMemory smallIntegerTag R: scratchB;
+ 		AndCq: objectMemory tagMask R: scratchA;
+ 		AndCq: objectMemory tagMask R: scratchB;
+ 		AddR: scratchA R: scratchB;
+ 		JumpNonZero: 0!

Item was removed:
- ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotSmallIntegersIn:andScratchReg: (in category 'compile abstract instructions') -----
- genJumpNotSmallIntegersIn: aRegister andScratchReg: scratchReg
- 	"Generate a compare and branch to test if aRegister and scratchReg contains other than SmallIntegers,
- 	 i.e. don't branch if both aRegister and scratchReg contain SmallIntegers.
- 	 Answer the jump.  Destroy scratchReg if required."
- 	<returnTypeC: #'AbstractInstruction *'>
- 	^cogit
- 		XorR: aRegister R: scratchReg;
- 		AndCq: objectMemory tagMask R: scratchReg;
- 		JumpNonZero: 0!

Item was added:
+ ----- Method: CogObjectRepresentationForSqueakV3>>genJumpNotSmallIntegersIn:andScratch:scratch: (in category 'compile abstract instructions') -----
+ genJumpNotSmallIntegersIn: aRegister andScratch: scratchA scratch: scratchB
+ 	"Generate a compare and branch to test if aRegister and scratchA contains other than SmallIntegers,
+ 	 i.e. don't branch if both aRegister and scratchA contain SmallIntegers.
+ 	 Answer the jump.  Destroy scratchA and scratchB if required."
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	<inline: true>
+ 	cogit AndR: aRegister R: scratchA.
+ 	^self genJumpNotSmallIntegerInScratchReg: scratchA!

Item was removed:
- ----- Method: CogObjectRepresentationForSqueakV3>>genJumpNotSmallIntegersIn:andScratchReg: (in category 'compile abstract instructions') -----
- genJumpNotSmallIntegersIn: aRegister andScratchReg: scratchReg
- 	"Generate a compare and branch to test if aRegister and scratchReg contains other than SmallIntegers,
- 	 i.e. don't branch if both aRegister and scratchReg contain SmallIntegers.
- 	 Answer the jump.  Destroy scratchReg if required."
- 	<returnTypeC: #'AbstractInstruction *'>
- 	<inline: true>
- 	cogit AndR: aRegister R: scratchReg.
- 	^self genJumpNotSmallIntegerInScratchReg: scratchReg!

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
  	  counterAddress countTripped counterReg index |
  	<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].
  
  	"short-cut the jump if operands are SmallInteger constants."
  	(argIsInt and: [rcvrIsInt]) ifTrue:
  		[^ self genStaticallyResolvedSpecialSelectorComparison].
  
  	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].
  	jumpNotSmallInts := (argIsInt or: [rcvrIsInt])
  							ifTrue: [objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg]
+ 							ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: ReceiverResultReg andScratch: TempReg scratch: ClassReg].
- 							ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: ReceiverResultReg andScratchReg: 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 genConditionalBranch: (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].
  	index := byte0 - self firstSpecialSelectorBytecodeOffset.
  	^self genMarshalledSend: index negated - 1 numArgs: 1 sendTable: ordinarySendTrampolines!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genSpecialSelectorArithmetic (in category 'bytecode generators') -----
  genSpecialSelectorArithmetic
  	| primDescriptor rcvrIsConst argIsConst rcvrIsInt argIsInt rcvrInt argInt result
  	 jumpNotSmallInts jumpContinue annotateInst instToAnnotate index |
  	<var: #primDescriptor type: #'BytecodeDescriptor *'>
  	<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
  	<var: #jumpContinue type: #'AbstractInstruction *'>
  	<var: #instToAnnotate type: #'AbstractInstruction *'>
  	primDescriptor := self generatorAt: byte0.
  	argIsInt := (argIsConst := self ssTop type = SSConstant)
  				 and: [objectMemory isIntegerObject: (argInt := self ssTop constant)].
  	rcvrIsInt := (rcvrIsConst := (self ssValue: 1) type = SSConstant)
  				 and: [objectMemory isIntegerObject: (rcvrInt := (self ssValue: 1) constant)].
  
  	(argIsInt and: [rcvrIsInt]) ifTrue:
  		[rcvrInt := objectMemory integerValueOf: rcvrInt.
  		 argInt := objectMemory integerValueOf: argInt.
  		 primDescriptor opcode caseOf: {
  			[AddRR]	-> [result := rcvrInt + argInt].
  			[SubRR]	-> [result := rcvrInt - argInt].
  			[AndRR]	-> [result := rcvrInt bitAnd: argInt].
  			[OrRR]	-> [result := rcvrInt bitOr: argInt] }.
  		(objectMemory isIntegerValue: result) ifTrue:
  			["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; ssPushAnnotatedConstant: (objectMemory integerObjectOf: result)].
  		^self genSpecialSelectorSend].
  
  	"If there's any constant involved other than a SmallInteger don't attempt to inline."
  	((rcvrIsConst and: [rcvrIsInt not])
  	 or: [argIsConst and: [argIsInt not]]) ifTrue:
  		[^self genSpecialSelectorSend].
  
  	"If we know nothing about the types then better not to inline as the inline cache and
  	 primitive code is not terribly slow so wasting time on duplicating tag tests is pointless."
  	(argIsInt or: [rcvrIsInt]) ifFalse:
  		[^self genSpecialSelectorSend].
  
  	argIsInt
  		ifTrue:
  			[self ssFlushTo: simStackPtr - 2.
  			 (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].
  	jumpNotSmallInts := (argIsInt or: [rcvrIsInt])
  							ifTrue: [objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg]
+ 							ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: ReceiverResultReg andScratch: TempReg scratch: ClassReg].
- 							ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: ReceiverResultReg andScratchReg: TempReg].
  	primDescriptor opcode caseOf: {
  		[AddRR] -> [argIsInt
  						ifTrue:
  							[instToAnnotate := self AddCq: argInt - ConstZero R: ReceiverResultReg.
  							 jumpContinue := self JumpNoOverflow: 0.
  							 "overflow; must undo the damage before continuing"
  							 self SubCq: argInt - ConstZero R: ReceiverResultReg]
  						ifFalse:
  							[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ReceiverResultReg.
  							 self AddR: Arg0Reg R: ReceiverResultReg.
  							jumpContinue := self JumpNoOverflow: 0.
  							"overflow; must undo the damage before continuing"
  							 rcvrIsInt
  								ifTrue: [self MoveCq: rcvrInt R: ReceiverResultReg]
  								ifFalse:
  									[self SubR: Arg0Reg R: ReceiverResultReg.
  									 objectRepresentation genSetSmallIntegerTagsIn: ReceiverResultReg]]].
  		[SubRR] -> [argIsInt
  						ifTrue:
  							[instToAnnotate := self SubCq: argInt - ConstZero R: ReceiverResultReg.
  							 jumpContinue := self JumpNoOverflow: 0.
  							 "overflow; must undo the damage before continuing"
  							 self AddCq: argInt - ConstZero R: ReceiverResultReg]
  						ifFalse:
  							[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: Arg0Reg.
  							 self SubR: Arg0Reg R: ReceiverResultReg.
  							 jumpContinue := self JumpNoOverflow: 0.
  							 "overflow; must undo the damage before continuing"
  							 self AddR: Arg0Reg R: ReceiverResultReg.
  							 objectRepresentation genSetSmallIntegerTagsIn: Arg0Reg]].
  		[AndRR] -> [argIsInt
  						ifTrue: [instToAnnotate := self AndCq: argInt R: ReceiverResultReg]
  						ifFalse: [self AndR: Arg0Reg R: ReceiverResultReg].
  					jumpContinue := self Jump: 0].
  		[OrRR]	-> [argIsInt
  						ifTrue: [instToAnnotate := self OrCq: argInt R: ReceiverResultReg]
  						ifFalse: [self OrR: Arg0Reg R: ReceiverResultReg].
  					jumpContinue := self Jump: 0] }.
  	jumpNotSmallInts jmpTarget: self Label.
  	argIsInt ifTrue:
  		[annotateInst ifTrue: [self annotateBytecode: instToAnnotate].
  		 self MoveCq: argInt R: Arg0Reg].
  	index := byte0 - self firstSpecialSelectorBytecodeOffset.
  	self genMarshalledSend: index negated - 1 numArgs: 1 sendTable: ordinarySendTrampolines.
  	jumpContinue jmpTarget: self Label.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genSpecialSelectorComparison (in category 'bytecode generators') -----
  genSpecialSelectorComparison
  	| nextPC postBranchPC targetBytecodePC primDescriptor branchDescriptor
  	  rcvrIsInt argIsInt argInt jumpNotSmallInts inlineCAB annotateInst index |
  	<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].
  
  	(argIsInt and: [rcvrIsInt]) ifTrue:
  		[^ self genStaticallyResolvedSpecialSelectorComparison].
  
  	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].
  	jumpNotSmallInts := (argIsInt or: [rcvrIsInt])
  							ifTrue: [objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg]
+ 							ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: ReceiverResultReg andScratch: TempReg scratch: ClassReg].
- 							ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: ReceiverResultReg andScratchReg: 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 genConditionalBranch: (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].
  	index := byte0 - self firstSpecialSelectorBytecodeOffset.
  	^self genMarshalledSend: index negated - 1 numArgs: 1 sendTable: ordinarySendTrampolines!



More information about the Vm-dev mailing list