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

commits at source.squeak.org commits at source.squeak.org
Tue Sep 22 23:55:15 UTC 2015


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

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

Name: VMMaker.oscog-eem.1463
Author: eem
Time: 22 September 2015, 4:53:01.397 pm
UUID: e20aaf0a-a2fd-494a-9597-dc013eabe882
Ancestors: VMMaker.oscog-eem.1462

x64: Implement the division support.  Fix the s:i:b: byte for registers >= R8.  Hence fix testMoveRMwr.  16 errors and 1 failure.  Extend the range of testMoveRMwr to test non-zero offsets.

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

Item was changed:
  ----- Method: CogIA32CompilerTests>>testMoveRMwr (in category 'tests') -----
  testMoveRMwr
  	"self new testMoveRMwr"
  	self concreteCompilerClass registersWithNamesDo:
  		[:sreg :srname|
  		self concreteCompilerClass registersWithNamesDo:
  			[:dreg :drname| | inst len |
+ 			#(0 64 65536) do:
+ 				[:offset|
+ 				inst := self gen: MoveRMwr operand: sreg operand: offset operand: dreg.
+ 				len := inst concretizeAt: 0.
+ 				self processor
+ 					disassembleInstructionAt: 0
+ 					In: inst machineCode object
+ 					into: [:str :sz| | plainJane herIntended |
+ 						"Convert e.g. '00000000: movl %eax, 0x2(%eax) : 89 40 02' to  'movl %eax, 0x2(%eax)'"
+ 						plainJane := self strip: str.
+ 						herIntended := 'movl ', srname, ', ', (offset = 0 ifTrue: [''] ifFalse: ['0x', (offset printStringBase: 16)]), '(',drname,')'.
+ 						self assert: (plainJane match: herIntended).
+ 						self assert: len = sz]]]]
+ 
+ 	"| failures |
+ 	 failures := Dictionary new.
+ 	 self concreteCompilerClass registersWithNamesDo:
+ 		[:sreg :srname|
+ 		self concreteCompilerClass registersWithNamesDo:
+ 			[:dreg :drname| | inst len |
+ 			#(0 64 65536) do:
+ 				[:offset|
+ 				inst := self gen: MoveRMwr operand: sreg operand: offset operand: dreg.
+ 				len := inst concretizeAt: 0.
+ 				self processor
+ 					disassembleInstructionAt: 0
+ 					In: inst machineCode object
+ 					into: [:str :sz| | plainJane herIntended |
+ 						plainJane := self strip: str.
+ 						herIntended := 'movl ', srname, ', ', (offset = 0 ifTrue: [''] ifFalse: ['0x', (offset printStringBase: 16)]), '(',drname,')'.
+ 						((plainJane match: herIntended) and: [len = sz]) ifFalse:
+ 							[failures at: herIntended put: plainJane]]]]].
+ 	 failures"!
- 			inst := self gen: MoveRMwr operand: sreg operand: 0 operand: dreg.
- 			len := inst concretizeAt: 0.
- 			self processor
- 				disassembleInstructionAt: 0
- 				In: inst machineCode object
- 				into: [:str :sz| | plainJane herIntended |
- 					"Convert e.g. '00000000: movl %eax, 0x2(%eax) : 89 40 02' to  'movl %eax, 0x2(%eax)'"
- 					plainJane := self strip: str.
- 					herIntended := 'movl ', srname, ', (',drname,')'.
- 					self assert: (plainJane match: herIntended).
- 					self assert: len = sz]]]!

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]					-> [^2].
+ 		[IDIVR]					-> [^3].
+ 		[IMULRR]				-> [^4].
- 		"[CDQ]					-> [^1].
- 		[IDIVR]					-> [^2].
- 		[IMULRR]				-> [^3].
  		[CPUID]					-> [^2].
