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

commits at source.squeak.org commits at source.squeak.org
Mon Sep 21 20:19:19 UTC 2015


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

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

Name: VMMaker.oscog-eem.1458
Author: eem
Time: 21 September 2015, 1:16:58.857 pm
UUID: 18916203-1fcb-4a85-9f86-9c798ab47c58
Ancestors: VMMaker.oscog-eem.1457

Add some more support for more passing tests in the x64 code generator.  Correct some of the x64's computeMaximumSize.

Modify the test harness to use the double dispatching for integer <=> register contexts conversion.

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

Item was added:
+ ----- Method: AbstractInstructionTests>>memoryAsBytes: (in category 'private') -----
+ memoryAsBytes: aByteArray
+ 	"Simply answer the ByteArray.  Subclasses that represent instruction
+ 	 data using Array shou;ld override to convert appropriately."
+ 	^aByteArray!

Item was changed:
  ----- Method: AbstractInstructionTests>>runAddRR: (in category 'running') -----
  runAddRR: assertPrintBar
  	"self defaultTester runAddRR: false"
  	"self defaultTester runAddRR: true"
  	| memory |
  	memory := ByteArray new: 16.
  	self concreteCompilerClass dataRegistersWithAccessorsDo:
  		[:sreg :srgetter :srsetter|
  		self concreteCompilerClass dataRegistersWithAccessorsDo:
  			[:dreg :drgetter :drsetter| | inst len |
  			inst := self gen: AddRR operand: sreg operand: dreg.
  			len := inst concretizeAt: 0.
  			memory replaceFrom: 1 to: len with: inst machineCode object startingAt: 1.
  			self pairs: (-2 to: 2)  do:
  				[:a :b| | bogus |
  				self processor
  					reset;
+ 					perform: srsetter with: (processor convertIntegerToInternal: a);
+ 					perform: drsetter with: (processor convertIntegerToInternal: b).
- 					perform: srsetter with: a signedIntToLong;
- 					perform: drsetter with: b signedIntToLong.
  				[[processor pc < len] whileTrue:
  					[self processor singleStepIn: memory]]
  					on: Error
  					do: [:ex| ].
  				"self processor printRegistersOn: Transcript.
  				 Transcript show: (self processor disassembleInstructionAt: 0 In: memory); cr"
  				assertPrintBar
+ 					ifTrue: [self assert: processor pc equals: inst machineCodeSize]
- 					ifTrue: [self assert: processor pc = inst machineCodeSize]
  					ifFalse: [bogus := processor pc ~= inst machineCodeSize].
  				self concreteCompilerClass dataRegistersWithAccessorsDo:
  					[:ireg :getter :setter| | expected |
  					expected := getter == drgetter
  									ifTrue: [srgetter == drgetter
  												ifTrue: [b + b]
  												ifFalse: [a + b]]
  									ifFalse: [getter = srgetter
  												ifTrue: [a]
  												ifFalse: [0]].
  					assertPrintBar
+ 						ifTrue: [self assert: (self processor convertInternalToInteger: (self processor perform: getter)) equals: expected]
- 						ifTrue: [self assert: (self processor perform: getter) signedIntFromLong = expected]
  						ifFalse:
+ 							[(self processor convertInternalToInteger: (self processor perform: getter)) ~= expected ifTrue:
- 							[(self processor perform: getter) signedIntFromLong ~= expected ifTrue:
  								[bogus := true]]].
  					assertPrintBar ifFalse:
  						[Transcript
  							nextPutAll: drgetter; nextPut: $(; print: b; nextPutAll: ') + ';
  							nextPutAll: srgetter; nextPut: $(; print: a; nextPutAll: ') = ';
+ 							print: (self processor convertInternalToInteger: (self processor perform: drgetter)); cr; flush.
- 							print: (self processor perform: drgetter) signedIntFromLong; cr; flush.
  						 bogus ifTrue:
  							[self processor printRegistersOn: Transcript.
  							 Transcript show: (self processor disassembleInstructionAt: 0 In: memory); cr]]]]]!

Item was changed:
  ----- Method: AbstractInstructionTests>>runArithmeticShiftRightRR: (in category 'running') -----
  runArithmeticShiftRightRR: assertPrintBar
  	"self defaultTester runArithmeticShiftRightRR: false"
  	"self defaultTester runArithmeticShiftRightRR: true"
  	| memory |
  	memory := ByteArray new: 16.
  	self concreteCompilerClass dataRegistersWithAccessorsDo:
  		[:sreg :srgetter :srsetter|
  		self concreteCompilerClass dataRegistersWithAccessorsDo:
  			[:dreg :drgetter :drsetter| | inst len |
  			inst := self gen: ArithmeticShiftRightRR operand: sreg operand: dreg.
  			len := inst concretizeAt: 0.
  			memory replaceFrom: 1 to: len with: inst machineCode object startingAt: 1.
  			self pairs: (-5 to: 19 by: 6)  do:
  				[:a :b| | bogus |
  				(a >= 0 and: [sreg ~= dreg or: [b >= 0]]) ifTrue:
  					[self processor
  						reset;
+ 						perform: srsetter with: (processor convertIntegerToInternal: a);
+ 						perform: drsetter with: (processor convertIntegerToInternal: b).
- 						perform: srsetter with: a signedIntToLong;
- 						perform: drsetter with: b signedIntToLong.
  					[self processor singleStepIn: memory.
  					 self processor pc ~= inst machineCodeSize] whileTrue.
  					"self processor printRegistersOn: Transcript.
  					 self processor disassembleFrom: 0 to: inst machineCodeSize in: memory on: Transcript"
  					assertPrintBar
  						ifTrue: [self assert: processor pc = inst machineCodeSize]
  						ifFalse: [bogus := processor pc ~= inst machineCodeSize].
  					self concreteCompilerClass dataRegistersWithAccessorsDo:
  						[:ireg :getter :setter| | expected |
  						expected := getter == drgetter
  										ifTrue: [srgetter == drgetter
  													ifTrue: [b >> b]
  													ifFalse: [b >> a]]
  										ifFalse: [getter = srgetter
  													ifTrue: [a]
  													ifFalse: [0]].
  						assertPrintBar
+ 							ifTrue: [self assert: (self processor convertInternalToInteger: (self processor perform: getter)) equals: expected]
- 							ifTrue: [self assert: (self processor perform: getter) signedIntFromLong = expected]
  							ifFalse:
+ 								[(self processor convertInternalToInteger: (self processor perform: getter)) ~= expected ifTrue:
+ 								[bogus := true]]].
- 								[(self processor perform: getter) signedIntFromLong ~= expected ifTrue:
- 									[bogus := true]]].
  						assertPrintBar ifFalse:
  							[Transcript
  								nextPutAll: drgetter; nextPut: $(; print: b; nextPutAll: ') >> ';
  								nextPutAll: srgetter; nextPut: $(; print: a; nextPutAll: ') = ';
+ 								print: (self processor convertInternalToInteger: (self processor perform: drgetter)); cr; flush.
- 								print: (self processor perform: drgetter) signedIntFromLong; cr; flush.
  							 bogus ifTrue:
  								[self processor printRegistersOn: Transcript.
  								 self processor disassembleFrom: 0 to: inst machineCodeSize in: memory on: Transcript]]]]]]!

Item was changed:
  ----- Method: AbstractInstructionTests>>runBinaryConditionalJumps: (in category 'running') -----
  runBinaryConditionalJumps: assertPrintBar
  	"self defaultTester runBinaryConditionalJumps: false"
  	| mask reg1 reg2 reg3 |
  	mask := (1 << self processor bitsInWord) - 1.
  	self concreteCompilerClass dataRegistersWithAccessorsDo:
  		[:n :get :set|
  		n = 0 ifTrue: [reg1 := get].
  		n = 1 ifTrue: [reg2 := set].
  		n = 2 ifTrue: [reg3 := set]].
  	#(	(JumpAbove > unsigned)			(JumpBelowOrEqual <= unsigned)
  		(JumpBelow < unsigned)			(JumpAboveOrEqual >= unsigned)
  		(JumpGreater > signed)			(JumpLessOrEqual <= signed)
  		(JumpLess < signed)				(JumpGreaterOrEqual >= signed)
  		(JumpZero = signed)				(JumpNonZero ~= signed)) do:
  		[:triple|
  		[:opName :relation :signednessOrResult| | opcode jumpNotTaken jumpTaken nop memory bogus |
  		self resetGen.
  		opcode := CogRTLOpcodes classPool at: opName.
  		self gen: CmpRR operand: 2 operand: 1.
  		jumpTaken := self gen: opcode.
  		self gen: MoveCqR operand: 0 operand: 0.
  		jumpNotTaken := self gen: Jump.
  		jumpTaken jmpTarget: (self gen: MoveCqR operand: 1 operand: 0).
  		jumpNotTaken jmpTarget: (nop := self gen: Nop).
  		memory := self generateInstructions.
  		"self processor disassembleFrom: 0 to: memory size in: memory on: Transcript"
  		bogus := false.
  		self pairs: (-2 to: 2)  do:
  			[:a :b| | taken |
  			self processor
  				reset;
+ 				perform: reg2 with: (processor convertIntegerToInternal: a);
+ 				perform: reg3 with: (processor convertIntegerToInternal: b).
- 				perform: reg2 with: a signedIntToLong64;
- 				perform: reg3 with: b signedIntToLong64.
  			[self processor singleStepIn: memory.
  			 self processor pc ~= nop address] whileTrue.
  			taken := (self processor perform: reg1) = 1.
  			assertPrintBar
  				ifTrue:
+ 					[self assert: taken equals: (signednessOrResult == #unsigned
+ 												ifTrue: [(a bitAnd: mask) perform: relation with: (b bitAnd: mask)]
+ 												ifFalse: [a perform: relation with: b])]
- 					[self assert: taken = (signednessOrResult == #unsigned
- 											ifTrue: [(a bitAnd: mask) perform: relation with: (b bitAnd: mask)]
- 											ifFalse: [a perform: relation with: b])]
  				ifFalse:
  					[Transcript
  						nextPutAll: reg2; nextPut: $(; print: a; nextPutAll: ') '; nextPutAll: relation; space;
  						nextPutAll: reg3; nextPut: $(; print: b; nextPutAll: ') = ';
  						print: taken; cr; flush.
  					 taken = (signednessOrResult == #unsigned
  											ifTrue: [(a bitAnd: mask) perform: relation with: (b bitAnd: mask)]
  											ifFalse: [a perform: relation with: b]) ifFalse:
  						[bogus := true]]].
  			 bogus ifTrue:
  				[self processor printRegistersOn: Transcript.
  				 Transcript show: (self processor disassembleInstructionAt: jumpTaken address In: memory); cr]]
  					valueWithArguments: triple]!

Item was changed:
  ----- Method: AbstractInstructionTests>>runSubRR: (in category 'running') -----
  runSubRR: assertPrintBar
  	"self defaultTester runSubRR: false"
  	| memory |
  	memory := ByteArray new: self concreteCompilerClass new machineCodeBytes.
  	self concreteCompilerClass dataRegistersWithAccessorsDo:
  		[:sreg :srgetter :srsetter|
  		self concreteCompilerClass dataRegistersWithAccessorsDo:
  			[:dreg :drgetter :drsetter| | inst len |
  			inst := self gen: SubRR operand: sreg operand: dreg.
  			len := inst concretizeAt: 0.
  			memory replaceFrom: 1 to: len with: inst machineCode object startingAt: 1.
  			self pairs: (-2 to: 2)  do:
  				[:a :b| | bogus |
  				self processor
  					reset;
+ 					perform: srsetter with: (processor convertIntegerToInternal: a);
+ 					perform: drsetter with: (processor convertIntegerToInternal: b).
- 					perform: srsetter with: a signedIntToLong;
- 					perform: drsetter with: b signedIntToLong.
  				[[processor pc < len] whileTrue:
  					[self processor singleStepIn: memory]]
  					on: Error
  					do: [:ex| ].
  				"self processor printRegistersOn: Transcript.
  				 Transcript show: (self processor disassembleInstructionAt: 0 In: memory); cr"
  				assertPrintBar
  					ifTrue: [self assert: processor pc = inst machineCodeSize]
  					ifFalse: [bogus := processor pc ~= inst machineCodeSize].
  				self concreteCompilerClass dataRegistersWithAccessorsDo:
  					[:ireg :getter :setter| | expected |
  					expected := drgetter == srgetter
  									ifTrue: [0]
  									ifFalse:
  										[getter == drgetter
  											ifTrue: [b - a]
  											ifFalse: [getter = srgetter
  														ifTrue: [a]
  														ifFalse: [0]]].
  					assertPrintBar
+ 						ifTrue: [self assert: (self processor convertInternalToInteger: (self processor perform: getter)) equals: expected]
- 						ifTrue: [self assert: (self processor perform: getter) signedIntFromLong = expected]
  						ifFalse:
+ 							[(self processor convertInternalToInteger: (self processor perform: getter)) ~= expected ifTrue:
- 							[(self processor perform: getter) signedIntFromLong ~= expected ifTrue:
  								[bogus := true]]].
  					assertPrintBar ifFalse:
  						[Transcript
  							nextPutAll: drgetter; nextPut: $(; print: b; nextPutAll: ') - ';
  							nextPutAll: srgetter; nextPut: $(; print: a; nextPutAll: ') = ';
+ 							print: (self processor convertInternalToInteger: (self processor perform: drgetter)); cr; flush.
- 							print: (self processor perform: drgetter) signedIntFromLong; cr; flush.
  						 bogus ifTrue:
  							[self processor printRegistersOn: Transcript.
  							 Transcript show: (self processor disassembleInstructionAt: 0 In: memory); cr]]]]]!

Item was changed:
  ----- Method: AbstractInstructionTests>>testNegateR (in category 'running') -----
  testNegateR
  	"self defaultTester testNegateR"
  	| memory |
  	memory := ByteArray new: self concreteCompilerClass new machineCodeBytes.
  	self concreteCompilerClass dataRegistersWithAccessorsDo:
  		[:reg :rgetter :rsetter|
  		-2 to: 2 do:
  			[:a| | inst len |
  			inst := self gen: NegateR operand: reg.
  			len := inst concretizeAt: 0.
  			memory replaceFrom: 1 to: len with: inst machineCode object startingAt: 1.
  			self processor
  				reset;
+ 				perform: rsetter with: (processor convertIntegerToInternal: a).
- 				perform: rsetter with: a signedIntToLong.
  			[[processor pc < len] whileTrue:
  				[self processor singleStepIn: memory]]
  				on: Error
  				do: [:ex| ].
  			"self processor printRegistersOn: Transcript.
  			 Transcript show: (self processor disassembleInstructionAt: 0 In: memory); cr"
+ 			self assert: processor pc equals: inst machineCodeSize.
- 			self assert: processor pc = inst machineCodeSize.
  			self concreteCompilerClass dataRegistersWithAccessorsDo:
  				[:ireg :getter :setter| | expected |
  				expected := getter == rgetter ifTrue: [ a negated ] ifFalse: [0].
+ 				self assert: (processor convertInternalToInteger: (processor perform: getter)) equals: expected]]]!
- 				self assert: (self processor perform: getter) signedIntFromLong = expected]]]!

Item was changed:
  ----- Method: CogX64Compiler>>computeMaximumSize (in category 'generate machine code') -----
  computeMaximumSize
  	"Compute the maximum size for each opcode.  This allows jump offsets to
  	 be determined, provided that all backward branches are long branches."
  	"N.B.  The ^N forms are to get around the bytecode compiler's long branch
  	 limits which are exceeded when each case jumps around the otherwise."
  	opcode caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]					-> [^0].
  		[AlignmentNops]		-> [^(operands at: 0) - 1].
  		[Fill16]					-> [^2].
  		[Fill32]					-> [^4].
  		[FillFromWord]			-> [^4].
  		[Nop]					-> [^1].
  		"Specific Control/Data Movement"
  		"[CDQ]					-> [^1].
  		[IDIVR]					-> [^2].
  		[IMULRR]				-> [^3].
  		[CPUID]					-> [^2].
  		[CMPXCHGAwR]			-> [^7].
  		[CMPXCHGMwrR]		-> [^8].
  		[LFENCE]				-> [^3].
  		[MFENCE]				-> [^3].
  		[SFENCE]				-> [^3].
  		[LOCK]					-> [^1].
  		[XCHGAwR]				-> [^6].
  		[XCHGMwrR]			-> [^7].
  		[XCHGRR]				-> [^2]."
  		"Control"
  		[CallFull]					-> [^12].
  		[Call]						-> [^5].
  		[JumpR]						-> [^2].
  		[JumpFull]					-> [self resolveJumpTarget. ^12].
  		[JumpLong]					-> [self resolveJumpTarget. ^5].
  		[Jump]						-> [self resolveJumpTarget. ^5].
  		[JumpZero]					-> [self resolveJumpTarget. ^6].
  		[JumpNonZero]				-> [self resolveJumpTarget. ^6].
  		[JumpNegative]				-> [self resolveJumpTarget. ^6].
  		[JumpNonNegative]			-> [self resolveJumpTarget. ^6].
  		[JumpOverflow]				-> [self resolveJumpTarget. ^6].
  		[JumpNoOverflow]			-> [self resolveJumpTarget. ^6].
  		[JumpCarry]				-> [self resolveJumpTarget. ^6].
  		[JumpNoCarry]				-> [self resolveJumpTarget. ^6].
  		[JumpLess]					-> [self resolveJumpTarget. ^6].
  		[JumpGreaterOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpGreater]				-> [self resolveJumpTarget. ^6].
  		[JumpLessOrEqual]			-> [self resolveJumpTarget. ^6].
  		[JumpBelow]				-> [self resolveJumpTarget. ^6].
  		[JumpAboveOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpAbove]				-> [self resolveJumpTarget. ^6].
  		[JumpBelowOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpLongZero]			-> [self resolveJumpTarget. ^6].
  		[JumpLongNonZero]		-> [self resolveJumpTarget. ^6].
  		[JumpFPEqual]				-> [self resolveJumpTarget. ^6].
  		[JumpFPNotEqual]			-> [self resolveJumpTarget. ^6].
  		[JumpFPLess]				-> [self resolveJumpTarget. ^6].
  		[JumpFPGreaterOrEqual]	-> [self resolveJumpTarget. ^6].
  		[JumpFPGreater]			-> [self resolveJumpTarget. ^6].
  		[JumpFPLessOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpFPOrdered]			-> [self resolveJumpTarget. ^6].
  		[JumpFPUnordered]			-> [self resolveJumpTarget. ^6].
  		[RetN]						-> [^(operands at: 0) = 0 ifTrue: [1] ifFalse: [3]].
  		[Stop]						-> [^1].
  
  		"Arithmetic"
+ 		[AddCqR]		-> [^(self isQuick: (operands at: 0))
+ 											ifTrue: [4]
+ 											ifFalse: [(self concreteRegister: (operands at: 1)) = RAX
+ 														ifTrue: [6]
+ 														ifFalse: [7]]].
+ 		"[AndCqR]		-> [^(self isQuick: (operands at: 0))
- 		"[AddCqR]		-> [^(self isQuick: (operands at: 0))
  											ifTrue: [3]
  											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]]].
- 		[AndCqR]		-> [^(self isQuick: (operands at: 0))
- 											ifTrue: [3]
- 											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
- 														ifTrue: [5]
- 														ifFalse: [6]]].
  		[CmpCqR]		-> [^(self isQuick: (operands at: 0))
  											ifTrue: [3]
  											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]]].
  		[OrCqR]			-> [^(self isQuick: (operands at: 0))
  											ifTrue: [3]
  											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]]].
  		[SubCqR]		-> [^(self isQuick: (operands at: 0))
  											ifTrue: [3]
  											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]]].
  		[TstCqR]		-> [^((self isQuick: (operands at: 0)) and: [(self concreteRegister: (operands at: 1)) < 4])
  											ifTrue: [3]
  											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]]].
  		[AddCwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
  		[AndCwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
  		[CmpCwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
  		[OrCwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
  		[SubCwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
  		[XorCwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]]."
  		[AddRR]			-> [^3].
  		[AndRR]			-> [^3].
  		[CmpRR]		-> [^3].
  		[OrRR]			-> [^3].
  		[XorRR]			-> [^3].
  		[SubRR]			-> [^3].
  		[NegateR]		-> [^3].
  		"[LoadEffectiveAddressMwrR]
  						-> [^((self isQuick: (operands at: 0))
  											ifTrue: [3]
  											ifFalse: [6])
  										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[LogicalShiftLeftCqR]		-> [^(operands at: 0) = 1 ifTrue: [2] ifFalse: [3]].
  		[LogicalShiftRightCqR]		-> [^(operands at: 0) = 1 ifTrue: [2] ifFalse: [3]].
+ 		[ArithmeticShiftRightCqR]	-> [^(operands at: 0) = 1 ifTrue: [2] ifFalse: [3]]."
- 		[ArithmeticShiftRightCqR]	-> [^(operands at: 0) = 1 ifTrue: [2] ifFalse: [3]].
  		[LogicalShiftLeftRR]			-> [^self computeShiftRRSize].
  		[LogicalShiftRightRR]		-> [^self computeShiftRRSize].
  		[ArithmeticShiftRightRR]		-> [^self computeShiftRRSize].
  		[AddRdRd]					-> [^4].
  		[CmpRdRd]					-> [^4].
  		[SubRdRd]					-> [^4].
  		[MulRdRd]					-> [^4].
  		[DivRdRd]					-> [^4].
+ 		[SqrtRd]					-> [^4].
- 		[SqrtRd]					-> [^4]."
  		"Data Movement"
  		[MoveCqR]		-> [^(operands at: 0) = 0 ifTrue: [3] ifFalse: [(self is32BitSignedImmediate: (operands at: 0)) ifTrue: [7] ifFalse: [10]]].
  		[MoveCwR]		-> [^10].
  		[MoveRR]		-> [^3].
  		[MoveRdRd]		-> [^4].
  		"[MoveAwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
  		[MoveRAw]		-> [^(self concreteRegister: (operands at: 0)) = EAX ifTrue: [5] ifFalse: [6]].
  		[MoveRMwr]	-> [^((self isQuick: (operands at: 1))
  											ifTrue: [3]
  											ifFalse: [6])
  										+ ((self concreteRegister: (operands at: 2)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[MoveRdM64r]	-> [^((self isQuick: (operands at: 1))
  											ifTrue: [5]
  											ifFalse: [8])
  										+ ((self concreteRegister: (operands at: 2)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[MoveMbrR]		-> [^((self isQuick: (operands at: 0))
  											ifTrue: [4]
  											ifFalse: [7])
  										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[MoveRMbr]		-> [^((self isQuick: (operands at: 1))
  											ifTrue: [3]
  											ifFalse: [6])
  										+ ((self concreteRegister: (operands at: 2)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[MoveM16rR]	-> [^((self isQuick: (operands at: 0))
  											ifTrue: [4]
  											ifFalse: [7])
  										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[MoveM64rRd]	-> [^((self isQuick: (operands at: 0))
  											ifTrue: [5]
  											ifFalse: [8])
  										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[MoveMwrR]		-> [^((self isQuick: (operands at: 0))
  											ifTrue: [3]
  											ifFalse: [6])
  										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[MoveXbrRR]	-> [self assert: (self concreteRegister: (operands at: 0)) ~= ESP.
  							^(self concreteRegister: (operands at: 1)) = EBP
  											ifTrue: [5]
  											ifFalse: [4]].
  		[MoveRXbrR]	->	[self assert: (self concreteRegister: (operands at: 1)) ~= ESP.
  							^((self concreteRegister: (operands at: 2)) = EBP
  											ifTrue: [4]
  											ifFalse: [3])
  										+ ((self concreteRegister: (operands at: 0)) >= 4
  											ifTrue: [2]
  											ifFalse: [0])].
  		[MoveXwrRR]	-> [self assert: (self concreteRegister: (operands at: 0)) ~= ESP.
  							^(self concreteRegister: (operands at: 1)) = EBP
  											ifTrue: [4]
  											ifFalse: [3]].
  		[MoveRXwrR]	-> [self assert: (self concreteRegister: (operands at: 1)) ~= ESP.
  							^(self concreteRegister: (operands at: 2)) = EBP
  											ifTrue: [4]
  											ifFalse: [3]].
  		[PopR]			-> [^1].
  		[PushR]			-> [^1].
  		[PushCq]		-> [^(self isQuick: (operands at: 0)) ifTrue: [2] ifFalse: [5]].
  		[PushCw]		-> [^5].
  		[PrefetchAw]	-> [^self hasSSEInstructions ifTrue: [7] ifFalse: [0]]."
  		"Conversion"
  		"[ConvertRRd]	-> [^4]" }.
  	^0 "to keep C compiler quiet"!

Item was added:
+ ----- 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 := self concreteRegister: (operands at: 0).
+ 	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 added:
+ ----- Method: CogX64Compiler>>concreteDPFPRegister: (in category 'encoding') -----
+ concreteDPFPRegister: registerIndex
+ 	 "Map a possibly abstract double-precision floating-point register into a concrete one.
+ 	  Abstract registers (defined in CogAbstractOpcodes) are all negative.  If registerIndex
+ 	  is negative assume it is an abstract register.
+ 
+ 	[1] IA-32 Intel® Architecture Software Developer's Manual Volume 2A: Instruction Set Reference, A-M"
+ 
+ 	^registerIndex
+ 		caseOf: {
+ 			[DPFPReg0]	-> [XMM0L / 2].
+ 			[DPFPReg1]	-> [XMM1L / 2].
+ 			[DPFPReg2]	-> [XMM2L / 2].
+ 			[DPFPReg3]	-> [XMM3L / 2].
+ 			[DPFPReg4]	-> [XMM4L / 2].
+ 			[DPFPReg5]	-> [XMM5L / 2].
+ 			[DPFPReg6]	-> [XMM6L / 2].
+ 			[DPFPReg7]	-> [XMM7L / 2] }
+ 		otherwise:
+ 			[self assert: (registerIndex between: XMM0L and: XMM7L).
+ 			 self assert: (registerIndex bitAnd: 1) = 0.
+ 			 registerIndex / 2]!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeAddRR (in category 'generate machine code') -----
+ concretizeAddRR
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| regLHS regRHS |
+ 	regLHS := self concreteRegister: (operands at: 0).
+ 	regRHS := self concreteRegister: (operands at: 1).
+ 	machineCode
+ 		at: 0 put: (self rexR: regRHS x: 0 b: regLHS);
+ 		at: 1 put: 16r03;
+ 		at: 2 put: (self mod: ModReg RM: regLHS RO: regRHS).
+ 	^machineCodeSize := 3!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeArithmeticShiftRightRR (in category 'generate machine code') -----
+ concretizeArithmeticShiftRightRR
+ 	"On the x64 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."
+ 	<inline: true>
+ 	| shiftCountReg destReg regToShift |
+ 	shiftCountReg := self concreteRegister: (operands at: 0).
+ 	destReg := self concreteRegister: (operands at: 1).
+ 	shiftCountReg = RCX ifTrue:
+ 		[machineCode
+ 			at: 0 put: (self rexR: 0 x: 0 b: destReg);
+ 			at: 1 put: 16rD3;
+ 			at: 2 put: (self mod: ModReg RM: destReg RO: 7).
+ 		 ^machineCodeSize := 3].
+ 	regToShift := destReg = shiftCountReg
+ 					ifTrue: [RCX]
+ 					ifFalse: [destReg = RCX
+ 								ifTrue: [shiftCountReg]
+ 								ifFalse: [destReg]].
+ 	shiftCountReg = RAX ifTrue:
+ 		[machineCode
+ 			at: 0 put: 16r48;
+ 			at: 1 put: 16r90 + RCX; "XCHG RAX,RCX"
+ 			at: 2 put: (self rexR: 0 x: 0 b: regToShift);
+ 			at: 3 put: 16rD3;			"SAR RCX,RAX"
+ 			at: 4 put: (self mod: ModReg RM: regToShift RO: 7);
+ 			at: 5 put: 16r48;
+ 			at: 6 put: 16r90 + RCX. "XCHG RAX,RCX"
+ 		 ^machineCodeSize := 7].
+ 	machineCode
+ 		at: 0 put: (self rexR: shiftCountReg x: 0 b: RCX);		"XCHG R?X,RCX"
+ 		at: 1 put: 16r87;
+ 		at: 2 put: (self mod: ModReg RM: RCX RO: shiftCountReg);
+ 		at: 3 put: (self rexR: 0 x: 0 b: regToShift);			"SAR RCX,R!!X"
+ 		at: 4 put: 16rD3;
+ 		at: 5 put: (self mod: ModReg RM: regToShift RO: 7);
+ 		at: 6 put: (self rexR: shiftCountReg x: 0 b: RCX);		"XCHG R?X,RCX"
+ 		at: 7 put: 16r87;
+ 		at: 8 put: (self mod: ModReg RM: RCX RO: shiftCountReg).
+ 	^machineCodeSize := 9!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeCmpRR (in category 'generate machine code') -----
  concretizeCmpRR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| regLHS regRHS |
  	"CmpRR RHS LHS computes LHS - RHS, i.e. apparently reversed.  You have to think subtract."
  	regRHS := self concreteRegister: (operands at: 0).
  	regLHS := self concreteRegister: (operands at: 1).
  	machineCode
+ 		at: 0 put: (self rexR: regRHS x: 0 b: regLHS);
- 		at: 0 put: (self rexR: regLHS x: 0 b: regRHS);
  		at: 1 put: 16r39;
  		at: 2 put: (self mod: ModReg RM: regLHS RO: regRHS).
  	^machineCodeSize := 3!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeCmpRdRd (in category 'generate machine code') -----
+ concretizeCmpRdRd
+ 	"Will get inlined into concretizeAt: switch.
+ 	 We use UCOMISD (see p 4-260 [2])"
+ 	<inline: true>
+ 	| regLHS regRHS |
+ 	"CmpRR RHS LHS computes LHS - RHS, i.e. apparently reversed.  You have to think subtract."
+ 	regRHS := self concreteDPFPRegister: (operands at: 0).
+ 	regLHS := self concreteDPFPRegister: (operands at: 1).
+ 	machineCode
+ 		at: 0 put: 16r66;
+ 		at: 1 put: 16r0F;
+ 		at: 2 put: 16r2E;
+ 		at: 3 put: (self mod: ModReg RM: regRHS RO: regLHS).
+ 	^machineCodeSize := 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeNegateR (in category 'generate machine code') -----
+ concretizeNegateR
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| reg |
+ 	reg := self concreteRegister: (operands at: 0).
+ 	machineCode
+ 		at: 0 put: (self rexR: reg x: 0 b: reg);
+ 		at: 1 put: 16rF7;
+ 		at: 2 put: (self mod: ModReg RM: reg RO: 3).
+ 	^machineCodeSize := 3!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeSEE2OpRdRd: (in category 'generate machine code') -----
+ concretizeSEE2OpRdRd: opCode
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| regLHS regRHS |
+ 	regRHS := self concreteDPFPRegister: (operands at: 0).
+ 	regLHS := self concreteDPFPRegister: (operands at: 1).
+ 	machineCode
+ 		at: 0 put: 16rF2;
+ 		at: 1 put: 16r0F;
+ 		at: 2 put: opCode;
+ 		at: 3 put: (self mod: ModReg RM: regRHS RO: regLHS).
+ 	^machineCodeSize := 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeSqrtRd (in category 'generate machine code') -----
+ concretizeSqrtRd
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| reg |
+ 	reg := self concreteDPFPRegister: (operands at: 0).
+ 	machineCode
+ 		at: 0 put: 16rF2;
+ 		at: 1 put: 16r0F;
+ 		at: 2 put: 16r51;
+ 		at: 3 put: (self mod: ModReg RM: reg RO: reg).
+ 	^machineCodeSize := 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeSubRR (in category 'generate machine code') -----
+ concretizeSubRR
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| regLHS regRHS |
+ 	regLHS := self concreteRegister: (operands at: 0).
+ 	regRHS := self concreteRegister: (operands at: 1).
+ 	machineCode
+ 		at: 0 put: (self rexR: regRHS x: 0 b: regLHS);
+ 		at: 1 put: 16r2b;
+ 		at: 2 put: (self mod: ModReg RM: regLHS RO: regRHS).
+ 	^machineCodeSize := 3!

Item was added:
+ ----- Method: CogX64Compiler>>hasDoublePrecisionFloatingPointSupport (in category 'testing') -----
+ hasDoublePrecisionFloatingPointSupport
+ 	^true!

Item was removed:
- ----- Method: Integer>>signedInt64FromLong (in category '*VMMaker-interpreter simulator') -----
- signedInt64FromLong
- 	"Self is a signed or unsigned 32-bit integer"
- 
- 	| sign |
- 	self < 0 ifTrue: [^self].
- 	sign := self bitAnd: 16r8000000000000000.
- 	sign = 0 ifTrue: [^ self].
- 	^ self - sign - sign!

Item was added:
+ ----- Method: Integer>>signedIntFromLong64 (in category '*VMMaker-interpreter simulator') -----
+ signedIntFromLong64
+ 	"Self is a signed or unsigned 64-bit integer"
+ 
+ 	| sign |
+ 	self < 0 ifTrue: [^self].
+ 	sign := self bitAnd: 16r8000000000000000.
+ 	sign = 0 ifTrue: [^self].
+ 	^self - sign - sign!



More information about the Vm-dev mailing list