[Vm-dev] VM Maker: VMMaker.oscog-tpr.1857.mcz

commits at source.squeak.org commits at source.squeak.org
Tue May 10 18:51:02 UTC 2016


tim Rowledge uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-tpr.1857.mcz

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

Name: VMMaker.oscog-tpr.1857
Author: tpr
Time: 10 May 2016, 11:49:45.497012 am
UUID: 01dc1cd0-4095-4ead-b3ca-408c051c29cf
Ancestors: VMMaker.oscog-eem.1856

Add some hopefully helpful documentation page pointers to ARM instructions

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

Item was changed:
  ----- Method: CogARMCompiler>>add:rn:imm:ror: (in category 'ARM convenience instructions') -----
  add: destReg rn: srcReg imm: immediate ror: rot
  "Remember the ROR is doubled by the cpu so use 30>>1 etc.
+ 	ADD destReg, srcReg, #immediate ROR #rot - ARM_ARM v7 DDI10406 p. A8-23"
- 	ADD destReg, srcReg, #immediate ROR #rot"
  
  	^self type: 1 op: AddOpcode set: 0 rn: srcReg rd: destReg shifterOperand: ((rot>>1) <<8 bitOr: immediate)!

Item was changed:
  ----- Method: CogARMCompiler>>add:rn:rm: (in category 'ARM convenience instructions') -----
  add: destReg rn: srcReg rm: addReg
  "return an ADD destReg, srcReg, addReg instruction
+ 	ADD destReg, srcReg, addReg - ARM_ARM v7 DDI10406 p. A8-24"
- 	ADD destReg, srcReg, addReg"
  
  	^self type: 0 op: AddOpcode set: 0 rn: srcReg rd: destReg shifterOperand: addReg!

Item was changed:
  ----- Method: CogARMCompiler>>adds:rn:imm:ror: (in category 'ARM convenience instructions') -----
  adds: destReg rn: srcReg imm: immediate ror: rot
  "Remember the ROR is doubled by the cpu so use 30>>1 etc
+ 	ADDS destReg, srcReg, #immediate ROR #rot - ARM_ARM v7 DDI10406 p. A8-23"
- 	ADDS destReg, srcREg, #immediate ROR #rot"
  
  	^self type: 1 op: AddOpcode set: 1 rn: srcReg rd: destReg shifterOperand: ((rot>>1) <<8 bitOr: immediate)!

Item was changed:
  ----- Method: CogARMCompiler>>and:rn:imm:ror: (in category 'ARM convenience instructions') -----
  and: destReg rn: srcReg imm: immediate ror: rot
  "Remember the ROR is doubled by the cpu so use 30>>1 etc
+ 	AND destReg, srcReg, #immediate ROR #rot - ARM_ARM v7 DDI10406 p. A8-34"
- 	AND destReg, srcReg, #immediate ROR #rot"
  
  	^self type: 1 op: AndOpcode set: 0 rn: srcReg rd: destReg shifterOperand: ((rot>>1) <<8 bitOr: immediate)!

Item was changed:
  ----- Method: CogARMCompiler>>ands:rn:imm:ror: (in category 'ARM convenience instructions') -----
  ands: destReg rn: srcReg imm: immediate ror: rot
  "Remember the ROR is doubled by the cpu so use 30>>1 etc
+ 	ANDS destReg, srcReg, #immediate ROR #rot - ARM_ARM v7 DDI10406 p. A8-34"
- 	ANDS destReg, srcReg, #immediate ROR #rot"
  
  	^self type: 1 op: AndOpcode set: 1 rn: srcReg rd: destReg shifterOperand: ((rot>>1) <<8 bitOr: immediate)!

Item was changed:
  ----- Method: CogARMCompiler>>b: (in category 'ARM convenience instructions') -----
  b: offset
  "return a B offset instruction; offset is signed 24bits of WORD offset, so +_32Mbyte range
+ 	B offset - ARM_ARM v7 DDI10406 pp. A8-44-5"
- 	B offset"
  	^self cond: AL br: 0 offset: offset
  !