+ 		[CMPXCHGAwR]			-> [^8].
+ 		[CMPXCHGMwrR]		-> [^9].
- 		[CMPXCHGAwR]			-> [^7].
- 		[CMPXCHGMwrR]		-> [^8].
  		[LFENCE]				-> [^3].
  		[MFENCE]				-> [^3].
  		[SFENCE]				-> [^3].
  		[LOCK]					-> [^1].
+ 		"[XCHGAwR]				-> [^6].
+ 		[XCHGMwrR]			-> [^7]."
+ 		[XCHGRR]				-> [^((self concreteRegister: (operands at: 0)) = RAX
+ 									   or: [(self concreteRegister: (operands at: 1)) = RAX])
+ 											ifTrue: [2]
+ 											ifFalse: [3]].
- 		[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 computeSizeOfArithCqR].
  		[AndCqR]		-> [^self computeSizeOfArithCqR].
  		[CmpCqR]		-> [^self computeSizeOfArithCqR].
  		[OrCqR]			-> [^self computeSizeOfArithCqR].
  		[SubCqR]		-> [^self computeSizeOfArithCqR].
  		[TstCqR]		-> [^self computeSizeOfArithCqR].
  		[AddCwR]		-> [^self computeSizeOfArithCwR].
+ 		[AndCwR]		-> [^self computeSizeOfArithCwR].
+ 		[CmpCwR]		-> [^self computeSizeOfArithCwR].
+ 		[OrCwR]		-> [^self computeSizeOfArithCwR].
+ 		[SubCwR]		-> [^self computeSizeOfArithCwR].
+ 		[XorCwR]		-> [^self computeSizeOfArithCwR].
- 		[AndCwR]		-> [^self computeSizeOfCwR].
- 		[CmpCwR]		-> [^self computeSizeOfCwR].
- 		[OrCwR]		-> [^self computeSizeOfCwR].
- 		[SubCwR]		-> [^self computeSizeOfCwR].
- 		[XorCwR]		-> [^self computeSizeOfCwR].
  		[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]]."
  		[LogicalShiftLeftRR]			-> [^self computeShiftRRSize].
  		[LogicalShiftRightRR]		-> [^self computeShiftRRSize].
  		[ArithmeticShiftRightRR]		-> [^self computeShiftRRSize].
  		[AddRdRd]					-> [^4].
  		[CmpRdRd]					-> [^4].
  		[SubRdRd]					-> [^4].
  		[MulRdRd]					-> [^4].
  		[DivRdRd]					-> [^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]]."
- 		[MoveRAw]		-> [^(self concreteRegister: (operands at: 0)) = EAX ifTrue: [5] ifFalse: [6]].
  		[MoveRMwr]	-> [^((self isQuick: (operands at: 1))
+ 									ifTrue: [((operands at: 1) = 0
+ 											and: [((self concreteRegister: (operands at: 2)) bitAnd: 7) ~= RBP])
+ 												ifTrue: [3]
+ 												ifFalse: [4]]
+ 									ifFalse: [7])
+ 								+ (((self concreteRegister: (operands at: 2)) bitAnd: 7) = RSP
+ 									ifTrue: [1]
+ 									ifFalse: [0])].
+ 		"[MoveRdM64r]	-> [^((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]			-> [^(self concreteRegister: (operands at: 0)) < 8 ifTrue: [1] ifFalse: [2]].
+ 		[PushR]			-> [^(self concreteRegister: (operands at: 0)) < 8 ifTrue: [1] ifFalse: [2]].
- 											ifFalse: [3]].
- 		[PopR]			-> [^1].
- 		[PushR]			-> [^1].
  		[PushCq]		-> [^(self isQuick: (operands at: 0)) ifTrue: [2] ifFalse: [5]].
