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

commits at source.squeak.org commits at source.squeak.org
Mon Sep 14 23:57:51 UTC 2015


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

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

Name: Cog-eem.274
Author: eem
Time: 14 September 2015, 4:57:12.376 pm
UUID: a51dc353-e7c3-4b7b-b47f-32c1f4f91a41
Ancestors: Cog-eem.273

Add BochsX64Alien.

Refactor BochsIA32Plugin to admit BochsX64Plugin below BochsPlugin.  Use positiveMachineIntegerFor: when answering the address of the C++ instance.

Add ProtoObject>>hasIdentityHash.

Revise Spur32to64BitBootstrap>>fillInObjects for the ephemeronQueue => mournQueue rename.

=============== Diff against Cog-eem.273 ===============

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

Item was removed:
- ----- Method: BochsIA32Plugin>>forceStopOnInterrupt (in category 'interruption') -----
- forceStopOnInterrupt
- 	interpreterProxy getInterruptPending ifTrue:
- 		[self forceStopRunning]!

Item was removed:
- ----- Method: BochsIA32Plugin>>primitiveDisassembleAt:InMemory: (in category 'primitives') -----
- "cpuAlien <BochsIA32Alien>" 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 cCode: 'memcpy(logObjData, log, logLen)' inSmalltalk: [logObjData. log].
- 	resultObj := interpreterProxy popRemappableOop.
- 	interpreterProxy
- 		storePointer: 0
- 		ofObject: resultObj
- 		withValue: (interpreterProxy integerObjectOf: instrLenOrErr).
- 	interpreterProxy storePointer: 1 ofObject: resultObj withValue: logObj.
- 
- 	^resultObj!

Item was removed:
- ----- Method: BochsIA32Plugin>>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 cCode: 'memcpy(logObjData, log, logLen)' inSmalltalk: [logObjData. log].
- 		interpreterProxy storePointer: 1 ofObject: resultObj withValue: logObj].
- 	interpreterProxy pop: 1 thenPush: resultObj!

Item was removed:
- ----- Method: BochsIA32Plugin>>primitiveFlushICacheFrom:To: (in category 'primitives') -----
- "cpuAlien <BochsIA32Alien>" 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: BochsIA32Plugin>>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 positive32BitIntegerFor:
- 										(self cCoerceSimple: cpu
- 											to: 'unsigned long'))!

Item was removed:
- ----- Method: BochsIA32Plugin>>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: BochsIA32Plugin>>primitiveRunInMemory:minimumAddress:maximumAddress:readOnlyBelow: (in category 'primitives') -----
- "cpuAlien <BochsIA32Alien>" 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: BochsIA32Plugin>>primitiveRunInMemory:minimumAddress:readOnlyBelow: (in category 'primitives') -----
- "cpuAlien <BochsIA32Alien>" 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 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: BochsIA32Plugin>>primitiveSingleStepInMemory:minimumAddress:maximumAddress:readOnlyBelow: (in category 'primitives') -----
- "cpuAlien <BochsIA32Alien>" 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 startOfData: cpuAlien) = 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: BochsIA32Plugin>>primitiveSingleStepInMemory:minimumAddress:readOnlyBelow: (in category 'primitives') -----
- "cpuAlien <BochsIA32Alien>" 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: BochsIA32Plugin>>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: BochsIA32Plugin>>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 added:
+ 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 added:
+ ----- Method: BochsPlugin class>>declareCVarsIn: (in category 'translation') -----
+ declareCVarsIn: aCCodeGenerator
+ 	"prevInterruptCheckChain lives in sqBochsIA32|X64Plugin.c"
+ 	super declareCVarsIn: aCCodeGenerator.
+ 	aCCodeGenerator removeVariable: 'prevInterruptCheckChain'!

Item was added:
+ ----- 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 added:
+ ----- 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."
+ 	^self ~~ BochsPlugin!

Item was added:
+ ----- Method: BochsPlugin>>forceStopOnInterrupt (in category 'interruption') -----
+ forceStopOnInterrupt
+ 	interpreterProxy getInterruptPending ifTrue:
+ 		[self forceStopRunning]!

Item was added:
+ ----- 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 *'>
+ 	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 cCode: 'memcpy(logObjData, log, logLen)' inSmalltalk: [logObjData. log].
+ 	resultObj := interpreterProxy popRemappableOop.
+ 	interpreterProxy
+ 		storePointer: 0
+ 		ofObject: resultObj
+ 		withValue: (interpreterProxy integerObjectOf: instrLenOrErr).
+ 	interpreterProxy storePointer: 1 ofObject: resultObj withValue: logObj.
+ 
+ 	^resultObj!