Item was changed:
  ----- Method: CogARMCompiler>>bics:rn:imm:ror: (in category 'ARM convenience instructions') -----
  bics: destReg rn: srcReg imm: immediate ror: rot
  "Remember the ROR is doubled by the cpu so use 30>>1 etc
+ 	BICS destReg, srcReg, #immediate ROR #rot - ARM_ARM v7 DDI10406 pp. A8-50-1"
- 	BICS destReg, srcReg, #immediate ROR #rot"
  
  	^self type: 1 op: BicOpcode set: 1 rn: srcReg rd: destReg shifterOperand: ((rot>>1) <<8 bitOr: immediate)!

Item was changed:
  ----- Method: CogARMCompiler>>bl: (in category 'ARM convenience instructions') -----
  bl: offset
  "return a BL offset instruction; offset is signed 24bits of WORD offset, so +_32Mbyte range. Return address is in LR
+ 	BL offset - ARM_ARM v7 DDI10406 pp. A8-58-9"
- 	BL offset"
  	^self cond: AL br: 1 offset: offset
  !

Item was changed:
  ----- Method: CogARMCompiler>>blx: (in category 'ARM convenience instructions') -----
  blx: targetReg
  	"Branch&link to the address in targetReg. Return address is in LR
+ 	BLX targetReg - ARM_ARM v7 DDI10406 pp. A8-60-1"
- 	BX targetReg"
  	<inline: true>
  	^self cond: AL bx: 1 target: targetReg
  !

Item was changed:
  ----- Method: CogARMCompiler>>bx: (in category 'ARM convenience instructions') -----
  bx: targetReg
+ 	"Branch to address in targetReg. BX targetReg
+ 	BX targetReg  - ARM_ARM v7 DDI10406 pp. A8-62-3"
- 	"Branch to address in targetReg. BX targetReg"
  	<inline: true>
  	^self cond: AL bx: 0 target: targetReg
  !

Item was changed:
  ----- Method: CogARMCompiler>>faddd:with: (in category 'ARM convenience instructions') -----
  faddd: destReg with: srcReg
  "FADDD or VADD instruction to add double srcReg to double destReg and stick result in double destReg
+ FADDD destReg, destReg, srcReg -  ARM_ARM v5 DDI 01001.pdf pp. C4-6
+ VADD.F64 destReg, destReg, srcReg - ARM_ARM v7 DDI10406.pdf pp. A8-536-7"
- ARM_ARM v5 DDI 01001.pdf pp. C4-6"
  	<inline: true>
  	^((2r11101110001100000000101100000000 bitOr: destReg<<16 ) bitOr: destReg<<12) bitOr: srcReg!

Item was changed:
  ----- Method: CogARMCompiler>>fcmpFrom:to: (in category 'ARM convenience instructions') -----
  fcmpFrom: regA to: regB
+ "FCMPD or VCMP instruction to compare two fpu double registers.
+ FCMPD regA, regB - ARM_ARM v5 DDI 01001.pdf pp. C4-10
+ VCMP.F64 regA, regB - ARM_ARM v7 DDI10406 -1"
- "FCMP or VCMP instruction to compare two fpu double registers.
- ARM_ARM v5 DDI 01001.pdf pp. C4-10"
  	<inline: true>
  	^(2r11101110101101000000101101000000 bitOr:(regA <<12)) bitOr: regB!

Item was changed:
  ----- Method: CogARMCompiler>>fcmpeFrom:to: (in category 'ARM convenience instructions') -----
  fcmpeFrom: regA to: regB
+ 	"FCMPED or VCMPE instruction to compare two fpu double registers.
+ FCMPED regA, regB - ARM_ARM v5 DDI 01001.pdf pp. C4-12
+ VCMPE.F64 regA,regB - ARM_ARM v7 DDI10406 pp. 570-1"
- 	"FCMPE or VCMPE instruction to compare two fpu double registers.
- 	 ARM_ARM v5 DDI 01001.pdf pp. C4-12"
  	<inline: true>
  	^(2r11101110101101000000101111000000 bitOr: (regA <<12)) bitOr: regB!