+ 		[PushCw]		-> [^self computeSizeOfArithCwR - 1].
+ 		[PrefetchAw]	-> [^self hasSSEInstructions ifTrue: [12] ifFalse: [0]].
- 		[PushCw]		-> [^5].
- 		[PrefetchAw]	-> [^self hasSSEInstructions ifTrue: [7] ifFalse: [0]]."
  		"Conversion"
  		"[ConvertRRd]	-> [^4]" }.
  	^0 "to keep C compiler quiet"!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeCDQ (in category 'generate machine code') -----
+ concretizeCDQ
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	machineCode
+ 		at: 0 put: 16r48;
+ 		at: 1 put: 16r99.
+ 	^machineCodeSize := 2!

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

Item was added:
+ ----- Method: CogX64Compiler>>concretizeMoveRMwr (in category 'generate machine code') -----
+ concretizeMoveRMwr
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| srcReg offset destReg |
+ 	srcReg := self concreteRegister: (operands at: 0).
+ 	offset := operands at: 1.
+ 	destReg := self concreteRegister: (operands at: 2).
+ 	machineCode
+ 		at: 0 put: (self rexR: srcReg x: 0 b: destReg);
+ 		at: 1 put: 16r89.
+ 	(destReg ~= RSP and: [destReg ~= R12]) ifTrue:
+ 		[(offset = 0 and: [destReg ~= RBP and: [destReg ~= R13]]) ifTrue:
+ 			[machineCode
+ 				at: 2 put: (self mod: ModRegInd RM: destReg RO: srcReg).
+ 			 ^machineCodeSize := 3].
+ 		 (self isQuick: offset) ifTrue:
+ 			[machineCode
+ 				at: 2 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
+ 				at: 3 put: (offset bitAnd: 16rFF).
+ 			 ^machineCodeSize := 4].
+ 		machineCode
+ 			at: 2 put: (self mod: ModRegRegDisp32 RM: destReg RO: srcReg);
+ 			at: 3 put: (offset bitAnd: 16rFF);
+ 			at: 4 put: (offset >> 8 bitAnd: 16rFF);
+ 			at: 5 put: (offset >> 16 bitAnd: 16rFF);
+ 			at: 6 put: (offset >> 24 bitAnd: 16rFF).
+ 		^machineCodeSize := 7].
+ 	"RSP:"
+ 	offset = 0 ifTrue:
+ 		[machineCode
+ 			at: 2 put: (self mod: ModRegInd RM: destReg RO: srcReg);
+ 			at: 3 put: (self s: SIB1 i: 4 b: destReg).
+ 		 ^machineCodeSize := 4].
+ 	(self isQuick: offset) ifTrue:
+ 		[machineCode
+ 			at: 2 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
+ 			at: 3 put: (self s: SIB1 i: 4 b: destReg);
+ 			at: 4 put: (offset bitAnd: 16rFF).
+ 		 ^machineCodeSize := 5].
+ 	machineCode
+ 		at: 2 put: (self mod: ModRegRegDisp32 RM: destReg RO: srcReg);
+ 		at: 3 put: (self s: SIB1 i: 4 b: destReg);
+ 		at: 4 put: (offset bitAnd: 16rFF);
+ 		at: 5 put: (offset >> 8 bitAnd: 16rFF);
+ 		at: 6 put: (offset >> 16 bitAnd: 16rFF);
+ 		at: 7 put: (offset >> 24 bitAnd: 16rFF).
+ 	^machineCodeSize := 8!

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

Item was added:
+ ----- Method: CogX64Compiler>>concretizePopR (in category 'generate machine code') -----
+ concretizePopR
+ 	<inline: true>
+ 	| reg |
+ 	reg := self concreteRegister: (operands at: 0).
+ 	reg < 8 ifTrue:
+ 		[machineCode at: 0 put: 16r58 + reg.
+ 		^machineCodeSize := 1].
+ 	machineCode
+ 		at: 0 put: 16r41;
+ 		at: 1 put: 16r58 + (reg - 8).
+ 	^machineCodeSize := 2!

