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

commits at source.squeak.org commits at source.squeak.org
Tue Nov 19 17:33:43 UTC 2019


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

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

Name: Cog-eem.361
Author: eem
Time: 19 November 2019, 9:33:41.186354 am
UUID: 9d7000ea-c13c-4dff-8cf2-2599ed3fc21d
Ancestors: Cog-eem.360

Nuke the code duplication, bring all four Biochs/GDB processor simulators under one abstract superclass.

=============== Diff against Cog-eem.360 ===============

Item was changed:
+ ProcessorSimulatorPlugin subclass: #BochsIA32Plugin
- BochsPlugin subclass: #BochsIA32Plugin
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Cog-ProcessorPlugins'!
  
  !BochsIA32Plugin commentStamp: '<historical>' prior: 0!
  I provide access to the Bochs C++ IA32 processor emulator.!

Item was removed:
- SmartSyntaxInterpreterPlugin subclass: #BochsPlugin
- 	instanceVariableNames: 'prevInterruptCheckChain'
- 	classVariableNames: ''
- 	poolDictionaries: 'VMBasicConstants'
- 	category: 'Cog-ProcessorPlugins'!
- 
- !BochsPlugin commentStamp: 'eem 9/14/2015 16:30' prior: 0!
- BochsPlugin is the abstract superclass for plugins that interface to the Bochs C++ IA32/x64 processor emulator..
- 
- Instance Variables
- 	prevInterruptCheckChain:		<Symbol/function pointer>
- 
- prevInterruptCheckChain
- 	- the previous value of the interruptCheckChain function pointer
- !

Item was removed:
- ----- Method: BochsPlugin class>>declareCVarsIn: (in category 'translation') -----
- declareCVarsIn: aCCodeGenerator
- 	"prevInterruptCheckChain lives in sqBochsIA32|X64Plugin.c"
- 	self ~~ BochsPlugin ifTrue:
- 		[super declareCVarsIn: aCCodeGenerator.
- 		 aCCodeGenerator removeVariable: 'prevInterruptCheckChain']!

Item was removed:
- ----- Method: BochsPlugin class>>hasHeaderFile (in category 'translation') -----
- hasHeaderFile
- 	"We need a header to declare newcpu and pull in bochs.h & cpu.h"
- 	^true!

Item was removed:
- ----- Method: BochsPlugin class>>shouldBeTranslated (in category 'translation') -----
- shouldBeTranslated
- 	"Is this class intended to be translated as a plugin, perhaps specific to a platform?
- 	 Most subclasses should answer true, but some such as simulation-only versions
- 	 should answer false for various reasons."
- 	^super shouldBeTranslated and: [self ~~ BochsPlugin]!

Item was removed:
- ----- Method: BochsPlugin>>forceStopOnInterrupt (in category 'interruption') -----
- forceStopOnInterrupt
- 	<returnTypeC: #void>
- 	interpreterProxy getInterruptPending ifTrue:
- 		[self forceStopRunning]!

Item was removed:
- ----- Method: BochsPlugin>>primitiveDisassembleAt:InMemory: (in category 'primitives') -----
- "cpuAlien <BochsIA32|X86Alien>" primitiveDisassembleAt: address "<Integer>" InMemory: memory "<Bitmap|ByteArray|WordArray>"
- 	"Return an Array of the instruction length and its decompilation as a string for the instruction at address in memory."
- 	| cpuAlien cpu instrLenOrErr resultObj log logLen logObj logObjData |
- 	<var: #cpu type: #'void *'>
- 	<var: #log type: #'char *'>
- 	<var: #logLen type: #long>
- 	<var: #logObjData type: #'char *'>
- 	cpuAlien := self primitive: #primitiveDisassembleAtInMemory
- 					parameters: #(Unsigned WordsOrBytes)
- 					receiver: #Oop.
- 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
- 	instrLenOrErr := self disassembleFor: cpu
- 						At: address
- 						In: memory
- 						Size: (interpreterProxy byteSizeOf: memory cPtrAsOop).
- 	instrLenOrErr < 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
- 	log := self getlog: (self cCode: [self addressOf: logLen] inSmalltalk: [logLen := 0]).
- 	resultObj := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2.
- 	resultObj = 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
- 
- 	"Easier keeping the damn thing on the stack than using pushRemappableOop:/popRemappableOop.
- 	 Where is topRemappableOop when you need it?"
- 	interpreterProxy pushRemappableOop: resultObj.
- 	logObj := interpreterProxy
- 				instantiateClass: interpreterProxy classString
- 				indexableSize: logLen.
- 	interpreterProxy failed ifTrue:
- 		[interpreterProxy popRemappableOop.
- 		 ^interpreterProxy primitiveFailFor: PrimErrNoMemory].
- 	logObjData := interpreterProxy arrayValueOf: logObj.
- 	self mem: logObjData cp: log y: logLen.
- 	resultObj := interpreterProxy popRemappableOop.
- 	interpreterProxy
- 		storePointer: 0
- 		ofObject: resultObj
- 		withValue: (interpreterProxy integerObjectOf: instrLenOrErr).
- 	interpreterProxy storePointer: 1 ofObject: resultObj withValue: logObj.
- 
- 	^resultObj!