Item was changed:
  ----- Method: CogARMCompiler>>fdivd:by: (in category 'ARM convenience instructions') -----
  fdivd: dividend by: divisor
  "FDIVD or VDIV instruction to divide double dividend by double divisor and stick result in double dividend
+ FDIVD dividend, dividend, divisor - ARM_ARM v5 DDI 01001.pdf pp. C4-32
+ VDIV.F64 dvidend, dividend, divisor - ARM_ARM v7 DDI10406 pp. A8-584-5"
- ARM_ARM v5 DDI 01001.pdf pp. C4-32"
  	<inline: true>
  	^((2r11101110100000000000101100000000 bitOr: dividend<<16 ) bitOr: dividend<<12) bitOr: divisor!

Item was changed:
  ----- Method: CogARMCompiler>>fldd:rn:plus:imm: (in category 'ARM convenience instructions') -----
  fldd: destReg rn: srcReg plus: u imm: immediate8bitValue
  "FLDD or VLDR instruction to move a value from address in an ARM srcReg +/- offset<<2 to an fpu double destReg
+ FLDD ARM_ARM v5 DDI 01001.pdf pp. C4-36
+ VLDR.64 ARM_ARM v7 DDI10406 pp. A8-622-3"
- ARM_ARM v5 DDI 01001.pdf pp. C4-36"
  	<inline: true>
  	"Note that
  		offset is <<2 to make byte address 
  		u =1 -> srcReg + offset<<2
  		u=0 -> srgREg - offset<<2"
  	^(((2r11101101000100000000101100000000 bitOr:(srcReg <<16)) bitOr: destReg<<12) bitOr: u<<23) bitOr: immediate8bitValue!

Item was changed:
  ----- Method: CogARMCompiler>>fmsrFrom:to: (in category 'ARM convenience instructions') -----
  fmsrFrom: regA to: regB
+ "FMSR or VMOV instruction to move a value from an ARM reg to an fpu double register ready for conversion
+ FMSR regB, regA - ARM_ARM v5 DDI 01001.pdf pp. C4-68
+ VMOV regB, regA - ARM_ARM v7 DDi10406 pp. A8-462-3"
- "FMSR or VMSR instruction to move a value from an ARM reg to an fpu double register ready for conversion
- ARM_ARM v5 DDI 01001.pdf pp. C4-68"
  	<inline: true>
  	|destReg|
  	"the dest reg bits are spread out a little"
  	destReg := (regB >>1) <<16 bitOr:(regB bitAnd: 1) << 7.
  	^(2r11101110000000000000101000010000 bitOr:(regA <<12)) bitOr: destReg!

Item was changed:
  ----- Method: CogARMCompiler>>fmstat (in category 'ARM convenience instructions') -----
  fmstat
  	"FMSTAT or VMRS unconditional transfer FP status to cpsr to choose jumps etc.
+ FMSTAT r15, FPSCR - ARM_ARM v5 DDI 01001.pdf pp. C4-72
+ VMRS APSR_nzcv, FPSCR - ARM_ARM v7 DDI10406 pp. A8-652-3"
- 	ARM_ARM v5 DDI 01001.pdf pp. C4-72"
  	<inline: true>
  	^2r11101110111100011111101000010000!

Item was changed:
  ----- Method: CogARMCompiler>>fmuld:with: (in category 'ARM convenience instructions') -----
  fmuld: destReg with: srcReg
  "FMULD or VMUL instruction to multiply double srcReg by double destReg and stick result in double destReg
+ FMULD destReg, destReg, srcReg - ARM_ARM v5 DDI 01001.pdf pp. C4-73
+ VMUL.F64 destReg, destReg, srcReg - ARM_ARM v7 DDI10406 pp A8-658-9"
- ARM_ARM v5 DDI 01001.pdf pp. C4-73"
  	<inline: true>
  	^((2r11101110001000000000101100000000 bitOr: destReg<<16 ) bitOr: destReg<<12) bitOr: srcReg!

Item was changed:
  ----- Method: CogARMCompiler>>fsitodFrom:to: (in category 'ARM convenience instructions') -----
  fsitodFrom: regA to: regB
  "FSITOD or VCVT instruction to move convert an integer value to an fpu double