Item was added:
+ ----- Method: BochsPlugin>>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 cCode: 'memcpy(logObjData, log, logLen)' inSmalltalk: [logObjData. log].
+ 		interpreterProxy storePointer: 1 ofObject: resultObj withValue: logObj].
+ 	interpreterProxy pop: 1 thenPush: resultObj!

Item was added:
+ ----- 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 startOfData: cpuAlien) = 0 ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
+ 	self flushICache: cpu From: startAddress To: endAddress!

Item was added:
+ ----- Method: BochsPlugin>>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: 'unsigned long'))!

Item was added:
+ ----- Method: BochsPlugin>>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 added:
+ ----- 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 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 added:
+ ----- 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 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 added:
+ ----- 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 startOfData: cpuAlien) = 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: 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 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ CogProcessorAlien variableByteSubclass: #BochsX64Alien
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'ExtendedOpcodeExceptionMap OpcodeExceptionMap PostBuildStackDelta'
+ 	poolDictionaries: ''
+ 	category: 'Cog-Processors'!

Item was added:
+ ----- Method: BochsX64Alien class>>dataSize (in category 'instance creation') -----
+ dataSize
+ 	^22672!

Item was added:
+ ----- Method: BochsX64Alien>>abstractInstructionCompilerClass (in category 'Cog API') -----
+ abstractInstructionCompilerClass
+ 	^CogX64Compiler!

Item was added:
+ ----- Method: BochsX64Alien>>bitsInWord (in category 'Cog API') -----
+ bitsInWord
+ 	^64!

Item was added:
+ ----- Method: BochsX64Alien>>cr0 (in category 'accessing') -----
+ cr0
+ 	^self unsignedLongLongAt: 1225!

Item was added:
+ ----- Method: BochsX64Alien>>cr0: (in category 'accessing') -----
+ cr0: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1225 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>cr1 (in category 'accessing') -----
+ cr1
+ 	^self unsignedLongLongAt: 1229!

Item was added:
+ ----- Method: BochsX64Alien>>cr1: (in category 'accessing') -----
+ cr1: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1229 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>cr2 (in category 'accessing') -----
+ cr2
+ 	^self unsignedLongLongAt: 1233!

Item was added:
+ ----- Method: BochsX64Alien>>cr2: (in category 'accessing') -----
+ cr2: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1233 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>cr3 (in category 'accessing') -----
+ cr3
+ 	^self unsignedLongLongAt: 1241!

Item was added:
+ ----- Method: BochsX64Alien>>cr3: (in category 'accessing') -----
+ cr3: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1241 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>cr4 (in category 'accessing') -----
+ cr4
+ 	^self unsignedLongLongAt: 1253!

Item was added:
+ ----- Method: BochsX64Alien>>cr4: (in category 'accessing') -----
+ cr4: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1253 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>primitiveDisassembleAt:inMemory: (in category 'primitives') -----
+ primitiveDisassembleAt: address inMemory: memoryArray "<Bitmap|ByteArray>"
+ 	"Answer an Array of the size and the disassembled code string for the instruction at the current instruction pointer in memory."
+ 	<primitive: 'primitiveDisassembleAtInMemory' module: 'BochsX64Plugin'>
+ 	^self primitiveFailed!

Item was added:
+ ----- Method: BochsX64Alien>>primitiveErrorAndLog (in category 'primitives') -----
+ primitiveErrorAndLog
+ 	"Answer an array of the current error code and log contents"
+ 	<primitive: 'primitiveErrorAndLog' module: 'BochsX64Plugin'>
+ 	^self primitiveFailed!

Item was added:
+ ----- Method: BochsX64Alien>>primitiveFlushICacheFrom:To: (in category 'primitives') -----
+ primitiveFlushICacheFrom: startAddress "<Integer>" To: endAddress "<Integer>"
+ 	"Flush the icache in the requested range"
+ 	<primitive: 'primitiveFlushICacheFromTo' module: 'BochsX64Plugin'>
+ 	^self primitiveFailed!

Item was added:
+ ----- Method: BochsX64Alien>>primitiveResetCPU (in category 'primitives') -----
+ primitiveResetCPU
+ 	"Reset the receiver to registers all zero, and protected 32-bit mode."
+ 	<primitive: 'primitiveResetCPU' module: 'BochsX64Plugin'>
+ 	^self reportPrimitiveFailure!

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

