[Vm-dev] VM Maker: Cog-eem.448.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Nov 21 06:16:32 UTC 2021


Eliot Miranda uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-eem.448.mcz

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

Name: Cog-eem.448
Author: eem
Time: 20 November 2021, 10:16:30.198832 pm
UUID: e6bb1c15-697d-434f-b09a-53afc0219839
Ancestors: Cog-eem.447

CogProcessorAlien:
Factor in memoryOffset, allowing the SpurMemoryManager simulators to implement a nuill pointer trap by leaving out the first word in memory.

=============== Diff against Cog-eem.447 ===============

Item was changed:
  ----- Method: BochsIA32Alien>>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."
  	|  relativeJump |
+ 	relativeJump := memoryArray longAt: pc + 2 - self primitiveMemoryOffset.
- 	relativeJump := memoryArray longAt: pc + 2 bigEndian: false.
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + 5
  			address: (pc + 5 + relativeJump) signedIntToLong
  			type: #call)
  		signal!

Item was changed:
  ----- Method: BochsIA32Alien>>handleExecutionPrimitiveFailureIn:minimumAddress: (in category 'error handling') -----
  handleExecutionPrimitiveFailureIn: memoryArray "<Bitmap|ByteArray>" minimumAddress: minimumAddress
  	"Handle an execution primitive failure.  Convert out-of-range call and absolute
  	 memory read into register instructions into ProcessorSimulationTrap signals."
  	"self printIntegerRegistersOn: Transcript"
  	"self printRegistersOn: Transcript"
  	| pc opcode |
  	((pc := self eip) between: minimumAddress and: memoryArray byteSize - 1) ifTrue:
