VM Maker: VMMaker.oscog-lw.189.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

VM Maker: VMMaker.oscog-lw.189.mcz

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

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

Name: VMMaker.oscog-lw.189
Author: lw
Time: 25 July 2012, 7:14:32.722 pm
UUID: b89b77ba-e03f-fb45-bb5f-ca55b387ee00
Ancestors: VMMaker.oscog-lw.188

Refactored all the data operations implemented so far and unified them. Subsequently added all the misssing data-operations (except for MUL, because that has a special format).
Refactored the different load word operations to ARMCompiler>>at:moveCw:intoR:. Operations which can be implemented using the lowest byte of that word as offset may just write those numbers twice, or rather change just the upper bits of the last instruction, which specify the actual instruction.

Added a test for the Add operation and made the AbstractInstructionTest>>testRunAddCqR &
AbstractInstructionTest>>testRunAddRR green.

Added "TODO" comments to those places in my code, where I am not sure about using extract method refactoring.

=============== Diff against VMMaker.oscog-lw.188 ===============

Item was added:
+ ----- Method: AbstractInstructionTests>>numberOfStepsIn: (in category 'running') -----
+ numberOfStepsIn: machineCodeSize
+ self subclassResponsibility!

Item was changed:
  ----- Method: AbstractInstructionTests>>runAddCqR: (in category 'running') -----
  runAddCqR: assertPrintBar
  "self defaultTester runAddCqR: true"
  "self defaultTester runAddCqR: false"
  | memory |