Item was removed:
- ----- Method: BochsPlugin>>primitiveErrorAndLog (in category 'primitives') -----
- primitiveErrorAndLog
- 	| log logLen resultObj logObj logObjData |
- 	<var: #log type: #'char *'>
- 	<var: #logLen type: #long>
- 	<var: #logObjData type: #'char *'>
- 	self primitive: #primitiveErrorAndLog parameters: #().
- 
- 	log := self getlog: (self cCode: [self addressOf: logLen] inSmalltalk: [logLen := 0]).
- 	resultObj := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2.
- 	resultObj = 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
- 
- 	interpreterProxy
- 		storePointer: 0
- 		ofObject: resultObj
- 		withValue: (interpreterProxy integerObjectOf: self errorAcorn).
- 
- 	logLen > 0 ifTrue:
- 		[interpreterProxy pushRemappableOop: resultObj.
- 		logObj := interpreterProxy
- 					instantiateClass: interpreterProxy classString
- 					indexableSize: logLen.
- 		interpreterProxy failed ifTrue:
- 			[interpreterProxy popRemappableOop.
- 			 ^interpreterProxy primitiveFailFor: PrimErrNoMemory].
- 
- 		resultObj := interpreterProxy popRemappableOop.
- 		logObjData := interpreterProxy arrayValueOf: logObj.
- 		self mem: logObjData cp: log y: logLen.
- 		interpreterProxy storePointer: 1 ofObject: resultObj withValue: logObj].
- 	interpreterProxy pop: 1 thenPush: resultObj!

Item was removed:
- ----- Method: BochsPlugin>>primitiveFlushICacheFrom:To: (in category 'primitives') -----
- "cpuAlien <BochsIA32|X86Alien>" primitiveFlushICacheFrom: startAddress "<Integer>" To: endAddress "<Integer>"
- 	"Flush the icache in the requested range"
- 	| cpuAlien cpu |
- 	<var: #cpu type: #'void *'>
- 	cpuAlien := self primitive: #primitiveFlushICacheFromTo
- 					parameters: #(Unsigned Unsigned)
- 					receiver: #Oop.
- 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
- 	self flushICache: cpu From: startAddress To: endAddress!

Item was removed:
- ----- Method: BochsPlugin>>primitiveNewCPU (in category 'primitives') -----
- primitiveNewCPU
- 	| cpu |
- 	<var: #cpu type: #'void *'>
- 	self primitive: #primitiveNewCPU parameters: #().
- 
- 	cpu := self newCPU.
- 	cpu = 0 ifTrue:
- 		[^interpreterProxy primitiveFail].
- 	interpreterProxy
- 		pop: 1
- 		thenPush: (interpreterProxy positiveMachineIntegerFor:
- 										(self cCoerceSimple: cpu
- 											to: 'usqIntptr_t'))!

Item was removed:
- ----- Method: BochsPlugin>>primitiveResetCPU (in category 'primitives') -----
- primitiveResetCPU
- 	| cpuAlien cpu maybeErr |
- 	<var: #cpu type: #'void *'>
- 	cpuAlien := self primitive: #primitiveResetCPU parameters: #() receiver: #Oop.
- 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
- 	maybeErr := self resetCPU: cpu.
- 	maybeErr ~= 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
- 	^cpuAlien!

Item was removed:
- ----- Method: BochsPlugin>>primitiveRunInMemory:minimumAddress:maximumAddress:readOnlyBelow: (in category 'primitives') -----
- "cpuAlien <BochsIA32|X86Alien>" primitiveRunInMemory: memory "<Bitmap|ByteArray|WordArray>" minimumAddress: minAddress "<Integer>" maximumAddress: maxAddress "<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."
- 	| cpuAlien cpu memorySize maybeErr |
- 	<var: #cpu type: #'void *'>
- 	cpuAlien := self primitive: #primitiveRunInMemoryMinAddressMaxAddressReadWrite
- 					parameters: #(WordsOrBytes Unsigned Unsigned Unsigned)
- 					receiver: #Oop.
- 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
- 	prevInterruptCheckChain := interpreterProxy setInterruptCheckChain: #forceStopOnInterrupt asSymbol.
- 	prevInterruptCheckChain = #forceStopOnInterrupt asSymbol ifTrue:
- 		[prevInterruptCheckChain = 0].
- 	memorySize := interpreterProxy byteSizeOf: memory cPtrAsOop.
- 	maybeErr := self runCPU: cpu
- 					In: memory
- 					Size: (memorySize min: maxAddress)
- 					MinAddressRead: minAddress
- 					Write: minWriteMaxExecAddress.
- 	interpreterProxy setInterruptCheckChain: prevInterruptCheckChain.
- 	maybeErr ~= 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
- 	^cpuAlien!

Item was removed:
- ----- Method: BochsPlugin>>primitiveRunInMemory:minimumAddress:readOnlyBelow: (in category 'primitives') -----
- "cpuAlien <BochsIA32|X86Alien>" 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."
- 	| cpuAlien cpu maybeErr |
- 	<var: #cpu type: #'void *'>
- 	cpuAlien := self primitive: #primitiveRunInMemoryMinimumAddressReadWrite
- 					parameters: #(WordsOrBytes Unsigned Unsigned)
- 					receiver: #Oop.
- 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 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!

