[Vm-dev] VM Maker: VMMaker.oscog-lw.191.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Jul 31 13:48:51 UTC 2012


Lars Wassermann uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-lw.191.mcz

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

Name: VMMaker.oscog-lw.191
Author: lw
Time: 31 July 2012, 3:46:30.782 pm
UUID: 646aea3c-a1b4-ab40-a9e6-46861b3c0aa2
Ancestors: VMMaker.oscog-eem.190

- added the shift opcodes

- added AddCqR and SubCqR, which test for negative immediates, which allows the compiler to exchange Add r0, r0, #-2 to Sub r0, r0, #2 and thus saves 4 instructions, 16 byte

- changed all the remaining AbstractInstructionTests test cases to allow multiple single stepping

- added NegateR test as another place of documentation for the NegateR opcode (twos complement, not ones)

- extracted the offset computation which is the same in all the different concretizeConditionalJump methods. Unfortunately, the computation includes a constant, which might get the address to overflow. In the image, this would result in a large integer, while in C, this would result in a negative number. Therefore, the methods signature is weird (CogAbstractInstruction>>computeJumpTargetOffsetPlus:).

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

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

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: a signedIntToLong;
+ 					perform: drsetter with: b signedIntToLong.
+ 				[[processor pc < len] whileTrue:
+ 					[self processor singleStepIn: memory]]
+ 					on: Error
+ 					do: [:ex| ].
- 					perform: drsetter with: b signedIntToLong;
- 					singleStepIn: memory.
  				"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 := getter == drgetter
  									ifTrue: [srgetter == drgetter
  												ifTrue: [b + b]
  												ifFalse: [a + b]]
  									ifFalse: [getter = srgetter
  												ifTrue: [a]
  												ifFalse: [0]].
  					assertPrintBar
  						ifTrue: [self assert: (self processor perform: getter) signedIntFromLong = expected]
  						ifFalse:
  							[(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 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>>runSubCqR: (in category 'running') -----
  runSubCqR: assertPrintBar
  	"self defaultTester runSubCqR: false"
  	| memory |
  	memory := ByteArray new: 16.
  	self concreteCompilerClass dataRegistersWithAccessorsDo:
  		[:reg :rgetter :rsetter|
  		self pairs: (-2 to: 2)  do:
  			[:a :b| | inst len bogus |
  			inst := self gen: SubCqR operand: a operand: reg.
  			len := inst concretizeAt: 0.
  			memory replaceFrom: 1 to: len with: inst machineCode object startingAt: 1.
  			self processor
  				reset;
+ 				perform: rsetter with: b signedIntToLong.
+ 			[[processor pc < len] whileTrue:
+ 				[self processor singleStepIn: memory]]
+ 				on: Error
+ 				do: [:ex| ].
- 				perform: rsetter with: b signedIntToLong;
- 				singleStepIn: memory.
  			"self processor printRegistersOn: Transcript.
  			 Transcript show: (self processor disassembleInstructionAt: 0 In: memory); cr"
  			assertPrintBar
  				ifTrue: [self assert: processor pc = inst machineCodeSize.
  						self assertCheckQuickArithOpCodeSize: inst machineCodeSize]
  				ifFalse: [bogus := processor pc ~= inst machineCodeSize].
  			self concreteCompilerClass dataRegistersWithAccessorsDo:
  				[:ireg :getter :setter| | expected |
  				expected := getter == rgetter ifTrue: [b - a] ifFalse: [0].
  				assertPrintBar
  					ifTrue: [self assert: (self processor perform: getter) signedIntFromLong = expected]
  					ifFalse:
  						[(self processor perform: getter) signedIntFromLong ~= expected ifTrue:
  							[bogus := true]]].
  				assertPrintBar ifFalse:
  					[Transcript
  						nextPutAll: rgetter; nextPut: $(; print: b; nextPutAll: ') - '; print: a; nextPutAll: ' = ';
  						print: (self processor perform: rgetter) signedIntFromLong; cr; flush.
  					 bogus ifTrue:
  						[self processor printRegistersOn: Transcript.
  						 Transcript show: (self processor disassembleInstructionAt: 0 In: memory); cr]]]]!

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

Item was changed:
  ----- Method: AbstractInstructionTests>>runSubRR: (in category 'running') -----
  runSubRR: assertPrintBar
  	"self defaultTester runSubRR: false"
  	| memory |
+ 	memory := ByteArray new: self concreteCompilerClass new machineCodeBytes.
- 	memory := ByteArray new: 16.
  	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: a signedIntToLong;
+ 					perform: drsetter with: b signedIntToLong.
+ 				[[processor pc < len] whileTrue:
+ 					[self processor singleStepIn: memory]]
+ 					on: Error
+ 					do: [:ex| ].
- 					perform: drsetter with: b signedIntToLong;
- 					singleStepIn: memory.
  				"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 perform: getter) signedIntFromLong = expected]
  						ifFalse:
  							[(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 perform: drgetter) signedIntFromLong; cr; flush.
  						 bogus ifTrue:
  							[self processor printRegistersOn: Transcript.
  							 Transcript show: (self processor disassembleInstructionAt: 0 In: memory); cr]]]]]!