+ memory := ByteArray new: 20.
- memory := ByteArray new: 16.
  self concreteCompilerClass dataRegistersWithAccessorsDo:
  [:reg :rgetter :rsetter|
  self pairs: (-2 to: 2)  do:
  [:a :b| | inst len bogus |
  inst := self gen: AddCqR 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.
+ (self numberOfStepsIn: inst machineCodeSize)
+ timesRepeat: [self processor singleStepIn: memory].
- 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: [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 added:
+ ----- Method: CogARMCompiler>>at:moveCw:intoR: (in category 'generate machine code - concretize') -----
+ at: offset moveCw: constant intoR: destReg
+ "This loads aWord into the inter-opcode temporary register. Because most ARM instruction enable using a (8-12bit) offset relative to a register, the LS Byte can be included in that instruction, saving one instruction. This is done in a decorator, e.g. CmpCqR"
+ "Generates:along the lines of
+ MOV destReg, #<constantByte3>, 12
+ ORR destReg, destReg, #<constantByte2>, 8
+ ORR destReg, destReg, #<constantByte1>, 4
+ ORR destReg, destReg, #<constantByte0>, 0
+ with minimal choice of the rotation (last digit)"
+ "The same area can be modified multiple times, because the opperation is (inclusive) or."
+ <inline: true>
+ 0 to: 12 by: 4 do: [ :i | | rightRingRotation byte |
+ rightRingRotation := 16rC - i.
+ "Counter rotation to get the according byte. Because Smalltalk does not have left ring shift, shift further right."
+ rightRingRotation ~= 0 ifTrue: [
+ byte := constant >> (-2 * rightRingRotation + 32) bitAnd: 16rFF.
+ "For 0, the shift has to be 0. For other immediates, the encoding with minimal rightRingRotation should be choosen."
+ byte = 0
+ ifTrue: [ rightRingRotation := 0]
+ ifFalse: [
+ 0 to: 2 do: [ :j |
+ (byte bitAnd: 16r03) = 0
+ ifTrue: [ rightRingRotation := rightRingRotation - 1.
+ byte := byte >> 2 ]]]]
+ ifFalse: [ byte := constant bitAnd: 16rFF].
+ machineCode
+ at: offset + i + 3 put: 16rE3;
+ at: offset + i + 2 put: (16r80 bitOr: destReg);
+ at: offset + i + 1 put: (rightRingRotation bitOr: destReg << 4);
+ at: offset + i"+0"put: byte.
+ ].
+ machineCode at: offset + 2 put: 16rA0. "only the first operation need be MOV"
+ ^16!

Item was added:
+ ----- Method: CogARMCompiler>>cResultRegister (in category 'abi') -----
+ cResultRegister
+ "Answer the abstract register for the C result register.
+ Only partially implemented.  Works on x86 since TempReg = EAX = C result reg."
+ ^self abstractRegisterForConcreteRegister: R0!

Item was changed:
  ----- Method: CogARMCompiler>>computeMaximumSize (in category 'generate machine code') -----
  computeMaximumSize
  "Because we don't use Thumb, each instruction has a multiple of 4 bytes. Most have exactly 4, but some abstract opcodes need more than one instruction."
+
+ (opcode = CmpCqR) | (opcode = AddCqR) | (opcode = SubCqR) | (opcode = AndCqR) | (opcode = OrCqR) | (opcode = XorCqR) ifTrue: [^self rotateable8bitImmediate: (operands at: 0)
+ ifTrue: [:r :i| maxSize := 4]
+ ifFalse: [maxSize := 20]].
+ (opcode = CmpCwR) | (opcode = AddCwR) | (opcode = SubCwR) | (opcode = AndCwR) | (opcode = OrCwR) | (opcode = XorCwR) ifTrue: [^maxSize := 20].
+
+ opcode
- opcode
  caseOf: {
+ [Label] -> [^maxSize := 0].
+ [AlignmentNops] -> [^maxSize := (operands at: 0) - 1].
+ [MoveAwR] -> [^maxSize := 16].
+ [MoveCqR] -> [^self rotateable8bitImmediate: (operands at: 0)
+ ifTrue: [:r :i| maxSize := 4]
+ ifFalse: [maxSize := 16]].
+ [MoveCwR] -> [^maxSize := 16].
+ [MoveRAw] -> [^maxSize := 16].
+ [RetN] -> [^(operands at: 0) = 0
- [Label] -> [^maxSize := 0].
- [AlignmentNops] -> [^maxSize := (operands at: 0) - 1].
- [CmpCqR] -> [^self rotateable8bitImmediate: (operands at: 0)
- ifTrue: [:r :i| maxSize := 4]
- ifFalse: [maxSize := 20]].
- [CmpCwR] -> [^maxSize := 20].
- [MoveAwR] -> [^maxSize := 16 "3 for loadAllButLSB"].
- [MoveCqR] -> [^self rotateable8bitImmediate: (operands at: 0)
- ifTrue: [:r :i| maxSize := 4]
- ifFalse: [maxSize := 16]].
- [MoveCwR] -> [^maxSize := 16].
- [MoveRAw] -> [^maxSize := 16 "3 for loadAllButLSB"].
- [RetN] -> [^(operands at: 0) = 0
  ifTrue: [maxSize := 4]
  ifFalse: [maxSize := 8]].
+ [JumpFPEqual] -> [^maxSize := 8].
+ [JumpFPNotEqual] -> [^maxSize := 8].
+ [JumpFPLess] -> [^maxSize := 8].
- [JumpFPEqual] -> [^maxSize := 8].
- [JumpFPNotEqual] -> [^maxSize := 8].
- [JumpFPLess] -> [^maxSize := 8].
  [JumpFPGreaterOrEqual] -> [^maxSize := 8].
+ [JumpFPGreater] -> [^maxSize := 8].
+ [JumpFPLessOrEqual] -> [^maxSize := 8].
+ [JumpFPOrdered] -> [^maxSize := 8].
+ [JumpFPUnordered] -> [^maxSize := 8].
+ }
- [JumpFPGreater] -> [^maxSize := 8].
- [JumpFPLessOrEqual] -> [^maxSize := 8].
- [JumpFPOrdered] -> [^maxSize := 8].
- [JumpFPUnordered] -> [^maxSize := 8].}
  otherwise: [^maxSize := 4].
  ^4 "to keep C compiler quiet"
  !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeCall (in category 'generate machine code - concretize') -----
  concretizeCall
  "Will get inlined into concretizeAt: switch."
  <inline: true>
+ | jumpTarget offset |
+ "TODO extract method: jumpTarget calculator together with CogIA32Compiler>>concretizeConditionalJump: and self class>>concretizeConditionalJump:"
+ <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.
+  
- | offset |
- self assert: (operands at: 0) ~= 0.
- offset := ((operands at: 0) - (address + 8)) signedIntFromLong "signed-conversion for range assertion".
  (self isQuick: offset)
  ifTrue: [
  self machineCodeAt: 0 put: (self t: 5 o: 8) + (offset >> 2 bitAnd: 16r00FFFFFF). "BL offset"
  ^machineCodeSize := 4]
  ifFalse: [
  self halt]
  "We should push at least lr. The problem is, that any push added here is only executed after return, and therefore useless."!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeCmpCqR (in category 'generate machine code - concretize') -----
  concretizeCmpCqR
  "Will get inlined into concretizeAt: switch."
+ "All other data operations write back their results. The write back register should be zero for CMP."
- "For 0, we can mov reg, #0"
  <inline: true>
+ | size |
+ size := self concretizeDataOperationCqR: 16rA.
+ machineCode at: size - 3 put: ((machineCode at: size -3) bitAnd: 16rFF).
+ ^size
+ !
- self
- rotateable8bitImmediate: (operands at: 0)
- ifTrue: [:rot :immediate | | reg |
- reg := self concreteRegister: (operands at: 1).
- self machineCodeAt: 0 put: ((self t: 1 o: 16rA s: 1) + reg << 12).
- machineCode at: 0 put: immediate.
- machineCode at: 1 put: rot.
- ^machineCodeSize := 4]
- ifFalse: [^self concretizeCmpCwR].
- !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeCmpCwR (in category 'generate machine code - concretize') -----
  concretizeCmpCwR
  "Will get inlined into concretizeAt: switch."
+ "All other data operations write back their results. The write back register should be zero for CMP."
- "Load the word into the RISCTempReg, then cmp R, RISCTempReg"
  <inline: true>
+ | size |
+ size := self concretizeDataOperationCwR: 16rA.
+ machineCode at: size - 3 put: ((machineCode at: size -3) bitAnd: 16rFF).
+ ^size!
- | constant cmpReg doubleTempReg |
- constant := operands at: 0.
- cmpReg := (self concreteRegister: (operands at: 1)).
- doubleTempReg := (RISCTempReg << 4 bitOr: RISCTempReg) << 12.
- "load the instructions into machineCode"
- self
- machineCodeAt: 0   put: (16rE3A00C00 bitOr: RISCTempReg << 12); "MOV dest, #<byte3>, 12"
- machineCodeAt: 4   put: (16rE3800800 bitOr: doubleTempReg); "ORR dest, dest, #<byte2>, 8"
- machineCodeAt: 8   put: (16rE3800400 bitOr: doubleTempReg); "ORR dest, dest, #<byte1>, 4"
- machineCodeAt: 12 put: (16rE3800000 bitOr: doubleTempReg). "ORR dest, dest, #<byte4>, 0"
- "fill in the according bytes"
- machineCode
- at: 0 put: (constant >> 8   bitAnd: 16rFF);
- at: 4 put: (constant >> 12 bitAnd: 16rFF);
- at: 8 put: (constant >> 24 bitAnd: 16rFF);
- at: 12 put: (constant bitAnd: 16rFF).
- self machineCodeAt: 16
- put: ((self t: 0 o: 16rA s: 1) bitOr: (cmpReg << 16 bitOr: RISCTempReg)).
- ^machineCodeSize := 20.!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeCmpRR (in category 'generate machine code - concretize') -----
+ concretizeCmpRR
+ "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>
+ | size |
+ size := self concretizeDataOperationRR: 16rA.
+ machineCode at: size - 3 put: ((machineCode at: size -3) bitAnd: 16rFF).
+ ^size!

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>
+ | 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 halt]!
- | offset |
- self assert: (operands at: 0) ~= 0.
- offset := ((operands at: 0) - (address + 8)) signedIntFromLong "signed-conversion for range assertion".
- self assert: offset <= 33554428 & (offset >= -33554432).
- self machineCodeAt: 0 put: (self c: conditionCode t: 5 o: 0 s: 0) + (offset >> 2 bitAnd: 16r00FFFFFF). "B offset"
- ^machineCodeSize := 4!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeDataOperationCqR: (in category 'generate machine code - concretize') -----
+ concretizeDataOperationCqR: opcode
+ "Will get inlined into concretizeAt: switch."
+ "For 0, we can mov reg, #0"
+ <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: opcode s: 1) bitOr: reg << 16).
+ machineCode at: 0 put: immediate.
+ machineCode at: 1 put: (reg << 4 bitOr: rot).
+ ^machineCodeSize := 4]
+ ifFalse: [^self concretizeDataOperationCwR: opcode].
+ !