Item was removed:
- ----- Method: BochsPlugin>>primitiveSingleStepInMemory:minimumAddress:maximumAddress:readOnlyBelow: (in category 'primitives') -----
- "cpuAlien <BochsIA32|X86Alien>" primitiveSingleStepInMemory: memory "<Bitmap|ByteArray|WordArray>" minimumAddress: minAddress "<Integer>" maximumAddress: maxAddress "<Integer>" readOnlyBelow: minWriteMaxExecAddress "<Integer>"
- 	"Single-step the cpu using the first argument as the memory and the following arguments defining valid addresses."
- 	| cpuAlien cpu memorySize maybeErr |
- 	<var: #cpu type: #'void *'>
- 	cpuAlien := self primitive: #primitiveSingleStepInMemoryMinAddressMaxAddressReadWrite
- 					parameters: #(WordsOrBytes Unsigned Unsigned Unsigned)
- 					receiver: #Oop.
- 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
- 	memorySize := interpreterProxy byteSizeOf: memory cPtrAsOop.
- 	maybeErr := self singleStepCPU: cpu
- 					In: memory
- 					Size: (memorySize min: maxAddress)
- 					MinAddressRead: minAddress
- 					Write: minWriteMaxExecAddress.
- 	maybeErr ~= 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
- 	^cpuAlien!

Item was removed:
- ----- Method: BochsPlugin>>primitiveSingleStepInMemory:minimumAddress:readOnlyBelow: (in category 'primitives') -----
- "cpuAlien <BochsIA32|X86Alien>" primitiveSingleStepInMemory: memory "<Bitmap|ByteArray|WordArray>" minimumAddress: minAddress "<Integer>"  readOnlyBelow: minWriteMaxExecAddress "<Integer>"
- 	"Single-step the cpu using the first argument as the memory and the following arguments defining valid addresses."
- 	| cpuAlien cpu maybeErr |
- 	<var: #cpu type: #'void *'>
- 	cpuAlien := self primitive: #primitiveSingleStepInMemoryMinimumAddressReadWrite
- 					parameters: #(WordsOrBytes Unsigned Unsigned)
- 					receiver: #Oop.
- 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
- 	maybeErr := self singleStepCPU: cpu
- 					In: memory
- 					Size: (interpreterProxy byteSizeOf: memory cPtrAsOop)
- 					MinAddressRead: minAddress
- 					Write: minWriteMaxExecAddress.
- 	maybeErr ~= 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
- 	^cpuAlien!

Item was removed:
- ----- Method: BochsPlugin>>sizeField: (in category 'alien support') -----
- sizeField: rcvr
- 	"Answer the first field of rcvr which is assumed to be an Alien of at least 8 bytes"
- 	<inline: true>
- 	^self longAt: rcvr + interpreterProxy baseHeaderSize!

Item was removed:
- ----- Method: BochsPlugin>>startOfData: (in category 'alien support') -----
- startOfData: rcvr "<Alien oop> ^<Integer>"
- 	"Answer the start of rcvr's data.  For direct aliens this is the address of
- 	 the second field.  For indirect and pointer aliens it is what the second field points to."
- 	<inline: true>
- 	^(self sizeField: rcvr) > 0
- 	 	ifTrue: [rcvr + interpreterProxy baseHeaderSize + interpreterProxy bytesPerOop]
- 		ifFalse: [self longAt: rcvr + interpreterProxy baseHeaderSize + interpreterProxy bytesPerOop]!

Item was changed:
+ ProcessorSimulatorPlugin subclass: #BochsX64Plugin
- BochsPlugin subclass: #BochsX64Plugin
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Cog-ProcessorPlugins'!

Item was removed:
- SmartSyntaxInterpreterPlugin subclass: #GdbARMPlugin
- 	instanceVariableNames: 'prevInterruptCheckChain'
- 	classVariableNames: ''
- 	poolDictionaries: 'VMBasicConstants'
- 	category: 'Cog-ProcessorPlugins'!
- 
- !GdbARMPlugin commentStamp: '<historical>' prior: 0!
- I provide access to the ARMulator ARM emulator and the libopcodes ARM disassembler.!

Item was removed:
- ----- Method: GdbARMPlugin class>>declareCVarsIn: (in category 'translation') -----
- declareCVarsIn: aCCodeGenerator
- 	"prevInterruptCheckChain lives in sqGdbARMPlugin.c"
- 	super declareCVarsIn: aCCodeGenerator.
- 	aCCodeGenerator removeVariable: 'prevInterruptCheckChain'!

Item was removed:
- ----- Method: GdbARMPlugin class>>declareHeaderFilesIn: (in category 'translation') -----
- declareHeaderFilesIn: cg
- 	self ~~ GdbARMPlugin ifTrue:
- 		[super declareHeaderFilesIn: cg]!

Item was removed:
- ----- Method: GdbARMPlugin class>>hasHeaderFile (in category 'translation') -----
- hasHeaderFile
- 	"We need a header to declare newcpu and pull in bochs.h & cpu.h"
- 	^true!