Item was added:
+ ----- 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: 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 = inst machineCodeSize.
+ 			self concreteCompilerClass dataRegistersWithAccessorsDo:
+ 				[:ireg :getter :setter| | expected |
+ 				expected := getter == rgetter ifTrue: [ a negated ] ifFalse: [0].
+ 				self assert: (self processor perform: getter) signedIntFromLong = expected]]]!

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

Item was added:
+ ----- Method: CogARMCompiler>>canDivQuoRem (in category 'testing') -----
+ canDivQuoRem
+ 	^false!

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

Item was added:
+ ----- Method: CogARMCompiler>>concretizeAddCqR (in category 'generate machine code - concretize') -----
+ concretizeAddCqR
+ 	"Will get inlined into concretizeAt: switch."
+ 	"Try whether the quick constant is a small negative number. If it is, optimize."
+ 	<inline: true>
+ 	^self rotateable8bitImmediate: (operands at: 0)
+ 		ifTrue: [ :rot :immediate | | reg |
+ 			reg := self concreteRegister: (operands at: 1).
+ 			self machineCodeAt: 0 put: ((self t: 1 o: 4 s: 1) bitOr: reg << 16).
+ 			machineCode at: 0 put: immediate.
+ 			machineCode at: 1 put: (reg << 4 bitOr: rot).
+ 			^machineCodeSize := 4]
+ 		ifFalse: [
+ 			self rotateable8bitImmediate: (operands at: 0) negated
+ 				ifTrue: [ :r :i | 
+ 						opcode := SubCqR.
+ 						operands at: 0 put: (operands at: 0) negated.
+ 						self concretizeDataOperationCqR: 2]
+ 				ifFalse: [self concretizeDataOperationCwR: 4]]!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeArithmeticShiftRightCqR (in category 'generate machine code - concretize') -----
+ concretizeArithmeticShiftRightCqR
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| distance reg |
+ 	distance := (operands at: 0) min: 31.
+ 	reg := self concreteRegister: (operands at: 1).
+ 	"cond 000 1101 0 0000 dest dist -100 srcR"
+ 	self machineCodeAt: 0 put: ((self t: 0 o: 16rD s: 0 rn: 0 rd: reg) 
+ 									bitOr: (distance << 7 bitOr: (64 bitOr: reg))).
+ 	^machineCodeSize := 4!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeArithmeticShiftRightRR (in category 'generate machine code - concretize') -----
+ concretizeArithmeticShiftRightRR
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| destReg distReg |
+ 	distReg := self concreteRegister: (operands at: 0).
+ 	destReg := self concreteRegister: (operands at: 1).
+ 	"cond 000 1101 0 0000 dest dist 0101 srcR"
+ 	self machineCodeAt: 0 put: ((self t: 0 o: 16rD s: 0 rn: 0 rd: destReg) 
+ 									bitOr: (distReg << 8 bitOr: (80 bitOr: destReg))).
+ 	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeConditionalJump: (in category 'generate machine code - concretize') -----
  concretizeConditionalJump: conditionCode
  	"Will get inlined into concretizeAt: switch."
  	"Sizing/generating jumps.
  		Jump targets can be to absolute addresses or other abstract instructions.
  		Generating initial trampolines instructions may have no maxSize and be to absolute addresses.
  		Otherwise instructions must have a machineCodeSize which must be kept to."
  	<inline: true>