Item was added:
+ ----- Method: BochsX64Alien>>primitiveSingleStepInMemory:minimumAddress:readOnlyBelow: (in category 'primitives') -----
+ primitiveSingleStepInMemory: memoryArray "<Bitmap|ByteArray>" minimumAddress: minimumAddress "<Integer>" readOnlyBelow: minimumWritableAddress "<Integer>"
+ 	"Single-step the receiver using the argument as the store.  Origin the argument at 0. i.e. the first byte of the
+ 	 memoryArray is address 0.  Make addresses below minimumAddress illegal.  Convert out-of-range
+ 	 calls, jumps and memory read/writes into ProcessorSimulationTrap signals."
+ 	<primitive: 'primitiveSingleStepInMemoryMinimumAddressReadWrite' module: 'BochsX64Plugin' error: ec>
+ 	^ec == #'inappropriate operation'
+ 		ifTrue: [self handleExecutionPrimitiveFailureIn: memoryArray
+ 					minimumAddress: minimumAddress]
+ 		ifFalse: [self reportPrimitiveFailure]!

Item was added:
+ ----- Method: BochsX64Alien>>r10 (in category 'accessing') -----
+ r10
+ 	^self unsignedLongLongAt: 549!

Item was added:
+ ----- Method: BochsX64Alien>>r10: (in category 'accessing') -----
+ r10: anUnsignedInteger
+ 	^self unsignedLongLongAt: 549 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>r11 (in category 'accessing') -----
+ r11
+ 	^self unsignedLongLongAt: 557!

Item was added:
+ ----- Method: BochsX64Alien>>r11: (in category 'accessing') -----
+ r11: anUnsignedInteger
+ 	^self unsignedLongLongAt: 557 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>r12 (in category 'accessing') -----
+ r12
+ 	^self unsignedLongLongAt: 565!

Item was added:
+ ----- Method: BochsX64Alien>>r12: (in category 'accessing') -----
+ r12: anUnsignedInteger
+ 	^self unsignedLongLongAt: 565 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>r13 (in category 'accessing') -----
+ r13
+ 	^self unsignedLongLongAt: 573!

Item was added:
+ ----- Method: BochsX64Alien>>r13: (in category 'accessing') -----
+ r13: anUnsignedInteger
+ 	^self unsignedLongLongAt: 573 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>r14 (in category 'accessing') -----
+ r14
+ 	^self unsignedLongLongAt: 581!

Item was added:
+ ----- Method: BochsX64Alien>>r14: (in category 'accessing') -----
+ r14: anUnsignedInteger
+ 	^self unsignedLongLongAt: 581 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>r15 (in category 'accessing') -----
+ r15
+ 	^self unsignedLongLongAt: 589!

Item was added:
+ ----- Method: BochsX64Alien>>r15: (in category 'accessing') -----
+ r15: anUnsignedInteger
+ 	^self unsignedLongLongAt: 589 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>r8 (in category 'accessing') -----
+ r8
+ 	^self unsignedLongLongAt: 533!

Item was added:
+ ----- Method: BochsX64Alien>>r8: (in category 'accessing') -----
+ r8: anUnsignedInteger
+ 	^self unsignedLongLongAt: 533 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>r9 (in category 'accessing') -----
+ r9
+ 	^self unsignedLongLongAt: 541!

Item was added:
+ ----- Method: BochsX64Alien>>r9: (in category 'accessing') -----
+ r9: anUnsignedInteger
+ 	^self unsignedLongLongAt: 541 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>rax (in category 'accessing') -----
+ rax
+ 	^self unsignedLongLongAt: 469!

Item was added:
+ ----- Method: BochsX64Alien>>rax: (in category 'accessing') -----
+ rax: anUnsignedInteger
+ 	^self unsignedLongLongAt: 469 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>rbp (in category 'accessing') -----
+ rbp
+ 	^self unsignedLongLongAt: 509!

Item was added:
+ ----- Method: BochsX64Alien>>rbp: (in category 'accessing') -----
+ rbp: anUnsignedInteger
+ 	^self unsignedLongLongAt: 509 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>rbx (in category 'accessing') -----
+ rbx
+ 	^self unsignedLongLongAt: 493!

Item was added:
+ ----- Method: BochsX64Alien>>rbx: (in category 'accessing') -----
+ rbx: anUnsignedInteger
+ 	^self unsignedLongLongAt: 493 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>rcx (in category 'accessing') -----
+ rcx
+ 	^self unsignedLongLongAt: 477!