Item was removed:
- ----- Method: GdbARMPlugin class>>shouldBeTranslated (in category 'translation') -----
- shouldBeTranslated
- 	"Is this class intended to be translated as a plugin, perhaps specific to a platform?
- 	 Most subclasses should answer true, but some such as simulation-only versions
- 	 should answer false for various reasons."
- 	^super shouldBeTranslated and: [self ~~ GdbARMPlugin]!

Item was removed:
- ----- Method: GdbARMPlugin>>forceStopOnInterrupt (in category 'interruption') -----
- forceStopOnInterrupt
- 	<returnTypeC: #void>
- 	interpreterProxy getInterruptPending ifTrue:
- 		[self forceStopRunning]!

Item was removed:
- ----- Method: GdbARMPlugin>>primitiveDisassembleAt:InMemory: (in category 'primitives') -----
- "cpuAlien <GdbARMAlien>" primitiveDisassembleAt: address "<Integer>" InMemory: memory "<Bitmap|ByteArray|WordArray>"
- 	"Return an Array of the instruction length and its decompilation as a string for the instruction at address in memory."
- 	| cpuAlien cpu instrLenOrErr resultObj log logLen logObj logObjData |
- 	<var: #cpu type: #'void *'>
- 	cpuAlien := self primitive: #primitiveDisassembleAtInMemory
- 					parameters: #(Unsigned WordsOrBytes)
- 					receiver: #Oop.
- 	(cpu := self startOfData: cpuAlien) = 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
- 	instrLenOrErr := self disassembleFor: cpu
- 						At: address
- 						In: memory
- 						Size: (interpreterProxy byteSizeOf: memory cPtrAsOop).
- 	instrLenOrErr < 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
- 	log := self getlog: (self cCode: [self addressOf: logLen] inSmalltalk: [logLen := 0]).
- 	resultObj := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2.
- 	resultObj = 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
- 
- 	"Easier keeping the damn thing on the stack than using pushRemappableOop:/popRemappableOop.
- 	 Where is topRemappableOop when you need it?"
- 	interpreterProxy pushRemappableOop: resultObj.
- 	logObj := interpreterProxy
- 				instantiateClass: interpreterProxy classString
- 				indexableSize: logLen.
- 	interpreterProxy failed ifTrue:
- 		[interpreterProxy popRemappableOop.
- 		 ^interpreterProxy primitiveFailFor: PrimErrNoMemory].
- 	logObjData := interpreterProxy arrayValueOf: logObj.
- 	self mem: logObjData cp: log y: logLen.
- 	resultObj := interpreterProxy popRemappableOop.
- 	interpreterProxy
- 		storePointer: 0
- 		ofObject: resultObj
- 		withValue: (interpreterProxy integerObjectOf: instrLenOrErr).
- 	interpreterProxy storePointer: 1 ofObject: resultObj withValue: logObj.
- 
- 	^resultObj!

Item was removed:
- ----- Method: GdbARMPlugin>>primitiveErrorAndLog (in category 'primitives') -----
- primitiveErrorAndLog
- 	| log logLen resultObj logObj logObjData |
- 	<var: #log type: #'char *'>
- 	<var: #logObjData type: #'char *'>
- 	self primitive: #primitiveErrorAndLog parameters: #().
- 
- 	log := self getlog: (self cCode: [self addressOf: logLen] inSmalltalk: [logLen := 0]).
- 	resultObj := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2.
- 	resultObj = 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
- 
- 	interpreterProxy
- 		storePointer: 0
- 		ofObject: resultObj
- 		withValue: (interpreterProxy integerObjectOf: self errorAcorn).
- 
- 	logLen > 0 ifTrue:
- 		[interpreterProxy pushRemappableOop: resultObj.
- 		logObj := interpreterProxy
- 					instantiateClass: interpreterProxy classString
- 					indexableSize: logLen.
- 		interpreterProxy failed ifTrue:
- 			[interpreterProxy popRemappableOop.
- 			 ^interpreterProxy primitiveFailFor: PrimErrNoMemory].
- 
- 		resultObj := interpreterProxy popRemappableOop.
- 		logObjData := interpreterProxy arrayValueOf: logObj.
- 		self mem: logObjData cp: log y: logLen.
- 		interpreterProxy storePointer: 1 ofObject: resultObj withValue: logObj].
- 	interpreterProxy pop: 1 thenPush: resultObj!

Item was removed:
- ----- Method: GdbARMPlugin>>primitiveFlushICacheFrom:To: (in category 'primitives') -----
- "cpuAlien <GdbARMAlien>" primitiveFlushICacheFrom: startAddress "<Integer>" To: endAddress "<Integer>"
- 	"Flush the icache in the requested range"
- 	| cpuAlien cpu |
- 	<var: #cpu type: 'void *'>
- 	cpuAlien := self primitive: #primitiveFlushICacheFromTo
- 					parameters: #(Unsigned Unsigned)
- 					receiver: #Oop.
- 	(cpu := self startOfData: cpuAlien) = 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
- 	self flushICache: cpu From: startAddress To: endAddress!