+ FSITOD regB, regA - ARM_ARM v5 DDI 01001.pdf pp. C4-95
+ VCVTW. regB, regA - ARM_ARM v7 DDI10406.pdf pp. A8-576-8"
- ARM_ARM v5 DDI 01001.pdf pp. C4-95"
  	<inline: true>
  	|srcReg|
  	"the src reg bits are spread out a little"
  	srcReg := (regA >>1) bitOr:(regA bitAnd: 1) << 5.
  	^(2r11101110101110000000101111000000 bitOr: srcReg ) bitOr: regB<<12!

Item was changed:
  ----- Method: CogARMCompiler>>fsqrtd: (in category 'ARM convenience instructions') -----
  fsqrtd: destReg
  "FSQRTD or VSQRT instruction to square root double dividend destReg and stick result in double destReg
+ ARM_ARM v5 DDI 01001.pdf pp. C4-97
+ VSQRT.F64 destReg, destReg - ARM_ARM v7 DDI10406 pp. A8-756-7"
- ARM_ARM v5 DDI 01001.pdf pp. C4-97"
  	<inline: true>
  	^((2r11101110101100010000101111000000 ) bitOr: destReg<<12) bitOr: destReg!

Item was changed:
  ----- Method: CogARMCompiler>>fstd:rn:plus:imm: (in category 'ARM convenience instructions') -----
+ fstd: fpReg rn: addrReg plus: u imm: immediate8bitValue
+ "FSTD or VSTR instruction to move a value to address in an ARM addrReg +/- offset<<2 from an fpu double fpReg
+ FSTD fpReg, addrReg, #offset - ARM_ARM v5 DDI 01001.pdf pp. C4-101
+ VSTR.64 fpReg, addrReg, #offset - ARM_ARM v7 DDI10406 pp. A8-780-1"
- fstd: destReg rn: srcReg plus: u imm: immediate8bitValue
- "FSTD or VSTR instruction to move a value to address in an ARM srcReg +/- offset<<2 from an fpu double destReg
- ARM_ARM v5 DDI 01001.pdf pp. C4-101"
  	<inline: true>
  	"Note that
  		offset is <<2 to make byte address 
+ 		u =1 -> addrReg + offset<<2
+ 		u=0 -> addrReg - offset<<2"
+ 	^(((2r11101101000000000000101100000000 bitOr:(addrReg <<16)) bitOr: fpReg<<12) bitOr: u<<23) bitOr: immediate8bitValue!
- 		u =1 -> srcReg + offset<<2
- 		u=0 -> srgREg - offset<<2"
- 	^(((2r11101101000000000000101100000000 bitOr:(srcReg <<16)) bitOr: destReg<<12) bitOr: u<<23) bitOr: immediate8bitValue!

Item was changed:
  ----- Method: CogARMCompiler>>fsubd:with: (in category 'ARM convenience instructions') -----
  fsubd: destReg with: srcReg
  "FSUBD or VSUB instruction to subtract double srcReg from double destREg and stick result in double destReg
+ FSUBD destReg, destReg, srcReg - ARM_ARM v5 DDI 01001.pdf pp. C4-112
+ VSUB.F64 destReg, destReg, srcReg - ARM_ARM v7 DDI10406 pp. A8-784-5"
- ARM_ARM v5 DDI 01001.pdf pp. C4-112"
  	<inline: true>
  	^((2r11101110001100000000101101000000 bitOr: destReg<<16 ) bitOr: destReg<<12) bitOr: srcReg!

Item was changed:
  ----- Method: CogARMCompiler>>genMulR:R: (in category 'abstract instructions') -----
  genMulR: regSource R: regDest