Item was added:
+ ----- Method: CogX64Compiler>>concretizePushR (in category 'generate machine code') -----
+ concretizePushR
+ 	<inline: true>
+ 	| reg |
+ 	reg := self concreteRegister: (operands at: 0).
+ 	reg < 8 ifTrue:
+ 		[machineCode at: 0 put: 16r50 + reg.
+ 		^machineCodeSize := 1].
+ 	machineCode
+ 		at: 0 put: 16r41;
+ 		at: 1 put: 16r50 + (reg - 8).
+ 	^machineCodeSize := 2!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeXCHGRR (in category 'generate machine code') -----
+ concretizeXCHGRR
+ 	| r1 r2 |
+ 	r1 := self concreteRegister: (operands at: 0).
+ 	r2 := self concreteRegister: (operands at: 1).
+ 	r2 = RAX ifTrue:
+ 		[r2 := r1. r1 := RAX].
+ 	r1 = RAX ifTrue:
+ 		[machineCode
+ 			at: 0 put: (self rexR: 0 x: 0 b: r2);
+ 			at: 1 put: 16r90 + (r2 \\ 8).
+ 		 ^machineCodeSize := 2].
+ 	machineCode
+ 		at: 0 put: (self rexR: r1 x: 0 b: r2);
+ 		at: 1 put: 87;
+ 		at: 2 put: (self mod: r2 RM: 0 RO: r1).
+ 	^machineCodeSize := 3!

Item was changed:
  ----- Method: CogX64Compiler>>genDivR:R:Quo:Rem: (in category 'abstract instructions') -----
  genDivR: abstractRegDivisor R: abstractRegDividend Quo: abstractRegQuotient Rem: abstractRegRemainder
  	| rDividend rDivisor rQuotient rRemainder saveRestoreEAX saveRestoreEDX saveRestoreExchanged |
  	self assert: abstractRegDividend ~= abstractRegDivisor.
  	self assert: abstractRegQuotient ~= abstractRegRemainder.
  	rDividend := self concreteRegister: abstractRegDividend.
  	rDivisor := self concreteRegister: abstractRegDivisor.
  	rQuotient := self concreteRegister: abstractRegQuotient.
  	rRemainder := self concreteRegister: abstractRegRemainder.