Item was added:
+ ----- Method: BochsX64Alien>>rcx: (in category 'accessing') -----
+ rcx: anUnsignedInteger
+ 	^self unsignedLongLongAt: 477 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>rdi (in category 'accessing') -----
+ rdi
+ 	^self unsignedLongLongAt: 525!

Item was added:
+ ----- Method: BochsX64Alien>>rdi: (in category 'accessing') -----
+ rdi: anUnsignedInteger
+ 	^self unsignedLongLongAt: 525 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>rdx (in category 'accessing') -----
+ rdx
+ 	^self unsignedLongLongAt: 485!

Item was added:
+ ----- Method: BochsX64Alien>>rdx: (in category 'accessing') -----
+ rdx: anUnsignedInteger
+ 	^self unsignedLongLongAt: 485 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>rflags (in category 'accessing') -----
+ rflags
+ 	^self unsignedLongLongAt: 621!

Item was added:
+ ----- Method: BochsX64Alien>>rip (in category 'accessing') -----
+ rip
+ 	^self unsignedLongLongAt: 597!

Item was added:
+ ----- Method: BochsX64Alien>>rip: (in category 'accessing') -----
+ rip: anUnsignedInteger
+ 	^self unsignedLongLongAt: 597 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>rsi (in category 'accessing') -----
+ rsi
+ 	^self unsignedLongLongAt: 517!

Item was added:
+ ----- Method: BochsX64Alien>>rsi: (in category 'accessing') -----
+ rsi: anUnsignedInteger
+ 	^self unsignedLongLongAt: 517 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>rsp (in category 'accessing') -----
+ rsp
+ 	^self unsignedLongLongAt: 501!

Item was added:
+ ----- Method: BochsX64Alien>>rsp: (in category 'accessing') -----
+ rsp: anUnsignedInteger
+ 	^self unsignedLongLongAt: 501 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>saveRip (in category 'accessing') -----
+ saveRip
+ 	^self unsignedLongAt: 1913!

Item was added:
+ ----- Method: BochsX64Alien>>saveRip: (in category 'accessing') -----
+ saveRip: anUnsignedInteger
+ 	^self unsignedLongAt: 1913 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>saveRsp (in category 'accessing') -----
+ saveRsp
+ 	^self unsignedLongAt: 1921!

Item was added:
+ ----- Method: BochsX64Alien>>saveRsp: (in category 'accessing') -----
+ saveRsp: anUnsignedInteger
+ 	^self unsignedLongAt: 1921 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>stopReason (in category 'accessing') -----
+ stopReason
+ 	^self unsignedByteAt: 1973!

Item was added:
+ ----- Method: BochsX64Alien>>stopReason: (in category 'accessing') -----
+ stopReason: anUnsignedInteger
+ 	^self unsignedByteAt: 1973 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>xmm0high (in category 'accessing') -----
+ xmm0high
+ 	^self unsignedLongLongAt: 1421!

Item was added:
+ ----- Method: BochsX64Alien>>xmm0high: (in category 'accessing') -----
+ xmm0high: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1421 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>xmm0low (in category 'accessing') -----
+ xmm0low
+ 	^self unsignedLongLongAt: 1413!

Item was added:
+ ----- Method: BochsX64Alien>>xmm0low: (in category 'accessing') -----
+ xmm0low: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1413 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>xmm1high (in category 'accessing') -----
+ xmm1high
+ 	^self unsignedLongLongAt: 1437!

Item was added:
+ ----- Method: BochsX64Alien>>xmm1high: (in category 'accessing') -----
+ xmm1high: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1437 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>xmm1low (in category 'accessing') -----
+ xmm1low
+ 	^self unsignedLongLongAt: 1429!

Item was added:
+ ----- Method: BochsX64Alien>>xmm1low: (in category 'accessing') -----
+ xmm1low: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1429 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>xmm2high (in category 'accessing') -----
+ xmm2high
+ 	^self unsignedLongLongAt: 1453!

Item was added:
+ ----- Method: BochsX64Alien>>xmm2high: (in category 'accessing') -----
+ xmm2high: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1453 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>xmm2low (in category 'accessing') -----
+ xmm2low
+ 	^self unsignedLongLongAt: 1445!

Item was added:
+ ----- Method: BochsX64Alien>>xmm2low: (in category 'accessing') -----
+ xmm2low: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1445 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>xmm3high (in category 'accessing') -----
+ xmm3high
+ 	^self unsignedLongLongAt: 1469!

Item was added:
+ ----- Method: BochsX64Alien>>xmm3high: (in category 'accessing') -----
+ xmm3high: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1469 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>xmm3low (in category 'accessing') -----
+ xmm3low
+ 	^self unsignedLongLongAt: 1461!

