[Vm-dev] VM Maker: Cog-tpr.153.mcz

commits at source.squeak.org commits at source.squeak.org
Fri May 16 17:37:58 UTC 2014


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

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

Name: Cog-tpr.153
Author: tpr
Time: 16 May 2014, 12:41:32.745 am
UUID: 520991ef-f9ae-420d-9dc1-28fff4c46d09
Ancestors: Cog-eem.152, Cog-tpr.149

Changes to GdbARMAlien to correct some off-by-gerbil errors, add new convenience instruction assembling, and fix exception trap handling.
Also add many test cases

=============== Diff against Cog-eem.152 ===============

Item was changed:
  ----- Method: CogProcessorAlien>>disassembleNextInstructionIn:for: (in category 'disassembly') -----
  disassembleNextInstructionIn: memory for: aSymbolManager "<Cogit|nil>"
  	| string |
  	string := self pc < memory size 
  				ifTrue: [(self primitiveDisassembleAt: self pc inMemory: memory) last.]
+ 				ifFalse: [^{'Invalid address ' . self pc. ')'}].
- 				ifFalse: ['Invalid address (', (self pc hex allButFirst: 3), ')'].
  	^aSymbolManager
  		ifNil: [string]
  		ifNotNil: [self decorateDisassembly: string for: aSymbolManager]!

Item was changed:
  ----- Method: CogProcessorAlien>>runInMemory:minimumAddress:readOnlyBelow: (in category 'execution') -----
  runInMemory: aMemory minimumAddress: minimumAddress readOnlyBelow: minimumWritableAddress
+ "Note that minimumWritableAddress is both the minimum writeable address AND the maximum executable address"
  	| result |
  	result := self primitiveRunInMemory: aMemory
  				minimumAddress: minimumAddress
  				readOnlyBelow: minimumWritableAddress.
  	result ~~ self ifTrue:
  		[self error: 'eek!!']!

Item was removed:
- ----- Method: GdbARMAlien>>branchAndLinkOpcodeWithOffset: (in category 'opcodes') -----
- branchAndLinkOpcodeWithOffset: aNumber
- 	
- 	| offset |
- 	offset := (aNumber - 8) asInteger.
- 	(offset between: -33554432 and: 33554428) ifFalse: [self error: 'The offset is to far. ARM does not support such far jumps.'].
- 	^ 16reb000000 bitOr: (offset >> 2 bitAnd: 16r00FFFFFF)
- !

Item was added:
+ ----- Method: GdbARMAlien>>byteSwappedNopOpcode (in category 'opcodes') -----
+ byteSwappedNopOpcode
+ 	"For the Tsts class which keeps filling BitMaps with nop, provide one swapped so it turns out correct when disassembled
+ 	mov r0, r0 swapped -> "
+ 	^ 16r00000A0E1!

Item was changed:
  ----- Method: GdbARMAlien>>cflag (in category 'accessing') -----
  cflag
+ "The ARM cpsr flags are kept as individual fields in the Alien structure. The address here is the 1-based byte offset into the ARMul_State structure"
+ 	^self unsignedLongAt: 573!
- 	^self unsignedLongAt: 577!

Item was changed:
  ----- Method: GdbARMAlien>>decorateDisassembly:for:fromAddress: (in category 'disassembly') -----
  decorateDisassembly: anInstructionString for: aSymbolManager "<Cogit>" fromAddress: address
+ 	(anInstructionString endsWith: 'mov	r0, r0')
- 	(anInstructionString endsWith: 'mov	r1, r1')
  		ifTrue: [^super decorateDisassembly: 'nop' for: aSymbolManager].
  	^super decorateDisassembly: anInstructionString for: aSymbolManager!

Item was added:
+ ----- Method: GdbARMAlien>>endCondition (in category 'accessing') -----
+ endCondition
+ "why did the simulator stop?"
+ 	^self unsignedLongAt: 5!

Item was added:
+ ----- Method: GdbARMAlien>>errorCode (in category 'accessing') -----
+ errorCode
+ "simulator error code"
+ 	^self unsignedLongAt: 9!

Item was added:
+ ----- Method: GdbARMAlien>>extractOffsetFromBL: (in category 'testing') -----
+ extractOffsetFromBL: instr
+ "we are told this is a BL <offset> instruction, so work out the offset it encodes"
+ 	| relativeJump |
+ 	relativeJump := instr bitAnd: 16r00FFFFFF.
+ 	relativeJump := (relativeJump bitAt: 24) = 1 
+ 						ifTrue: [((relativeJump bitOr: 16r3F000000) << 2) signedIntFromLong]
+ 						ifFalse: [relativeJump << 2].
+ 	^relativeJump!

Item was changed:
  ----- Method: GdbARMAlien>>handleCallFailureAt:in: (in category 'error handling') -----
  handleCallFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
  	"Convert an execution primitive failure for a call into a ProcessorSimulationTrap signal."
+ 	|  callAddress failedInstruction|
+ 	"grab the instruction at issue"
+ 	failedInstruction := memoryArray unsignedLongAt: pc + 1 bigEndian: false.
+ 	(self instructionIsBL: failedInstruction)
+ 		ifFalse:[self halt].
+ 	"short jump via BL, therefore we have a 24bit signed integer offset"
+ 	callAddress := (pc + 8 + (self extractOffsetFromBL: failedInstruction)).
+ 
- 	|  relativeJump callAddress |
- 	((memoryArray byteAt: pc + 4) bitAnd: 16rF) = 16rB "BL opcode"
- 		ifTrue: ["short jump via BL, therefore we have a 24bit signed integer offset"
- 			relativeJump := (memoryArray unsignedLongAt: pc + 1 bigEndian: false) bitAnd: 16r00FFFFFF.
- 			relativeJump := (relativeJump bitAt: 24) = 1 
- 									ifTrue: [((relativeJump bitOr: 16r3F000000) << 2) signedIntFromLong]
- 									ifFalse: [relativeJump << 2].
- 			callAddress := (pc + 8 + relativeJump)]
- 		
- 		ifFalse: ["long jump using RISCTempReg"
- 			"The memoryArray starts indexing from 1, whereas the pc is based on 0-indexing, therefore all access-offsets are one greater than expected"
- 			callAddress := (memoryArray byteAt: pc + 4) 
- 								+ ((memoryArray byteAt: pc - 4) << 24) 
- 								+ ((memoryArray byteAt: pc - 8) << 16) 
- 								+ ((memoryArray byteAt: pc - 12) << 8)].
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + 4
  			address: callAddress signedIntToLong
  			type: #call)
  		signal!

Item was changed:
  ----- Method: GdbARMAlien>>handleExecutionPrimitiveFailureAt:in: (in category 'error handling') -----
  handleExecutionPrimitiveFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
+ 	"Handle an execution primitive failure for an otherwise unhandled opcode."
- 	"Handle an execution primitive failure for an unhandled opcode."
  	^self reportPrimitiveFailure!

Item was changed:
  ----- Method: GdbARMAlien>>handleExecutionPrimitiveFailureIn:minimumAddress: (in category 'error handling') -----
  handleExecutionPrimitiveFailureIn: memoryArray "<Bitmap|ByteArray>" minimumAddress: minimumAddress "<Integer>"
  	"Handle an execution primitive failure.  Convert out-of-range call and absolute
  	 memory read into register instructions into ProcessorSimulationTrap signals."
  	"self printRegistersOn: Transcript"
  	| pc |