+ 	| offset |
+ 	offset := self computeJumpTargetOffsetPlus: 8.
- 	| jumpTarget offset |
- 	"TODO extract method: jumpTarget calculator together with CogIA32Compiler"
- 	<var: #jumpTarget type: #'AbstractInstruction *'>
- 	jumpTarget := cogit cCoerceSimple: (operands at: 0) to: #'AbstractInstruction *'.
- 	cogit assertSaneJumpTarget: jumpTarget.
- 	(self isAnInstruction: jumpTarget) ifTrue:
- 		[jumpTarget := cogit cCoerceSimple: jumpTarget address to: #'AbstractInstruction *'].
- 	self assert: jumpTarget ~= 0.
- 	offset := jumpTarget signedIntFromLong - (address + 8) signedIntFromLong.
   	(self isQuick: offset)
  		ifTrue: [
  			self machineCodeAt: 0 put: (self t: 5 o: 8) + (offset >> 2 bitAnd: 16r00FFFFFF). "BL offset"
  			^machineCodeSize := 4]
  		ifFalse: [
+ 			self concretizeConditionalJumpLong: conditionCode]!
- 			self halt]!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeConditionalJumpLong: (in category 'generate machine code - concretize') -----
+ concretizeConditionalJumpLong: conditionCode
+ 	"Will get inlined into concretizeAt: switch."
+ 	"Sizing/generating jumps.
+ 		Jump targets can be to absolute addresses or other abstract instructions.
+ 		Generating initial trampolines instructions may have no maxSize and be to absolute addresses.
+ 		Otherwise instructions must have a machineCodeSize which must be kept to."
+ 	<inline: true>
+ 	| offset |
+ 	offset := self computeJumpTargetOffsetPlus: 24 "16+8".
+ 	!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeDataOperationRR: (in category 'generate machine code - concretize') -----
  concretizeDataOperationRR: opcode
  	"Will get inlined into concretizeAt: switch."
  	"Load the word into the RISCTempReg, then cmp R, RISCTempReg"
  	<inline: true>
  	| destReg srcReg |
  	srcReg := self concreteRegister: (operands at: 0).
  	destReg := (self concreteRegister: (operands at: 1)).
  	self machineCodeAt: 0 
+ 		put: ((self t: 0 o: opcode s: 1 rn: destReg rd: destReg) bitOr: srcReg).
- 		put: ((self t: 0 o: opcode s: 1 rn: srcReg rd: destReg) bitOr: destReg).
  	^machineCodeSize := 4.!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeLogicalShiftLeftCqR (in category 'generate machine code - concretize') -----