Item was removed:
- ----- Method: GdbARMPlugin>>primitiveNewCPU (in category 'primitives') -----
- primitiveNewCPU
- 	| cpu |
- 	<var: #cpu type: 'void *'>
- 	self primitive: #primitiveNewCPU parameters: #().
- 
- 	cpu := self cCode: 'newCPU()' inSmalltalk: [0].
- 	cpu = 0 ifTrue:
- 		[^interpreterProxy primitiveFail].
- 	interpreterProxy
- 		pop: 1
- 		thenPush: (interpreterProxy positiveMachineIntegerFor:
- 										(self cCoerceSimple: cpu
- 											to: 'usqIntptr_t'))!

Item was removed:
- ----- Method: GdbARMPlugin>>primitiveResetCPU (in category 'primitives') -----
- primitiveResetCPU
- 	| cpuAlien cpu maybeErr |
- 	<var: #cpu type: 'void *'>
- 	cpuAlien := self primitive: #primitiveResetCPU parameters: #() receiver: #Oop.
- 	(cpu := self startOfData: cpuAlien) = 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
- 	maybeErr := self resetCPU: cpu.
- 	maybeErr ~= 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
- 	^cpuAlien!

Item was removed:
- ----- Method: GdbARMPlugin>>primitiveRunInMemory:minimumAddress:maximumAddress:readOnlyBelow: (in category 'primitives') -----
- "cpuAlien <GdbARMAlien>" primitiveRunInMemory: memory "<Bitmap|ByteArray|WordArray>" minimumAddress: minAddress "<Integer>" maximumAddress: maxAddress "<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."
- 	| cpuAlien cpu memorySize maybeErr |
- 	<var: #cpu type: #'void *'>
- 	cpuAlien := self primitive: #primitiveRunInMemoryMinAddressMaxAddressReadWrite
- 					parameters: #(WordsOrBytes Unsigned Unsigned Unsigned)
- 					receiver: #Oop.
- 	(cpu := self startOfData: cpuAlien) = 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
- 	prevInterruptCheckChain := interpreterProxy setInterruptCheckChain: #forceStopOnInterrupt asSymbol.
- 	prevInterruptCheckChain = #forceStopOnInterrupt asSymbol ifTrue:
- 		[prevInterruptCheckChain = 0].
- 	memorySize := interpreterProxy byteSizeOf: memory cPtrAsOop.
- 	maybeErr := self runCPU: cpu
- 					In: memory
- 					Size: (memorySize min: maxAddress)
- 					MinAddressRead: minAddress
- 					Write: minWriteMaxExecAddress.
- 	interpreterProxy setInterruptCheckChain: prevInterruptCheckChain.
- 	maybeErr ~= 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
- 	^cpuAlien!

Item was removed:
- ----- 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"
- 	| 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!

Item was removed:
- ----- Method: GdbARMPlugin>>primitiveSingleStepInMemory:minimumAddress:maximumAddress:readOnlyBelow: (in category 'primitives') -----
- "cpuAlien <GdbARMAlien>" primitiveSingleStepInMemory: memory "<Bitmap|ByteArray|WordArray>" minimumAddress: minAddress "<Integer>" maximumAddress: maxAddress "<Integer>" readOnlyBelow: minWriteMaxExecAddress "<Integer>"
- 	"Single-step 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 memorySize maybeErr |
- 	<var: #cpu type: #'void *'>
- 	cpuAlien := self primitive: #primitiveSingleStepInMemoryMinAddressMaxAddressReadWrite
- 					parameters: #(WordsOrBytes Unsigned Unsigned Unsigned)
- 					receiver: #Oop.
- 	(cpu := self startOfData: cpuAlien) = 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
- 	prevInterruptCheckChain := interpreterProxy setInterruptCheckChain: #forceStopOnInterrupt asSymbol.
- 	prevInterruptCheckChain = #forceStopOnInterrupt asSymbol ifTrue:
- 		[prevInterruptCheckChain = 0].
- 	memorySize := interpreterProxy byteSizeOf: memory cPtrAsOop.
- 	maybeErr := self singleStepCPU: cpu
- 					In: memory
- 					Size: (memorySize min: maxAddress)
- 					MinAddressRead: minAddress
- 					Write: minWriteMaxExecAddress.
- 	interpreterProxy setInterruptCheckChain: prevInterruptCheckChain.
- 	maybeErr ~= 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
- 	^cpuAlien!

Item was removed:
- ----- Method: GdbARMPlugin>>primitiveSingleStepInMemory:minimumAddress:readOnlyBelow: (in category 'primitives') -----
- "cpuAlien <GdbARMAlien>" primitiveSingleStepInMemory: memory "<Bitmap|ByteArray|WordArray>" minimumAddress: minAddress "<Integer>"  readOnlyBelow: minWriteMaxExecAddress "<Integer>"
- 	"Single-step the cpu using the first argument as the memory and the following arguments defining valid addresses."
- 	| cpuAlien cpu maybeErr |
- 	<var: #cpu type: #'void *'>
- 	cpuAlien := self primitive: #primitiveSingleStepInMemoryMinimumAddressReadWrite
- 					parameters: #(WordsOrBytes Unsigned Unsigned)
- 					receiver: #Oop.
- 	(cpu := self startOfData: cpuAlien) = 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
- 	maybeErr := self singleStepCPU: cpu
- 					In: memory
- 					Size: (interpreterProxy byteSizeOf: memory cPtrAsOop)
- 					MinAddressRead: minAddress
- 					Write: minWriteMaxExecAddress.
- 	maybeErr ~= 0 ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
- 	^cpuAlien!