Item was added:
+ ----- Method: CogARMCompiler>>concretizeDataOperationCwR: (in category 'generate machine code - concretize') -----
+ concretizeDataOperationCwR: opcode
+ "Will get inlined into concretizeAt: switch."
+ "Load the word into the RISCTempReg, then cmp R, RISCTempReg"
+ <inline: true>
+ | constant srcDestReg |
+ constant := operands at: 0.
+ srcDestReg := (self concreteRegister: (operands at: 1)).
+ self at: 0 moveCw: constant intoR: RISCTempReg.
+ self machineCodeAt: 16
+ put: ((self t: 0 o: opcode s: 1) bitOr: ((srcDestReg << 16 bitOr: srcDestReg <<12) bitOr: RISCTempReg)).
+ ^machineCodeSize := 20.!

Item was added:
+ ----- 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: srcReg rd: destReg) bitOr: destReg).
+ ^machineCodeSize := 4.!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveAwR (in category 'generate machine code - concretize') -----
  concretizeMoveAwR
  "Will get inlined into concretizeAt: switch."
  <inline: true>
+ | srcAddr destReg |
- | srcAddr destReg loadSize |
  srcAddr := operands at: 0.
  destReg := self concreteRegister: (operands at: 1).
+ "load the address into RISCTempReg"
+ self at: 0 moveCw: srcAddr intoR: RISCTempReg.
+ "Moving allows building an 8bit offset, so the lowest byte can be used in this instruction and we save 4 byte."
+ machineCode
+ at: 15 put: 16rE5; "LDR srcReg, [R3, +LSB(addr)]"
+ at: 14 put: (16r90 bitOr: RISCTempReg);
+ at: 13 put: (destReg << 4).
+ ^machineCodeSize := 16!
- "load the address into R3"
- loadSize := self loadAllButLSBWord: srcAddr.
- machineCode
- at: loadSize + 3 put: 16rE5; "LDR srcReg, [R3, +LSB(addr)]"
- at: loadSize + 2 put: (16r90 bitOr: RISCTempReg);
- at: loadSize + 1 put: (destReg << 4);
- at: loadSize put: (srcAddr bitAnd: 16rFF).
- ^machineCodeSize := loadSize + 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveCqR (in category 'generate machine code - concretize') -----
  concretizeMoveCqR
  "Will get inlined into concretizeAt: switch."