+ 	"Use SMULL to produce a 64-bit result, explicitly in RISCTempReg,regDest. - ARM_ARM v7 DDI10406 pp. A8-354-5
- 	"Use SMULL to produce a 64-bit result, explicitly in RISCTempReg,regDest.
  	 By comparing RISCTempReg with regDest ASR 31(which effectively makes it 0 or -1) we know that the result being EQ means the hi reg and the top bit of the lo reg are the same - ie no overflow. The condition code can then be forced to oVerflow by use of MSR APSR_nzcvq, #1, lsl 28"
  	| first |
  	<var: 'first' type: #'AbstractInstruction *'>
  	first := cogit gen: SMULL operand: regSource operand: regDest. "result in RISCTempReg,regDest"
  	cogit gen: CMPSMULL operand: RISCTempReg operand: regDest.
  	cogit gen: MSR operand: 1.
  	^first!

Item was changed:
  ----- Method: CogARMCompiler>>ldr:rn:plus:imm: (in category 'ARM convenience instructions') -----
  ldr: destReg rn: baseReg plus: u imm: immediate12bitValue
+ "	LDR destReg, [baseReg, immediate12bitValue] u=0 -> subtract imm; =1 -> add imm  - ARM_ARM v7 DDI10406 pp. A8-120-1"
- "	LDR destReg, [baseReg, immediate12bitValue] u=0 -> subtract imm; =1 -> add imm "
  	^self memMxr: AL reg: destReg  base: baseReg u: u b: 0 l: 1 imm: immediate12bitValue!

Item was changed:
  ----- Method: CogARMCompiler>>ldr:rn:plusImm: (in category 'ARM convenience instructions') -----
  ldr: destReg rn: baseReg plusImm: immediate12bitValue
+ "	LDR destReg, [baseReg, +immediate12bitValue] - ARM_ARM v7 DDI10406 pp. A8-120-1"
- "	LDR destReg, [baseReg, +immediate12bitValue]"
  	^self memMxr: AL reg: destReg  base: baseReg u: 1 b: 0 l: 1 imm: immediate12bitValue!

Item was changed:
  ----- Method: CogARMCompiler>>ldr:rn:rm: (in category 'ARM convenience instructions') -----
  ldr: destReg rn: baseReg rm: offsetReg
+ "	LDR destReg, [baseReg, + offsetReg]  - ARM_ARM v7 DDI10406 pp. A8-124-5
- "	LDR destReg, [baseReg, + offsetReg]
  	The contents of offsetReg are assumed to be correctly signed"
  	^self memMxr: AL reg: destReg  base: baseReg p: 1 u: 1 b: 0 w: 0 l: 1 rm: offsetReg!

Item was changed:
  ----- Method: CogARMCompiler>>ldrb:rn:plus:imm: (in category 'ARM convenience instructions') -----
  ldrb: destReg rn: baseReg plus: u imm: immediate12bitValue
+ "	LDRB destReg, [baseReg, 'u' immediate12bitValue] u=0 ->  - ARM_ARM v7 DDI10406 pp. A8-128-9
- "	LDRB destReg, [baseReg, 'u' immediate12bitValue] u=0 -> subtract imm; =1 -> add imm 
  	Note that this is a very low level interface that does not check the sign of the immediate, nor validity. See for example #concretizeMoveMbrR"
  	^self memMxr: AL reg: destReg  base: baseReg u: u b: 1 l: 1 imm: immediate12bitValue!

Item was changed:
  ----- Method: CogARMCompiler>>ldrb:rn:rm: (in category 'ARM convenience instructions') -----
  ldrb: destReg rn: baseReg rm: offsetReg
+ "	LDRB destReg, [baseReg, + offsetReg]  - ARM_ARM v7 DDI10406 pp. A8-132-3
- "	LDR destReg, [baseReg, + offsetReg] 
  	The contents of offsetReg are assumed to be correctly signed"
  	^self memMxr: AL reg: destReg  base: baseReg p: 1 u: 1 b: 1 w: 0 l: 1 rm: offsetReg!

Item was changed:
  ----- Method: CogARMCompiler>>ldrh:rn:plus:imm: (in category 'ARM convenience instructions') -----
  ldrh: destReg rn: baseReg plus: u imm: immediate8bitValue