Item was removed:
- ----- Method: GdbARMPlugin>>sizeField: (in category 'alien support') -----
- sizeField: rcvr
- 	"Answer the first field of rcvr which is assumed to be an Alien of at least 8 bytes"
- 	<inline: true>
- 	^self longAt: rcvr + interpreterProxy baseHeaderSize!

Item was removed:
- ----- Method: GdbARMPlugin>>startOfData: (in category 'alien support') -----
- startOfData: rcvr "<Alien oop> ^<Integer>"
- 	"Answer the start of rcvr's data.  For direct aliens this is the address of
- 	 the second field.  For indirect and pointer aliens it is what the second field points to."
- 	<inline: true>
- 	^(self sizeField: rcvr) > 0
- 	 	ifTrue: [rcvr + interpreterProxy baseHeaderSize + interpreterProxy bytesPerOop]
- 		ifFalse: [self longAt: rcvr + interpreterProxy baseHeaderSize + interpreterProxy bytesPerOop]!

Item was changed:
+ ProcessorSimulatorPlugin subclass: #GdbARMv6Plugin
- GdbARMPlugin subclass: #GdbARMv6Plugin
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Cog-ProcessorPlugins'!

Item was changed:
  ----- Method: GdbARMv6Plugin class>>moduleName (in category 'translation') -----
  moduleName
  	"Answer the receiver's module name that is used for the plugin's C code."
  
+ 	^'GdbARMPlugin'!
- 	^superclass name asString!

Item was changed:
+ ProcessorSimulatorPlugin subclass: #GdbARMv8Plugin
- GdbARMPlugin subclass: #GdbARMv8Plugin
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Cog-ProcessorPlugins'!

Item was added:
+ SmartSyntaxInterpreterPlugin subclass: #ProcessorSimulatorPlugin
+ 	instanceVariableNames: 'prevInterruptCheckChain'
+ 	classVariableNames: ''
+ 	poolDictionaries: 'VMBasicConstants'
+ 	category: 'Cog-ProcessorPlugins'!
+ 
+ !ProcessorSimulatorPlugin commentStamp: 'eem 11/19/2019 09:32' prior: 0!
+ ProcessorSimulatorPlugin is the abstract superclass for plugins that interface to a processor simulator that executes the machine code for some processor the Cog JIT generates code for.  These include the Bochs C++ IA32/x64 processor emulator, and the GDB simulator for the ARMv6 and ARMv8 architectures.
+ 
+ Instance Variables
+ 	prevInterruptCheckChain:		<Symbol/function pointer>
+ 
+ prevInterruptCheckChain
+ 	- the previous value of the interruptCheckChain function pointer
+ !

Item was added:
+ ----- Method: ProcessorSimulatorPlugin class>>declareCVarsIn: (in category 'translation') -----
+ declareCVarsIn: aCCodeGenerator
+ 	"prevInterruptCheckChain lives in the platform support code."
+ 	self ~~ ProcessorSimulatorPlugin ifTrue:
+ 		[super declareCVarsIn: aCCodeGenerator.
+ 		 aCCodeGenerator removeVariable: 'prevInterruptCheckChain']!

Item was added:
+ ----- Method: ProcessorSimulatorPlugin class>>hasHeaderFile (in category 'translation') -----
+ hasHeaderFile
+ 	^true!

Item was added:
+ ----- Method: ProcessorSimulatorPlugin class>>shouldBeTranslated (in category 'translation') -----
+ shouldBeTranslated
+ 	"Only translate the concrete subclasses."
+ 	^super shouldBeTranslated and: [self ~~ ProcessorSimulatorPlugin]!

Item was added:
+ ----- Method: ProcessorSimulatorPlugin>>forceStopOnInterrupt (in category 'interruption') -----
+ forceStopOnInterrupt
+ 	<returnTypeC: #void>
+ 	interpreterProxy getInterruptPending ifTrue:
+ 		[self forceStopRunning]!

Item was added:
+ ----- Method: ProcessorSimulatorPlugin>>primitiveDisassembleAt:InMemory: (in category 'primitives') -----
+ "cpuAlien <BochsIA32|X86Alien>" primitiveDisassembleAt: address "<Integer>" InMemory: memory "<Bitmap|ByteArray|WordArray>"
+ 	"Return an Array of the instruction length and its decompilation as a string for the instruction at address in memory."
+ 	| cpuAlien cpu instrLenOrErr resultObj log logLen logObj logObjData |
+ 	<var: #cpu type: #'void *'>
+ 	<var: #log type: #'char *'>
+ 	<var: #logLen type: #long>
+ 	<var: #logObjData type: #'char *'>
+ 	cpuAlien := self primitive: #primitiveDisassembleAtInMemory
+ 					parameters: #(Unsigned WordsOrBytes)
+ 					receiver: #Oop.
+ 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
+ 	instrLenOrErr := self disassembleFor: cpu
+ 						At: address
+ 						In: memory
+ 						Size: (interpreterProxy byteSizeOf: memory cPtrAsOop).
+ 	instrLenOrErr < 0 ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
+ 	log := self getlog: (self cCode: [self addressOf: logLen] inSmalltalk: [logLen := 0]).
+ 	resultObj := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2.
+ 	resultObj = 0 ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
+ 
+ 	"Easier keeping the damn thing on the stack than using pushRemappableOop:/popRemappableOop.
+ 	 Where is topRemappableOop when you need it?"
+ 	interpreterProxy pushRemappableOop: resultObj.
+ 	logObj := interpreterProxy
+ 				instantiateClass: interpreterProxy classString
+ 				indexableSize: logLen.
+ 	interpreterProxy failed ifTrue:
+ 		[interpreterProxy popRemappableOop.
+ 		 ^interpreterProxy primitiveFailFor: PrimErrNoMemory].
+ 	logObjData := interpreterProxy arrayValueOf: logObj.
+ 	self mem: logObjData cp: log y: logLen.
+ 	resultObj := interpreterProxy popRemappableOop.
+ 	interpreterProxy
+ 		storePointer: 0
+ 		ofObject: resultObj
+ 		withValue: (interpreterProxy integerObjectOf: instrLenOrErr).
+ 	interpreterProxy storePointer: 1 ofObject: resultObj withValue: logObj.
+ 
+ 	^resultObj!