+ concretizeLogicalShiftLeftCqR
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| distance reg |
+ 	distance := (operands at: 0) min: 31.
+ 	reg := self concreteRegister: (operands at: 1).
+ 	"cond 000 1101 0 0000 dest dista 000 srcR"
+ 	self machineCodeAt: 0 put: ((self t: 0 o: 16rD s: 0 rn: 0 rd: reg) 
+ 									bitOr: (distance << 7 bitOr: reg)).
+ 	^machineCodeSize := 4!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeLogicalShiftLeftRR (in category 'generate machine code - concretize') -----
+ concretizeLogicalShiftLeftRR
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| destReg distReg |
+ 	distReg := self concreteRegister: (operands at: 0).
+ 	destReg := self concreteRegister: (operands at: 1).
+ 	"cond 000 1101 0 0000 dest dist 0001 srcR"
+ 	self machineCodeAt: 0 put: ((self t: 0 o: 16rD s: 0 rn: 0 rd: destReg) 
+ 									bitOr: (distReg << 8 bitOr: (16 bitOr: destReg))).
+ 	^machineCodeSize := 4!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeLogicalShiftRightCqR (in category 'generate machine code - concretize') -----
+ concretizeLogicalShiftRightCqR
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| distance reg |
+ 	distance := (operands at: 0) min: 31.
+ 	reg := self concreteRegister: (operands at: 1).
+ 	"cond 000 1101 0 0000 dest dist -010 srcR"
+ 	self machineCodeAt: 0 put: ((self t: 0 o: 16rD s: 0 rn: 0 rd: reg) 
+ 									bitOr: (distance << 7 bitOr: (32 bitOr: reg))).
+ 	^machineCodeSize := 4!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeLogicalShiftRightRR (in category 'generate machine code - concretize') -----
+ concretizeLogicalShiftRightRR
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| destReg distReg |
+ 	distReg := self concreteRegister: (operands at: 0).
+ 	destReg := self concreteRegister: (operands at: 1).
+ 	"cond 000 1101 0 0000 dest dist 0011 srcR"
+ 	self machineCodeAt: 0 put: ((self t: 0 o: 16rD s: 0 rn: 0 rd: destReg) 
+ 									bitOr: (distReg << 8 bitOr: (48 bitOr: destReg))).
+ 	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeNegateR (in category 'generate machine code - concretize') -----
  concretizeNegateR
  	"Will get inlined into concretizeAt: switch."
- 	"All other data operations write back their results. The write back register should be zero for CMP."
  	<inline: true>
  	| reg |
  	reg := self concreteRegister: (operands at: 0).
+ 	"rsb r0, r0, #0"
+ 	self machineCodeAt: 0 put: (self t: 1 o: 3 s: 0 rn: reg rd: reg).
- 	self machineCodeAt: 0 put: ((self t: 0 o: 16rF s: 0 rn: 0 rd: reg) bitOr: reg).
  	^machineCodeSize := 4!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeNop (in category 'generate machine code - concretize') -----
+ concretizeNop
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	self machineCodeAt: 0 put: 16rE1A01001.
+ 	^machineCodeSize := 4
+ 			!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeSubCqR (in category 'generate machine code - concretize') -----
+ concretizeSubCqR
+ 	"Will get inlined into concretizeAt: switch."
+ 	"Try whether the quick constant is a small negative number. If it is, optimize."
+ 	<inline: true>
+ 	^self rotateable8bitImmediate: (operands at: 0)
+ 		ifTrue: [ :rot :immediate | | reg |
+ 			reg := self concreteRegister: (operands at: 1).
+ 			self machineCodeAt: 0 put: ((self t: 1 o: 2 s: 1) bitOr: reg << 16).
+ 			machineCode at: 0 put: immediate.
+ 			machineCode at: 1 put: (reg << 4 bitOr: rot).
+ 			^machineCodeSize := 4]
+ 		ifFalse: [
+ 			self rotateable8bitImmediate: (operands at: 0) negated
+ 				ifTrue: [ :r :i | 
+ 						opcode := AddCqR.
+ 						operands at: 0 put: (operands at: 0) negated.
+ 						self concretizeDataOperationCqR: 4]
+ 				ifFalse: [self concretizeDataOperationCwR: 2]]!