Item was added:
+ ----- Method: BochsX64Alien>>xmm3low: (in category 'accessing') -----
+ xmm3low: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1461 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>xmm4high (in category 'accessing') -----
+ xmm4high
+ 	^self unsignedLongLongAt: 1485!

Item was added:
+ ----- Method: BochsX64Alien>>xmm4high: (in category 'accessing') -----
+ xmm4high: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1485 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>xmm4low (in category 'accessing') -----
+ xmm4low
+ 	^self unsignedLongLongAt: 1477!

Item was added:
+ ----- Method: BochsX64Alien>>xmm4low: (in category 'accessing') -----
+ xmm4low: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1477 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>xmm5high (in category 'accessing') -----
+ xmm5high
+ 	^self unsignedLongLongAt: 1501!

Item was added:
+ ----- Method: BochsX64Alien>>xmm5high: (in category 'accessing') -----
+ xmm5high: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1501 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>xmm5low (in category 'accessing') -----
+ xmm5low
+ 	^self unsignedLongLongAt: 1493!

Item was added:
+ ----- Method: BochsX64Alien>>xmm5low: (in category 'accessing') -----
+ xmm5low: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1493 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>xmm6high (in category 'accessing') -----
+ xmm6high
+ 	^self unsignedLongLongAt: 1517!

Item was added:
+ ----- Method: BochsX64Alien>>xmm6high: (in category 'accessing') -----
+ xmm6high: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1517 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>xmm6low (in category 'accessing') -----
+ xmm6low
+ 	^self unsignedLongLongAt: 1509!

Item was added:
+ ----- Method: BochsX64Alien>>xmm6low: (in category 'accessing') -----
+ xmm6low: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1509 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>xmm7high (in category 'accessing') -----
+ xmm7high
+ 	^self unsignedLongLongAt: 1533!

Item was added:
+ ----- Method: BochsX64Alien>>xmm7high: (in category 'accessing') -----
+ xmm7high: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1533 put: anUnsignedInteger!

Item was added:
+ ----- Method: BochsX64Alien>>xmm7low (in category 'accessing') -----
+ xmm7low
+ 	^self unsignedLongLongAt: 1525!

Item was added:
+ ----- Method: BochsX64Alien>>xmm7low: (in category 'accessing') -----
+ xmm7low: anUnsignedInteger
+ 	^self unsignedLongLongAt: 1525 put: anUnsignedInteger!

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

Item was added:
+ ----- Method: ProtoObject>>hasIdentityHash (in category '*Cog-Tests-xrays') -----
+ hasIdentityHash
+ 	<primitive: 161>
+ 	self primitiveFailed!

Item was changed:
  ----- Method: Spur32to64BitBootstrap>>fillInObjects (in category 'bootstrap image') -----
  fillInObjects
  	"interpreter32 printOop: obj32"
  	| i |
+ 	{heap32 markStack. heap32 weaklingStack. heap32 mournQueue} do:
- 	{heap32 markStack. heap32 weaklingStack. heap32 ephemeronQueue} do:
  		[:obj|
  		obj ~= heap32 nilObject ifTrue:
  			[map at: obj put: (map at: heap32 nilObject)]].
  	i := 0.
  	heap32 allObjectsDo:
  		[:obj32|
  		(i := i + 1) >= 10000 ifTrue:
  			[Transcript nextPut: $.; flush. i := 0].
  		(map at: obj32 ifAbsent: nil)
  			ifNotNil:
  				[:obj64| | format classIndex |
  				(heap64 numSlotsOf: obj64) > 0 ifTrue: "filter-out filtered objStack pages"
  					[format := heap32 formatOf: obj32.
  					 (heap64 isPointersFormat: format)
  						ifTrue:
  							[((heap64 isIndexableFormat: format)
  								and: [(classIndex := heap64 classIndexOf: obj64) <= ClassBlockClosureCompactIndex
  								and: [classIndex >= ClassMethodContextCompactIndex]])
  								ifTrue: [self fillInPointerObjectWithPC: obj64 from: obj32]
  								ifFalse: [self fillInPointerObject: obj64 from: obj32]]
  						ifFalse:
  							[(heap64 isCompiledMethodFormat: format)
  								ifTrue: [self fillInCompiledMethod: obj64 from: obj32]
  								ifFalse: [self fillInBitsObject: obj64 from: obj32]]]]
  			ifNil: [self assert: (self isUnmappedObject: obj32)]]!



More information about the Vm-dev mailing list