+ "If the quick constant is in fact a shiftable 8bit, generate the apropriate MOV, otherwise do what is necessary for a whole word."
- "For 0, we can mov reg, #0"
  <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: 16rD s: 0).
- self machineCodeAt: 0 put: ((self t: 1 o: 16rD s: 0) + reg << 12).
  machineCode at: 0 put: immediate.
+ machineCode at: 1 put: (reg << 4 bitOr: rot).
- machineCode at: 1 put: rot.
  ^machineCodeSize := 4]
  ifFalse: [^self concretizeMoveCwR].
  !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveCwR (in category 'generate machine code - concretize') -----
  concretizeMoveCwR
  "Will get inlined into concretizeAt: switch."
  <inline: true>
  | constant destReg |
  constant := operands at: 0.
+ destReg := self concreteRegister: (operands at: 1).
+ self at: 0 moveCw: constant intoR: destReg.
- destReg := (self concreteRegister: (operands at: 1)) << 12.
- "load the instructions into machineCode"
- self
- machineCodeAt: 0   put: (16rE3A00C00 bitOr: destReg); "MOV dest, #<byte1>, 12"
- machineCodeAt: 4   put: (16rE3830800 bitOr: destReg); "ORR dest, dest, #<byte2>, 8"
- machineCodeAt: 8   put: (16rE3830400 bitOr: destReg); "ORR dest, dest, #<byte3>, 4"
- machineCodeAt: 12 put: (16rE3830000 bitOr: destReg). "ORR dest, dest, #<byte0>, 0"
- "fill in the according bytes"
- machineCode
- at: 0 put: (constant >> 8   bitAnd: 16rFF);
- at: 4 put: (constant >> 12 bitAnd: 16rFF);
- at: 8 put: (constant >> 24 bitAnd: 16rFF);
- at: 12 put: (constant bitAnd: 16rFF).
-
  ^machineCodeSize := 16.!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeMoveMwrR (in category 'generate machine code - concretize') -----