Item was changed:
  ----- Method: CogARMCompiler>>dispatchConcretize (in category 'generate machine code') -----
  dispatchConcretize
  	"Attempt to generate concrete machine code for the instruction at address.
  	 This is the inner dispatch of concretizeAt: actualAddress which exists only
  	 to get around the branch size limits in the SqueakV3 (blue book derived)
  	 bytecode set."
  
  	opcode caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]					-> [^self concretizeLabel].
  		[AlignmentNops]		-> [^self concretizeAlignmentNops].
  		[Fill16]					-> [^self concretizeFill16].
  		[Fill32]					-> [^self concretizeFill32].
  		[FillFromWord]			-> [^self concretizeFillFromWord].
  		[Nop]					-> [^self concretizeNop].
  		"Specific Control/Data Movement"
  		"[LDM]					-> [^self concretizeLDM].
  		[STM]					-> [^self concretizeSTM]."
  		"Control"
  		[Call]						-> [^self concretizeCall].
  		[JumpR]						-> [^self concretizeJumpR].
+ 		[JumpLong]					-> [^self concretizeConditionalJumpLong: AL].
+ 		[JumpLongZero]			-> [^self concretizeConditionalJumpLong: EQ].
+ 		[JumpLongNonZero]		-> [^self concretizeConditionalJumpLong: NE].
- 		[JumpLong]					-> [^self concretizeJumpLong].
- 		"[JumpLongZero]			-> [^self concretizeConditionalJumpLong: EQ].
- 		[JumpLongNonZero]		-> [^self concretizeConditionalJumpLong: NE]."
  		[Jump]						-> [^self concretizeConditionalJump: AL].
  		[JumpZero]					-> [^self concretizeConditionalJump: EQ].
  		[JumpNonZero]				-> [^self concretizeConditionalJump: NE].
  		[JumpNegative]				-> [^self concretizeConditionalJump: MI].
  		[JumpNonNegative]			-> [^self concretizeConditionalJump: PL].
  		[JumpOverflow]				-> [^self concretizeConditionalJump: VS].
  		[JumpNoOverflow]			-> [^self concretizeConditionalJump: VC].
  		[JumpCarry]				-> [^self concretizeConditionalJump: CS].
  		[JumpNoCarry]				-> [^self concretizeConditionalJump: CC].
  		[JumpLess]					-> [^self concretizeConditionalJump: LT].
  		[JumpGreaterOrEqual]		-> [^self concretizeConditionalJump: GE].
  		[JumpGreater]				-> [^self concretizeConditionalJump: GT].
  		[JumpLessOrEqual]			-> [^self concretizeConditionalJump: LE].
  		[JumpBelow]				-> [^self concretizeConditionalJump: CS]. "according to http://courses.engr.illinois.edu/ece390/books/labmanual/assembly.html"
  		[JumpAboveOrEqual]		-> [^self concretizeConditionalJump: CC]. " --""-- "
  		[JumpAbove]				-> [^self concretizeConditionalJump: HI].
  		[JumpBelowOrEqual]		-> [^self concretizeConditionalJump: LS].
  		[JumpFPEqual]				-> [^self concretizeFPConditionalJump: EQ].
  		[JumpFPNotEqual]			-> [^self concretizeFPConditionalJump: NE].
  		"[JumpFPLess]				-> [^self concretizeFPConditionalJump: LT].
  		[JumpFPGreaterOrEqual]	-> [^self concretizeFPConditionalJump: GE].
  		[JumpFPGreater]			-> [^self concretizeFPConditionalJump: GT].
  		[JumpFPLessOrEqual]		-> [^self concretizeFPConditionalJump: LE].
  		[JumpFPOrdered]			-> [^self concretizeFPConditionalJump: VC].
  		[JumpFPUnordered]			-> [^self concretizeFPConditionalJump: VS]."
  		[RetN]						-> [^self concretizeRetN].
  		"Arithmetic"