Item was added:
+ ----- Method: ProcessorSimulatorPlugin>>primitiveErrorAndLog (in category 'primitives') -----
+ primitiveErrorAndLog
+ 	| log logLen resultObj logObj logObjData |
+ 	<var: #log type: #'char *'>
+ 	<var: #logLen type: #long>
+ 	<var: #logObjData type: #'char *'>
+ 	self primitive: #primitiveErrorAndLog parameters: #().
+ 
+ 	log := self getlog: (self cCode: [self addressOf: logLen] inSmalltalk: [logLen := 0]).
+ 	resultObj := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2.
+ 	resultObj = 0 ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
+ 
+ 	interpreterProxy
+ 		storePointer: 0
+ 		ofObject: resultObj
+ 		withValue: (interpreterProxy integerObjectOf: self errorAcorn).
+ 
+ 	logLen > 0 ifTrue:
+ 		[interpreterProxy pushRemappableOop: resultObj.
+ 		logObj := interpreterProxy
+ 					instantiateClass: interpreterProxy classString
+ 					indexableSize: logLen.
+ 		interpreterProxy failed ifTrue:
+ 			[interpreterProxy popRemappableOop.
+ 			 ^interpreterProxy primitiveFailFor: PrimErrNoMemory].
+ 
+ 		resultObj := interpreterProxy popRemappableOop.
+ 		logObjData := interpreterProxy arrayValueOf: logObj.
+ 		self mem: logObjData cp: log y: logLen.
+ 		interpreterProxy storePointer: 1 ofObject: resultObj withValue: logObj].
+ 	interpreterProxy pop: 1 thenPush: resultObj!

Item was added:
+ ----- Method: ProcessorSimulatorPlugin>>primitiveFlushICacheFrom:To: (in category 'primitives') -----
+ "cpuAlien <BochsIA32|X86Alien>" primitiveFlushICacheFrom: startAddress "<Integer>" To: endAddress "<Integer>"
+ 	"Flush the icache in the requested range"
+ 	| cpuAlien cpu |
+ 	<var: #cpu type: #'void *'>
+ 	cpuAlien := self primitive: #primitiveFlushICacheFromTo
+ 					parameters: #(Unsigned Unsigned)
+ 					receiver: #Oop.
+ 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
+ 	self flushICache: cpu From: startAddress To: endAddress!

Item was added:
+ ----- Method: ProcessorSimulatorPlugin>>primitiveNewCPU (in category 'primitives') -----
+ primitiveNewCPU
+ 	| cpu |
+ 	<var: #cpu type: #'void *'>
+ 	self primitive: #primitiveNewCPU parameters: #().
+ 
+ 	cpu := self newCPU.
+ 	cpu = 0 ifTrue:
+ 		[^interpreterProxy primitiveFail].
+ 	interpreterProxy
+ 		pop: 1
+ 		thenPush: (interpreterProxy positiveMachineIntegerFor:
+ 										(self cCoerceSimple: cpu
+ 											to: 'usqIntptr_t'))!

Item was added:
+ ----- Method: ProcessorSimulatorPlugin>>primitiveResetCPU (in category 'primitives') -----
+ primitiveResetCPU
+ 	| cpuAlien cpu maybeErr |
+ 	<var: #cpu type: #'void *'>
+ 	cpuAlien := self primitive: #primitiveResetCPU parameters: #() receiver: #Oop.
+ 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
+ 	maybeErr := self resetCPU: cpu.
+ 	maybeErr ~= 0 ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
+ 	^cpuAlien!