+ concretizeMoveMwrR
+ "Will get inlined into concretizeAt: switch."
+ <inline: true>
+ | srcReg offset destReg |
+ offset := operands at: 0.
+ srcReg := self concreteRegister: (operands at: 1).
+ destReg := self concreteRegister: (operands at: 2).
+ self is12BitValue: offset
+ ifTrue: [ :u :immediate |
+ self machineCodeAt: 0
+ put: ((self t: 2 o: (8 bitOr: u <<2) s: 1 rn: srcReg rd: destReg) bitOr: immediate).
+ ^machineCodeSize := 4]
+ ifFalse: [ self halt. ]!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveRAw (in category 'generate machine code - concretize') -----
  concretizeMoveRAw
  "Will get inlined into concretizeAt: switch."
  <inline: true>
+ | srcReg destAddr |
- | srcReg destAddr loadSize |
  srcReg := self concreteRegister: (operands at: 0).
  destAddr := operands at: 1.
  "load the address into R3"
+ self at: 0 moveCw: destAddr intoR: RISCTempReg.
- loadSize := self loadAllButLSBWord: destAddr.
  machineCode
+ at: 15 put: 16rE5; "STR srcReg, [R3, +LSB(addr)]"
+ at: 14 put: (16r80 bitOr: RISCTempReg);
+ at: 13 put: (srcReg << 4).
+ ^machineCodeSize := 16!
- at: loadSize + 3 put: 16rE5; "STR srcReg, [R3, +LSB(addr)]"
- at: loadSize + 2 put: (16r80 bitOr: RISCTempReg);
- at: loadSize + 1 put: (srcReg << 4);
- at: loadSize put: (destAddr bitAnd: 16rFF).
- ^machineCodeSize := loadSize + 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveRR (in category 'generate machine code - concretize') -----
  concretizeMoveRR
  "Will get inlined into concretizeAt: switch."
  <inline: true>
  | srcReg destReg |
  srcReg := self concreteRegister: (operands at: 0).
  destReg := self concreteRegister: (operands at: 1).
+ "cond 000 1101 0 0000 dest 0000 0000 srcR"
+ self machineCodeAt: 0 put: ((self t: 0 o: 16rD s: 0 rn: 0 rd: destReg) bitOr: srcReg).
- self machineCodeAt: 0 put: 16rE1A0F00F.
- machineCode
- at: 1 put: (16rF0 bitAnd: destReg << 4);
- at: 0 put: (16r0F bitAnd: srcReg).
  ^machineCodeSize := 4!