+ 		[AddCqR]					-> [^self concretizeAddCqR].
- 		[AddCqR]					-> [^self concretizeDataOperationCqR: 4].
  		[AddCwR]					-> [^self concretizeDataOperationCwR: 4].
  		[AddRR]						-> [^self concretizeDataOperationRR: 4].
  		"[AddRdRd]					-> [^self concretizeSEE2OpRdRd: 16r58]."
  		[AndCqR]					-> [^self concretizeDataOperationCqR: 0].
  		[AndCwR]					-> [^self concretizeDataOperationCwR: 0].
  		[AndRR]						-> [^self concretizeDataOperationRR: 0].
  		[CmpCqR]					-> [^self concretizeCmpCqR].
  		[CmpCwR]					-> [^self concretizeCmpCwR].
  		[CmpRR]					-> [^self concretizeCmpRR].
  		[CmpRdRd]					-> [^self concretizeCmpRdRd].
  		"[DivRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5E].
  		[MulRdRd]					-> [^self concretizeSEE2OpRdRd: 16r59]."
  		[OrCqR]						-> [^self concretizeDataOperationCqR: 16rC].
  		[OrCwR]					-> [^self concretizeDataOperationCwR: 16rC].
  		[OrRR]						-> [^self concretizeDataOperationRR: 16rC].
+ 		[SubCqR]					-> [^self concretizeSubCqR].
- 		[SubCqR]					-> [^self concretizeDataOperationCqR: 2].
  		[SubCwR]					-> [^self concretizeDataOperationCwR: 2].
  		[SubRR]						-> [^self concretizeDataOperationRR: 2].
  		"[SubRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5C]."
  		[SqrtRd]						-> [^self concretizeSqrtRd].
  		[XorCqR]						-> [^self concretizeDataOperationCqR: 1].
  		[XorCwR]						-> [^self concretizeDataOperationCwR: 1].
  		[XorRR]							-> [^self concretizeDataOperationRR: 1].
  		[NegateR]						-> [^self concretizeNegateR].
  		[LoadEffectiveAddressMwrR]	-> [^self concretizeLoadEffectiveAddressMwrR].
  		[ArithmeticShiftRightCqR]		-> [^self concretizeArithmeticShiftRightCqR].
  		[LogicalShiftRightCqR]			-> [^self concretizeLogicalShiftRightCqR].
  		[LogicalShiftLeftCqR]			-> [^self concretizeLogicalShiftLeftCqR].
  		[ArithmeticShiftRightRR]			-> [^self concretizeArithmeticShiftRightRR].
  		[LogicalShiftLeftRR]				-> [^self concretizeLogicalShiftLeftRR].
+ 		[LogicalShiftRightRR]			-> [^self concretizeLogicalShiftRightRR].
  		"Data Movement"
  		[MoveCqR]			-> [^self concretizeMoveCqR].
  		[MoveCwR]			-> [^self concretizeMoveCwR].
  		[MoveRR]			-> [^self concretizeMoveRR].
  		[MoveAwR]			-> [^self concretizeMoveAwR].
  		[MoveRAw]			-> [^self concretizeMoveRAw].
  		[MoveMbrR]			-> [^self concretizeMoveMbrR].
  		[MoveRMbr]			-> [^self concretizeMoveRMbr].
  		[MoveM16rR]		-> [^self concretizeMoveM16rR].
  		[MoveM64rRd]		-> [^self concretizeMoveM64rRd].
  		[MoveMwrR]		-> [^self concretizeMoveMwrR].
  		[MoveXbrRR]		-> [^self concretizeMoveXbrRR].
  		[MoveXwrRR]		-> [^self concretizeMoveXwrRR].
  		[MoveRXwrR]		-> [^self concretizeMoveRXwrR].
  		[MoveRMwr]		-> [^self concretizeMoveRMwr].
  		[MoveRdM64r]		-> [^self concretizeMoveRdM64r].
  		[PopR]				-> [^self concretizePopR].
  		[PushR]				-> [^self concretizePushR].
  		[PushCw]			-> [^self concretizePushCw].
  		[PrefetchAw]		-> [^self concretizePrefetchAw].
  		"Conversion"