+ 		[opcode := memoryArray byteAt: pc + 1 - self primitiveMemoryOffset.
- 		[opcode := memoryArray byteAt: pc + 1.
  		 opcode ~= 16r0f ifTrue:
  			[^self
  				perform: (OpcodeExceptionMap at: opcode + 1)
  				with: pc
  				with: memoryArray].
+ 		 opcode := memoryArray byteAt: pc + 2 - self primitiveMemoryOffset.
- 		 opcode := memoryArray byteAt: pc + 2.
  		 ^self
  				perform: (ExtendedOpcodeExceptionMap at: opcode + 1)
  				with: pc
  				with: memoryArray].
  	^self reportPrimitiveFailure!

Item was changed:
  ----- Method: BochsIA32Alien>>handleJmpFailureAt:in: (in category 'error handling') -----
  handleJmpFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
  	"Convert an execution primitive failure for a jmp into a ProcessorSimulationTrap signal."
  	|  relativeJump |
+ 	relativeJump := memoryArray longAt: pc + 2 - self primitiveMemoryOffset.
- 	relativeJump := memoryArray longAt: pc + 2 bigEndian: false.
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + 5
  			address: (pc + 5 + relativeJump) signedIntToLong
  			type: #jump)
  		signal!

Item was changed:
  ----- Method: BochsIA32Alien>>handleMovALObFailureAt:in: (in category 'error handling') -----
  handleMovALObFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
  	"Convert an execution primitive failure for a read into al into a ProcessorSimulationTrap signal."
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + 5
+ 			address: (memoryArray unsignedLongAt: pc + 2 - self primitiveMemoryOffset)
- 			address: (memoryArray unsignedLongAt: pc + 2 bigEndian: false)
  			type: #read
  			accessor: #al:)
  		signal!

Item was changed:
  ----- Method: BochsIA32Alien>>handleMovAXOvFailureAt:in: (in category 'error handling') -----
  handleMovAXOvFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
  	"Convert an execution primitive failure for a read into eax into a ProcessorSimulationTrap signal."
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + 5
+ 			address: (memoryArray unsignedLongAt: pc + 2 - self primitiveMemoryOffset)
- 			address: (memoryArray unsignedLongAt: pc + 2 bigEndian: false)
  			type: #read
  			accessor: #eax:)
  		signal!

Item was changed:
  ----- Method: BochsIA32Alien>>handleMovEbGbFailureAt:in: (in category 'error handling') -----
  handleMovEbGbFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
  	"Convert an execution primitive failure for a byte register write into a ProcessorSimulationTrap signal."
  	| modrmByte address |
  	modrmByte := memoryArray byteAt: pc + 2.
  	(modrmByte bitAnd: 7) ~= 4 ifTrue: "MoveRMbr with r = ESP requires an SIB byte"
  		[address := (modrmByte bitAnd: 16rC0)
  					caseOf: {
  						[0 "ModRegInd"]
+ 						->	[memoryArray unsignedLongAt: pc + 3 - self primitiveMemoryOffset].
- 						->	[memoryArray unsignedLongAt: pc + 3 bigEndian: false].
  						[16r80 "ModRegRegDisp32"]
  						->	[(self perform: (#(eax ecx edx ebx esp ebp esi edi) at: (modrmByte bitAnd: 7) + 1))
+ 								+ (memoryArray unsignedLongAt: pc + 3 - self primitiveMemoryOffset)
- 								+ (memoryArray unsignedLongAt: pc + 3 bigEndian: false)
  								bitAnd: 16rFFFFFFFF] }
  					otherwise: [^self reportPrimitiveFailure].
  		^(ProcessorSimulationTrap
  				pc: pc
  				nextpc: pc + 6
  				address: address
  				type: #write
  				accessor: (#(al cl dl bl ah ch dh bh) at: ((modrmByte >> 3 bitAnd: 7) + 1)))
  			signal].
  	^self reportPrimitiveFailure!

Item was changed:
  ----- Method: BochsIA32Alien>>handleMovEvGvFailureAt:in: (in category 'error handling') -----
  handleMovEvGvFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
  	"Convert an execution primitive failure for a register write into a ProcessorSimulationTrap signal."
  	| modrmByte |
+ 	^((modrmByte := memoryArray byteAt: pc + 2 - self primitiveMemoryOffset) bitAnd: 16rC7) = 16r5 "ModRegInd & disp32"
- 	^((modrmByte := memoryArray byteAt: pc + 2) bitAnd: 16rC7) = 16r5 "ModRegInd & disp32"
  		ifTrue:
  			[(ProcessorSimulationTrap
  					pc: pc
  					nextpc: pc + 6
+ 					address: (memoryArray unsignedLongAt: pc + 3 - self primitiveMemoryOffset)
- 					address: (memoryArray unsignedLongAt: pc + 3 bigEndian: false)
  					type: #write
  					accessor: (#(eax ecx edx ebx esp ebp esi edi) at: ((modrmByte >> 3 bitAnd: 7) + 1)))
  				signal]
  		ifFalse:
  			[self reportPrimitiveFailure]!

Item was changed:
  ----- Method: BochsIA32Alien>>handleMovGbEbFailureAt:in: (in category 'error handling') -----
  handleMovGbEbFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
  	"Convert an execution primitive failure for a byte register load into a ProcessorSimulationTrap signal."
  	| modrmByte address |
  	modrmByte := memoryArray byteAt: pc + 2.
  	address := (modrmByte bitAnd: 16rC0)
  					caseOf: {
  						[0 "ModRegInd"]
+ 						->	[memoryArray unsignedLongAt: pc + 3 - self primitiveMemoryOffset].
- 						->	[memoryArray unsignedLongAt: pc + 3 bigEndian: false].
  						[16r80 "ModRegRegDisp32"]
  						->	[(self perform: (#(eax ecx edx ebx esp ebp esi edi) at: (modrmByte bitAnd: 7) + 1))
+ 								+ (memoryArray unsignedLongAt: pc + 3 - self primitiveMemoryOffset)
- 								+ (memoryArray unsignedLongAt: pc + 3 bigEndian: false)
  								bitAnd: 16rFFFFFFFF] }
  					otherwise: [^self reportPrimitiveFailure].
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + 6
  			address: address
  			type: #read
  			accessor: (#(al: cl: dl: bl: ah: ch: dh: bh:) at: ((modrmByte >> 3 bitAnd: 7) + 1)))
  		signal!

Item was changed:
  ----- Method: BochsIA32Alien>>handleMovGvEbFailureAt:in: (in category 'error handling') -----
  handleMovGvEbFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
  	"Convert an execution primitive failure for a register load into a ProcessorSimulationTrap signal."
  	| modrmByte mode srcIsSP srcVal dst offset |
  	modrmByte := memoryArray byteAt: pc + 3.
  	mode := modrmByte >> 6 bitAnd: 3.
  	dst := #(eax: ecx: edx: ebx: esp: ebp: esi: edi:) at: ((modrmByte >> 3 bitAnd: 7) + 1).
  	mode = 0 ifTrue: "ModRegInd"
+ 		[offset := memoryArray unsignedLongAt: pc + 4 - self primitiveMemoryOffset. "1-relative"
- 		[offset := memoryArray unsignedLongAt: pc + 4. "1-relative"
  		 ^(ProcessorSimulationTrap
  					pc: pc
  					nextpc: pc + 7
  					address: offset
  					type: #read
  					accessor: dst)
  				signal].
  	srcIsSP := (modrmByte bitAnd: 7) = 4.
  	srcVal := self perform: (#(eax ecx edx ebx esp ebp esi edi) at: (modrmByte bitAnd: 7) + 1).
  	mode = 1 ifTrue: "ModRegRegDisp8"
+ 		[offset := memoryArray byteAt: pc + ((srcIsSP ifTrue: [5] ifFalse: [4] "1-relative") - self primitiveMemoryOffset).
- 		[offset := memoryArray byteAt: pc + (srcIsSP ifTrue: [5] ifFalse: [4]). "1-relative"
  		 offset > 127 ifTrue: [offset := offset - 256].
  		 ^(ProcessorSimulationTrap
  					pc: pc
  					nextpc: pc + (srcIsSP ifTrue: [5] ifFalse: [4])
  					address: (srcVal + offset bitAnd: 16rFFFFFFFF)
  					type: #read
  					accessor: dst)
  				signal].
  	mode = 2 ifTrue: "ModRegRegDisp32"
+ 		[offset := memoryArray unsignedLongAt: pc + ((srcIsSP ifTrue: [5] ifFalse: [4] "1-relative") - self primitiveMemoryOffset).
- 		[offset := memoryArray unsignedLongAt: pc + (srcIsSP ifTrue: [5] ifFalse: [4]). "1-relative"
  		 ^(ProcessorSimulationTrap
  					pc: pc
  					nextpc: pc + (srcIsSP ifTrue: [8] ifFalse: [7])
  					address: (srcVal + offset bitAnd: 16rFFFFFFFF)
  					type: #read
  					accessor: dst)
  				signal].
  	^self reportPrimitiveFailure!

Item was changed:
  ----- Method: BochsIA32Alien>>handleMovGvEvFailureAt:in: (in category 'error handling') -----
  handleMovGvEvFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
  	"Convert an execution primitive failure for a register load into a ProcessorSimulationTrap signal."
  	| modrmByte |
+ 	^(((modrmByte := memoryArray byteAt: pc + 2 - self primitiveMemoryOffset) bitAnd: 16rC7) = 16r5) "ModRegInd & disp32"
- 	^(((modrmByte := memoryArray byteAt: pc + 2) bitAnd: 16rC7) = 16r5) "ModRegInd & disp32"
  		ifTrue:
  			[(ProcessorSimulationTrap
  					pc: pc
  					nextpc: pc + 6
+ 					address: (memoryArray unsignedLongAt: pc + 3 - self primitiveMemoryOffset)
- 					address: (memoryArray unsignedLongAt: pc + 3 bigEndian: false)
  					type: #read
  					accessor: (#(eax: ecx: edx: ebx: esp: ebp: esi: edi:) at: ((modrmByte >> 3 bitAnd: 7) + 1)))
  				signal]
  		ifFalse:
  			[self reportPrimitiveFailure]!

Item was changed:
  ----- Method: BochsIA32Alien>>handleMovObALFailureAt:in: (in category 'error handling') -----
  handleMovObALFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
  	"Convert an execution primitive failure for a byte write of al into a ProcessorSimulationTrap signal."
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + 5
+ 			address: (memoryArray unsignedLongAt: pc + 2 - self primitiveMemoryOffset)
- 			address: (memoryArray unsignedLongAt: pc + 2 bigEndian: false)
  			type: #write
  			accessor: #al)
  		signal!

Item was changed:
  ----- Method: BochsIA32Alien>>handleMovOvAXFailureAt:in: (in category 'error handling') -----
  handleMovOvAXFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
  	"Convert an execution primitive failure for a write of eax into a ProcessorSimulationTrap signal."
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + 5
+ 			address: (memoryArray unsignedLongAt: pc + 2 - self primitiveMemoryOffset)
- 			address: (memoryArray unsignedLongAt: pc + 2 bigEndian: false)
  			type: #write
  			accessor: #eax)
  		signal!

Item was changed:
  ----- Method: BochsIA32Alien>>handleRetFailureAt:in: (in category 'error handling') -----
  handleRetFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
  	"Convert an execution primitive failure for a ret into a ProcessorSimulationTrap signal."
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + 1
+ 			address: (memoryArray unsignedLongAt: self esp + 1 - self primitiveMemoryOffset)
- 			address: (memoryArray unsignedLongAt: self esp + 1)
  			type: #return
  			accessor: #eip:)
  		signal!

Item was changed:
  ----- Method: BochsIA32Alien>>leafRetpcIn: (in category 'accessing-abstract') -----
  leafRetpcIn: aMemory
+ 	^aMemory unsignedLongAt: self esp + 1 - self primitiveMemoryOffset!
- 	^aMemory unsignedLongAt: self esp + 1 bigEndian: false!

Item was changed:
  ----- Method: BochsIA32Alien>>popWordIn: (in category 'execution') -----
  popWordIn: aMemory 
  	| sp word |
+ 	word := aMemory unsignedLongAt: (sp := self esp) + 1 - self primitiveMemoryOffset.
- 	word := aMemory unsignedLongAt: (sp := self esp) + 1 bigEndian: false.
  	self esp: sp + 4.
  	^word!

Item was added:
+ ----- Method: BochsIA32Alien>>primitiveMemoryOffset (in category 'primitives') -----
+ primitiveMemoryOffset
+ 	"Answer the memory offset. This may be non-zero to adapt to the SpurMemoryManager
+ 	 simulators discarding the first work of memory to implement a null pointer trap."
+ 	<primitive: 'primitiveMemoryOffset' module: 'BochsIA32Plugin' error: ec>
+ 	^self reportPrimitiveFailure!

Item was added:
+ ----- Method: BochsIA32Alien>>primitiveSetMemoryOffset: (in category 'primitives') -----
+ primitiveSetMemoryOffset: memoryOffset
+ 	"Set the memory offset. This may be non-zero to adapt to the SpurMemoryManager
+ 	 simulators discarding the first work of memory to implement a null pointer trap.
+ 	 Answer the previous value."
+ 	<primitive: 'primitiveMemoryOffset' module: 'BochsIA32Plugin' error: ec>
+ 	^self reportPrimitiveFailure!

Item was changed:
  ----- Method: BochsIA32Alien>>pushWord:in: (in category 'execution') -----
  pushWord: aValue in: aMemory
  	| sp |
  	sp := (self esp: self esp - 4).
+ 	aMemory longAt: sp + 1 - self primitiveMemoryOffset put: aValue bigEndian: false!
- 	aMemory longAt: sp + 1 put: aValue bigEndian: false!

Item was changed:
  ----- Method: BochsIA32Alien>>retpcIn: (in category 'accessing-abstract') -----
  retpcIn: aMemory
+ 	^aMemory unsignedLongAt: self ebp + 5 - self primitiveMemoryOffset!
- 	^aMemory unsignedLongAt: self ebp + 5 bigEndian: false!

Item was changed:
  ----- Method: BochsX64Alien>>handleCallFailureAt:in:rex: (in category 'error handling') -----
  handleCallFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" rex: rexByteOrNil "<Integer|nil>"
  	"Convert an execution primitive failure for a call into a ProcessorSimulationTrap signal."
  	| relativeJump |
  	self assert: rexByteOrNil isNil.
+ 	relativeJump := memoryArray longAt: pc + 2 - self primitiveMemoryOffset.
- 	relativeJump := memoryArray longAt: pc + 2 bigEndian: false.
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + 5
  			address: (pc + 5 + relativeJump) signedIntToLong64
  			type: #call)
  		signal!

Item was changed:
  ----- Method: BochsX64Alien>>handleExecutionPrimitiveFailureIn:minimumAddress: (in category 'error handling') -----
  handleExecutionPrimitiveFailureIn: memoryArray "<Bitmap|ByteArray>" minimumAddress: minimumAddress
  	"Handle an execution primitive failure.  Convert out-of-range call and absolute
  	 memory read into register instructions into ProcessorSimulationTrap signals."
  	"self printIntegerRegistersOn: Transcript"
  	"self printRegistersOn: Transcript"
+ 	| pc opcode rexByteOrNil |
- 	| pc opcode rexByteOrNil offset |
  	((pc := self rip) between: minimumAddress and: memoryArray byteSize - 1) ifTrue:
+ 		[opcode := memoryArray byteAt: pc + 1 - self primitiveMemoryOffset.
- 		[opcode := memoryArray byteAt: pc + (offset := 1).
  		 (opcode bitAnd: 16rF8) = self rexPrefix ifTrue: "skip rex prefix if present"
  			[rexByteOrNil := opcode.
+ 			 opcode := memoryArray byteAt: pc + 2 - self primitiveMemoryOffset].
- 			 opcode := memoryArray byteAt: pc + (offset := 2)].
  		 ^self
  			perform: (OpcodeExceptionMap at: opcode + 1)
  			with: pc
  			with: memoryArray
  			with: rexByteOrNil].
  	^self reportPrimitiveFailure!

Item was changed:
  ----- Method: BochsX64Alien>>handleGroup5FailureAt:in:rex: (in category 'error handling') -----
  handleGroup5FailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" rex: rexByteOrNil "<Integer|nil>"
  	"Convert an execution primitive failure for a group 5 instruction into the relevant ProcessorSimulationTrap signal."
  	| modrmByte getter |
  	self assert: rexByteOrNil isNil.
+ 	modrmByte := memoryArray byteAt: pc + 2 - self primitiveMemoryOffset.
- 	modrmByte := memoryArray byteAt: pc + 2.
  	(modrmByte >> 3 bitAnd: 7)
  		caseOf: {
  			[2 "Call Ev"]	->	[getter := self registerStateGetters at: (modrmByte bitAnd: 7) + 1.
  							^(ProcessorSimulationTrap
  									pc: pc
  									nextpc: pc + 2
  									address: (self perform: getter)
  									type: #call)
  								signal].
  			[4 "Jump Ev"]	->	[getter := self registerStateGetters at: (modrmByte bitAnd: 7) + 1.
  							^(ProcessorSimulationTrap
  									pc: pc
  									nextpc: pc + 2
  									address: (self perform: getter)
  									type: #jump)
+ 								signal] }
+ 		otherwise: [self reportPrimitiveFailure]!
- 								signal] }!

Item was changed:
  ----- Method: BochsX64Alien>>handleGroup6through10FailureAt:in:rex: (in category 'error handling') -----
  handleGroup6through10FailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" rex: rexByteOrNil "<Integer|nil>"
+ 	"Convert an execution primitive failure for a group 6 instruction into the relevant ProcessorSimulationTrap signal."
- 	"Convert an execution primitive failure for a group 5 instruction into the relevant ProcessorSimulationTrap signal."
  	| rexByte modrmByte baseReg srcReg |
+ 	(((rexByte := memoryArray byteAt: pc + 2 - self primitiveMemoryOffset) bitAnd: 16rF8) = self rexPrefix
+ 	and: [(memoryArray byteAt: pc + 3 - self primitiveMemoryOffset) = 16r0F
+ 	and: [(memoryArray byteAt: pc + 4 - self primitiveMemoryOffset) = 16rB1]]) ifTrue:
+ 		[modrmByte := memoryArray byteAt: pc + 5 - self primitiveMemoryOffset.
- 	(((rexByte := memoryArray byteAt: pc + 2) bitAnd: 16rF8) = self rexPrefix
- 	and: [(memoryArray byteAt: pc + 3) = 16r0F
- 	and: [(memoryArray byteAt: pc + 4) = 16rB1]]) ifTrue:
- 		[modrmByte := memoryArray byteAt: pc + 5.
  		 modrmByte >> 6 = 0 ifTrue: "ModRegInd"
  			[srcReg := (modrmByte >> 3 bitAnd: 7) + ((rexByte bitAnd: 4) bitShift: 1).
  			 baseReg := (modrmByte bitAnd: 7) + ((rexByte bitAnd: 1) bitShift: 3).
  			^(CompareAndSwapSimulationTrap
  						pc: pc
  						nextpc: pc + 5
  						address: (self perform: (self registerStateGetters at: baseReg + 1))
  						type: #write
  						accessor: (self registerStateSetters at: srcReg + 1))
  					failedComparisonRegisterAccessor: #rax:;
  					expectedValue: self rax;
  					storedValue: (self perform: (self registerStateGetters at: srcReg + 1));
+ 					signal]].
+ 	self reportPrimitiveFailure!
- 					signal]]!

Item was changed:
  ----- Method: BochsX64Alien>>handleJmpFailureAt:in:rex: (in category 'error handling') -----
  handleJmpFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" rex: rexByteOrNil "<Integer|nil>"
  	"Convert an execution primitive failure for a jmp into a ProcessorSimulationTrap signal."
  	|  relativeJump |
  	self assert: rexByteOrNil isNil.
+ 	relativeJump := memoryArray longAt: pc + 2 - self primitiveMemoryOffset.
- 	relativeJump := memoryArray longAt: pc + 2 bigEndian: false.
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + 5
  			address: (pc + 5 + relativeJump) signedIntToLong64
  			type: #jump)
  		signal!

Item was changed:
  ----- Method: BochsX64Alien>>handleMovALObFailureAt:in:rex: (in category 'error handling') -----
  handleMovALObFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" rex: rexByteOrNil "<Integer|nil>"
  	"Convert an execution primitive failure for a read into al into a ProcessorSimulationTrap signal."
  	rexByteOrNil ifNotNil:
  		[self assert: rexByteOrNil = 16r48.
  		 ^(ProcessorSimulationTrap
  				pc: pc
  				nextpc: pc + 10
+ 				address: (memoryArray unsignedLong64At: pc + 3 - self primitiveMemoryOffset)
- 				address: (memoryArray unsignedLong64At: pc + 3)
  				type: #read
  				accessor: #al:)
  			signal].
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + 5
+ 			address: (memoryArray unsignedLongAt: pc + 2 - self primitiveMemoryOffset)
- 			address: (memoryArray unsignedLongAt: pc + 2)
  			type: #read
  			accessor: #al:)
  		signal!

Item was changed:
  ----- Method: BochsX64Alien>>handleMovAXOvFailureAt:in:rex: (in category 'error handling') -----
  handleMovAXOvFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" rex: rexByteOrNil "<Integer|nil>"
  	"Convert an execution primitive failure for a read into rax/eax into a ProcessorSimulationTrap signal."
  	rexByteOrNil ifNotNil:
  		[self assert: rexByteOrNil = 16r48.
  		 ^(ProcessorSimulationTrap
  				pc: pc
  				nextpc: pc + 10
+ 				address: (memoryArray unsignedLong64At: pc + 3 - self primitiveMemoryOffset)
- 				address: (memoryArray unsignedLong64At: pc + 3)
  				type: #read
  				accessor: #rax:)
  			signal].
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + 5
+ 			address: (memoryArray unsignedLongAt: pc + 2 - self primitiveMemoryOffset)
- 			address: (memoryArray unsignedLongAt: pc + 2)
  			type: #read
  			accessor: #eax:)
  		signal!

Item was changed:
  ----- Method: BochsX64Alien>>handleMovEbGbFailureAt:in:rex: (in category 'error handling') -----
  handleMovEbGbFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" rex: rexByteOrNil "<Integer|nil>"
  	"Convert an execution primitive failure for a byte register write into a ProcessorSimulationTrap signal."
  	| modrmByte offset size baseReg srcReg |
  	modrmByte := memoryArray byteAt: pc + 3.
  	(modrmByte bitAnd: 16rC0) caseOf: {
+ 		[16r80 "ModRegRegDisp32"] -> [offset := memoryArray unsignedLongAt: pc + 4 - self primitiveMemoryOffset.
- 		[16r80 "ModRegRegDisp32"] -> [offset := memoryArray unsignedLongAt: pc + 4 bigEndian: false.
  										 size := 7].
+ 		[16r40 "ModRegRegDisp8"] -> [offset := memoryArray byteAt: pc + 4 - self primitiveMemoryOffset.
- 		[16r40 "ModRegRegDisp8"] -> [offset := memoryArray byteAt: pc + 4.
  										offset > 127 ifTrue: [offset := offset - 256].
  										 size := 4].
  		[16r0 "ModRegInd"] -> [offset := 0.
  								size := 3]}
  		otherwise: [self reportPrimitiveFailure].
  	srcReg := (modrmByte >> 3 bitAnd: 7) + ((rexByteOrNil bitAnd: 4) bitShift: 1).
  	baseReg := (modrmByte bitAnd: 7) + ((rexByteOrNil bitAnd: 1) bitShift: 3).
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + size
  			address: (((self perform: (self registerStateGetters at: baseReg + 1))
  					+ offset)
  						bitAnd: 16rFFFFFFFFFFFFFFFF)
  			type: #write
  			accessor: (#(al cl dl bl spl bpl sil dil r8l r9l r10l r11l r12l r13l r14l r15l) at: srcReg + 1))
  		signal!

Item was changed:
  ----- Method: BochsX64Alien>>handleMovEvGvFailureAt:in:rex: (in category 'error handling') -----
  handleMovEvGvFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" rex: rexByteOrNil "<Integer|nil>"
  	"Convert an execution primitive failure for a register write into a ProcessorSimulationTrap signal."
  	| modrmByte getter base offset |
  	self assert: rexByteOrNil notNil.
+ 	modrmByte := memoryArray byteAt: pc + 3 - self primitiveMemoryOffset.
- 	modrmByte := memoryArray byteAt: pc + 3.
  	getter := self registerStateGetters at: (modrmByte >> 3 bitAnd: 7) + ((rexByteOrNil bitAnd: 4) << 1) + 1.
  	(modrmByte bitAnd: 16rC7) = 16r5 ifTrue: "ModRegInd & disp32"
  		[^(ProcessorSimulationTrap
  				pc: pc
  				nextpc: pc + 7
+ 				address: (memoryArray unsignedLongAt: pc + 4 - self primitiveMemoryOffset)
- 				address: (memoryArray unsignedLongAt: pc + 4 bigEndian: false)
  				type: #write
  				accessor: getter)
  			signal].
  	(modrmByte bitAnd: 16rC0) = 0 ifTrue: "ModRegInd"
  		[base := self registerStateGetters at: (modrmByte bitAnd: 7) + ((rexByteOrNil bitAnd: 1) << 3) + 1.
  		 ^(ProcessorSimulationTrap
  				pc: pc
  				nextpc: pc + 3
  				address: (self perform: base)
  				type: #write
  				accessor: getter)
  			signal].
  	(modrmByte bitAnd: 16rC0) = 16r80 ifTrue: "ModRegRegDisp32"
+ 		[offset := memoryArray longAt: pc + 4 - self primitiveMemoryOffset.
- 		[offset := memoryArray longAt: pc + 4 bigEndian: false.
  		 base := self registerStateGetters at: (modrmByte bitAnd: 7) + ((rexByteOrNil bitAnd: 1) << 3) + 1.
  		 ^(ProcessorSimulationTrap
  				pc: pc
  				nextpc: pc + 7
  				address: (self perform: base) + offset
  				type: #write
  				accessor: getter)
  			signal].
  	(modrmByte bitAnd: 16rC0) = 16r40 ifTrue: "ModRegRegDisp8"
+ 		[offset := memoryArray unsignedByteAt: pc + 4 - self primitiveMemoryOffset.
- 		[offset := memoryArray unsignedByteAt: pc + 4.
  		 offset > 127 ifTrue: [offset := offset - 256].
  		 base := self registerStateGetters at: (modrmByte bitAnd: 7) + ((rexByteOrNil bitAnd: 1) << 3) + 1.
  		 ^(ProcessorSimulationTrap
  				pc: pc
  				nextpc: pc + 4
  				address: (self perform: base) + offset
  				type: #write
  				accessor: getter)
  			signal].
  	^self reportPrimitiveFailure!

Item was changed:
  ----- Method: BochsX64Alien>>handleMovGbEbFailureAt:in:rex: (in category 'error handling') -----
  handleMovGbEbFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" rex: rexByteOrNil "<Integer|nil>"
  	"Convert an execution primitive failure for a byte register load into a ProcessorSimulationTrap signal."
  	| modrmByte offset size |
+ 	modrmByte := memoryArray byteAt: pc + 3 - self primitiveMemoryOffset.
- 	modrmByte := memoryArray byteAt: pc + 3.
  	(modrmByte bitAnd: 16rC0) caseOf: {
+ 		[16r80 "ModRegRegDisp32"] -> [offset := memoryArray unsignedLongAt: pc + 4 - self primitiveMemoryOffset.
- 		[16r80 "ModRegRegDisp32"] -> [offset := memoryArray unsignedLongAt: pc + 4 bigEndian: false.
  										 size := 7].
  		[16r40 "ModRegRegDisp8"] -> [offset := memoryArray byteAt: pc + 4.
  										offset > 127 ifTrue: [offset := offset - 256].
  										 size := 4] }
  		otherwise: [self reportPrimitiveFailure].
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + size
  			address: (((self perform: (self registerStateGetters at: (modrmByte bitAnd: 7) + ((rexByteOrNil bitAnd: 1) bitShift: 3) + 1))
  					+ offset)
  						bitAnd: 16rFFFFFFFFFFFFFFFF)
  			type: #read
  			accessor: (#(al: cl: dl: bl: spl: bpl: sil: dil: r8l: r9l: r10l: r11l: r12l: r13l: r14l: r15l:) at: ((modrmByte >> 3 bitAnd: 7) + ((rexByteOrNil bitAnd: 4) bitShift: 1) + 1)))
  		signal!

Item was changed:
  ----- Method: BochsX64Alien>>handleMovGvEbFailureAt:in:rex: (in category 'error handling') -----
  handleMovGvEbFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" rex: rexByteOrNil "<Integer|nil>"
  	"Convert an execution primitive failure for a register load into a ProcessorSimulationTrap signal."
  	| modrmByte mode srcIsSP srcVal dst offset |
  	self shouldBeImplemented.
  	modrmByte := memoryArray byteAt: pc + 3.
  	mode := modrmByte >> 6 bitAnd: 3.
  	srcIsSP := (modrmByte bitAnd: 7) = 4.
  	srcVal := self perform: (#(eax ecx edx ebx esp ebp esi edi) at: (modrmByte bitAnd: 7) + 1).
  	dst := #(eax: ecx: edx: ebx: esp: ebp: esi: edi:) at: ((modrmByte >> 3 bitAnd: 7) + 1).
  	mode = 1 ifTrue: "ModRegRegDisp8"
+ 		[offset := memoryArray byteAt: pc + ((srcIsSP ifTrue: [5] ifFalse: [4] "1-relative") - self primitiveMemoryOffset). 
- 		[offset := memoryArray byteAt: pc + (srcIsSP ifTrue: [5] ifFalse: [4]). "1-relative"
  		 offset > 127 ifTrue: [offset := offset - 256].
  		 ^(ProcessorSimulationTrap
  					pc: pc
  					nextpc: pc + (srcIsSP ifTrue: [5] ifFalse: [4])
  					address: ((srcVal + offset) bitAnd: 16rFFFFFFFF)
  					type: #read
  					accessor: dst)
  				signal].
  	mode = 2 ifTrue: "ModRegRegDisp32"
+ 		[offset := memoryArray unsignedLongAt: pc + ((srcIsSP ifTrue: [5] ifFalse: [4] "1-relative") - self primitiveMemoryOffset). 
- 		[offset := memoryArray unsignedLongAt: pc + (srcIsSP ifTrue: [5] ifFalse: [4]). "1-relative"
  		 ^(ProcessorSimulationTrap
  					pc: pc
  					nextpc: pc + (srcIsSP ifTrue: [8] ifFalse: [7])
  					address: ((srcVal + offset) bitAnd: 16rFFFFFFFF)
  					type: #read
  					accessor: dst)
  				signal].
  	^self reportPrimitiveFailure!

Item was changed:
  ----- Method: BochsX64Alien>>handleMovGvEvFailureAt:in:rex: (in category 'error handling') -----
  handleMovGvEvFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" rex: rexByteOrNil "<Integer|nil>"
  	"Convert an execution primitive failure for a register load into a ProcessorSimulationTrap signal."
  	| modrmByte getter setter offset |
  	self assert: rexByteOrNil notNil.
+ 	modrmByte := memoryArray byteAt: pc + 3 - self primitiveMemoryOffset.
- 	modrmByte := memoryArray byteAt: pc + 3.
  	setter := self registerStateSetters at: ((modrmByte >> 3 bitAnd: 7) + ((rexByteOrNil bitAnd: 4) << 1) + 1).
  	(modrmByte bitAnd: 16rC7) = 16r5 ifTrue: "ModRegInd & disp32"
  		[^(ProcessorSimulationTrap
  				pc: pc
  				nextpc: pc + 7
+ 				address: (memoryArray unsignedLongAt: pc + 4 - self primitiveMemoryOffset)
- 				address: (memoryArray unsignedLongAt: pc + 4 bigEndian: false)
  				type: #read
  				accessor: setter)
  			signal].
  	getter := self registerStateGetters at: ((modrmByte bitAnd: 7) + ((rexByteOrNil bitAnd: 1) << 3) + 1).
  	(modrmByte bitAnd: 16rC0) = 16r80 ifTrue: "ModRegRegDisp32"
+ 		[offset := memoryArray longAt: pc + 4 - self primitiveMemoryOffset.
- 		[offset := memoryArray longAt: pc + 4 bigEndian: false.
  		 ^(ProcessorSimulationTrap
  				pc: pc
  				nextpc: pc + 7
  				address: (self perform: getter) + offset
  				type: #read
  				accessor: setter)
  			signal].
  	(modrmByte bitAnd: 16rC0) = 16r40 ifTrue: "ModRegRegDisp8"
+ 		[offset := memoryArray byteAt: pc + 4 - self primitiveMemoryOffset.
- 		[offset := memoryArray byteAt: pc + 4.
  		 offset > 16r7F ifTrue:
  			[offset := offset - 16r100].
  		 ^(ProcessorSimulationTrap
  				pc: pc
  				nextpc: pc + 4
  				address: (self perform: getter) + offset
  				type: #read
  				accessor: setter)
  			signal].
  	(modrmByte bitAnd: 16rC0) = 16r00 ifTrue: "ModRegInd"
  		[^(ProcessorSimulationTrap
  				pc: pc
  				nextpc: pc + 3
  				address: (self perform: getter)
  				type: #read
  				accessor: setter)
  			signal].
  	^self reportPrimitiveFailure!

Item was changed:
  ----- Method: BochsX64Alien>>handleMovObALFailureAt:in:rex: (in category 'error handling') -----
  handleMovObALFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" rex: rexByteOrNil "<Integer|nil>"
  	"Convert an execution primitive failure for a write of al into a ProcessorSimulationTrap signal."
  	self assert: rexByteOrNil = 16r48.
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + 10
+ 			address: (memoryArray unsignedLong64At: pc + 3 - self primitiveMemoryOffset)
- 			address: (memoryArray unsignedLong64At: pc + 3)
  			type: #write
  			accessor: #al)
  		signal!

Item was changed:
  ----- Method: BochsX64Alien>>handleMovOvAXFailureAt:in:rex: (in category 'error handling') -----
  handleMovOvAXFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" rex: rexByteOrNil "<Integer|nil>"
  	"Convert an execution primitive failure for a write of rax into a ProcessorSimulationTrap signal."
  	self assert: rexByteOrNil = 16r48.
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + 10
+ 			address: (memoryArray unsignedLong64At: pc + 3 - self primitiveMemoryOffset)
- 			address: (memoryArray unsignedLong64At: pc + 3)
  			type: #write
  			accessor: #rax)
  		signal!

Item was changed:
  ----- Method: BochsX64Alien>>handleRetFailureAt:in:rex: (in category 'error handling') -----
  handleRetFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" rex: rexByteOrNil "<Integer|nil>"
  	"Convert an execution primitive failure for a ret into a ProcessorSimulationTrap signal."
  	self shouldBeImplemented.
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + 1
+ 			address: (memoryArray unsignedLong64At: self rsp + 1 - self primitiveMemoryOffset)
- 			address: (memoryArray unsignedLong64At: self rsp + 1)
  			type: #return
  			accessor: #rip:)
  		signal!

Item was changed:
  ----- Method: BochsX64Alien>>handleTwoByteEscapeFailureAt:in:rex: (in category 'error handling') -----
  handleTwoByteEscapeFailureAt: pc in: memoryArray "<Bitmap|ByteArray>" rex: rexByteOrNil
  	"Handle an execution primitive failure for the 0f prefix.  Convert failures into ProcessorSimulationTrap signals."
  	"self printIntegerRegistersOn: Transcript"
  	"self printRegistersOn: Transcript"
+ 	| opcode |
- 	| opcode offset |
  	"assume 0fh opcode or 0fh rex opcode"
+ 	opcode := memoryArray byteAt: pc + (rexByteOrNil ifNil: [2] ifNotNil: [3] "1 relative") - self primitiveMemoryOffset.
- 	offset := rexByteOrNil ifNil: [1] ifNotNil: [2].
- 	opcode := memoryArray byteAt: pc + offset + 1.
  	 ^self
  			perform: (ExtendedOpcodeExceptionMap at: opcode + 1)
  			with: pc
  			with: memoryArray
  			with: rexByteOrNil!

Item was changed:
  ----- Method: BochsX64Alien>>popWordIn: (in category 'execution') -----
  popWordIn: aMemory 
  	| sp word |
+ 	word := aMemory long64At: (sp := self rsp) + 1 - self primitiveMemoryOffset.
- 	word := aMemory long64At: (sp := self rsp) + 1.
  	self rsp: sp + 8.
  	^word!

Item was added:
+ ----- Method: BochsX64Alien>>primitiveMemoryOffset (in category 'primitives') -----
+ primitiveMemoryOffset
+ 	"Answer the memory offset. This may be non-zero to adapt to the SpurMemoryManager
+ 	 simulators discarding the first work of memory to implement a null pointer trap."
+ 	<primitive: 'primitiveMemoryOffset' module: 'BochsX64Plugin' error: ec>
+ 	^self reportPrimitiveFailure!

Item was added:
+ ----- Method: BochsX64Alien>>primitiveSetMemoryOffset: (in category 'primitives') -----
+ primitiveSetMemoryOffset: memoryOffset
+ 	"Set the memory offset. This may be non-zero to adapt to the SpurMemoryManager
+ 	 simulators discarding the first work of memory to implement a null pointer trap.
+ 	 Answer the previous value."
+ 	<primitive: 'primitiveMemoryOffset' module: 'BochsX64Plugin' error: ec>
+ 	^self reportPrimitiveFailure!

Item was changed:
  ----- Method: BochsX64Alien>>pushWord:in: (in category 'execution') -----
  pushWord: aValue in: aMemory
  	| sp |
+ 	sp := self rsp: self rsp - 8.
+ 	aMemory long64At: sp + 1 - self primitiveMemoryOffset put: aValue!
- 	sp := (self rsp: self rsp - 8).
- 	aMemory long64At: sp + 1 put: aValue!

Item was changed:
  ----- Method: BochsX64Alien>>retpcIn: (in category 'accessing-abstract') -----
  retpcIn: aMemory
+ 	^aMemory long64At: self rbp + 9 - self primitiveMemoryOffset!
- 	^aMemory long64At: self rbp + 9!

Item was added:
+ ----- Method: CogProcessorAlien>>memoryOffset (in category 'Cog API') -----
+ memoryOffset
+ 	"Answer the memory offset. This may be non-zero to adapt to the SpurMemoryManager
+ 	 simulators discarding the first work of memory to implement a null pointer trap."
+ 	^self primitiveMemoryOffset!

Item was added:
+ ----- Method: CogProcessorAlien>>memoryOffset: (in category 'Cog API') -----
+ memoryOffset: anInteger
+ 	"Set the memory offset. This may be non-zero to adapt to the SpurMemoryManager
+ 	  simulators discarding the first work of memory to implement a null pointer trap.
+ 	  Answer the previous value."
+ 	^self primitiveSetMemoryOffset: anInteger!

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"
  	| pcOnEntry pc instr |
  	pc := pcOnEntry := self pc.
  	self endCondition = InstructionPrefetchError ifTrue:
  		[pc := self pc: self priorPc].
  
  	(pc between: minimumAddress and: memoryArray byteSize - 1) ifTrue:
+ 		[instr := memoryArray unsignedLongAt:  pc + 1 - self primitiveMemoryOffset.
- 		[instr := memoryArray unsignedLongAt:  pc + 1 bigEndian: false.
  
  		 (self endCondition = InstructionPrefetchError) ifTrue:
  			[^self handleFailingBranch: instr to: pcOnEntry at: pc].
  
  		 (self instructionIsAnyLoadStore: instr) ifTrue:
  			[^self handleFailingLoadStore: instr at: pc].
  
  		 (self instructionIsAnyFPArithmetic: instr) ifTrue:
  			[^self handleFailingFPArithmetic: instr at: pc].
  
  		 ^self handleExecutionPrimitiveFailureAt: pc in: memoryArray].
  
  	^self reportPrimitiveFailure!

Item was changed:
  ----- Method: GdbARMAlien>>handleExecutionPrimitiveFailureIn:minimumAddress:code: (in category 'error handling') -----
  handleExecutionPrimitiveFailureIn: memoryArray "<Bitmap|ByteArray>" minimumAddress: minimumAddress "<Integer>"code: errorCode "<Integer>"
  	"Handle an execution primitive failure.  Convert out-of-range call and absolute
  	 memory read into register instructions into ProcessorSimulationTrap signals."
  	"self printRegistersOn: Transcript"
  	| pcOnEntry pc instr |
  	pc := pcOnEntry := self pc.
  	errorCode = InstructionPrefetchError ifTrue:
  		[pc := self pc: self priorPc].
  
  	(pc between: minimumAddress and: memoryArray byteSize - 1) ifTrue:
+ 		[instr := memoryArray unsignedLongAt: pc + 1 - self primitiveMemoryOffset.
- 		[instr := memoryArray unsignedLongAt:  pc + 1 bigEndian: false.
  
  		 errorCode = InstructionPrefetchError ifTrue:
  			[^self handleFailingBranch: instr to: pcOnEntry at: pc].
  
  		 (self instructionIsAnyLoadStore: instr) ifTrue:
  			[^self handleFailingLoadStore: instr at: pc].
  
  		 (self instructionIsAnyFPArithmetic: instr) ifTrue:
+ 			[^self handleFailingFPArithmetic: instr at: pc]].
- 			[^self handleFailingFPArithmetic: instr at: pc].
  
- 		 ^self handleExecutionPrimitiveFailureAt: pc in: memoryArray].
- 
  	^self reportPrimitiveFailure!

Item was changed:
  ----- Method: GdbARMAlien>>popWordIn: (in category 'execution') -----
  popWordIn: aMemory 
  	| sp word |
+ 	word := aMemory unsignedLongAt: (sp := self sp) + 1 - self primitiveMemoryOffset.
- 	word := aMemory unsignedLongAt: (sp := self sp) + 1 bigEndian: false.
  	self sp: sp + 4.
  	^word!

Item was added:
+ ----- Method: GdbARMAlien>>primitiveMemoryOffset (in category 'primitives') -----
+ primitiveMemoryOffset
+ 	"Answer the memory offset. This may be non-zero to adapt to the SpurMemoryManager
+ 	 simulators discarding the first work of memory to implement a null pointer trap."
+ 	<primitive: 'primitiveMemoryOffset' module: 'GdbARMPlugin' error: ec>
+ 	^self reportPrimitiveFailure!

Item was added:
+ ----- Method: GdbARMAlien>>primitiveSetMemoryOffset: (in category 'primitives') -----
+ primitiveSetMemoryOffset: memoryOffset
+ 	"Set the memory offset. This may be non-zero to adapt to the SpurMemoryManager
+ 	 simulators discarding the first work of memory to implement a null pointer trap.
+ 	 Answer the previous value."
+ 	<primitive: 'primitiveMemoryOffset' module: 'GdbARMPlugin' error: ec>
+ 	^self reportPrimitiveFailure!

Item was changed:
  ----- Method: GdbARMAlien>>pushWord:in: (in category 'execution') -----
  pushWord: aValue in: aMemory
+ 	aMemory longAt: (self sp: self sp - 4) + 1 - self primitiveMemoryOffset put: aValue bigEndian: false!
- 	aMemory longAt: (self sp: self sp - 4) + 1 put: aValue bigEndian: false!

Item was changed:
  ----- Method: GdbARMAlien>>retpcIn: (in category 'accessing-abstract') -----
  retpcIn: aMemory
  	"The return address is on the stack, having been pushed by either
  	 simulateCallOf:nextpc:memory: or simulateJumpCallOf:memory:"
+ 	^aMemory unsignedLongAt: self fp + 5 - self primitiveMemoryOffset!
- 	^aMemory unsignedLongAt: self fp + 5 bigEndian: false!

Item was changed:
  ----- Method: GdbARMv8Alien class>>initialize (in category 'class initialization') -----
  initialize
  	"Initialize the execution failure dispatch table.  This is organized around op0 in C4.1 of the Arm ARM.
  	 Each tuple is a type and a failure routine, or nil of not needed to be handled as an execution failure."
  	"self initialize"
  	Level0FailureTable := #(
  			"0"	nil nil nil nil
+ 			"4"	(LDST	handleFailingLoadStore:at:)
- 			"4"	(LDST	handleFailingLoadStore:at:in:)
  			"5"	nil
+ 			"6"	(LDST	handleFailingLoadStore:at:)
- 			"6"	(LDST	handleFailingLoadStore:at:in:)
  			"7"	nil nil nil
+ 			"a"	(BR		handleFailingBranch:at:)
+ 			"b"	(BR		handleFailingBranch:at:)
+ 			"c"	(LDST	handleFailingLoadStore:at:)
- 			"a"	(BR		handleFailingBranch:at:in:)
- 			"b"	(BR		handleFailingBranch:at:in:)
- 			"c"	(LDST	handleFailingLoadStore:at:in:)
  			"d"	nil
+ 			"e"	(LDST	handleFailingLoadStore:at:)
- 			"e"	(LDST	handleFailingLoadStore:at:in:)
  			nil).
  
  	"At least Raspberry Pi 4 running Manjaro allows access to EL1 level system registers...
  	 These values are derived from the program in
  		https://android.googlesource.com/kernel/common/+/refs/tags/ASB-2019-03-05_4.14-p-release/Documentation/arm64/cpu-feature-registers.txt
  	 run on a raspberry Pi 4 Model B"
  	 
  	ID_AA64ISAR0_EL1		:= 16r00010000.
  	ID_AA64ISAR1_EL1		:= 16r00000000.
  	ID_AA64MMFR0_EL1	:= 16rFF000000.
  	ID_AA64MMFR1_EL1	:= 16r00000000.
  	ID_AA64PFR0_EL1		:= 16r00000011.
  	ID_AA64PFR1_EL1		:= 16r00000000.
  	ID_AA64DFR0_EL1		:= 16r00000006.
  	ID_AA64DFR1_EL1		:= 16r00000000
  !

Item was changed:
  ----- Method: GdbARMv8Alien>>handleExecutionPrimitiveFailureIn:minimumAddress:code: (in category 'error handling') -----
  handleExecutionPrimitiveFailureIn: memoryArray "<Bitmap|ByteArray>" minimumAddress: minimumAddress "<Integer>" code: errorCode "<Integer>"
  	"Handle an execution primitive failure.  Convert out-of-range call and absolute
  	 memory read into register instructions into ProcessorSimulationTrap signals."
  	"self disassembleInstructionAt: self pc In: memoryArray"
  	| instr pc op |
  	pc := self pc.
  	instr := self instr.
+ 	"(pc between: minimumAddress and: memoryArray byteSize - 1) ifTrue:
+ 		[self assert: instr = (memoryArray unsignedLongAt: pc + 1 - self primitiveGetMemoryOffset)]."
- 	(pc between: minimumAddress and: memoryArray byteSize - 1) ifTrue:
- 		[self assert: instr = (memoryArray unsignedLongAt: pc + 1 bigEndian: false)].
  	op := instr >> 25 bitAnd: 16rF.
  	(Level0FailureTable at: op + 1) ifNotNil:
  		[:tuple|
+ 		^self perform: (tuple at: 2) with: instr with: pc].
- 		^self perform: (tuple at: 2) with: instr with: pc with: memoryArray].
  	^self reportPrimitiveFailure!

Item was added:
+ ----- Method: GdbARMv8Alien>>handleFailingBranch:at: (in category 'error handling') -----
+ handleFailingBranch: instruction at: pc
+ 	"see C4.1.3 Branches, Exception Generating and System instructions in Arm ARM.
+ 	 Table C4-4 op1 plus the two top bit of op1"
+ 	| opcOp2Op3Op4 op1CRnCRmOp2 |
+ 	"self disassembleInstructionAt: self pc In: memoryArray"
+ 	(instruction bitShift: -25) = 2r1101011 ifTrue: "Unconditional branch (register) on page C4-262"
+ 		[opcOp2Op3Op4 := instruction bitAnd: 2r1111111111111110000011111.
+ 		 opcOp2Op3Op4 = 2r10111110000000000000000 ifTrue: "RET"
+ 			[^(ProcessorSimulationTrap
+ 				pc: pc
+ 				nextpc: pc + 4
+ 				address: self lr
+ 				type: #return)
+ 			signal].
+ 		 opcOp2Op3Op4 = 2r1111110000000000000000 ifTrue: "BLR"
+ 			[^(ProcessorSimulationTrap
+ 				pc: pc
+ 				nextpc: pc + 4
+ 				address: (self perform: (self registerStateGetters at: ((instruction >> 5) bitAnd: 31) + 1))
+ 				type: #call)
+ 			signal].
+ 		 opcOp2Op3Op4 = 2r0111110000000000000000 ifTrue: "BR"
+ 			[^(ProcessorSimulationTrap
+ 				pc: pc
+ 				nextpc: pc + 4
+ 				address: (self perform: (self registerStateGetters at: ((instruction >> 5) bitAnd: 31) + 1))
+ 				type: #jump)
+ 			signal]].
+ 	instruction = self clrexOpcode ifTrue:
+ 		[self pc: pc + 4.
+ 		 ^self].
+ 	(instruction bitShift: -19) = 2r1101010100111 ifTrue: "MRS Op0=3"
+ 		[op1CRnCRmOp2 := instruction bitAnd: 2r1111111111111100000.
+ 		 "At least Raspberry Pi 4 running Manjaro allows access to ID_AA64ISAR0_EL1"
+ 		 op1CRnCRmOp2 = 2r11000000000 ifTrue:
+ 			[self perform: (self registerStateSetters at: (instruction bitAnd: 31) + 1) with: ID_AA64ISAR0_EL1.
+ 			 self pc: pc + 4.
+ 			 ^self]].
+ 	self reportPrimitiveFailure!

Item was removed:
- ----- Method: GdbARMv8Alien>>handleFailingBranch:at:in: (in category 'error handling') -----
- handleFailingBranch: instruction at: pc in: memoryArray "<DoubleWordArray|ByteArray>"
- 	"see C4.1.3 Branches, Exception Generating and System instructions in Arm ARM.
- 	 Table C4-4 op1 plus the two top bit of op1"
- 	| opcOp2Op3Op4 op1CRnCRmOp2 |
- 	"self disassembleInstructionAt: self pc In: memoryArray"
- 	(instruction bitShift: -25) = 2r1101011 ifTrue: "Unconditional branch (register) on page C4-262"
- 		[opcOp2Op3Op4 := instruction bitAnd: 2r1111111111111110000011111.
- 		 opcOp2Op3Op4 = 2r10111110000000000000000 ifTrue: "RET"
- 			[^(ProcessorSimulationTrap
- 				pc: pc
- 				nextpc: pc + 4
- 				address: self lr
- 				type: #return)
- 			signal].
- 		 opcOp2Op3Op4 = 2r1111110000000000000000 ifTrue: "BLR"
- 			[^(ProcessorSimulationTrap
- 				pc: pc
- 				nextpc: pc + 4
- 				address: (self perform: (self registerStateGetters at: ((instruction >> 5) bitAnd: 31) + 1))
- 				type: #call)
- 			signal].
- 		 opcOp2Op3Op4 = 2r0111110000000000000000 ifTrue: "BR"
- 			[^(ProcessorSimulationTrap
- 				pc: pc
- 				nextpc: pc + 4
- 				address: (self perform: (self registerStateGetters at: ((instruction >> 5) bitAnd: 31) + 1))
- 				type: #jump)
- 			signal]].
- 	instruction = self clrexOpcode ifTrue:
- 		[self pc: pc + 4.
- 		 ^self].
- 	(instruction bitShift: -19) = 2r1101010100111 ifTrue: "MRS Op0=3"
- 		[op1CRnCRmOp2 := instruction bitAnd: 2r1111111111111100000.
- 		 "At least Raspberry Pi 4 running Manjaro allows access to ID_AA64ISAR0_EL1"
- 		 op1CRnCRmOp2 = 2r11000000000 ifTrue:
- 			[self perform: (self registerStateSetters at: (instruction bitAnd: 31) + 1) with: ID_AA64ISAR0_EL1.
- 			 self pc: pc + 4.
- 			 ^self]].
- 	self reportPrimitiveFailure!

Item was added:
+ ----- Method: GdbARMv8Alien>>handleFailingLoadStore:at: (in category 'error handling') -----
+ handleFailingLoadStore: instruction at: pc
+ 	"C4.1.4		Loads and Stores	C4-266
+ 	 This section describes the encoding of the Loads and Stores group. The encodings in this section are decoded from A64 instruction set encoding on page C4-252.
+ 
+ 		Table C4-5 Encoding table for the Loads and Stores group
+   
+ 		op0 31:28 1 op1 26 0 op2 24:23 x op3 21:16 x op4 11:10
+ 
+ 		op0		op2		op3			op4
+ 		xx11	0x		0xxxxx		00	Load/store register (unscaled immediate) on page C4-283
+ 		xx11	0x		0xxxxx		01	Load/store register (immediate post-indexed) on page C4-284
+ 		xx11	0x		0xxxxx		10	Load/store register (unprivileged) on page C4-286
+ 		xx11	0x		0xxxxx		11	Load/store register (immediate pre-indexed) on page C4-286
+ 		xx11	0x		1xxxxx		00	Atomic memory operations on page C4-288
+ 		xx11	0x		1xxxxx		10	Load/store register (register offset) on page C4-295
+ 		xx11	0x		1xxxxx		x1	Load/store register (pac) on page C4-297
+ 		xx11	1x		1xxxxx		-	Load/store register (unsigned immediate) on page C4-297
+ 
+ 		Load/store exclusive table starts on page C4-277 (. implies a bit)
+ 		|size..|0 0 1 0 0 0|o2.|L.|o1.|Rs.....|o0.|Rt2.....|Rn.....|Rt.....|
+ 		o2 = bit 23, L=bit 22, o1 = bit 21, o0 = bit 15"
+ 
+ 	| op0op2 size op4 rm rn rt opc v offsetFromImm addr shift |
+ 	"self disassembleInstructionAt: self pc In: memoryArray"
+ 	size := instruction bitShift: -30.
+ 	opc := (instruction bitShift: -22) bitAnd: 3.
+ 	op4 := (instruction bitShift: -10) bitAnd: 3.
+ 	rn := (instruction bitShift: -5) bitAnd: 31.
+ 	rt := instruction bitAnd: 31.
+ 	(rn = 31 and: [self sp anyMask: 15]) ifTrue:
+ 		[self reportStackAlignmentVolation].
+ 	"op0 = xx11 op2 = 0x"
+ 	(op0op2 := (instruction bitShift: -23) bitAnd: 2r1100010) = 2r1100000 ifFalse:
+ 		[offsetFromImm := ARMv8A64Opcodes extractOffsetFromLoadStore: instruction.
+ 		 (v := instruction >> 26 bitAnd: 1) = 0 ifFalse: [self halt].
+ 		 addr := (self perform: (self registerStateGetters at: rn + 1)) + offsetFromImm.
+ 		 op0op2 = 2r1100010 ifTrue: "Load/store register (unsigned immediate) on page C4-297"
+ 			[^(opc = 0
+ 				ifTrue:
+ 					[ProcessorSimulationTrap
+ 							pc: pc
+ 							nextpc: pc + 4
+ 							address: addr
+ 							type: #write
+ 							accessor: ((self registerStateGettersForSizes: size) at: rt + 1)]
+ 				ifFalse:
+ 					[ProcessorSimulationTrap
+ 							pc: pc
+ 							nextpc: pc + 4
+ 							address: addr
+ 							type: #read
+ 							accessor: ((self registerStateSettersForSizes: size) at: rt + 1)])
+ 					signal].
+ 		 op0op2 = 2r1000010 ifTrue: "Load/store register pair (signed immediate) on page C4-282"
+ 			[| rt2 |
+ 			 rt2 := (instruction bitShift: -10) bitAnd: 31.
+ 			 ^opc = 0
+ 				ifTrue:
+ 					[(ProcessorSimulationTrap
+ 							pc: pc
+ 							nextpc: pc + 4
+ 							address: addr
+ 							type: #write
+ 							accessor: ((self registerStateGettersForSizes: size + 1) at: rt + 1))
+ 						signal.
+ 					 (ProcessorSimulationTrap
+ 							pc: pc
+ 							nextpc: pc + 4
+ 							address: addr + 8
+ 							type: #write
+ 							accessor: ((self registerStateGettersForSizes: size + 1) at: rt2 + 1))
+ 						signal]
+ 				ifFalse:
+ 					[(ProcessorSimulationTrap
+ 							pc: pc
+ 							nextpc: pc + 4
+ 							address: addr
+ 							type: #read
+ 							accessor: ((self registerStateSettersForSizes: size + 1) at: rt + 1))
+ 						signal.
+ 					 (ProcessorSimulationTrap
+ 							pc: pc
+ 							nextpc: pc + 4
+ 							address: addr + 8
+ 							type: #read
+ 							accessor: ((self registerStateSettersForSizes: size + 1) at: rt2 + 1))
+ 						signal]].
+ 		
+ 		op0op2 = 0 ifTrue: "LDAXR/STLXR register on page C4-279"
+ 			[| result rs |
+ 			 self assert: size = 3.
+ 			 opc = 1 ifTrue:
+ 				[^(ProcessorSimulationTrap
+ 							pc: pc
+ 							nextpc: pc + 4
+ 							address: addr
+ 							type: #read
+ 							accessor: (self registerStateSetters at: rt + 1)) signal].
+ 			 opc = 0 ifTrue:
+ 				[result := (ProcessorSimulationTrap
+ 								pc: pc
+ 								nextpc: pc + 4
+ 								address: addr
+ 								type: #write
+ 								accessor: (self registerStateGetters at: rt + 1)) signal.
+ 				rs := instruction >> 16 bitAnd: 31.
+ 				"For now assume the write succeeded..."
+ 				self perform: ((self registerStateSettersForSizes: 2) at: rs + 1)
+ 					with: 0.
+ 				^result]]].
+ 
+ 	((instruction bitShift: -21) noMask: 1) ifTrue: "op3 = 0xxxxx"
+ 		[offsetFromImm := ((instruction bitShift: -12) bitAnd: 16r1FF) bitShift: size.
+ 		 opc = 0 ifTrue:"C4-286	opc = 0 => store"
+ 			[self assert: size = 3.
+ 			^(ProcessorSimulationTrap
+ 					pc: pc
+ 					nextpc: pc + 4
+ 					address: (self perform: (self registerStateGetters at: rn + 1)) + offsetFromImm
+ 					type: #write
+ 					accessor: (self registerStateGetters at: rt + 1))
+ 				signal].
+ 		 opc = 1 ifTrue:
+ 			 [^(ProcessorSimulationTrap
+ 					pc: pc
+ 					nextpc: pc + 4
+ 					address: (self perform: (self registerStateGetters at: rn + 1)) + offsetFromImm
+ 					type: #read
+ 					accessor: ((self registerStateSettersForSizes: size) at: rt + 1))
+ 				signal].
+ 		self halt: 'op3 = 0xxxxx opc > 1'].
+ 
+ 		"op0	op2		op3			op4
+ 		 xx11	0x		1xxxxx		10		Load/store register (register offset) on page C4-295 (296/297)"
+ 	
+ 	v := instruction >> 26 bitAnd: 1.
+ 	rm := instruction >> 16 bitAnd: 31.
+ 	shift := instruction anyMask: 1 << 12.
+ 	(size = 3 and: [v = 0]) ifTrue:
+ 		[addr := (self perform: (self registerStateGetters at: rn + 1))
+ 				+ (shift
+ 					ifTrue: [(self perform: (self registerStateGetters at: rm + 1)) << size]
+ 					ifFalse: [self perform: (self registerStateGetters at: rm + 1)]).
+ 		 opc = 0 ifTrue: "STR (register) - 64-bit variant on page C6-1242"
+ 			[^(ProcessorSimulationTrap
+ 					pc: pc
+ 					nextpc: pc + 4
+ 					address: addr
+ 					type: #write
+ 					accessor: (self registerStateGetters at: rt + 1))
+ 				signal].
+ 		 opc = 1 ifTrue: "LDR (register) - 64-bit variant on page C6-981"
+ 			 [^(ProcessorSimulationTrap
+ 					pc: pc
+ 					nextpc: pc + 4
+ 					address: addr
+ 					type: #read
+ 					accessor: (self registerStateSetters at: rt + 1))
+ 				signal].
+ 		 (opc = 3 and: [instruction >> 10 allMask: 63]) ifTrue: "CASAL C4-278/C6-829"
+ 			[^(CompareAndSwapSimulationTrap
+ 					pc: pc
+ 					nextpc: pc + 4
+ 					address: (self perform: (self registerStateGetters at: rn + 1))
+ 					type: #write
+ 					accessor: (self registerStateSetters at: rm + 1))
+ 				expectedValue: (self perform: (self registerStateGetters at: rm + 1));
+ 				storedValue: (self perform: (self registerStateGetters at: rt + 1));
+ 				signal].
+ 		self halt: 'op3 = 1xxxxx opc > 1'].
+ 	self halt: 'op3 = 1xxxxx size ~= 3'!

Item was removed:
- ----- Method: GdbARMv8Alien>>handleFailingLoadStore:at:in: (in category 'error handling') -----
- handleFailingLoadStore: instruction at: pc in: memoryArray "<DoubleWordArray|ByteArray>"
- 	"C4.1.4		Loads and Stores	C4-266
- 	 This section describes the encoding of the Loads and Stores group. The encodings in this section are decoded from A64 instruction set encoding on page C4-252.
- 
- 		Table C4-5 Encoding table for the Loads and Stores group
-   
- 		op0 31:28 1 op1 26 0 op2 24:23 x op3 21:16 x op4 11:10
- 
- 		op0		op2		op3			op4
- 		xx11	0x		0xxxxx		00	Load/store register (unscaled immediate) on page C4-283
- 		xx11	0x		0xxxxx		01	Load/store register (immediate post-indexed) on page C4-284
- 		xx11	0x		0xxxxx		10	Load/store register (unprivileged) on page C4-286
- 		xx11	0x		0xxxxx		11	Load/store register (immediate pre-indexed) on page C4-286
- 		xx11	0x		1xxxxx		00	Atomic memory operations on page C4-288
- 		xx11	0x		1xxxxx		10	Load/store register (register offset) on page C4-295
- 		xx11	0x		1xxxxx		x1	Load/store register (pac) on page C4-297
- 		xx11	1x		1xxxxx		-	Load/store register (unsigned immediate) on page C4-297
- 
- 		Load/store exclusive table starts on page C4-277 (. implies a bit)
- 		|size..|0 0 1 0 0 0|o2.|L.|o1.|Rs.....|o0.|Rt2.....|Rn.....|Rt.....|
- 		o2 = bit 23, L=bit 22, o1 = bit 21, o0 = bit 15"
- 
- 	| op0op2 size op4 rm rn rt opc v offsetFromImm addr shift |
- 	"self disassembleInstructionAt: self pc In: memoryArray"
- 	size := instruction bitShift: -30.
- 	opc := (instruction bitShift: -22) bitAnd: 3.
- 	op4 := (instruction bitShift: -10) bitAnd: 3.
- 	rn := (instruction bitShift: -5) bitAnd: 31.
- 	rt := instruction bitAnd: 31.
- 	(rn = 31 and: [self sp anyMask: 15]) ifTrue:
- 		[self reportStackAlignmentVolation].
- 	"op0 = xx11 op2 = 0x"
- 	(op0op2 := (instruction bitShift: -23) bitAnd: 2r1100010) = 2r1100000 ifFalse:
- 		[offsetFromImm := ARMv8A64Opcodes extractOffsetFromLoadStore: instruction.
- 		 (v := instruction >> 26 bitAnd: 1) = 0 ifFalse: [self halt].
- 		 addr := (self perform: (self registerStateGetters at: rn + 1)) + offsetFromImm.
- 		 op0op2 = 2r1100010 ifTrue: "Load/store register (unsigned immediate) on page C4-297"
- 			[^(opc = 0
- 				ifTrue:
- 					[ProcessorSimulationTrap
- 							pc: pc
- 							nextpc: pc + 4
- 							address: addr
- 							type: #write
- 							accessor: ((self registerStateGettersForSizes: size) at: rt + 1)]
- 				ifFalse:
- 					[ProcessorSimulationTrap
- 							pc: pc
- 							nextpc: pc + 4
- 							address: addr
- 							type: #read
- 							accessor: ((self registerStateSettersForSizes: size) at: rt + 1)])
- 					signal].
- 		 op0op2 = 2r1000010 ifTrue: "Load/store register pair (signed immediate) on page C4-282"
- 			[| rt2 |
- 			 rt2 := (instruction bitShift: -10) bitAnd: 31.
- 			 ^opc = 0
- 				ifTrue:
- 					[(ProcessorSimulationTrap
- 							pc: pc
- 							nextpc: pc + 4
- 							address: addr
- 							type: #write
- 							accessor: ((self registerStateGettersForSizes: size + 1) at: rt + 1))
- 						signal.
- 					 (ProcessorSimulationTrap
- 							pc: pc
- 							nextpc: pc + 4
- 							address: addr + 8
- 							type: #write
- 							accessor: ((self registerStateGettersForSizes: size + 1) at: rt2 + 1))
- 						signal]
- 				ifFalse:
- 					[(ProcessorSimulationTrap
- 							pc: pc
- 							nextpc: pc + 4
- 							address: addr
- 							type: #read
- 							accessor: ((self registerStateSettersForSizes: size + 1) at: rt + 1))
- 						signal.
- 					 (ProcessorSimulationTrap
- 							pc: pc
- 							nextpc: pc + 4
- 							address: addr + 8
- 							type: #read
- 							accessor: ((self registerStateSettersForSizes: size + 1) at: rt2 + 1))
- 						signal]].
- 		
- 		op0op2 = 0 ifTrue: "LDAXR/STLXR register on page C4-279"
- 			[| result rs |
- 			 self assert: size = 3.
- 			 opc = 1 ifTrue:
- 				[^(ProcessorSimulationTrap
- 							pc: pc
- 							nextpc: pc + 4
- 							address: addr
- 							type: #read
- 							accessor: (self registerStateSetters at: rt + 1)) signal].
- 			 opc = 0 ifTrue:
- 				[result := (ProcessorSimulationTrap
- 								pc: pc
- 								nextpc: pc + 4
- 								address: addr
- 								type: #write
- 								accessor: (self registerStateGetters at: rt + 1)) signal.
- 				rs := instruction >> 16 bitAnd: 31.
- 				"For now assume the write succeeded..."
- 				self perform: ((self registerStateSettersForSizes: 2) at: rs + 1)
- 					with: 0.
- 				^result]]].
- 
- 	((instruction bitShift: -21) noMask: 1) ifTrue: "op3 = 0xxxxx"
- 		[offsetFromImm := ((instruction bitShift: -12) bitAnd: 16r1FF) bitShift: size.
- 		 opc = 0 ifTrue:"C4-286	opc = 0 => store"
- 			[self assert: size = 3.
- 			^(ProcessorSimulationTrap
- 					pc: pc
- 					nextpc: pc + 4
- 					address: (self perform: (self registerStateGetters at: rn + 1)) + offsetFromImm
- 					type: #write
- 					accessor: (self registerStateGetters at: rt + 1))
- 				signal].
- 		 opc = 1 ifTrue:
- 			 [^(ProcessorSimulationTrap
- 					pc: pc
- 					nextpc: pc + 4
- 					address: (self perform: (self registerStateGetters at: rn + 1)) + offsetFromImm
- 					type: #read
- 					accessor: ((self registerStateSettersForSizes: size) at: rt + 1))
- 				signal].
- 		self halt: 'op3 = 0xxxxx opc > 1'].
- 
- 		"op0	op2		op3			op4
- 		 xx11	0x		1xxxxx		10		Load/store register (register offset) on page C4-295 (296/297)"
- 	
- 	v := instruction >> 26 bitAnd: 1.
- 	rm := instruction >> 16 bitAnd: 31.
- 	shift := instruction anyMask: 1 << 12.
- 	(size = 3 and: [v = 0]) ifTrue:
- 		[addr := (self perform: (self registerStateGetters at: rn + 1))
- 				+ (shift
- 					ifTrue: [(self perform: (self registerStateGetters at: rm + 1)) << size]
- 					ifFalse: [self perform: (self registerStateGetters at: rm + 1)]).
- 		 opc = 0 ifTrue: "STR (register) - 64-bit variant on page C6-1242"
- 			[^(ProcessorSimulationTrap
- 					pc: pc
- 					nextpc: pc + 4
- 					address: addr
- 					type: #write
- 					accessor: (self registerStateGetters at: rt + 1))
- 				signal].
- 		 opc = 1 ifTrue: "LDR (register) - 64-bit variant on page C6-981"
- 			 [^(ProcessorSimulationTrap
- 					pc: pc
- 					nextpc: pc + 4
- 					address: addr
- 					type: #read
- 					accessor: (self registerStateSetters at: rt + 1))
- 				signal].
- 		 (opc = 3 and: [instruction >> 10 allMask: 63]) ifTrue: "CASAL C4-278/C6-829"
- 			[^(CompareAndSwapSimulationTrap
- 					pc: pc
- 					nextpc: pc + 4
- 					address: (self perform: (self registerStateGetters at: rn + 1))
- 					type: #write
- 					accessor: (self registerStateSetters at: rm + 1))
- 				expectedValue: (self perform: (self registerStateGetters at: rm + 1));
- 				storedValue: (self perform: (self registerStateGetters at: rt + 1));
- 				signal].
- 		self halt: 'op3 = 1xxxxx opc > 1'].
- 	self halt: 'op3 = 1xxxxx size ~= 3'!

Item was changed:
  ----- Method: GdbARMv8Alien>>popWordIn: (in category 'execution') -----
  popWordIn: aMemory 
  	| sp word |
+ 	word := aMemory long64At: (sp := self sp) + 1 - self primitiveMemoryOffset.
- 	word := aMemory long64At: (sp := self sp) + 1.
  	self sp: sp + 8.
  	^word!

Item was added:
+ ----- Method: GdbARMv8Alien>>primitiveMemoryOffset (in category 'primitives') -----
+ primitiveMemoryOffset
+ 	"Answer the memory offset. This may be non-zero to adapt to the SpurMemoryManager
+ 	 simulators discarding the first work of memory to implement a null pointer trap."
+ 	<primitive: 'primitiveMemoryOffset' module: 'GdbARMv8Plugin' error: ec>
+ 	^self reportPrimitiveFailure!

Item was added:
+ ----- Method: GdbARMv8Alien>>primitiveSetMemoryOffset: (in category 'primitives') -----
+ primitiveSetMemoryOffset: memoryOffset
+ 	"Set the memory offset. This may be non-zero to adapt to the SpurMemoryManager
+ 	 simulators discarding the first work of memory to implement a null pointer trap.
+ 	 Answer the previous value."
+ 	<primitive: 'primitiveMemoryOffset' module: 'GdbARMv8Plugin' error: ec>
+ 	^self reportPrimitiveFailure!

Item was changed:
  ----- Method: GdbARMv8Alien>>pushPair:and:in: (in category 'execution') -----
  pushPair: aValue and: bValue in: aMemory
  	| sp |
  	sp := self sp.
  	self assert: (sp noMask: 15).
  	aMemory
+ 		unsignedLong64At: sp - 8 + 1 - self primitiveMemoryOffset put: aValue;
+ 		unsignedLong64At: sp - 16 + 1 - self primitiveMemoryOffset put: bValue.
- 		unsignedLong64At: sp - 8 + 1 put: aValue;
- 		unsignedLong64At: sp - 16 + 1 put: bValue.
  	^self sp: sp - 16!

Item was changed:
  ----- Method: GdbARMv8Alien>>pushWord:in: (in category 'execution') -----
  pushWord: aValue in: aMemory
  	self assert: (self sp noMask: 15).
+ 	aMemory unsignedLong64At: (self sp: self sp - 8) + 1 - self primitiveMemoryOffset put: aValue!
- 	aMemory unsignedLong64At: (self sp: self sp - 8) + 1 put: aValue!

Item was changed:
  ----- Method: GdbARMv8Alien>>retpcIn: (in category 'accessing-abstract') -----
  retpcIn: aMemory
  	"The return address is on the stack, having been pushed by either
  	 simulateCallOf:nextpc:memory: or simulateJumpCallOf:memory:"
+ 	^aMemory long64At: self fp + 9 - self primitiveMemoryOffset!
- 	^aMemory long64At: self fp + 9!

Item was added:
+ ----- Method: GdbARMv8Alien64>>handleExecutionPrimitiveFailureIn:minimumAddress:code: (in category 'error handling') -----
+ handleExecutionPrimitiveFailureIn: memoryArray "<Bitmap|ByteArray>" minimumAddress: minimumAddress "<Integer>" code: errorCode "<Integer>"
+ 	"Handle an execution primitive failure.  Convert out-of-range call and absolute
+ 	 memory read into register instructions into ProcessorSimulationTrap signals."
+ 	"self disassembleInstructionAt: self pc In: memoryArray"
+ 	| instr pc op |
+ 	pc := self pc.
+ 	instr := self instr.
+ 	"(pc between: minimumAddress and: memoryArray byteSize - 1) ifTrue:
+ 		[self assert: instr = (memoryArray unsignedLongAt: pc + 1 - self primitiveGetMemoryOffset)]."
+ 	op := instr >> 25 bitAnd: 16rF.
+ 	(Level0FailureTable at: op + 1) ifNotNil:
+ 		[:tuple|
+ 		^self perform: (tuple at: 2) with: instr with: pc].
+ 	^self reportPrimitiveFailure!

Item was changed:
  ----- Method: MIPSSimulator>>popWordIn: (in category 'processor api') -----
  popWordIn: aMemory 
  	| sp word |
+ 	word := aMemory unsignedLongAt: (sp := self sp) + 1 - self memoryOffset.
- 	word := aMemory unsignedLongAt: (sp := self sp) + 1 bigEndian: false.
  	self sp: sp + 4.
  	^word!

Item was changed:
  ----- Method: MIPSSimulator>>pushWord:in: (in category 'processor api') -----
  pushWord: aValue in: aMemory
+ 	aMemory longAt: (self sp: self sp - 4) + 1 - self memoryOffset put: aValue bigEndian: false!
- 	aMemory longAt: (self sp: self sp - 4) + 1 put: aValue bigEndian: false!



More information about the Vm-dev mailing list