[Vm-dev] VM Maker: VMMaker.oscog-eem.1516.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Nov 13 19:44:57 UTC 2015
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1516.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1516
Author: eem
Time: 13 November 2015, 11:43:01.923 am
UUID: e7c665c7-2a20-4873-959b-86a9eb315d3f
Ancestors: VMMaker.oscog-eem.1515
Use the memoryAsBytes: routine to map an AbstractInstruction's machine code to a ByteArray in the tests.
Refactor the varBase and pc-relative addressing queries up into AbstractInstructionTests from CogX64CompilerTests so that making CogARMCompilerForTests inherit from CogInLineLiteralsARMCompiler results in compilable instructions.
=============== Diff against VMMaker.oscog-eem.1515 ===============
Item was added:
+ ----- Method: AbstractInstructionTests>>addressIsInCurrentCompilation: (in category 'cogit compatibility') -----
+ addressIsInCurrentCompilation: address
+ "Provide a range of addresses that are assumed to be in the current compilation. Within this range operands
+ can be interpreted as pc-relative addresses, and hence allow testing of pc-relative addresses,"
+ ^self currentCompilationBase <= address
+ and: [address - self currentCompilationBase < 1024]!
Item was added:
+ ----- Method: AbstractInstructionTests>>currentCompilationBase (in category 'cogit compatibility') -----
+ currentCompilationBase
+ "Provide a range of addresses that are assumed to be in the current compilation. Within this range operands
+ can be interpreted as pc-relative addresses, and hence allow testing of pc-relative addresses,"
+ ^16r8000!
Item was changed:
----- Method: AbstractInstructionTests>>generateInstructions (in category 'generating machine code') -----
generateInstructions
"See Cogit>>computeMaximumSizes, generateInstructionsAt: & outputInstructionsAt:.
This is a pure Smalltalk (non-Slang) version of that trio of methods."
| address pcDependentInstructions instructions |
address := 0.
pcDependentInstructions := OrderedCollection new.
opcodes do:
[:abstractInstruction|
abstractInstruction
address: address;
maxSize: abstractInstruction computeMaximumSize.
address := address + abstractInstruction maxSize].
address := 0.
opcodes do:
[:abstractInstruction|
abstractInstruction isPCDependent
ifTrue:
[abstractInstruction sizePCDependentInstructionAt: address.
pcDependentInstructions addLast: abstractInstruction.
address := address + abstractInstruction machineCodeSize]
ifFalse:
[address := abstractInstruction concretizeAt: address]].
pcDependentInstructions do:
[:abstractInstruction|
abstractInstruction concretizeAt: abstractInstruction address].
instructions := ByteArray new: address.
address := 0.
opcodes do:
+ [:abstractInstruction| | machineCodeBytes |
- [:abstractInstruction|
self assert: abstractInstruction address = address.
+ machineCodeBytes := self memoryAsBytes: abstractInstruction machineCode object.
+ 1 to: abstractInstruction machineCodeSize do:
- 0 to: abstractInstruction machineCodeSize - 1 do:
[:j|
+ instructions at: address + 1 put: (machineCodeBytes at: j).
- instructions at: address + 1 put: (abstractInstruction machineCode at: j).
address := address + 1]].
^instructions!
Item was changed:
----- Method: AbstractInstructionTests>>memoryAsBytes: (in category 'private') -----
+ memoryAsBytes: instructionMachineCode
+ "Answer an AbstractInstruction's machine code as a ByteArray. Subclasses that represent instruction
+ data using Array should override to convert appropriately."
+ instructionMachineCode isCObjectAccessor ifTrue:
+ [^self memoryAsBytes: instructionMachineCode object].
+ self assert: instructionMachineCode class isBits.
+ ^instructionMachineCode!
- memoryAsBytes: aByteArray
- "Simply answer the ByteArray. Subclasses that represent instruction
- data using Array shou;ld override to convert appropriately."
- ^aByteArray!
Item was added:
+ ----- Method: AbstractInstructionTests>>methodLabel (in category 'cogit compatibility') -----
+ methodLabel
+ ^nil!
Item was changed:
----- Method: AbstractInstructionTests>>runAddCqR: (in category 'running') -----
runAddCqR: assertPrintBar
"self defaultTester runAddCqR: true"
"self defaultTester runAddCqR: false"
- | memory |
- memory := ByteArray new: 20.
self concreteCompilerClass dataRegistersWithAccessorsDo:
[:reg :rgetter :rsetter|
self pairs: (-2 to: 2) do:
+ [:a :b| | inst len bogus memory |
- [:a :b| | inst len bogus |
inst := self gen: AddCqR operand: a operand: reg.
len := inst concretizeAt: 0.
+ memory := self memoryAsBytes: inst machineCode.
- memory replaceFrom: 1 to: len with: inst machineCode object startingAt: 1.
self processor
reset;
perform: rsetter with: (processor convertIntegerToInternal: b).
[[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.
self assertCheckQuickArithOpCodeSize: 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 convertInternalToInteger: (self processor perform: getter)) equals: expected]
ifFalse:
[(self processor convertInternalToInteger: (self processor perform: getter)) ~= expected ifTrue:
[bogus := true]]].
assertPrintBar ifFalse:
[Transcript
nextPutAll: rgetter; nextPut: $(; print: b; nextPutAll: ') + '; print: a; nextPutAll: ' = ';
print: (self processor convertInternalToInteger: (self processor perform: rgetter)); cr; flush.
bogus ifTrue:
[self processor printRegistersOn: Transcript.
Transcript show: (self processor disassembleInstructionAt: 0 In: memory); cr]]]]!
Item was changed:
----- Method: AbstractInstructionTests>>runAddCwR: (in category 'running') -----
runAddCwR: assertPrintBar
"self defaultTester runAddCwR: false"
- | memory |
- memory := ByteArray new: self concreteCompilerClass new machineCodeBytes.
self concreteCompilerClass dataRegistersWithAccessorsDo:
[:reg :rgetter :rsetter|
self pairs: (-2 to: 2) do:
+ [:a :b| | inst len bogus memory |
- [:a :b| | inst len bogus |
inst := self gen: AddCwR operand: a operand: reg.
len := inst concretizeAt: 0.
+ memory := self memoryAsBytes: inst machineCode.
- memory replaceFrom: 1 to: len with: inst machineCode object startingAt: 1.
self processor
reset;
perform: rsetter with: (self processor convertIntegerToInternal: b).
[[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.
self assertCheckLongArithOpCodeSize: inst machineCodeSize]
ifFalse: [bogus := processor pc ~= inst machineCodeSize].
self concreteCompilerClass dataRegistersWithAccessorsDo:
[:ireg :getter :setter| | expected |
(self concreteCompilerClass isConcreteRISCTempRegister: ireg) ifFalse:
[expected := getter == rgetter ifTrue: [b + a] ifFalse: [0].
assertPrintBar
ifTrue: [self assert: (self processor convertInternalToInteger: (self processor perform: getter)) equals: expected]
ifFalse:
[(self processor convertInternalToInteger: (self processor perform: getter)) ~= expected ifTrue:
[bogus := true]]].
assertPrintBar ifFalse:
[Transcript
nextPutAll: rgetter; nextPut: $(; print: b; nextPutAll: ') + '; print: a; nextPutAll: ' = ';
print: (self processor convertInternalToInteger: (self processor perform: rgetter)); 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 memory |
- [:dreg :drgetter :drsetter| | inst len |
inst := self gen: AddRR operand: sreg operand: dreg.
len := inst concretizeAt: 0.
+ memory := self memoryAsBytes: inst machineCode.
- 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).
[[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]
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]
ifFalse:
[(self processor convertInternalToInteger: (self processor perform: getter)) ~= 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.
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 memory |
- [:dreg :drgetter :drsetter| | inst len |
inst := self gen: ArithmeticShiftRightRR operand: sreg operand: dreg.
len := inst concretizeAt: 0.
+ memory := self memoryAsBytes: inst machineCode.
- 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).
[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]
ifFalse:
[(self processor convertInternalToInteger: (self processor perform: getter)) ~= 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.
bogus ifTrue:
[self processor printRegistersOn: Transcript.
self processor disassembleFrom: 0 to: inst machineCodeSize in: memory on: Transcript]]]]]]!
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 memory |
- [:a :b| | inst len bogus |
inst := self gen: SubCqR operand: a operand: reg.
len := inst concretizeAt: 0.
+ memory := self memoryAsBytes: inst machineCode.
- memory replaceFrom: 1 to: len with: inst machineCode object startingAt: 1.
self processor
reset;
perform: rsetter with: (processor convertIntegerToInternal: b).
[[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.
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 convertInternalToInteger: (self processor perform: getter)) equals: expected]
ifFalse:
[(self processor convertInternalToInteger: (self processor perform: getter)) ~= expected ifTrue:
[bogus := true]]].
assertPrintBar ifFalse:
[Transcript
nextPutAll: rgetter; nextPut: $(; print: b; nextPutAll: ') - '; print: a; nextPutAll: ' = ';
print: (self processor convertInternalToInteger: (self processor perform: rgetter)); 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.
self concreteCompilerClass dataRegistersWithAccessorsDo:
[:reg :rgetter :rsetter|
self pairs: (-2 to: 2) do:
+ [:a :b| | inst len bogus memory |
- [:a :b| | inst len bogus |
inst := self gen: SubCwR operand: a operand: reg.
len := inst concretizeAt: 0.
+ memory := self memoryAsBytes: inst machineCode.
- memory replaceFrom: 1 to: len with: inst machineCode object startingAt: 1.
self processor
reset;
perform: rsetter with: (self processor convertIntegerToInternal: b).
[[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.
self assertCheckLongArithOpCodeSize: inst machineCodeSize]
ifFalse: [bogus := processor pc ~= inst machineCodeSize].
self concreteCompilerClass dataRegistersWithAccessorsDo:
[:ireg :getter :setter| | expected |
(self concreteCompilerClass isConcreteRISCTempRegister: ireg) ifFalse:
[expected := getter == rgetter ifTrue: [b - a] ifFalse: [0].
assertPrintBar
ifTrue: [self assert: (self processor convertInternalToInteger: (self processor perform: getter)) equals: expected]
ifFalse:
[(self processor convertInternalToInteger: (self processor perform: getter)) ~= expected ifTrue:
[bogus := true]]].
assertPrintBar ifFalse:
[Transcript
nextPutAll: rgetter; nextPut: $(; print: b; nextPutAll: ') - '; print: a; nextPutAll: ' = ';
print: (self processor convertInternalToInteger: (self processor perform: rgetter)); 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.
self concreteCompilerClass dataRegistersWithAccessorsDo:
[:sreg :srgetter :srsetter|
self concreteCompilerClass dataRegistersWithAccessorsDo:
+ [:dreg :drgetter :drsetter| | inst len memory |
- [:dreg :drgetter :drsetter| | inst len |
inst := self gen: SubRR operand: sreg operand: dreg.
len := inst concretizeAt: 0.
+ memory := self memoryAsBytes: inst machineCode.
- 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).
[[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]
ifFalse:
[(self processor convertInternalToInteger: (self processor perform: getter)) ~= 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.
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 memory |
- [:a| | inst len |
inst := self gen: NegateR operand: reg.
len := inst concretizeAt: 0.
+ memory := self memoryAsBytes: inst machineCode.
- memory replaceFrom: 1 to: len with: inst machineCode object startingAt: 1.
self processor
reset;
perform: rsetter with: (processor convertIntegerToInternal: a).
[[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 concreteCompilerClass dataRegistersWithAccessorsDo:
[:ireg :getter :setter| | expected |
expected := getter == rgetter ifTrue: [ a negated ] ifFalse: [0].
self assert: (processor convertInternalToInteger: (processor perform: getter)) equals: expected]]]!
Item was added:
+ ----- Method: AbstractInstructionTests>>varBaseAddress (in category 'cogit compatibility') -----
+ varBaseAddress
+ "Answer a value that should be sufficiently high that var base relative addressing is never generated."
+ ^1 << 60!
Item was changed:
+ CogInLineLiteralsARMCompiler subclass: #CogARMCompilerForTests
- CogARMCompiler subclass: #CogARMCompilerForTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-Tests'!
Item was removed:
- ----- Method: CogARMCompilerTests>>generateInstructions (in category 'generating machine code') -----
- generateInstructions
- "See Cogit>>computeMaximumSizes, generateInstructionsAt: & outputInstructionsAt:.
- This is a pure Smalltalk (non-Slang) version of that trio of methods.
- The wrinkle here is that in teh simulator a CogARMInstruction's machien code is a simple Array of integers, not a ByteArray of four byte quads."
- | address pcDependentInstructions instructions |
- address := 0.
- pcDependentInstructions := OrderedCollection new.
- opcodes do:
- [:abstractInstruction|
- abstractInstruction
- address: address;
- maxSize: abstractInstruction computeMaximumSize.
- address := address + abstractInstruction maxSize].
- address := 0.
- opcodes do:
- [:abstractInstruction|
- abstractInstruction isPCDependent
- ifTrue:
- [abstractInstruction sizePCDependentInstructionAt: address.
- pcDependentInstructions addLast: abstractInstruction.
- address := address + abstractInstruction machineCodeSize]
- ifFalse:
- [address := abstractInstruction concretizeAt: address]].
- pcDependentInstructions do:
- [:abstractInstruction|
- abstractInstruction concretizeAt: abstractInstruction address].
- instructions := Array new: address / 4.
- address := 0.
- opcodes do:
- [:abstractInstruction|
- self assert: abstractInstruction address / 4 = address.
- 0 to: abstractInstruction machineCodeSize - 1 by: 4 do:
- [:j|
- instructions at: address + 1 put: (abstractInstruction machineCode at: j / 4).
- address := address + 1]].
- ^instructions!
Item was changed:
----- Method: CogARMCompilerTests>>memoryAsBytes: (in category 'private') -----
+ memoryAsBytes: instructionMachineCode
- memoryAsBytes: aByteArrayOrArray
"Manage the fact that in the simulator inst machineCode object is an Array and the disassembler requires a ByteArray or some such."
| bytes |
+ instructionMachineCode isCObjectAccessor ifTrue:
+ [^self memoryAsBytes: instructionMachineCode object].
+ instructionMachineCode isArray ifFalse:
+ [self assert: instructionMachineCode class isBits.
+ ^instructionMachineCode].
+ bytes := ByteArray new: instructionMachineCode size * 4.
+ 1 to: instructionMachineCode size do:
- aByteArrayOrArray isArray ifFalse:
- [^aByteArrayOrArray].
- bytes := ByteArray new: aByteArrayOrArray size * 4.
- 1 to: aByteArrayOrArray size do:
[:i|
+ (instructionMachineCode at: i) ifNotNil:
- (aByteArrayOrArray at: i) ifNotNil:
[:word|
bytes unsignedLongAt: i - 1* 4 + 1 put: word]].
^bytes!
Item was added:
+ ----- Method: CogARMCompilerTests>>objectMemory (in category 'cogit compatibility') -----
+ objectMemory
+ ^self!
Item was changed:
----- Method: CogARMCompilerTests>>testMoveCwR (in category 'tests') -----
testMoveCwR
"self new testMoveCwR"
- | memory |
- memory := ByteArray new: 16.
#(16rFF00FF00 16r00000012 16r12345678) do:
+ [:n|
- [:n| | inst len |
self concreteCompilerClass dataRegistersWithAccessorsDo:
+ [ :r :rgetter :rset | | inst len memory |
- [ :r :rgetter :rset |
inst := self gen: MoveCwR operand: n operand: r.
len := inst concretizeAt: 0.
+ memory := self memoryAsBytes: inst machineCode.
- memory replaceFrom: 1 to: len with: inst machineCode object startingAt: 1.
self processor
reset.
+ [[processor pc < inst machineCodeSize] whileTrue:
- [[processor pc < len] whileTrue:
[self processor singleStepIn: memory]]
on: Error
do: [:ex| ].
self concreteCompilerClass dataRegistersWithAccessorsDo:
[:ireg :getter :setter| | expected |
expected := getter == rgetter ifTrue: [ n ] ifFalse: [0].
self assert: (self processor perform: getter) = expected].
self assert: self processor pc = 16]]
!
Item was changed:
----- Method: CogARMCompilerTests>>testPerformAdd (in category 'tests') -----
testPerformAdd
"self new testPerformAdd"
| memory |
#(16rFF00FF00 16r00000012 16r12345678) do:
[:n| | |
self concreteCompilerClass dataRegistersWithAccessorsDo:
[ :r :rgetter :rset |
self resetGen. "initialise important stuff"
self gen: MoveCwR operand: n operand: r.
self gen: AddCqR operand: 42 operand: r.
memory := self generateInstructions.
+ "self disassembleOpcodesIn: memory to: Transcript."
- self disassembleOpcodesIn: memory to: Transcript .
self processor
reset.
[[processor pc < memory size] whileTrue:
[self processor singleStepIn: memory]]
on: Error
do: [:ex| ].
self concreteCompilerClass dataRegistersWithAccessorsDo:
[:ireg :getter :setter| | expected |
expected := getter == rgetter ifTrue: [ n + 42] ifFalse: [0].
self assert: (self processor perform: getter) = expected].
self assert: self processor pc = 20]]
!
Item was added:
+ ----- Method: CogARMCompilerTests>>wordSize (in category 'cogit compatibility') -----
+ wordSize
+ ^4!
Item was removed:
- ----- Method: CogX64CompilerTests>>addressIsInCurrentCompilation: (in category 'accessing') -----
- addressIsInCurrentCompilation: address
- ^self currentCompilationBase <= address
- and: [address - self currentCompilationBase < 1024]!
Item was removed:
- ----- Method: CogX64CompilerTests>>currentCompilationBase (in category 'accessing') -----
- currentCompilationBase
- ^16r8000!
Item was removed:
- ----- Method: CogX64CompilerTests>>varBaseAddress (in category 'accessing') -----
- varBaseAddress
- "Answer a value that should be sufficiently high that var base relative addressing is never generated."
- ^1 << 60!
More information about the Vm-dev
mailing list