+ 		[ConvertRRd]		-> [^self concretizeConvertRRd].
+ 		"ARM specific opcodes" 
+ 		[LDMFD]			-> [^self concretizeLDMFD].
+ 		[STMFD]			-> [^self concretizeSTMFD]	}!
- 		[ConvertRRd]		-> [^self concretizeConvertRRd] }!

Item was added:
+ ----- Method: CogARMCompiler>>genRestoreRegisters (in category 'abi') -----
+ genRestoreRegisters
+ 	"Load the general purpose registers after the return of a trampoline call."
+ 	"Load r0-r6, all of which were saved. Don't load sb(r9), sl(r10), fp(r11), sp or lr"
+ 	cogit
+ 		gen: LDMFD operand: 16r7F!

Item was added:
+ ----- Method: CogARMCompiler>>hasDoublePrecisionFloatingPointSupport (in category 'testing') -----
+ hasDoublePrecisionFloatingPointSupport
+ 	"might be true, but is for the forseeable future disabled"
+ 	^false!

Item was added:
+ ----- Method: CogARMCompiler>>hasLinkRegister (in category 'testing') -----
+ hasLinkRegister
+ 	^true "lr"!

Item was added:
+ ----- Method: CogARMCompiler>>hasPCDependentInstruction (in category 'testing') -----
+ hasPCDependentInstruction
+ 	"e.g. B, BL: Branch, Branch and Link"
+ 	^true!

Item was added:
+ ----- Method: CogARMCompilerForTests class>>fp64RegistersWithAccessorsDo: (in category 'test support') -----
+ fp64RegistersWithAccessorsDo: aBlock
+ 	"there are none, because we do not support VFP, yet"!

Item was added:
+ ----- Method: CogARMCompilerTests>>assertCheckLongArithOpCodeSize: (in category 'running') -----
+ assertCheckLongArithOpCodeSize: bytes
+ 	self assert: bytes > 4!

Item was changed:
  ----- Method: CogARMCompilerTests>>assertCheckQuickArithOpCodeSize: (in category 'running') -----
  assertCheckQuickArithOpCodeSize: bytes
  	"The problem is that there are negative value, which are not quick encodable in ARM"
+ 	self assert: bytes <= 4!
- 	self assert: bytes <= 20!

Item was added:
+ ----- Method: CogARMCompilerTests>>assertSaneJumpTarget: (in category 'cogit compiler compatibility') -----
+ assertSaneJumpTarget: jumpTarget
+ 	<var: #jumpTarget type: #'void *'>
+ 
+ 	self assert: (self addressIsInInstructions: jumpTarget)!