+ "	LDRH destReg, [baseReg, 'u' immediate8bitValue] u=0 -> subtract imm; =1 -> add imm  - ARM_ARM v7 DDI10406 pp. A8-152-3"
- "	LDRH destReg, [baseReg, 'u' immediate8bitValue] u=0 -> subtract imm; =1 -> add imm "
  	^self memM16xr: AL reg: destReg  base: baseReg p: 1 u: u  w: 0 l: 1 offset: immediate8bitValue!

Item was changed:
  ----- Method: CogARMCompiler>>ldrh:rn:rm: (in category 'ARM convenience instructions') -----
  ldrh: destReg rn: baseReg rm: offsetReg
+ "	LDRH destReg, [baseReg, +offsetReg]  - ARM_ARM v7 DDI10406 pp. A8-156-7
- "	LDRH destReg, [baseReg, +offsetReg]
  	The contents of offsetReg are assumed to be correctly signed"
  	^self memM16xr: AL reg: destReg  base: baseReg p: 1 u: 1  w: 0 l: 1 rm: offsetReg!

Item was changed:
  ----- Method: CogARMCompiler>>mov:imm:ror: (in category 'ARM convenience instructions') -----
  mov: destReg imm: immediate8bitValue ror: rot
  	"Remember the ROR is doubled by the cpu so use 30>>1 etc.
+ 	MOV destReg, #immediate8BitValue ROR rot - ARM_ARM v7 DDI10406 pp. A8-194-5"
- 	MOV destReg, #immediate8BitValue ROR rot"
  	^self type: 1 op: MoveOpcode set: 0 rn: 0 rd: destReg shifterOperand: ((rot>>1) <<8 bitOr: immediate8bitValue)!

Item was changed:
  ----- Method: CogARMCompiler>>mov:rn: (in category 'ARM convenience instructions') -----
  mov: destReg rn: srcReg
+ "	MOV destReg, srcReg - ARM_ARM v7 DDI10406 pp. A8-196-7"
- "	MOV destReg, srcReg"
  
  	^self type: 0 op: MoveOpcode set: 0 rn: 0 rd: destReg shifterOperand: srcReg!

Item was changed:
  ----- Method: CogARMCompiler>>movs:rn: (in category 'ARM convenience instructions') -----
  movs: destReg rn: srcReg
+ "	MOVS destReg, srcReg - ARM_ARM v7 DDI10406 pp. A8-196-7"
- "	MOVS destReg, srcReg"
  
  	^self type: 0 op: MoveOpcode set: 1 rn: 0 rd: destReg shifterOperand: srcReg!

Item was changed:
  ----- Method: CogARMCompiler>>mvn:imm:ror: (in category 'ARM convenience instructions') -----
  mvn: destReg imm: immediate8bitValue ror: rot
  	"Remember the ROR is doubled by the cpu so use 30>>1 etc.
+ 	MVN destReg, #immediate8BitValue ROR rot - ARM_ARM v7 DDI10406 pp. A8-214-5"
- 	MVN destReg, #immediate8BitValue ROR rot"
  	^self type: 1 op: MoveNotOpcode set: 0 rn: 0 rd: destReg shifterOperand: ((rot>>1) <<8 bitOr: immediate8bitValue)!

Item was changed:
  ----- Method: CogARMCompiler>>orr:imm:ror: (in category 'ARM convenience instructions') -----
  orr: destReg imm: immediate8bitValue ror: rot
  	"Remember the ROR is doubled by the cpu so use 30>>1 etc.
+ 	ORR destReg, #immediate8BitValue ROR rot - ARM_ARM v7 DDI10406 pp. A8-228-9"
- 	ORR destReg, #immediate8BitValue ROR rot"
  	^self type: 1 op: OrOpcode set: 0 rn: destReg rd: destReg shifterOperand: ((rot>>1) <<8 bitOr: immediate8bitValue)!

Item was changed:
  ----- Method: CogARMCompiler>>pld:plus:offset: (in category 'encoding') -----
  pld: baseReg plus: u offset: immediate
+ 	"hint to memory that we will want to read from baseReg +/- imediate sometime soon
+ 	PLD baseReg, immediate  - ARM_ARM v7 DDI10406 pp. A8-236-7"
- 	"hint to memory that we will want to read from baseReg +/- imediate sometime soon"
  	<inline: true>
  	^ 2r11110101010100001111000000000000 bitOr: (baseReg<<16 bitOr:(u <<23 bitOr: immediate))!