Item was added:
+ ----- 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).
+ self machineCodeAt: 0 put: ((self t: 0 o: 16rF s: 0 rn: 0 rd: reg) bitOr: reg).
+ ^machineCodeSize := 4!

Item was added:
+ ----- Method: CogARMCompiler>>concretizePopR (in category 'generate machine code - concretize') -----
+ concretizePopR
+ "Will get inlined into concretizeAt: switch."
+ <inline: true>
+ | destReg |
+ destReg := self concreteRegister: (operands at: 0).
+ "cond | 010 | 0100 | 1 | -Rn- | -Rd- | 0000 0000 0100 " "LDR destReg, [SP], #4"
+ self machineCodeAt: 0 put: ((self t: 2 o: 4 s: 1 rn: SP rd: destReg) bitOr: 4).
+ ^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizePushR (in category 'generate machine code - concretize') -----
  concretizePushR
  "Will get inlined into concretizeAt: switch."
  <inline: true>
  | srcReg |
  srcReg := self concreteRegister: (operands at: 0).
+ "cond | 010 | 1001 | 1 | -Rn- | -Rd- | 0000 0000 0100" "STR srcReg, [sp, #-4]"
+ self machineCodeAt: 0 put: ((self t: 2 o: 9 s: 1 rn: SP rd: srcReg) bitOr: 4).
-
- self machineCodeAt: 0 put: ((self t: 4 o: 9) + 16rD0000 bitOr: 1 << srcReg).
  ^machineCodeSize := 4!

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 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 concretizeDataOperationCqR: 4].
+ [AddCwR] -> [^self concretizeDataOperationCwR: 4].
+ [AddRR] -> [^self concretizeDataOperationRR: 4].
- [AddCqR] -> [^self concretizeAddCqR].
- [AddCwR] -> [^self concretizeAddCwR].
- [AddRR] -> [^self concretizeAddRR].
  "[AddRdRd] -> [^self concretizeSEE2OpRdRd: 16r58]."
+ [AndCqR] -> [^self concretizeDataOperationCqR: 0].
+ [AndCwR] -> [^self concretizeDataOperationCwR: 0].
+ [AndRR] -> [^self concretizeDataOperationRR: 0].
- [AndCqR] -> [^self concretizeAndCqR].
- [AndCwR] -> [^self concretizeAndCwR].
- [AndRR] -> [^self concretizeAndRR].
  [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 concretizeDataOperationCqR: 2].
+ [SubCwR] -> [^self concretizeDataOperationCwR: 2].
+ [SubRR] -> [^self concretizeDataOperationRR: 2].
- [OrCqR] -> [^self concretizeOrCqR].
- [OrCwR] -> [^self concretizeOrCwR].
- [OrRR] -> [^self concretizeOrRR].
- [SubCqR] -> [^self concretizeSubCqR].
- [SubCwR] -> [^self concretizeSubCwR].
- [SubRR] -> [^self concretizeSubRR].
  "[SubRdRd] -> [^self concretizeSEE2OpRdRd: 16r5C]."
  [SqrtRd] -> [^self concretizeSqrtRd].
+ [XorCqR] -> [^self concretizeDataOperationCqR: 1].
+ [XorCwR] -> [^self concretizeDataOperationCwR: 1].
+ [XorRR] -> [^self concretizeDataOperationRR: 1].
- [XorCwR] -> [^self concretizeXorCwR].
- [XorRR] -> [^self concretizeXorRR].
  [NegateR] -> [^self concretizeNegateR].
  [LoadEffectiveAddressMwrR] -> [^self concretizeLoadEffectiveAddressMwrR].
  [ArithmeticShiftRightCqR] -> [^self concretizeArithmeticShiftRightCqR].
  [LogicalShiftRightCqR] -> [^self concretizeLogicalShiftRightCqR].
  [LogicalShiftLeftCqR] -> [^self concretizeLogicalShiftLeftCqR].
  [ArithmeticShiftRightRR] -> [^self concretizeArithmeticShiftRightRR].
  [LogicalShiftLeftRR] -> [^self concretizeLogicalShiftLeftRR].
  "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] }!