Item was added:
+ ----- Method: CogAbstractInstruction>>computeJumpTargetOffsetPlus: (in category 'generate machine code') -----
+ computeJumpTargetOffsetPlus: anInteger
+ 	<inline: true> "Since it's an extraction from other methods."
+ 	| jumpTarget |
+ 	<var: #jumpTarget type: #'AbstractInstruction *'>
+ 	jumpTarget := cogit cCoerceSimple: (operands at: 0) to: #'AbstractInstruction *'.
+ 	cogit assertSaneJumpTarget: jumpTarget.
+ 	(self isAnInstruction: jumpTarget) ifTrue:
+ 		[jumpTarget := cogit cCoerceSimple: jumpTarget address to: #'AbstractInstruction *'].
+ 	self assert: jumpTarget ~= 0.
+ 	^jumpTarget signedIntFromLong - (address + anInteger) signedIntFromLong.!

Item was changed:
  ----- Method: CogAbstractInstruction>>hasPCDependentInstructions (in category 'testing') -----
  hasPCDependentInstructions
  	"Answer whether the concrete machine code contains pc-dependent
+ 	 instructions, such as the IA32/x86's short and long relative jumps
- 	 instructions, such as the IA32/x86's short and lopng relative jumps
  	 and the EMT64/x86-64's pc-relative addressing mode.  Such
  	 instructions require an extra pass to generate them correctly."
  	^false!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeConditionalJump: (in category 'generate machine code') -----
  concretizeConditionalJump: conditionCode
  	"Will get inlined into concretizeAt: switch."
  	"Sizing/generating jumps.
  		Jump targets can be to absolute addresses or other abstract instructions.
  		Generating initial trampolines instructions may have no maxSize and be to absolute addresses.
  		Otherwise instructions must have a machineCodeSize which must be kept to."
  	<inline: true>
+ 	| offset |
- 	| jumpTarget offset |
  	<var: #jumpTarget type: #'AbstractInstruction *'>
+ 	offset := self computeJumpTargetOffsetPlus: 2.
- 	jumpTarget := cogit cCoerceSimple: (operands at: 0) to: #'AbstractInstruction *'.
- 	cogit assertSaneJumpTarget: jumpTarget.
- 	(self isAnInstruction: jumpTarget) ifTrue:
- 		[jumpTarget := cogit cCoerceSimple: jumpTarget address to: #'AbstractInstruction *'].
- 	self assert: jumpTarget ~= 0.
- 	offset := jumpTarget signedIntFromLong - (address + 2) signedIntFromLong.
  	(machineCodeSize = 0 "size not determined because no sizeJump pass; generating initial trampolines"
  		ifTrue: [self isQuick: offset]
  		ifFalse: [machineCodeSize = 2]) ifTrue:
  		[machineCode
  			at: 0 put: 16r70 + conditionCode;
  			at: 1 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := 2].
+ 	^self concretizeConditionalJumpLong: conditionCode!
- 	offset := jumpTarget signedIntFromLong - (address + 6) signedIntFromLong.
- 	machineCode
- 		at: 0 put: 16r0F;
- 		at: 1 put: 16r80 + conditionCode;
- 		at: 2 put: (offset bitAnd: 16rFF);
- 		at: 3 put: (offset >> 8 bitAnd: 16rFF);
- 		at: 4 put: (offset >> 16 bitAnd: 16rFF);
- 		at: 5 put: (offset >> 24 bitAnd: 16rFF).
- 	^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeConditionalJumpLong: (in category 'generate machine code') -----
  concretizeConditionalJumpLong: conditionCode
  	"Will get inlined into concretizeAt: switch."
  	"Sizing/generating jumps.
  		Jump targets can be to absolute addresses or other abstract instructions.
  		Generating initial trampolines instructions may have no maxSize and be to absolute addresses.
  		Otherwise instructions must have a machineCodeSize which must be kept to."
  	<inline: true>
+ 	| offset |
+ 	offset := self computeJumpTargetOffsetPlus: 6.
- 	| jumpTarget offset |
- 	<var: #jumpTarget type: #'AbstractInstruction *'>
- 	jumpTarget := cogit cCoerceSimple: (operands at: 0) to: #'AbstractInstruction *'.
- 	cogit assertSaneJumpTarget: jumpTarget.
- 	(self isAnInstruction: jumpTarget) ifTrue:
- 		[jumpTarget := cogit cCoerceSimple: jumpTarget address to: #'AbstractInstruction *'].
- 	self assert: jumpTarget ~= 0.
- 	offset := jumpTarget signedIntFromLong - (address + 6) signedIntFromLong.
  	machineCode
  		at: 0 put: 16r0F;
  		at: 1 put: 16r80 + conditionCode;
  		at: 2 put: (offset bitAnd: 16rFF);
  		at: 3 put: (offset >> 8 bitAnd: 16rFF);
  		at: 4 put: (offset >> 16 bitAnd: 16rFF);
  		at: 5 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 6!



More information about the Vm-dev mailing list