Item was changed:
  ----- Method: CogARMCompiler>>popR: (in category 'ARM convenience instructions') -----
  popR: dstReg
  "	pop word off TOS
+ 	LDR srcReg, [sp] #4 - ARM_ARM v7 DDI10406 pp. A8-120-1"
- 	LDR srcReg, [sp] #4"
  	^self memMxr: AL reg: dstReg base: SP p: 0 u: 1 b: 0 w: 0 l: 1 imm: 4!

Item was changed:
  ----- Method: CogARMCompiler>>pushR: (in category 'ARM convenience instructions') -----
  pushR: srcReg
  "	push word to TOS 
+ 	STR srcReg, [sp, #-4]!! - ARM_ARM v7 DDI10406 pp. A8-382-3"
- 	STR srcReg, [sp, #-4]!!"
  	^self memMxr: AL reg: srcReg base: SP p: 1 u: 0 b: 0 w: 1l: 0 imm: 4!

Item was changed:
  ----- Method: CogARMCompiler>>stop (in category 'encoding') -----
  stop
+ "generate a BKPT ( - ARM_ARM v7 DDI10406 pp. A8-56) instruction. We could, given a good enough creative impulse and an over-active sense of humour, add some numerically encoded witticism to this instruction in bits 8-19 & 0-3. It has no effect on the execution but can be a way to specify which breakpoint has been hit etc."
- "generate a BKPT instruction. We could, given a good enough creative impulse and an over-active sense of humour, add some numerically encoded witticism to this instruction in bits 8-19 & 0-3. It has no effect on the execution but can be a way to specify which breakpoint has been hit etc."
  	<inline: true>
  	^AL << 28 bitOr: (16r42 << 20 bitOr: (7 << 4))!

Item was changed:
  ----- Method: CogARMCompiler>>str:rn:plus:imm: (in category 'ARM convenience instructions') -----
  str: destReg rn: baseReg plus: u imm: immediate12bitValue
+ "	STR destReg, [baseReg, 'u' immediate12bitValue] u=0 -> subtract imm; =1 -> add imm - ARM_ARM v7 DDI10406 pp. A8-382-3 "
- "	STR destReg, [baseReg, 'u' immediate12bitValue] u=0 -> subtract imm; =1 -> add imm "
  	^self memMxr: AL reg: destReg  base: baseReg u: u b: 0 l: 0 imm: immediate12bitValue!

Item was changed:
  ----- Method: CogARMCompiler>>str:rn:plusImm: (in category 'ARM convenience instructions') -----
  str: srcReg rn: baseReg plusImm: immediate12bitValue
+ "	STR srcReg, [baseReg, +immediate12bitValue] - ARM_ARM v7 DDI10406 pp. A8-382-3"
- "	STR srcReg, [baseReg, +immediate12bitValue]"
  	^self memMxr: AL reg: srcReg  base: baseReg u: 1 b: 0 l: 0 imm: immediate12bitValue!

Item was changed:
  ----- Method: CogARMCompiler>>str:rn:rm: (in category 'ARM convenience instructions') -----
  str: srcReg rn: baseReg rm: offsetReg
+ "	STR srcReg, [baseReg, + offsetReg]  - ARM_ARM v7 DDI10406 pp. A8-384-5
- "	STR srcReg, [baseReg, + offsetReg] 
  The contents of offsetReg are assumed to be correctly signed"
  	^self memMxr: AL reg: srcReg  base: baseReg p: 1 u: 1 b: 0 w: 0 l: 0 rm: offsetReg!

Item was changed:
  ----- Method: CogARMCompiler>>strb:rn:plus:imm: (in category 'ARM convenience instructions') -----
  strb: destReg rn: baseReg plus: u imm: immediate12bitValue
+ "	STRB destReg, [baseReg, 'u' immediate12bitValue] u=0 -> subtract imm; =1 -> add imm  - ARM_ARM v7 DDI10406 pp. A8-388-9"
- "	STRB destReg, [baseReg, 'u' immediate12bitValue] u=0 -> subtract imm; =1 -> add imm "
  	^self memMxr: AL reg: destReg  base: baseReg u: u b: 1 l: 0 imm: immediate12bitValue!

Item was changed:
  ----- Method: CogARMCompiler>>strb:rn:rm: (in category 'ARM convenience instructions') -----
  strb: srcReg rn: baseReg rm: offsetReg
+ "	STRB srcReg, [baseReg, + offsetReg]  - ARM_ARM v7 DDI10406 pp. A8-390-1
- "	STRB srcReg, [baseReg, + offsetReg] 
  	The contents of offsetReg are assumed to be correctly signed"
  	^self memMxr: AL reg: srcReg  base: baseReg p: 1 u: 1 b: 1 w: 0 l: 0 rm: offsetReg!

Item was changed:
  ----- Method: CogARMCompiler>>strh:rn:plus:imm: (in category 'ARM convenience instructions') -----
  strh: destReg rn: baseReg plus: u imm: immediate8bitValue
+ "	STRH destReg, [baseReg, 'u' immediate8bitValue] u=0 -> subtract imm; =1 -> add imm  - ARM_ARM v7 DDI10406 pp. A8-408-9"
- "	STRH destReg, [baseReg, 'u' immediate8bitValue] u=0 -> subtract imm; =1 -> add imm "
  	^self memM16xr: AL reg: destReg  base: baseReg p: 1 u: u  w: 0 l: 0 offset: immediate8bitValue!

Item was changed:
  ----- Method: CogARMCompiler>>strh:rn:rm: (in category 'ARM convenience instructions') -----
  strh: srcReg rn: baseReg rm: offsetReg
+ "	STRH srcReg, [baseReg, +offsetReg] - ARM_ARM v7 DDI10406 pp. A8-410-1"
- "	STRH srcReg, [baseReg, +offsetReg]"
  	^self memM16xr: AL reg: srcReg base: baseReg p: 1 u: 1 w: 0 l: 0 rm: offsetReg!

Item was changed:
  ----- Method: CogARMCompiler>>sub:rn:imm:ror: (in category 'ARM convenience instructions') -----
  sub: destReg rn: srcReg imm: immediate ror: rot
  "	Remember the ROR is doubled by the cpu so use 30>>1 etc
+ 	SUB destReg, srcReg, #immediate ROR rot - ARM_ARM v7 DDI10406 pp. A8-418-9"
- 	SUB destReg, srcReg, #immediate ROR rot"
  
  	^self type: 1 op: SubOpcode set: 0 rn: srcReg rd: destReg shifterOperand: ((rot>>1) <<8 bitOr: immediate)!

Item was changed:
  ----- Method: CogARMCompiler>>subs:rn:imm:ror: (in category 'ARM convenience instructions') -----
  subs: destReg rn: srcReg imm: immediate ror: rot
  "	Remember the ROR is doubled by the cpu so use 30>>1 etc
+ 	SUBS destReg, srcReg, #immediate ROR rot - ARM_ARM v7 DDI10406 pp. A8-418-9"
- 	SUBS destReg, srcReg, #immediate ROR rot"
  
  	^self type: 1 op: SubOpcode set: 1 rn: srcReg rd: destReg shifterOperand: ((rot>>1) <<8 bitOr: immediate)!

Item was changed:
  ----- Method: CogARMCompiler>>tst:rn:imm:ror: (in category 'ARM convenience instructions') -----
  tst: ignored rn: srcReg imm: immediate ror: rot
  "	Remember the ROR is doubled by the cpu so use 30>>1 etc"
  "also note that TST has no destReg
+ 	TST srcReg, #immediate ROR rot - ARM_ARM v7 DDI10406 pp. A8-452-3"
- 	TST srcReg, #immediate ROR rot"
  
  	^self type: 1 op: TstOpcode set: 1 rn: srcReg rd: 0 shifterOperand: ((rot>>1) <<8 bitOr: immediate)!



More information about the Vm-dev mailing list