Item was added:
+ ----- Method: CogARMCompiler>>is12BitValue:ifTrue:ifFalse: (in category 'testing') -----
+ is12BitValue: constant ifTrue: trueAlternativeBlock ifFalse: falseAlternativeBlock
+ "For LDR and STR, there is an instruction allowing for one instruction encoding if the offset is encodable in 12 bit."
+ constant abs <= 4095 "(2 raisedTo: 12)-1"
+ ifTrue: [
+ constant >= 0
+ ifTrue: [trueAlternativeBlock value: 1 value: constant]
+ ifFalse: [trueAlternativeBlock value: 0 value: constant abs]]
+ ifFalse: falseAlternativeBlock!

Item was removed:
- ----- Method: CogARMCompiler>>loadAllButLSBWord: (in category 'generate machine code - concretize') -----
- loadAllButLSBWord: aWord
- "This loads aWord into the inter-opcode temporary register. Because most ARM instruction enable using a (8-12bit) offset relative to a register, the LS Byte can be included in that instruction, saving one instruction."
- "The temporary register within abstract opcodes is RISCTempReg"
- self
- machineCodeAt: 0   put: (16rE3A00C00 bitOr: RISCTempReg << 12); "MOV R3, #<byte1>, 12"
- machineCodeAt: 4   put: 16rE3800800 + (RISCTempReg << 12) + (RISCTempReg << 16); "ORR R3, R3, #<byte2>, 8"
- machineCodeAt: 8   put: 16rE3800800 + (RISCTempReg << 12) + (RISCTempReg << 16). "ORR R3, R3, #<byte3>, 4"
- "fill in the bytes"
- machineCode
- at: 0 put: (aWord >> 8   bitAnd: 16rFF);
- at: 4 put: (aWord >> 12 bitAnd: 16rFF);
- at: 8 put: (aWord >> 24 bitAnd: 16rFF).
- ^12!

Item was changed:
+ ----- Method: CogARMCompiler>>rotateable8bitImmediate:ifTrue:ifFalse: (in category 'testing') -----
- ----- Method: CogARMCompiler>>rotateable8bitImmediate:ifTrue:ifFalse: (in category 'generate machine code - concretize') -----
  rotateable8bitImmediate: constant ifTrue: trueAlternativeBlock ifFalse: falseAlternativeBlock
  "For data processing operands, there is the immediate shifter_operand variant,
  where an 8 bit value is ring shifted _right_ by 2*i.
  This is only suitable for quick constant(Cq), which don't change."
 
  (constant bitAnd: 16rFF) = constant ifTrue: [ ^trueAlternativeBlock value: 0 value: constant].
  1 to: 15 do: [:i |
  (constant bitAnd: 16rFF << (i<<1)) = constant
  ifTrue: [ ^trueAlternativeBlock value: 16 - i value: constant >> (i << 1)]].
  ^falseAlternativeBlock value!