+ 	"IDIV r does a signed divide of RDX:RAX by r, RAX := Quotient, RDX := Remainder.
+ 	 Since we must sign extend the dividend into RDX we must substitute another register if RDX is an input."
+ 	(rDividend = RDX or: [rDivisor = RDX]) ifTrue:
- 	"IDIV r does a signed divide of EDX:EAX by r, EAX := Quotient, EDX := Remainder.
- 	 Since we must sign extend the dividend into EDX we must substitute another register if EDX is an input"
- 	(rDividend = EDX or: [rDivisor = EDX]) ifTrue:
  		[| rUnused |
  		"Slang, sigh..."
+ 		rUnused := RAX.
+ 		[rUnused <= RDI] whileTrue:
+ 			[(rUnused ~= RSP and: [rUnused ~= RBP and: [rUnused ~= RDX
- 		rUnused := EAX.
- 		[rUnused <= EDI] whileTrue:
- 			[(rUnused ~= ESP and: [rUnused ~= EBP and: [rUnused ~= EDX
  			  and: [rUnused ~= rDividend and: [rUnused ~= rDivisor
  			  and: [rUnused ~= rQuotient and: [rUnused ~= rRemainder]]]]]]) ifTrue:
  				[cogit PushR: rUnused.
+ 				cogit MoveR: RDX R: rUnused.
+ 				rDividend = RDX
- 				cogit MoveR: EDX R: rUnused.
- 				rDividend = EDX
  					ifTrue: [self genDivR: rDivisor R: rUnused Quo: rQuotient Rem: rRemainder]
  					ifFalse: [self genDivR: rUnused R: rDividend Quo: rQuotient Rem: rRemainder].
  				cogit PopR: rUnused.
  				^self].
  			  rUnused := rUnused + 1].
  		self error: 'couldn''t find unused register in genDivR:R:Quo:Rem:'].
+ 	"If either output does not include RAX or RDX we must save and restore RAX and/or RDX."
+ 	(saveRestoreEAX := rQuotient ~= RAX and: [rRemainder ~= RAX]) ifTrue:
+ 		[cogit PushR: RAX].
+ 	(saveRestoreEDX := rQuotient ~= RDX and: [rRemainder ~= RDX]) ifTrue:
+ 		[cogit PushR: RDX].
- 	"If either output does not include EAX or EDX we must save and restore EAX and/or EDX."
- 	(saveRestoreEAX := rQuotient ~= EAX and: [rRemainder ~= EAX]) ifTrue:
- 		[cogit PushR: EAX].
- 	(saveRestoreEDX := rQuotient ~= EDX and: [rRemainder ~= EDX]) ifTrue:
- 		[cogit PushR: EDX].
  	saveRestoreExchanged := -1.
+ 	rDividend ~= RAX ifTrue:
+ 		[rDivisor = RAX
- 	rDividend ~= EAX ifTrue:
- 		[rDivisor = EAX
  			ifTrue: [((rDividend ~= rQuotient and: [rDividend ~= rRemainder])
+ 					and: [rDividend ~= RDX or: [saveRestoreEDX not]]) ifTrue:
- 					and: [rDividend ~= EDX or: [saveRestoreEDX not]]) ifTrue:
  						[cogit PushR: (saveRestoreExchanged := rDividend)].
  					cogit gen: XCHGRR operand: rDivisor operand: rDividend]
+ 			ifFalse: [cogit MoveR: rDividend R: RAX]].
+ 	"CDQ sign-extends RAX into RDX as required for IDIV"
- 			ifFalse: [cogit MoveR: rDividend R: EAX]].
- 	"CDQ sign-extends EAX into EDX as required for IDIV"
  	cogit gen: CDQ.
+ 	cogit gen: IDIVR operand: (rDivisor = RAX ifTrue: [rDividend] ifFalse: [rDivisor]).
- 	cogit gen: IDIVR operand: (rDivisor = EAX ifTrue: [rDividend] ifFalse: [rDivisor]).
  	"Must not overwrite result while juggling"
+ 	(rQuotient = RDX and: [rRemainder = RAX])
- 	(rQuotient = EDX and: [rRemainder = EAX])
  		ifTrue: [cogit gen: XCHGRR operand: rQuotient operand: rRemainder]
  		ifFalse:
+ 			[rQuotient = RDX
- 			[rQuotient = EDX
  				ifTrue:
+ 					[rRemainder ~= RDX ifTrue:
+ 						[cogit MoveR: RDX R: rRemainder].
+ 					rQuotient ~= RAX ifTrue:
+ 						[cogit MoveR: RAX R: rQuotient]]
- 					[rRemainder ~= EDX ifTrue:
- 						[cogit MoveR: EDX R: rRemainder].
- 					rQuotient ~= EAX ifTrue:
- 						[cogit MoveR: EAX R: rQuotient]]
  				ifFalse:
+ 					[rQuotient ~= RAX ifTrue:
+ 						[cogit MoveR: RAX R: rQuotient].
+ 					rRemainder ~= RDX ifTrue:
+ 						[cogit MoveR: RDX R: rRemainder]]].
- 					[rQuotient ~= EAX ifTrue:
- 						[cogit MoveR: EAX R: rQuotient].
- 					rRemainder ~= EDX ifTrue:
- 						[cogit MoveR: EDX R: rRemainder]]].
  	saveRestoreExchanged >= 0 ifTrue:
  		[cogit PopR: saveRestoreExchanged].
  	saveRestoreEDX ifTrue:
+ 		[cogit PopR: RDX].
- 		[cogit PopR: EDX].
  	saveRestoreEAX ifTrue:
+ 		[cogit PopR: RAX]!
- 		[cogit PopR: EAX]!

Item was added:
+ ----- Method: CogX64Compiler>>s:i:b: (in category 'encoding') -----
+ s: scale i: indexReg b: baseReg 
+ 	^scale << 6 + ((indexReg bitAnd: 7) << 3) + (baseReg bitAnd: 7)!

Item was changed:
  ----- Method: CogX64CompilerTests>>testDivQuoRem (in category 'tests') -----
  testDivQuoRem
  	"| failures ops |
  	 failures := Set new.
  	 [ops := (CogX64CompilerTests new testDivQuoRem)]
  		on: TestResult failure
  		do: [:ex| | c |
  			c := ex signalerContext.
  			[c tempNames includes: 'op'] whileFalse:
  				[c := c sender].
  			failures add: (c namedTempAt: (c tempNames indexOf: 'op')).
  			ex resume].
  	 { ops size. failures size. ops asSortedCollection asArray. failures asSortedCollection asArray}"
  	| map compiler memory ops |
  	map := Dictionary new.
  	compiler := self gen: nil.
  	memory := ByteArray new: 4096 * 2.
  	ops := Set new.
  	self concreteCompilerClass dataRegistersWithAccessorsExcept: #(rbp rsp) do:
  		[:sreg :srget :srset|
  		self concreteCompilerClass dataRegistersWithAccessorsExcept: { #rbp. #rsp. srget } do:
  			[:dreg :drget :drset|
  			 | instructions op |
  			self concreteCompilerClass dataRegistersWithAccessorsExcept: #(rbp rsp) do:
  				[:qreg :qrget :qrset| 
  				self concreteCompilerClass dataRegistersWithAccessorsExcept: { #rbp. #rsp. qrget } do:
  					[:rreg :rrget :rrset|
  					self resetGen.
  					op := qrget, ' := ', drget, ' quo: ', srget, '. ', rrget, ' := ', drget, ' rem: ', srget.
  					ops add: op.
  					compiler genDivR: sreg R: dreg Quo: qreg Rem: rreg.
  					instructions := self generateInstructions.
  					memory atAllPut: 0; replaceFrom: 1 to: instructions size with: instructions startingAt: 1; at: instructions size + 1 put: self processor nopOpcode.
  					#(-768 -456 -123 123 456 789)
  						with: #(987 654 321 -321 -654 -987)
+ 						do: [:dd :dv| "| calc mask |
+ 							mask := 16rFFFFFFFFFFFFFFFF.
+ 							calc := ((dd quo: dv) bitAnd: mask) hex, ' := ', (dd bitAnd: mask) hex, ' quo: ', (dv bitAnd: mask) hex, '. ', ((dd rem: dv) bitAnd: mask) hex, ' := ', (dd bitAnd: mask) hex, ' rem: ', (dv bitAnd: mask) hex.
- 						do: [:dd :dv| "| calc |
- 							calc := ((dd quo: dv) bitAnd: 16rFFFFFFFF) hex, ' := ', (dd bitAnd: 16rFFFFFFFF) hex, ' quo: ', (dv bitAnd: 16rFFFFFFFF) hex, '. ', ((dd rem: dv) bitAnd: 16rFFFFFFFF) hex, ' := ', (dd bitAnd: 16rFFFFFFFF) hex, ' rem: ', (dv bitAnd: 16rFFFFFFFF) hex.
  							calc := calc."
  							"Transcript cr; cr; nextPutAll: op; cr; nextPutAll: calc; cr.
  							 self processor
  								disassembleFrom: 0 to: instructions size in: memory on: Transcript;
  								printIntegerRegistersOn: Transcript."
  							map
  								at: #rax put: (self processor rax: 16rA5A5A5A5);
  								at: #rbx put: (self processor rbx: 16rB5B5B5B5);
  								at: #rcx put: (self processor rcx: 16rC5C5C5C5);
  								at: #rdx put: (self processor rdx: 16rD5D5D5D5);
  								at: #rsi put: (self processor rsi: 16r51515151);
  								at: #rdi put: (self processor rdi: 16rD1D1D1D1);
  								at: srget put: (self processor perform: srset with: (self processor convertIntegerToInternal: dv));
  								at: drget put: (self processor perform: drset with: (self processor convertIntegerToInternal: dd)).
  							self processor rsp: memory size; rip: 0.
  							self shouldnt:
  								[[self processor pc < instructions size] whileTrue:
  									[self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2]]
  								raise: Error.
  							map
  								at: qrget put: (self processor convertIntegerToInternal: (dd quo: dv));
  								at: rrget put: (self processor convertIntegerToInternal: (dd rem: dv)).
  							map keysAndValuesDo:
  								[:accessor :value|
  								self assert: value = (self processor perform: accessor)]]]]]].
  	^ops!

Item was changed:
  ----- Method: CogX64CompilerTests>>testMoveRMwr (in category 'tests') -----
  testMoveRMwr
+ 	"self new testMoveRMwr"
- 	"self new testMoveRM0wr"
  	self concreteCompilerClass registersWithNamesDo:
  		[:sreg :srname|
  		self concreteCompilerClass registersWithNamesDo:
  			[:dreg :drname| | inst len |
+ 			#(0 64 65536) do:
+ 				[:offset|
+ 				inst := self gen: MoveRMwr operand: sreg operand: offset operand: dreg.
+ 				len := inst concretizeAt: 0.
+ 				self processor
+ 					disassembleInstructionAt: 0
+ 					In: inst machineCode object
+ 					into: [:str :sz| | plainJane herIntended |
+ 						"Convert e.g. '00000000: movq %rax, 0x2(%rax) : 48 89 40 02' to  'movl %rax, 0x2(%rax)'"
+ 						plainJane := self strip: str.
+ 						herIntended := 'movq ', srname, ', ', (offset = 0 ifTrue: [''] ifFalse: ['0x', (offset printStringBase: 16 length: 16 padded: true)]), '(',drname,')'.
+ 						self assert: (plainJane match: herIntended).
+ 						self assert: len = sz]]]]
+ 
+ 	"| failures |
+ 	 failures := Dictionary new.
+ 	 self concreteCompilerClass registersWithNamesDo:
+ 		[:sreg :srname|
+ 		self concreteCompilerClass registersWithNamesDo:
+ 			[:dreg :drname| | inst len |
+ 			#(0 64 65536) do:
+ 				[:offset|
+ 				inst := self gen: MoveRMwr operand: sreg operand: offset operand: dreg.
+ 				len := inst concretizeAt: 0.
+ 				self processor
+ 					disassembleInstructionAt: 0
+ 					In: inst machineCode object
+ 					into: [:str :sz| | plainJane herIntended |
+ 						plainJane := self strip: str.
+ 						herIntended := 'movq ', srname, ', ', (offset = 0 ifTrue: [''] ifFalse: ['0x', (offset printStringBase: 16 length: 16 padded: true)]), '(',drname,')'.
+ 						((plainJane match: herIntended) and: [len = sz]) ifFalse:
+ 							[failures at: herIntended put: plainJane]]]]].
+ 	 failures"!
- 			inst := self gen: MoveRMwr operand: sreg operand: 0 operand: dreg.
- 			len := inst concretizeAt: 0.
- 			self processor
- 				disassembleInstructionAt: 0
- 				In: inst machineCode object
- 				into: [:str :sz| | plainJane herIntended |
- 					"Convert e.g. '00000000: movl %eax, 0x2(%eax) : 89 40 02' to  'movl %eax, 0x2(%eax)'"
- 					plainJane := self strip: str.
- 					herIntended := 'movl ', srname, ', (',drname,')'.
- 					self assert: (plainJane match: herIntended).
- 					self assert: len = sz]]]!



More information about the Vm-dev mailing list