+ 	self endCondition = 5 ifTrue:[self pc: self priorPc].
  	((pc := self pc) between: minimumAddress and: memoryArray byteSize - 1) ifTrue:
  		[(self instructionTypeAt: pc in: memoryArray)
  			caseOf: {
  				[#Call] 			-> [^self handleCallFailureAt: pc in: memoryArray].
+ 				[#LongCall] 	-> [^self handleLongCallFailureAt: pc in: memoryArray].
  				[#Jump] 		-> [^self handleJmpFailureAt: pc in: memoryArray].
+ 				[#LongJump] 	-> [^self handleLongJmpFailureAt: pc in: memoryArray].
  				[#MoveAwR]	-> [^self handleMoveAwRFailureAt: pc in: memoryArray].
  				[#MoveMbrR]	-> [^self handleMoveMbrRFailureAt: pc in: memoryArray].
  				[#MoveRAw]	-> [^self handleMoveRAwFailureAt: pc in: memoryArray].
  				[#MoveRMbr]	-> [^self handleMoveRMbrFailureAt: pc in: memoryArray].
  				[#Ret]			-> [^self handleRetFailureAt: pc in: memoryArray].} 
  			otherwise: [^self handleExecutionPrimitiveFailureAt: pc in: memoryArray]].
  	((pc := self lr - 4) between: minimumAddress and: memoryArray byteSize - 1) ifTrue:
  		[(self instructionTypeAt: pc in: memoryArray)
  			caseOf: {
  				[#Call] 		-> [^self handleCallFailureAt: pc in: memoryArray].
+ 				[#LongCall] -> [^self handleLongCallFailureAt: pc in: memoryArray].
  				[#Jump] 	-> [^self handleJmpFailureAt: pc in: memoryArray].
+ 				[#LongJump] 	-> [^self handleLongJmpFailureAt: pc in: memoryArray].
  				[#Ret]		-> [^self handleRetFailureAt: pc in: memoryArray].} 
  			otherwise: [^self handleExecutionPrimitiveFailureAt: pc in: memoryArray]].
  	^self reportPrimitiveFailure!

Item was changed:
  ----- Method: GdbARMAlien>>handleJmpFailureAt:in: (in category 'error handling') -----
  handleJmpFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
+ 	"Convert an execution primitive failure for a jump into a ProcessorSimulationTrap signal."
+ 	|  callAddress failedInstruction|
+ 	"grab the instruction at issue"
+ 	failedInstruction := memoryArray unsignedLongAt: pc + 1 bigEndian: false.
+ 	(self instructionIsB: failedInstruction)
+ 		ifFalse:[self halt].
+ 	"short jump via B, therefore we have a 24bit signed integer offset"
+ 	callAddress := (pc + 8 + (self extractOffsetFromBL: failedInstruction)).
+ 
- 	"Convert an execution primitive failure for a jmp into a ProcessorSimulationTrap signal."
- 	|  relativeJump |
- 	self halt.
- 	relativeJump := memoryArray longAt: pc + 2 bigEndian: false.
  	^(ProcessorSimulationTrap
  			pc: pc
+ 			nextpc: pc + 4
+ 			address: callAddress signedIntToLong
- 			nextpc: pc + 5
- 			address: (pc + 5 + relativeJump) signedIntToLong
  			type: #jump)
  		signal!

Item was added:
+ ----- Method: GdbARMAlien>>handleLongCallFailureAt:in: (in category 'error handling') -----
+ handleLongCallFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
+ 	"Convert an execution primitive failure for a long call into a ProcessorSimulationTrap signal."
+ 	|  callAddress failedInstruction|
+ 	"grab the instruction at issue"
+ 	failedInstruction := memoryArray unsignedLongAt: pc + 1 bigEndian: false.
+ 	"Hmm. Perhaps we ought to test for an actual BLX here rather than assuming?"
+ 	(self instructionIsBLX: failedInstruction)
+ 				ifFalse:[ self halt: 'failed call type test'].
+ 	"The memoryArray starts indexing from 1, whereas the pc is based on 0-indexing, therefore all access-offsets are one greater than expected" 
+ 	"address, combined from prior four MOV/ORR instructions. See CogARMCompiler>concretizeLongCall"
+ 	callAddress := (memoryArray byteAt: pc -3) 
+ 						+ ((memoryArray byteAt: pc - 7) << 8) 
+ 						+ ((memoryArray byteAt: pc - 11) << 16) 
+ 						+ ((memoryArray byteAt: pc - 15) << 24).
+ 	^(ProcessorSimulationTrap
+ 			pc: pc
+ 			nextpc: pc + 4
+ 			address: callAddress signedIntToLong
+ 			type: #call)
+ 		signal!

Item was added:
+ ----- Method: GdbARMAlien>>handleLongJmpFailureAt:in: (in category 'error handling') -----
+ handleLongJmpFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
+ 	"Convert an execution primitive failure for a long jump into a ProcessorSimulationTrap signal."
+ 	|  callAddress failedInstruction|
+ 	"grab the instruction at issue"
+ 	failedInstruction := memoryArray unsignedLongAt: pc + 1 bigEndian: false.
+ 	"Hmm. Perhaps we ought to test for an actual BX here rather than assuming?"
+ 	(self instructionIsBX: failedInstruction)
+ 				ifFalse:[ self halt: 'failed call type test'].
+ 	"The memoryArray starts indexing from 1, whereas the pc is based on 0-indexing, therefore all access-offsets are one greater than expected" 
+ 	"address, combined from prior four MOV/ORR instructions. See CogARMCompiler>concretizeLongCall"
+ 	callAddress := (memoryArray byteAt: pc -3) 
+ 						+ ((memoryArray byteAt: pc - 7) << 8) 
+ 						+ ((memoryArray byteAt: pc - 11) << 16) 
+ 						+ ((memoryArray byteAt: pc - 15) << 248).
+ 	^(ProcessorSimulationTrap
+ 			pc: pc
+ 			nextpc: pc + 4
+ 			address: callAddress signedIntToLong
+ 			type: #jump)
+ 		signal!

Item was changed:
  ----- Method: GdbARMAlien>>handleMoveAwRFailureAt:in: (in category 'error handling') -----
  handleMoveAwRFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
  	"Convert an execution primitive failure for a register load from an Address into a ProcessorSimulationTrap signal."
+ 	((memoryArray byteAt: pc + 4) = 16rE5  "test for 0xE59X as the most significant two bytes - X being the index of the RISCTempReg (or 0xA in current code).
+ 		LDR Rx, [RiscTempReg, #0]"
+ 		and: [(memoryArray byteAt: pc + 3) = (16r90 + CogARMCompiler ARMTempReg)])
- 	((memoryArray byteAt: pc + 4) = 16rE5  "test for E593 as the most significant two bytes"
- 		and: [(memoryArray byteAt: pc + 3) = (16r90 + (CogARMCompiler classPool at: #RISCTempReg))])
  		ifTrue:
  			[(ProcessorSimulationTrap
  					pc: pc
  					nextpc: pc + 4 
+ 					address: (memoryArray byteAt: pc -3) "address, combined from prior four MOV/ORR instructions. See CogARMCompiler>concretizeMoveAwR"
+ 								+ ((memoryArray byteAt: pc - 7) << 8) 
+ 								+ ((memoryArray byteAt: pc - 11) << 16) 
+ 								+ ((memoryArray byteAt: pc - 15) << 24)
- 					address: (memoryArray byteAt: pc + 1) "address, combined from four instructions"
- 								+ ((memoryArray byteAt: pc - 3) << 24) 
- 								+ ((memoryArray byteAt: pc - 7) << 16) 
- 								+ ((memoryArray byteAt: pc - 11) << 8)
  					type: #read
+ 					accessor: (self registerStateSetters at: ("destination register" (memoryArray byteAt: pc + 2) >> 4) + 1))
- 					accessor: (self registerStateSetters at: ((memoryArray byteAt: pc + 2) >> 4) + 1))
  				signal]
  		ifFalse:
  			[self reportPrimitiveFailure]!

Item was changed:
  ----- Method: GdbARMAlien>>handleMoveRAwFailureAt:in: (in category 'error handling') -----
  handleMoveRAwFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
  	"Convert an execution primitive failure for a register write into Memory at a predefined address into a ProcessorSimulationTrap signal."
  	^((memoryArray byteAt: pc + 4) = 16rE5 
+ 		and: [(memoryArray byteAt: pc + 3) = (16r80 + CogARMCompiler ARMTempReg)])
- 		and: [(memoryArray byteAt: pc + 3) = (16r80 + (CogARMCompiler classPool at: #RISCTempReg))])
  		ifTrue:
  			[(ProcessorSimulationTrap
  					pc: pc
  					nextpc: pc + 4
+ 					address: (memoryArray byteAt: pc -3) 
+ 								+ ((memoryArray byteAt: pc - 7) << 8) 
+ 								+ ((memoryArray byteAt: pc - 11) << 16) 
+ 								+ ((memoryArray byteAt: pc - 15) <<24)
- 					address: (memoryArray byteAt: pc + 1) 
- 								+ ((memoryArray byteAt: pc - 3) << 24) 
- 								+ ((memoryArray byteAt: pc - 7) << 16) 
- 								+ ((memoryArray byteAt: pc - 11) << 8)
  					type: #write
  					accessor: (self registerStateNames at: ((memoryArray byteAt: pc + 2) >> 4) + 1))
  				signal]
  		ifFalse:
  			[self reportPrimitiveFailure]!

Item was changed:
  ----- Method: GdbARMAlien>>ifflags (in category 'accessing') -----
  ifflags
+ "The ARM cpsr flags are kept as individual fields in the Alien structure. The address here is the 1-based byte offset into the ARMul_State structure"
+ 	^self unsignedLongAt: 581!
- 	^self unsignedLongAt: 585!

Item was added:
+ ----- Method: GdbARMAlien>>instructionIsB: (in category 'testing') -----
+ instructionIsB: instr
+ "is this a B <offset> instruction?"
+ 	^instr >> 28 < 16rF "test for allowed condcode - 0xF is extension" and: [(instr bitAnd: (16rF<<24)) = (16rA<<24)]!

Item was added:
+ ----- Method: GdbARMAlien>>instructionIsBL: (in category 'testing') -----
+ instructionIsBL: instr
+ "is this a BL <offset> instruction?"
+ 	^instr >> 28 < 16rF "test for allowed condcode - 0xF is extension" and: [(instr bitAnd: (16rF<<24)) = (16rB<<24)]!

Item was added:
+ ----- Method: GdbARMAlien>>instructionIsBLX: (in category 'testing') -----
+ instructionIsBLX: instr
+ "is this a BLX <targetReg> instruction?"
+ 	^instr >> 28 < 16rF "test for allowed condcode - 0xF is extension" and: [(instr bitAnd: 16r0FFFFFF0) = 16r12FFF30]!

Item was added:
+ ----- Method: GdbARMAlien>>instructionIsBX: (in category 'testing') -----
+ instructionIsBX: instr
+ "is this a BX <targetReg> instruction?"
+ 	^instr >> 28 < 16rF "test for allowed condcode - 0xF is extension" and: [(instr bitAnd: 16r0FFFFFF0) = 16r12FFF10]!

Item was added:
+ ----- Method: GdbARMAlien>>instructionIsLDR:byReg: (in category 'testing') -----
+ instructionIsLDR: instr byReg: rn
+ "is this a LDR r1, [r2, rn] instruction? Special case to detect MoveAwR case"
+ 	| foo |
+ 	^instr >> 28 < 16rF "test for allowed condcode - 0xF is extension" and: [foo := (instr >> 20 bitAnd: 16rFF). foo = 16r59  and:[(instr >>16 bitAnd: 16rF) = rn]]!

Item was added:
+ ----- Method: GdbARMAlien>>instructionIsLDRB: (in category 'testing') -----
+ instructionIsLDRB: instr
+ "is this a LDRB instruction?"
+ 	| foo |
+ 	^instr >> 28 < 16rF "test for allowed condcode - 0xF is extension" 
+ 		and: [foo := (instr >> 20 bitAnd: 16rFF).
+ 			foo = 16r55 "ldrb r1, [r2, #imm]"
+ 				or:[foo = 16r5D "ldrb r1, [r2, #-imm]"
+ 				or:[foo = 16r7D "ldrb r1, [r2, r3]"]]]!

Item was added:
+ ----- Method: GdbARMAlien>>instructionIsSTR: (in category 'testing') -----
+ instructionIsSTR: instr
+ "is this a STR instruction?"
+ 	| foo |
+ 	^instr >> 28 < 16rF "test for allowed condcode - 0xF is extension" and: [foo := (instr >> 20 bitAnd: 16rFF). foo = 16r58 "str r1, [r2, #imm]" or:[foo = 16r50 "str r1, [r2, #-imm]" or:[foo = 16r78 "str r1, [r2, r3]"]]]!

Item was added:
+ ----- Method: GdbARMAlien>>instructionIsSTR:byReg: (in category 'testing') -----
+ instructionIsSTR: instr byReg: rn
+ "is this a STR r1, [r2, rn] instruction? Special case to detect MoveRAw case"
+ 	| foo |
+ 	^instr >> 28 < 16rF "test for allowed condcode - 0xF is extension" and: [foo := (instr >> 20 bitAnd: 16rFF). foo = 16r58  and:[(instr >>16 bitAnd: 16rF) = rn]]!

Item was added:
+ ----- Method: GdbARMAlien>>instructionIsSTRB: (in category 'testing') -----
+ instructionIsSTRB: instr
+ "is this a STRB instruction?"
+ 	| foo |
+ 	^instr >> 28 < 16rF "test for allowed condcode - 0xF is extension" and: [foo := (instr >> 20 bitAnd: 16rFF). foo = 16r54 "strb r1, [r2, #imm]" or:[foo = 16r5c "strb r1, [r2, #-imm]" or:[foo = 16r7c "strb r1, [r2, r3]"]]]!

Item was changed:
  ----- Method: GdbARMAlien>>instructionTypeAt:in: (in category 'error handling') -----
  instructionTypeAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
+ 	"Identify which type of instruction is at pc in memoryArray. For the time being, only those instructions needed for PrimitiveFailure are identified."
- 	"Identify which type of instruction is at pc in memoryArray. For the time beeing, only those instructions needed for PrimitiveFailure are identified."
  	| RISCTempReg lastInstruction typeOperandStatus |
+ 	RISCTempReg := CogARMCompiler ARMTempReg.
+ 	lastInstruction := memoryArray unsignedLongAt:  pc + 1 bigEndian: false .
+ 	"self disassembleFrom: pc - 16 to: pc + 11 in: memoryArray on: Transcript cr"
- 	RISCTempReg := CogARMCompiler classPool at: #RISCTempReg.
- 	lastInstruction := memoryArray unsignedLongAt: pc + 1 bigEndian: false.
- 	"self disassembleFrom: pc - 16 to: pc + 3 in: memoryArray on: Transcript cr"
  	
  	"Ret"
+ 	lastInstruction = self popPcOpcode ifTrue: [#Ret].
- 	lastInstruction = 16rE8BD8000 ifTrue: [#Ret].
  
  	"Call"
+ 	(self instructionIsBL: lastInstruction) ifTrue: [^#Call].
+ 	"long call"
+ 	(self instructionIsBLX: lastInstruction) ifTrue: [^#LongCall].
- 	(((memoryArray byteAt: pc + 4) bitAnd: 16rF) = 16rB "BL opcode"
- 		or: [(memoryArray unsignedLongAt: pc - 3 bigEndian: false) = 16rE1A0E00F]) ifTrue: [^#Call].
  	
+ 	
  	"Jump"
+ 	(self instructionIsB: lastInstruction) ifTrue: [^#Jump].
+ 	"long Jump"
+ 	(self instructionIsBX: lastInstruction) ifTrue: [^#LongJump].
- 	((memoryArray byteAt: pc + 3) >> 4 = 16rA "B opcode, for short jumps"
- 		or: [(lastInstruction >> 12 bitAnd: 16r0FFFF) = 
- 				(16r0280F + (RISCTempReg << 4)) 	"ADD? PC, RISCTempReg, #anything, for JumpLong-Instructions"])
- 		ifTrue: [^#Jump].
  		
  	typeOperandStatus := lastInstruction >> 20 bitAnd: 16rFF.
  	"MoveRMbr"
+ 	(self instructionIsSTRB: lastInstruction) ifTrue: [^#MoveRMbr].
- 	(typeOperandStatus = 16r54 or: [typeOperandStatus = 16r5C] or: [typeOperandStatus = 16r7C])
- 		ifTrue: [^#MoveRMbr].
  		
  	"MoveRAw"
+ 	(self instructionIsSTR: lastInstruction byReg: RISCTempReg) ifTrue: [^#MoveRAw].
- 	(typeOperandStatus = 16r58 and: [(lastInstruction >> 16 bitAnd: 16rF) = RISCTempReg])
- 		ifTrue: [^#MoveRAw].
  		
  	"MoveMbrR"
+ 	(self instructionIsLDRB: lastInstruction) ifTrue: [^#MoveMbrR].
- 	(typeOperandStatus = 16r55 or: [typeOperandStatus = 16r5D] or: [typeOperandStatus = 16r7D])
- 		ifTrue: [^#MoveMbrR].
  		
  	"MoveAwR"
+ 	(self instructionIsLDR: lastInstruction byReg: RISCTempReg) ifTrue: [^#MoveAwR].
- 	((typeOperandStatus = 16r59) and: [(lastInstruction >> 16 bitAnd: 16rF) = RISCTempReg])
- 		ifTrue: [^#MoveAwR].
  	
  	
  	^#UnidentifiedInstruction!

Item was changed:
  ----- Method: GdbARMAlien>>nflag (in category 'accessing') -----
  nflag
+ "The ARM cpsr flags are kept as individual fields in the Alien structure. The address here is the 1-based byte offset into the ARMul_State structure"
+ 	^self unsignedLongAt: 565!
- 	^self unsignedLongAt: 569!

Item was added:
+ ----- Method: GdbARMAlien>>popPcOpcode (in category 'opcodes') -----
+ popPcOpcode
+ "See also CogARMCompiler>concretizePopR"
+ 	^16rE49DF004!

Item was added:
+ ----- Method: GdbARMAlien>>postTrapCorrectedPC (in category 'accessing') -----
+ postTrapCorrectedPC
+ 	"return the pc - 8 for trap handling - remember the ARM alwayshas that funky +8 offset vs the actual instruction running/failig"
+ 	^self pc -8!

Item was changed:
  ----- Method: GdbARMAlien>>primitiveRunInMemory:minimumAddress:readOnlyBelow: (in category 'primitives') -----
  primitiveRunInMemory: memoryArray "<Bitmap|ByteArray>" minimumAddress: minimumAddress "<Integer>" readOnlyBelow: minimumWritableAddress "<Integer>"
  	"Run the receiver using the argument as the store.  Origin the argument at 0. i.e. the first byte of the
  	 memoryArray is address 0.  Make addresses below minimumAddress illegal.  Convert out-of-range
+ 	 calls, jumps and memory read/writes into ProcessorSimulationTrap signals.
+ 	Note that minWriteMaxExecAddress is both the minimum writeable address AND the maximum executable address"
- 	 calls, jumps and memory read/writes into ProcessorSimulationTrap signals."
  	<primitive: 'primitiveRunInMemoryMinimumAddressReadWrite' module: 'GdbARMPlugin' error: ec>
  	^ec == #'inappropriate operation'
  		ifTrue: [self handleExecutionPrimitiveFailureIn: memoryArray
  					minimumAddress: minimumAddress]
  		ifFalse: [self reportPrimitiveFailure]
  
  	"self printRegistersOn: Transcript"!

Item was added:
+ ----- Method: GdbARMAlien>>priorPc (in category 'accessing') -----
+ priorPc
+ "where did the simulator stop just before a prefetch abort?"
+ 	^self unsignedLongAt: 609!

Item was added:
+ ----- Method: GdbARMAlien>>rawCPSR (in category 'accessing') -----
+ rawCPSR
+ "The ARM cpsr flags are kept as individual fields in the Alien structure. The address here is the 1-based byte offset into the ARMul_State structure"
+ "read the raw value of the cpsr from the alien structure"
+ 	^self unsignedLongAt: 533!

Item was changed:
  ----- Method: GdbARMAlien>>registerStateSetters (in category 'accessing-abstract') -----
  registerStateSetters
+ "a list of register setting messages used to initialise or reset registers"
  	^#(	r0: r1: r2: r3: r4: r5: r6: r7: r8: r9: r10: fp: r12: sp: lr: pc:)!

Item was changed:
  ----- Method: GdbARMAlien>>sflag (in category 'accessing') -----
  sflag
+ "The ARM cpsr flags are kept as individual fields in the Alien structure. The address here is the 1-based byte offset into the ARMul_State structure"
+ 	^self unsignedLongAt: 585!
- 	^self unsignedLongAt: 589!

Item was added:
+ ----- Method: GdbARMAlien>>tflag (in category 'accessing') -----
+ tflag
+ "The ARM cpsr flags are kept as individual fields in the Alien structure. The address here is the 1-based byte offset into the ARMul_State structure"
+ "This would be the Thumb flag if we have it -which depends rather oddly on the compiletime flags used to build the ARMulator. Sigh"
+ 	^self unsignedLongAt: 589!

Item was changed:
  ----- Method: GdbARMAlien>>vflag (in category 'accessing') -----
  vflag
+ "The ARM cpsr flags are kept as individual fields in the Alien structure. The address here is the 1-based byte offset into the ARMul_State structure"
+ 	^self unsignedLongAt: 577!
- 	^self unsignedLongAt: 581!

Item was changed:
  ----- Method: GdbARMAlien>>zflag (in category 'accessing') -----
  zflag
+ "The ARM cpsr flags are kept as individual fields in the Alien structure. The address here is the 1-based byte offset into the ARMul_State structure"
+ 	^self unsignedLongAt: 569!
- 	^self unsignedLongAt: 573!

Item was added:
+ ----- Method: GdbARMAlienTests>>memory (in category 'accessing') -----
+ memory 
+ "build a memory for this test; a ByteArray of 1024 bytes, filled with NOPs"
+ 	| mem |
+ 	mem := ByteArray new: 1024.
+ 	1 to: 1024  by: 4do:[:i|
+ 		mem unsignedLongAt: i put: 16rE1A00000 bigEndian: false].
+ 	^mem!

Item was added:
+ ----- Method: GdbARMAlienTests>>testCall (in category 'tests') -----
+ testCall
+ 	"Call a function that is in-range."
+ 	
+ 	"self new testCall"
+ 	| memory |
+ 	memory := self memory.
+ 	self processor reset.
+ 
+ 	memory unsignedLongAt: 5 put: (CogARMCompiler new mov: 10 imm: 0 ror: 0)  bigEndian: false. 
+ 	memory unsignedLongAt: 9 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 13 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false. 
+ 	memory unsignedLongAt: 17 put: (CogARMCompiler new orr: 10 imm: 40 ror: 0) bigEndian: false. 
+ 
+ 	memory unsignedLongAt: 21 put: (CogARMCompiler new bl: 12) bigEndian: false.
+ 
+ 	memory unsignedLongAt: 25 put: (CogARMCompiler new mov:5imm: 99 ror:0 ) bigEndian: false.
+ 	memory unsignedLongAt: 41 put: (CogARMCompiler new mov: 4 imm: 42 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 45 put: (CogARMCompiler new bx: 14) bigEndian: false.
+ 	
+ 	"processor disassembleFrom: 0 to: 60 in: memory on: Transcript cr"
+ 	self processor
+ 			pc: 4;
+ 			sp: (memory size - 4); "Room for return address"
+ 			singleStepIn: memory.
+ 			"We have to step several times, because the first step only changes the pc, but does not fetch anything from the address it points to."
+ 	self processor singleStepIn: memory.
+ 	self processor singleStepIn: memory.
+ 	self processor singleStepIn: memory.
+ 	self assert: processor pc = 16r14.
+ 	self processor singleStepIn: memory.
+ 	self assert: processor pc = 16r28 "check the call".
+ 	self processor singleStepIn: memory.
+ 	self assert: processor r4 = 42.
+ 	self processor singleStepIn: memory.
+ 	self processor singleStepIn: memory.
+ 
+ 	self assert: self processor pc = 16r1C.
+ 	self assert: self processor lr = 16r18.
+ 	self assert: self processor r5 = 99
+ !

Item was changed:
  ----- Method: GdbARMAlienTests>>testCallTrap (in category 'tests') -----
  testCallTrap
  	"Call a function that is out-of-range.  Ensure the call is trapped."
  	"self new testCallTrap"
  	| memory |
+ 	memory := self memory.
+ 	memory unsignedLongAt: 5 put: (CogARMCompiler new bl: 1020) bigEndian: false.
+ 	"Can't do this diassemble until after the #asByteArray - "
+ 	"processor disassembleFrom: 0 to:16 in: memory on: Transcript cr"
- 	memory := Bitmap new: 256 withAll: self processor nopOpcode.
- 	memory longAt: 5 put: (self processor branchAndLinkOpcodeWithOffset: 1020) bigEndian: false.
- 	memory := memory asByteArray.
  	self processor
  			pc: 4;
  			sp: (memory size - 4); "Room for return address"
  			singleStepIn: memory.
  			"We have to step twice, because the first step only changes the pc, but does not fetch anything from the address it points to."
  	self should: [self processor singleStepIn: memory]
  		raise: ProcessorSimulationTrap
  		withExceptionDo:
  			[:pst|
+ 			self assert: self processor pc = 4.
- 			self assert: self processor pc = 1024.
  			self assert: self processor lr = 8.
  			self assert: pst pc = 4.
  			self assert: pst nextpc = 8.
+ 			self assert: pst address = 1032.
- 			self assert: pst address = 1024.
  			self assert: pst type = #call].!

Item was added:
+ ----- Method: GdbARMAlienTests>>testCallTrap2 (in category 'tests') -----
+ testCallTrap2
+ 	"Call a function that is out-of-range.  Ensure the call is trapped
+ 	This version calls well outside the memory array."
+ 	"self new testCallTrap2"
+ 	| memory |
+ 	memory := self memory.
+ 	memory unsignedLongAt: 5 put: (CogARMCompiler new bl: 16rFF00) bigEndian: false.
+ 	"Can't do this diassemble until after the #asByteArray - "
+ 	"processor disassembleFrom: 0 to:16 in: memory on: Transcript cr"
+ 	self processor
+ 			pc: 4;
+ 			sp: (memory size - 4); "Room for return address"
+ 			singleStepIn: memory.
+ 			"We have to step twice, because the first step only changes the pc, but does not fetch anything from the address it points to."
+ 	self should: [self processor singleStepIn: memory]
+ 		raise: ProcessorSimulationTrap
+ 		withExceptionDo:
+ 			[:pst|
+ 			self assert: self processor pc = 16r4.
+ 			self assert: self processor lr = 8.
+ 			self assert: pst pc = 4.
+ 			self assert: pst nextpc = 8.
+ 			self assert: pst address  = 16rFF0C.
+ 			self assert: pst type = #call].!

Item was added:
+ ----- Method: GdbARMAlienTests>>testCallTrap3 (in category 'tests') -----
+ testCallTrap3
+ 	"Call a function that is out-of-range.  Ensure the call is trapped
+ 	This version calls well outside the memory array negatively"
+ 	"self new testCallTrap3"
+ 	| memory |
+ 	memory := self memory.
+ 	memory unsignedLongAt: 5 put: (CogARMCompiler new bl: -16rFF00) bigEndian: false.
+ 	"Can't do this diassemble until after the #asByteArray - "
+ 	"processor disassembleFrom: 0 to:16 in: memory on: Transcript cr"
+ 	self processor
+ 			pc: 4;
+ 			sp: (memory size - 4); "Room for return address"
+ 			singleStepIn: memory.
+ 			"We have to step twice, because the first step only changes the pc, but does not fetch anything from the address it points to."
+ 	self should: [self processor singleStepIn: memory]
+ 		raise: ProcessorSimulationTrap
+ 		withExceptionDo:
+ 			[:pst|
+ 			self assert: self processor pc = 16r4.
+ 			self assert: self processor lr = 8.
+ 			self assert: pst pc = 4.
+ 			self assert: pst nextpc = 8.
+ 			self assert: pst address  = 16rFFFF010C.
+ 			self assert: pst type = #call].!

Item was changed:
  ----- Method: GdbARMAlienTests>>testDisassembling (in category 'tests') -----
  testDisassembling
+ 	"self new testDisassembling"
  
  	| memory result |
  	memory := WordArray new: 2.
+ 	memory at: 1 put: 3800756324.
- 	memory at: 1 put: 16rEF200000.
  	result := self processor
  		disassembleInstructionAt: 0 
  		In: memory 
  		into: [:str :len | 
  			self 
  				assert: len = 4;
+ 				assert: str = '00000000: add	pc, sl, #100	; 0x64'].!
- 				assert: str = '0x00000000: svc	0x00200000'].!

Item was changed:
  ----- Method: GdbARMAlienTests>>testExecutionTrap (in category 'tests') -----
  testExecutionTrap
  	"Execute a run of nops.  test executing beyond the executable limit is trapped."
  	"self new testExecutionTrap"
  	| memory |
+ 	 "Run through NOPs until we hit the limit set by readOnlyBelow: "
- 	 "The address is out of range of memory every which way (whether relative or absolute and whether big-endian or little."
  	memory := (Bitmap new: 1024 * 2 withAll: self processor nopOpcode) asByteArray.
  	self processor
  			pc: 0;
  			sp: (memory size - 4). "Room for return address"
  	self should: [self processor runInMemory: memory minimumAddress: 0 readOnlyBelow: memory size / 2]
  		raise: Error
  		withExceptionDo:
  			[:err|
+ 			self assert: self processor pc = (memory size / 2-4).
- 			self assert: self processor pc = (memory size / 2).
  			self assert: ('Error 0: Illegal Instruction fetch address (0x1000).' match: err messageText)].
+ 	self processor reset;  pc: 0.
- 	self processor pc: 0.
  	self should: [[self processor singleStepIn: memory minimumAddress: 0 readOnlyBelow: memory size / 2] repeat]
  		raise: Error
  		withExceptionDo:
  			[:err|
+ 			self assert: self processor pc = (memory size / 2- 4).
- 			self assert: self processor pc = (memory size / 2).
  			self assert: ('Error 0: Illegal Instruction fetch address (0x1000).' match: err messageText)]!

Item was changed:
  ----- Method: GdbARMAlienTests>>testFlags (in category 'tests') -----
  testFlags
+ "test the processor flag state reading and setting"
  	"self new testFlags"
  	| memory |
+ 	memory := Bitmap new: 5.
+ 	self processor reset.
- 	memory := Bitmap new: 3.
  	memory longAt: 1 put: 16rE3A03001 bigEndian: false. "MOV r3, #1"
  	memory longAt: 5 put: 16rE3530001 bigEndian: false. "CMP r3, #1"
+ 	memory longAt: 9 put: 16r13A00003 bigEndian: false. "MOVNE r0, #3"
+ 	memory longAt: 13 put: 16r03A00005 bigEndian: false. "MOVEQ r0, #5"
  	memory := memory asByteArray.
  	self processor
  		disassembleInstructionAt: 0 
  		In: memory 
  		into: [:str :len | 
  			self 
  				assert: len = 4;
+ 				assert: str equals: '00000000: mov	r3, #1'].
- 				assert: str equals: '0x00000000: mov	r3, #1'].
  	self processor
  		disassembleInstructionAt: 4 
  		In: memory 
  		into: [:str :len | 
  			self 
  				assert: len = 4;
+ 				assert: str equals: '00000004: cmp	r3, #1'].
- 				assert: str equals: '0x00000004: cmp	r3, #1'].
  	self processor
+ 		disassembleInstructionAt: 8 
+ 		In: memory 
+ 		into: [:str :len | 
+ 			self 
+ 				assert: len = 4;
+ 				assert: str equals: '00000008: movne	r0, #3'].
+ 	self processor
+ 		disassembleInstructionAt: 12 
+ 		In: memory 
+ 		into: [:str :len | 
+ 			self 
+ 				assert: len = 4;
+ 				assert: str equals: '0000000c: moveq	r0, #5'].
+ 	self processor
  		pc: 0;
  		singleStepIn: memory;
+ 		singleStepIn: memory;
+ 		singleStepIn: memory;
+ 		assert: self processor r0 = 0;
  		singleStepIn: memory.
  	self 
+ 		assert: self processor pc = 16;
- 		assert: self processor pc = 16r8;
  		assert: self processor r3 = 1;
+ 		assert: self processor r0 = 5;
  		assert: self processor zflag = 1;
  		assert: self processor cflag = 1;
  		assert: self processor vflag = 0;
  		assert: self processor nflag = 0.
  	self processor reset.
  	self assert: self processor eflags = 3. "IFFlags are both set."!

Item was added:
+ ----- Method: GdbARMAlienTests>>testJump (in category 'tests') -----
+ testJump
+ 	"Jump in-range."
+ 	
+ 	"self new testJump"
+ 	| memory |
+ 	memory := self memory.
+ 	self processor reset.
+ 
+ 	memory unsignedLongAt: 5 put: (CogARMCompiler new mov: 10 imm: 0 ror: 0)  bigEndian: false. 
+ 	memory unsignedLongAt: 9 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 13 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false. 
+ 	memory unsignedLongAt: 17 put: (CogARMCompiler new orr: 10 imm: 40 ror: 0) bigEndian: false. 
+ 
+ 	memory unsignedLongAt: 21 put: (CogARMCompiler new b: 12) bigEndian: false.
+ 
+ 	memory unsignedLongAt: 25 put: (CogARMCompiler new mov:5imm: 99 ror:0 ) bigEndian: false.
+ 	memory unsignedLongAt: 41 put: (CogARMCompiler new mov: 4 imm: 42 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 45 put: (CogARMCompiler new bx: 14) bigEndian: false.
+ 	
+ 	"processor disassembleFrom: 0 to: 60 in: memory on: Transcript cr"
+ 	self processor
+ 			pc: 4;
+ 			sp: (memory size - 4); "Room for return address"
+ 			singleStepIn: memory.
+ 			"We have to step several times, because the first step only changes the pc, but does not fetch anything from the address it points to."
+ 	self processor singleStepIn: memory.
+ 	self processor singleStepIn: memory.
+ 	self processor singleStepIn: memory.
+ 	self assert: processor pc = 16r14.
+ 	self processor singleStepIn: memory.
+ 	self assert: processor pc = 16r28 "check the call".
+ 	self processor singleStepIn: memory.
+ 	self assert: processor r4= 42.
+ !

Item was added:
+ ----- Method: GdbARMAlienTests>>testJumpTrap (in category 'tests') -----
+ testJumpTrap
+ 	"Jump a function that is out-of-range.  Ensure the call is trapped."
+ 	"self new testJumpTrap"
+ 	| memory |
+ 	memory := self memory.
+ 	memory unsignedLongAt: 5 put: (CogARMCompiler new b: 1020) bigEndian: false.
+ 	"Can't do this diassemble until after the #asByteArray - "
+ 	"processor disassembleFrom: 0 to:16 in: memory on: Transcript cr"
+ 	self processor
+ 			pc: 4;
+ 			sp: (memory size - 4); "Room for return address"
+ 			singleStepIn: memory.
+ 			"We have to step twice, because the first step only changes the pc, but does not fetch anything from the address it points to."
+ 	self should: [self processor singleStepIn: memory]
+ 		raise: ProcessorSimulationTrap
+ 		withExceptionDo:
+ 			[:pst|
+ 			self assert: self processor pc = 4.
+ 			self assert: self processor lr = 0.
+ 			self assert: pst pc = 4.
+ 			self assert: pst nextpc = 8.
+ 			self assert: pst address = 1032.
+ 			self assert: pst type = #jump].!

Item was added:
+ ----- Method: GdbARMAlienTests>>testLongCall (in category 'tests') -----
+ testLongCall
+ 	"Long-Call a function that is in-range."
+ 	
+ 	"self new testLongCall"
+ 	| memory |
+ 	memory := self memory.
+ 	self processor reset.
+ 
+ 	memory unsignedLongAt: 5 put: (CogARMCompiler new mov: 10 imm: 0 ror: 0)  bigEndian: false. 
+ 	memory unsignedLongAt: 9 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 13 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false. 
+ 	memory unsignedLongAt: 17 put: (CogARMCompiler new orr: 10 imm: 40 ror: 0) bigEndian: false. 
+ 
+ 	memory unsignedLongAt: 21 put: (CogARMCompiler new blx: 10) bigEndian: false.
+ 
+ 	memory unsignedLongAt: 25 put: (CogARMCompiler new mov:5imm: 99 ror:0 ) bigEndian: false.
+ 	memory unsignedLongAt: 41 put: (CogARMCompiler new mov: 4 imm: 42 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 45 put: (CogARMCompiler new bx: 14) bigEndian: false.
+ 	
+ 	"processor disassembleFrom: 0 to: 60 in: memory on: Transcript cr"
+ 	self processor
+ 			pc: 4;
+ 			sp: (memory size - 4); "Room for return address"
+ 			singleStepIn: memory.
+ 			"We have to step several times, because the first step only changes the pc, but does not fetch anything from the address it points to."
+ 	self processor singleStepIn: memory.
+ 	self processor singleStepIn: memory.
+ 	self processor singleStepIn: memory.
+ 	self assert: processor pc = 16r14.
+ 	self processor singleStepIn: memory.
+ 	self assert: processor pc = 16r28 "check the call".
+ 	self processor singleStepIn: memory.
+ 	self assert: processor r4 = 42.
+ 	self processor singleStepIn: memory.
+ 	self processor singleStepIn: memory.
+ 
+ 	self assert: self processor pc = 16r1C.
+ 	self assert: self processor lr = 16r18.
+ 	self assert: self processor r5 = 99
+ !

Item was added:
+ ----- Method: GdbARMAlienTests>>testLongCallTrap (in category 'tests') -----
+ testLongCallTrap
+ 	"Long-Call a function that is above-range."
+ 	
+ 	"self new testLongCallTrap"
+ 	| memory |
+ 	memory := self memory.
+ 	self processor reset.
+ 
+ 	memory unsignedLongAt: 5 put: (CogARMCompiler new mov: 10 imm: 0 ror: 0)  bigEndian: false. 
+ 	memory unsignedLongAt: 9 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 13 put: (CogARMCompiler new orr: 10 imm: 4 ror: 24) bigEndian: false. 
+ 	memory unsignedLongAt: 17 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false. 
+ 
+ 	memory unsignedLongAt: 21 put: (CogARMCompiler new blx: 10) bigEndian: false.
+ 
+ 	memory unsignedLongAt: 25 put: (CogARMCompiler new mov:5imm: 99 ror:0 ) bigEndian: false.
+ 	memory unsignedLongAt: 41 put: (CogARMCompiler new mov: 4 imm: 42 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 45 put: (CogARMCompiler new bx: 14) bigEndian: false.
+ 	
+ 	"processor disassembleFrom: 0 to: 60 in: memory on: Transcript cr"
+ 	self processor
+ 			pc: 4;
+ 			sp: (memory size - 4); "Room for return address"
+ 			singleStepIn: memory.
+ 			"We have to step several times, because the first step only changes the pc, but does not fetch anything from the address it points to."
+ 	self should: [self processor singleStepIn: memory.
+ 				self processor singleStepIn: memory.
+ 				self processor singleStepIn: memory.
+ 				self processor singleStepIn: memory.
+ 				self processor singleStepIn: memory.
+ 				self processor singleStepIn: memory.
+ 				self processor singleStepIn: memory]
+ 		raise: ProcessorSimulationTrap
+ 		withExceptionDo:
+ 			[:pst|
+ 			self assert: self processor pc = 16r14.
+ 			self assert: self processor lr = 16r18.
+ 			self assert: pst pc = 16r14.
+ 			self assert: pst nextpc = 16r18.
+ 			self assert: pst address = 1024.
+ 			self assert: pst type = #call].!

Item was added:
+ ----- Method: GdbARMAlienTests>>testLongCallTrap2 (in category 'tests') -----
+ testLongCallTrap2
+ 	"Long-Call a function that is way outside range."
+ 	
+ 	"self new testLongCallTrap2"
+ 	| memory |
+ 	memory := self memory.
+ 	self processor reset.
+ 
+ 	memory unsignedLongAt: 5 put: (CogARMCompiler new mov: 10 imm: 16rFF ror: 8)  bigEndian: false. 
+ 	memory unsignedLongAt: 9 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 13 put: (CogARMCompiler new orr: 10 imm: 4 ror: 24) bigEndian: false. 
+ 	memory unsignedLongAt: 17 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false. 
+ 
+ 	memory unsignedLongAt: 21 put: (CogARMCompiler new blx: 10) bigEndian: false.
+ 
+ 	memory unsignedLongAt: 25 put: (CogARMCompiler new mov:5imm: 99 ror:0 ) bigEndian: false.
+ 	memory unsignedLongAt: 41 put: (CogARMCompiler new mov: 4 imm: 42 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 45 put: (CogARMCompiler new bx: 14) bigEndian: false.
+ 	
+ 	"processor disassembleFrom: 0 to: 60 in: memory on: Transcript cr"
+ 	self processor
+ 			pc: 4;
+ 			sp: (memory size - 4); "Room for return address"
+ 			singleStepIn: memory.
+ 			"We have to step several times, because the first step only changes the pc, but does not fetch anything from the address it points to."
+ 	self should: [self processor singleStepIn: memory.
+ 				self processor singleStepIn: memory.
+ 				self processor singleStepIn: memory.
+ 				self processor singleStepIn: memory.
+ 				self processor singleStepIn: memory.
+ 				self processor singleStepIn: memory.
+ 				self processor singleStepIn: memory]
+ 		raise: ProcessorSimulationTrap
+ 		withExceptionDo:
+ 			[:pst|
+ 			self assert: self processor pc = 16r14.
+ 			self assert: self processor lr = 16r18.
+ 			self assert: pst pc = 16r14.
+ 			self assert: pst nextpc = 16r18.
+ 			self assert: pst address = 16rFF000400.
+ 			self assert: pst type = #call].!

Item was added:
+ ----- Method: GdbARMAlienTests>>testLongJump (in category 'tests') -----
+ testLongJump
+ 	"Jump in-range."
+ 	
+ 	"self new testLongJump"
+ 	| memory |
+ 	memory := self memory.
+ 	self processor reset.
+ 
+ 	memory unsignedLongAt: 5 put: (CogARMCompiler new mov: 10 imm: 0 ror: 0)  bigEndian: false. 
+ 	memory unsignedLongAt: 9 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 13 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false. 
+ 	memory unsignedLongAt: 17 put: (CogARMCompiler new orr: 10 imm: 40 ror: 0) bigEndian: false. 
+ 
+ 	memory unsignedLongAt: 21 put: (CogARMCompiler new bx: 10) bigEndian: false.
+ 
+ 	memory unsignedLongAt: 25 put: (CogARMCompiler new mov:5imm: 99 ror:0 ) bigEndian: false.
+ 	memory unsignedLongAt: 41 put: (CogARMCompiler new mov: 4 imm: 42 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 45 put: (CogARMCompiler new bx: 14) bigEndian: false.
+ 	
+ 	"processor disassembleFrom: 0 to: 60 in: memory on: Transcript cr"
+ 	self processor
+ 			pc: 4;
+ 			sp: (memory size - 4); "Room for return address"
+ 			singleStepIn: memory.
+ 			"We have to step several times, because the first step only changes the pc, but does not fetch anything from the address it points to."
+ 	self processor singleStepIn: memory.
+ 	self processor singleStepIn: memory.
+ 	self processor singleStepIn: memory.
+ 	self assert: processor pc = 16r14.
+ 	self processor singleStepIn: memory.
+ 	self assert: processor pc = 16r28 "check the call".
+ 	self processor singleStepIn: memory.
+ 	self assert: processor r4= 42.
+ !

Item was added:
+ ----- Method: GdbARMAlienTests>>testLongJumpAddressForming (in category 'tests') -----
+ testLongJumpAddressForming
+ 	"self new testLongJumpAddressForming"
+ 	"test of the somewhat loopy code used in CogARMCompiler>concretizeConditionalJumpLong: to generate the oading of a long address for jumps"
+ 	| memory |
+ 	memory := self memory.
+ 	self processor reset.
+ 	memory unsignedLongAt: 1 put: (CogARMCompiler new mov: 10 imm: 16r7F ror: 8)  bigEndian: false. 
+ 	memory unsignedLongAt: 5 put: (CogARMCompiler new orr: 10 imm: 16rFF ror: 16) bigEndian: false.
+ 	memory unsignedLongAt: 9 put: (CogARMCompiler new orr: 10 imm: 16rFE ror: 24) bigEndian: false. 
+ 	memory unsignedLongAt: 13 put: (CogARMCompiler new orr: 10 imm: 16r68 ror: 0) bigEndian: false. 
+ 
+ 	self processor
+ 		disassembleInstructionAt: 0 
+ 		In: memory 
+ 		into: [:str :len | 
+ 			self 
+ 				assert: len = 4;
+ 				assert: str equals: '00000000: mov	sl, #2130706432	; 0x7f000000'].
+ 	self processor
+ 		disassembleInstructionAt: 4 
+ 		In: memory 
+ 		into: [:str :len | 
+ 			self 
+ 				assert: len = 4;
+ 				assert: str equals: '00000004: orr	sl, sl, #16711680	; 0xff0000'].
+ 	self processor
+ 		disassembleInstructionAt: 8 
+ 		In: memory 
+ 		into: [:str :len | 
+ 			self 
+ 				assert: len = 4;
+ 				assert: str equals: '00000008: orr	sl, sl, #65024	; 0xfe00'].
+ 	self processor
+ 		disassembleInstructionAt: 12 
+ 		In: memory 
+ 		into: [:str :len | 
+ 			self 
+ 				assert: len = 4;
+ 				assert: str equals: '0000000c: orr	sl, sl, #104	; 0x68'].
+ 	self processor
+ 		pc: 0;
+ 		singleStepIn: memory;
+ 		singleStepIn: memory;
+ 		singleStepIn: memory;
+ 		singleStepIn: memory.
+ 	self 
+ 		assert: self processor pc = 16;
+ 		assert: self processor r10 = 16r7FFFFE68;
+ 		assert: self processor zflag = 0;
+ 		assert: self processor cflag = 0;
+ 		assert: self processor vflag = 0;
+ 		assert: self processor nflag = 0.
+ !

Item was added:
+ ----- Method: GdbARMAlienTests>>testLongJumpTrap (in category 'tests') -----
+ testLongJumpTrap
+ 	"Long-Jump a function that is above-range."
+ 	
+ 	"self new testLongJumpTrap"
+ 	| memory |
+ 	memory := self memory.
+ 	self processor reset.
+ 
+ 	memory unsignedLongAt: 5 put: (CogARMCompiler new mov: 10 imm: 0 ror: 0)  bigEndian: false. 
+ 	memory unsignedLongAt: 9 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 13 put: (CogARMCompiler new orr: 10 imm: 4 ror: 24) bigEndian: false. 
+ 	memory unsignedLongAt: 17 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false. 
+ 
+ 	memory unsignedLongAt: 21 put: (CogARMCompiler new bx: 10) bigEndian: false.
+ 
+ 	memory unsignedLongAt: 25 put: (CogARMCompiler new mov:5imm: 99 ror:0 ) bigEndian: false.
+ 	memory unsignedLongAt: 41 put: (CogARMCompiler new mov: 4 imm: 42 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 45 put: (CogARMCompiler new bx: 14) bigEndian: false.
+ 	
+ 	"processor disassembleFrom: 0 to: 60 in: memory on: Transcript cr"
+ 	self processor
+ 			pc: 4;
+ 			sp: (memory size - 4); "Room for return address"
+ 			singleStepIn: memory.
+ 			"We have to step several times, because the first step only changes the pc, but does not fetch anything from the address it points to."
+ 	self should: [self processor singleStepIn: memory.
+ 				self processor singleStepIn: memory.
+ 				self processor singleStepIn: memory.
+ 				self processor singleStepIn: memory.
+ 				self processor singleStepIn: memory.
+ 				self processor singleStepIn: memory.
+ 				self processor singleStepIn: memory]
+ 		raise: ProcessorSimulationTrap
+ 		withExceptionDo:
+ 			[:pst|
+ 			self assert: self processor pc = 16r14.
+ 			self assert: pst pc = 16r14.
+ 			self assert: pst nextpc = 16r18.
+ 			self assert: pst address = 1024.
+ 			self assert: pst type =  #jump].!

Item was added:
+ ----- Method: GdbARMAlienTests>>testMoveAwR (in category 'tests') -----
+ testMoveAwR
+ 	"Read a register from a constant address that is in-range."
+ 	
+ 	"self new testMoveAwR"
+ 	| memory |
+ 	memory := self memory.
+ 	self processor reset.
+ 
+ 	"LEA sl, #16r228"
+ 	memory unsignedLongAt: 5 put: (CogARMCompiler new mov: 10 imm: 0 ror: 0)  bigEndian: false. 
+ 	memory unsignedLongAt: 9 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 13 put: (CogARMCompiler new orr: 10 imm: 2 ror: 24) bigEndian: false. 
+ 	memory unsignedLongAt: 17 put: (CogARMCompiler new orr: 10 imm: 40 ror: 0) bigEndian: false. 
+ 	"LDR R5, [sl]"
+ 	memory unsignedLongAt: 21 put: (CogARMCompiler new ldr: 5 rn: 10 plusImm: 0) bigEndian: false.
+ 
+ 	
+ 	"processor disassembleFrom: 0 to: 60 in: memory on: Transcript cr"
+ 	memory unsignedLongAt: 16r228 + 1 put: 99.
+ 	self processor
+ 			pc: 4;
+ 			sp: (memory size - 4); "Room for return address"
+ 			singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 			"We have to step several times, because the first step only changes the pc, but does not fetch anything from the address it points to."
+ 	self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 	self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 	self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 	self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 	self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 	self assert:[processor r5 = 99]
+ !

Item was added:
+ ----- Method: GdbARMAlienTests>>testMoveAwRTrap1 (in category 'tests') -----
+ testMoveAwRTrap1
+ 	"Read from a register at a constant address that is out-of--range."
+ 	
+ 	"self new testMoveAwRTrap1"
+ 	| memory |
+ 	memory := self memory.
+ 	self processor reset.
+ 
+ 	"LEA sl, #16rFF00001FC"
+ 	memory unsignedLongAt: 5 put: (CogARMCompiler new mov: 10 imm: 16rFF ror: 8)  bigEndian: false. 
+ 	memory unsignedLongAt: 9 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 13 put: (CogARMCompiler new orr: 10 imm: 1 ror: 24) bigEndian: false. 
+ 	memory unsignedLongAt: 17 put: (CogARMCompiler new orr: 10 imm: 16rFC ror: 0) bigEndian: false. 
+ 	"STR R5, [sl]"
+ 	memory unsignedLongAt: 21 put: (CogARMCompiler new ldr: 5 rn: 10 plusImm: 0) bigEndian: false.
+ 
+ 	
+ 	"processor disassembleFrom: 0 to: 60 in: memory on: Transcript cr"
+ 	self processor
+ 			pc: 4;
+ 			sp: (memory size - 4); "Room for return address"
+ 			singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 			"We have to step several times, because the first step only changes the pc, but does not fetch anything from the address it points to."
+ 	
+ 	self should: [self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 				self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 				self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 				self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 				self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2]
+ 		raise: ProcessorSimulationTrap
+ 		withExceptionDo:
+ 			[:pst|
+ 			self assert: self processor pc = 16r14.
+ 			self assert: pst pc = 16r14.
+ 			self assert: pst nextpc = 16r18.
+ 			self assert: pst address = 16rFF0001FC.
+ 			self assert: pst type = #read]!

Item was added:
+ ----- Method: GdbARMAlienTests>>testMoveRAw (in category 'tests') -----
+ testMoveRAw
+ 	"Write a register to a constant address that is in-range."
+ 	
+ 	"self new testMoveRAw"
+ 	| memory |
+ 	memory := self memory.
+ 	self processor reset.
+ 
+ 	"LEA sl, #16r3FC"
+ 	memory unsignedLongAt: 5 put: (CogARMCompiler new mov: 10 imm: 0 ror: 0)  bigEndian: false. 
+ 	memory unsignedLongAt: 9 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 13 put: (CogARMCompiler new orr: 10 imm: 2 ror: 24) bigEndian: false. 
+ 	memory unsignedLongAt: 17 put: (CogARMCompiler new orr: 10 imm: 40 ror: 0) bigEndian: false. 
+ 	"STR R5, [sl]"
+ 	memory unsignedLongAt: 21 put: (CogARMCompiler new str: 5 rn: 10 plusImm: 0) bigEndian: false.
+ 
+ 	
+ 	"processor disassembleFrom: 0 to: 60 in: memory on: Transcript cr"
+ 	self processor
+ 			pc: 4;
+ 			sp: (memory size - 4); "Room for return address"
+ 			r5: 99;
+ 			singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 			"We have to step several times, because the first step only changes the pc, but does not fetch anything from the address it points to."
+ 	self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 	self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 	self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 	self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 	self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 	self assert:[(memory unsignedLongAt: (processor r10) + 1) = processor r5]
+ !

Item was added:
+ ----- Method: GdbARMAlienTests>>testMoveRAwTrap1 (in category 'tests') -----
+ testMoveRAwTrap1
+ 	"Write a register to a constant address that is below-range."
+ 	
+ 	"self new testMoveRAwTrap1"
+ 	| memory |
+ 	memory := self memory.
+ 	self processor reset.
+ 
+ 	"LEA sl, #16r1FC"
+ 	memory unsignedLongAt: 5 put: (CogARMCompiler new mov: 10 imm: 0 ror: 0)  bigEndian: false. 
+ 	memory unsignedLongAt: 9 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 13 put: (CogARMCompiler new orr: 10 imm: 1 ror: 24) bigEndian: false. 
+ 	memory unsignedLongAt: 17 put: (CogARMCompiler new orr: 10 imm: 16rFC ror: 0) bigEndian: false. 
+ 	"STR R5, [sl]"
+ 	memory unsignedLongAt: 21 put: (CogARMCompiler new str: 5 rn: 10 plusImm: 0) bigEndian: false.
+ 
+ 	
+ 	"processor disassembleFrom: 0 to: 60 in: memory on: Transcript cr"
+ 	self processor
+ 			pc: 4;
+ 			sp: (memory size - 4); "Room for return address"
+ 			r5: 99;
+ 			singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 			"We have to step several times, because the first step only changes the pc, but does not fetch anything from the address it points to."
+ 	
+ 	self should: [self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 				self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 				self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 				self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 				self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2]
+ 		raise: ProcessorSimulationTrap
+ 		withExceptionDo:
+ 			[:pst|
+ 			self assert: self processor pc = 16r14.
+ 			self assert: pst pc = 16r14.
+ 			self assert: pst nextpc = 16r18.
+ 			self assert: pst address = 16r1FC.
+ 			self assert: pst type = #write]!

Item was added:
+ ----- Method: GdbARMAlienTests>>testMoveRAwTrap2 (in category 'tests') -----
+ testMoveRAwTrap2
+ 	"Write a register to a constant address that is below-range."
+ 	
+ 	"self new testMoveRAwTrap2"
+ 	| memory |
+ 	memory := self memory.
+ 	self processor reset.
+ 
+ 	"LEA sl, #16r1FC"
+ 	memory unsignedLongAt: 5 put: (CogARMCompiler new mov: 10 imm: 0 ror: 0)  bigEndian: false. 
+ 	memory unsignedLongAt: 9 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false.
+ 	memory unsignedLongAt: 13 put: (CogARMCompiler new orr: 10 imm: 16rFF ror: 24) bigEndian: false. 
+ 	memory unsignedLongAt: 17 put: (CogARMCompiler new orr: 10 imm: 16rFC ror: 0) bigEndian: false. 
+ 	"STR R5, [sl]"
+ 	memory unsignedLongAt: 21 put: (CogARMCompiler new str: 5 rn: 10 plusImm: 0) bigEndian: false.
+ 
+ 	
+ 	"processor disassembleFrom: 0 to: 60 in: memory on: Transcript cr"
+ 	self processor
+ 			pc: 4;
+ 			sp: (memory size - 4); "Room for return address"
+ 			r5: 99;
+ 			singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 			"We have to step several times, because the first step only changes the pc, but does not fetch anything from the address it points to."
+ 	
+ 	self should: [self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 				self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 				self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 				self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2.
+ 				self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2]
+ 		raise: ProcessorSimulationTrap
+ 		withExceptionDo:
+ 			[:pst|
+ 			self assert: self processor pc = 16r14.
+ 			self assert: pst pc = 16r14.
+ 			self assert: pst nextpc = 16r18.
+ 			self assert: pst address = 16rFFFC.
+ 			self assert: pst type = #write]!

Item was added:
+ ----- Method: GdbARMAlienTests>>testQuickDisassemby (in category 'tests') -----
+ testQuickDisassemby
+ 	"self new testQuickDisassemby"
+ 
+ 	| memory result |
+ 	memory := WordArray new: 2.
+ 	memory at: 1 put: 3858758348.
+ 	result := self processor
+ 		disassembleInstructionAt: 0 
+ 		In: memory 
+ 		into: [:str :len | 
+ 			^str].!

Item was added:
+ ----- Method: GdbARMAlienTests>>testQuickDisassembyOf: (in category 'execution') -----
+ testQuickDisassembyOf: word
+ 	"self new testQuickDisassembyOf: 3858758348"
+ 
+ 	| memory result |
+ 	memory := WordArray new: 2.
+ 	memory at: 1 put: word.
+ 	result := self processor
+ 		disassembleInstructionAt: 0 
+ 		In: memory 
+ 		into: [:str :len | 
+ 			^str].!

Item was changed:
+ ----- Method: GdbARMAlienTests>>testResetCPU (in category 'execution') -----
- ----- Method: GdbARMAlienTests>>testResetCPU (in category 'tests') -----
  testResetCPU
  	"self new testResetCPU"
  	self integerRegisterSetters do:
  		[:setter|
  		self processor perform: setter with: 16r55555555].
  	self integerRegisterGetters do:
  		[:getter|
  		self assert: 16r55555555 = (self processor perform: getter)].
  	self processor reset.
  	self integerRegisterGetters do:
  		[:getter|
  		self assert: 0 = (self processor perform: getter)]!

Item was changed:
  ----- Method: GdbARMPlugin>>primitiveRunInMemory:minimumAddress:readOnlyBelow: (in category 'primitives') -----
  "cpuAlien <GdbARMAlien>" primitiveRunInMemory: memory "<Bitmap|ByteArray|WordArray>" minimumAddress: minAddress "<Integer>" readOnlyBelow: minWriteMaxExecAddress "<Integer>"
+ 	"Run the cpu using the first argument as the memory and the following arguments defining valid addresses, running until it halts or hits an exception.
+ 	Note that minWriteMaxExecAddress is both the minimum writeable address AND the maximum executable address"
- 	"Run the cpu using the first argument as the memory and the following arguments defining valid addresses, running until it halts or hits an exception."
  	| cpuAlien cpu maybeErr |
  	<var: #cpu type: #'void *'>
  	cpuAlien := self primitive: #primitiveRunInMemoryMinimumAddressReadWrite
  					parameters: #(WordsOrBytes Unsigned Unsigned)
  					receiver: #Oop.
  	(cpu := self startOfData: cpuAlien) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	prevInterruptCheckChain := interpreterProxy setInterruptCheckChain: #forceStopOnInterrupt asSymbol.
  	prevInterruptCheckChain = #forceStopOnInterrupt asSymbol ifTrue:
  		[prevInterruptCheckChain = 0].
  	maybeErr := self runCPU: cpu
  					In: memory
  					Size: (interpreterProxy byteSizeOf: memory cPtrAsOop)
  					MinAddressRead: minAddress
  					Write: minWriteMaxExecAddress.
  	interpreterProxy setInterruptCheckChain: prevInterruptCheckChain.
  	maybeErr ~= 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
  	^cpuAlien!



More information about the Vm-dev mailing list