Item was added:
+ ----- Method: ProcessorSimulatorPlugin>>primitiveRunInMemory:minimumAddress:maximumAddress:readOnlyBelow: (in category 'primitives') -----
+ "cpuAlien <BochsIA32|X86Alien>" primitiveRunInMemory: memory "<Bitmap|ByteArray|WordArray>" minimumAddress: minAddress "<Integer>" maximumAddress: maxAddress "<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."
+ 	| cpuAlien cpu memorySize maybeErr |
+ 	<var: #cpu type: #'void *'>
+ 	cpuAlien := self primitive: #primitiveRunInMemoryMinAddressMaxAddressReadWrite
+ 					parameters: #(WordsOrBytes Unsigned Unsigned Unsigned)
+ 					receiver: #Oop.
+ 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
+ 	prevInterruptCheckChain := interpreterProxy setInterruptCheckChain: #forceStopOnInterrupt asSymbol.
+ 	prevInterruptCheckChain = #forceStopOnInterrupt asSymbol ifTrue:
+ 		[prevInterruptCheckChain = 0].
+ 	memorySize := interpreterProxy byteSizeOf: memory cPtrAsOop.
+ 	maybeErr := self runCPU: cpu
+ 					In: memory
+ 					Size: (memorySize min: maxAddress)
+ 					MinAddressRead: minAddress
+ 					Write: minWriteMaxExecAddress.
+ 	interpreterProxy setInterruptCheckChain: prevInterruptCheckChain.
+ 	maybeErr ~= 0 ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
+ 	^cpuAlien!

Item was added:
+ ----- Method: ProcessorSimulatorPlugin>>primitiveRunInMemory:minimumAddress:readOnlyBelow: (in category 'primitives') -----
+ "cpuAlien <BochsIA32|X86Alien>" 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."
+ 	| cpuAlien cpu maybeErr |
+ 	<var: #cpu type: #'void *'>
+ 	cpuAlien := self primitive: #primitiveRunInMemoryMinimumAddressReadWrite
+ 					parameters: #(WordsOrBytes Unsigned Unsigned)
+ 					receiver: #Oop.
+ 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 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!

Item was added:
+ ----- Method: ProcessorSimulatorPlugin>>primitiveSingleStepInMemory:minimumAddress:maximumAddress:readOnlyBelow: (in category 'primitives') -----
+ "cpuAlien <BochsIA32|X86Alien>" primitiveSingleStepInMemory: memory "<Bitmap|ByteArray|WordArray>" minimumAddress: minAddress "<Integer>" maximumAddress: maxAddress "<Integer>" readOnlyBelow: minWriteMaxExecAddress "<Integer>"
+ 	"Single-step the cpu using the first argument as the memory and the following arguments defining valid addresses."
+ 	| cpuAlien cpu memorySize maybeErr |
+ 	<var: #cpu type: #'void *'>
+ 	cpuAlien := self primitive: #primitiveSingleStepInMemoryMinAddressMaxAddressReadWrite
+ 					parameters: #(WordsOrBytes Unsigned Unsigned Unsigned)
+ 					receiver: #Oop.
+ 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
+ 	memorySize := interpreterProxy byteSizeOf: memory cPtrAsOop.
+ 	maybeErr := self singleStepCPU: cpu
+ 					In: memory
+ 					Size: (memorySize min: maxAddress)
+ 					MinAddressRead: minAddress
+ 					Write: minWriteMaxExecAddress.
+ 	maybeErr ~= 0 ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
+ 	^cpuAlien!

Item was added:
+ ----- Method: ProcessorSimulatorPlugin>>primitiveSingleStepInMemory:minimumAddress:readOnlyBelow: (in category 'primitives') -----
+ "cpuAlien <BochsIA32|X86Alien>" primitiveSingleStepInMemory: memory "<Bitmap|ByteArray|WordArray>" minimumAddress: minAddress "<Integer>"  readOnlyBelow: minWriteMaxExecAddress "<Integer>"
+ 	"Single-step the cpu using the first argument as the memory and the following arguments defining valid addresses."
+ 	| cpuAlien cpu maybeErr |
+ 	<var: #cpu type: #'void *'>
+ 	cpuAlien := self primitive: #primitiveSingleStepInMemoryMinimumAddressReadWrite
+ 					parameters: #(WordsOrBytes Unsigned Unsigned)
+ 					receiver: #Oop.
+ 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
+ 	maybeErr := self singleStepCPU: cpu
+ 					In: memory
+ 					Size: (interpreterProxy byteSizeOf: memory cPtrAsOop)
+ 					MinAddressRead: minAddress
+ 					Write: minWriteMaxExecAddress.
+ 	maybeErr ~= 0 ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
+ 	^cpuAlien!

Item was added:
+ ----- Method: ProcessorSimulatorPlugin>>sizeField: (in category 'alien support') -----
+ sizeField: rcvr
+ 	"Answer the first field of rcvr which is assumed to be an Alien of at least 8 bytes"
+ 	<inline: true>
+ 	^self longAt: rcvr + interpreterProxy baseHeaderSize!

Item was added:
+ ----- Method: ProcessorSimulatorPlugin>>startOfData: (in category 'alien support') -----
+ startOfData: rcvr "<Alien oop> ^<Integer>"
+ 	"Answer the start of rcvr's data.  For direct aliens this is the address of
+ 	 the second field.  For indirect and pointer aliens it is what the second field points to."
+ 	<inline: true>
+ 	^(self sizeField: rcvr) > 0
+ 	 	ifTrue: [rcvr + interpreterProxy baseHeaderSize + interpreterProxy bytesPerOop]
+ 		ifFalse: [self longAt: rcvr + interpreterProxy baseHeaderSize + interpreterProxy bytesPerOop]!




More information about the Vm-dev mailing list