Item was added:
+ ----- Method: CogARMCompilerForTests class>>dataRegistersWithAccessorsDo: (in category 'test support') -----
+ dataRegistersWithAccessorsDo: aTrinaryBlock
+ "r0 ... sp. We can't use pc or RISCTempReg, because some opcodes may be encoded as multiple instructions and this, we need to be able to step."
+ #(0 1 2 4 5 6 7 8 9 10 11 12 13 14) withIndexDo:
+ [:reg :i|
+ aTrinaryBlock
+ value: reg
+ value: (#(r0 r1 r2 r4 r5 r6 r7 r8 r9 r10 r11 r12 sp lr) at: i)
+ value: (#(r0: r1: r2: r4: r5: r6: r7: r8: r9: r10: r11: r12: sp: lr:) at: i)]!

Item was changed:
  ----- Method: CogARMCompilerForTests class>>registersWithNamesDo: (in category 'test support') -----
  registersWithNamesDo: aBinaryBlock
  self registers
+ with: #('r0' 'r1' 'r2' 'r3' 'r4' 'r5' 'r6' 'r7' 'r8' 'r9' 'sl' 'fp' 'ip' 'sp' 'lr' 'pc')
- with: #('r0' 'r1' 'r2' 'r3' 'r4' 'r5' 'r6' 'r7' 'r8' 'r9' 'r10' 'fp' 'r12' 'sp' 'lr' 'pc')
  do: aBinaryBlock!

Item was added:
+ ----- 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 <= 20!

Item was added:
+ ----- Method: CogARMCompilerTests>>numberOfStepsIn: (in category 'running') -----
+ numberOfStepsIn: aSize
+
+ ^ aSize // 4!

Item was added:
+ ----- Method: CogARMCompilerTests>>testAdd (in category 'tests') -----
+ testAdd
+ "self new testAdd"
+
+ "the forms are valid, "
+ "test AddCqR"
+ self concreteCompilerClass registersWithNamesDo: [ :reg :regName |
+ #(0 16rF 16rFF) do:
+ [:n| | inst len |
+ inst := self gen: AddCqR operand: n operand: reg.
+ len := inst concretizeAt: 0.
+ self processor
+ disassembleInstructionAt: 0
+ In: inst machineCode object
+ into: [:str :sz| | plainJane herIntended |
+ plainJane := self strip: str.
+ herIntended := 'adds ', regName, ', ', regName, ', #', n asString.
+ self assert: (plainJane match: herIntended)]]].
+
+ "test AddCwR"
+ self concreteCompilerClass registersWithNamesDo: [ :reg :regName |
+ #(16rFFFFFFFF 16r88888888 0) do:
+ [:n| | inst len |
+ inst := self gen: AddCwR operand: n operand: reg.
+ len := inst concretizeAt: 0.
+ self processor
+ disassembleInstructionAt: 0
+ In: inst machineCode object
+ into: [:str :sz| | plainJane herIntended |
+ plainJane := self strip: str.
+ herIntended := 'mov r3, #', (n bitAnd: 16rFF << 8) asString.
+ self assert: (plainJane match: herIntended)].
+ self processor
+ disassembleInstructionAt: 4
+ In: inst machineCode object
+ into: [:str :sz| | plainJane herIntended |
+ plainJane := self strip: str.
+ herIntended := 'orr r3, r3, #', (n bitAnd: 16rFF << 16) asString.
+ self assert: (plainJane match: herIntended)].
+ self processor
+ disassembleInstructionAt: 8
+ In: inst machineCode object
+ into: [:str :sz| | plainJane herIntended |
+ plainJane := self strip: str.
+ herIntended := 'orr r3, r3, #', (n bitAnd: 16rFF << 24) signedIntFromLong asString.
+ self assert: (plainJane match: herIntended)].
+ self processor
+ disassembleInstructionAt: 12
+ In: inst machineCode object
+ into: [:str :sz| | plainJane herIntended |
+ plainJane := self strip: str.
+ herIntended := 'orr r3, r3, #', (n bitAnd: 16rFF) asString.
+ self assert: (plainJane match: herIntended)].
+ self processor
+ disassembleInstructionAt: 16
+ In: inst machineCode object
+ into: [:str :sz| | plainJane herIntended |
+ plainJane := self strip: str.
+ herIntended := 'adds ', regName, ', ', regName, ', r3'.
+ self assert: (plainJane match: herIntended)]]]
+ !

Item was added:
+ ----- Method: CogIA32CompilerTests>>numberOfStepsIn: (in category 'running') -----
+ numberOfStepsIn: aSize
+ ^1!