[Vm-dev] VM Maker: Cog-lw.48.mcz
Eliot Miranda
eliot.miranda at gmail.com
Wed Jul 11 20:14:28 UTC 2012
Congratulations are due to Lars Wassermann, the GSoC student on the ARM
Jitter for Squeak VM project, who has got as far as implementing a plugin
for an ARM simulator that passes all its tests and can evaluate fibonacci.
Lars is making great progress.
e.g.
nfib
"long fib(long n) { return n <= 1 ? 1 : fib(n-1) + fib(n-2) + 1; }
as compiled by arm-elf-gnuabi-gcc fib.c -c -marm
also, the jumps are changed by hand."
"| bat nfib ip |
bat := GdbARMAlienTests new.
nfib := bat nfib asWordArray.
ip := 0.
23 timesRepeat:
[bat processor disassembleInstructionAt: ip In: nfib into:
[:da :len|
Transcript nextPutAll: da; cr; flush.
ip := ip + len]]"
^#("00000000 <fib>:
0:" 16re92d4810 "push {r4, fp, lr} fp = r11, sp is changed in this
command
4:" 16re28db008 "add fp, sp, #8 now, the frame pointer is changed
8:" 16re24dd00c "sub sp, sp, #12
c:" 16re50b0010 "str r0, [fp, #-16]
10:" 16re51b3010 "ldr r3, [fp, #-16] r3 <- [fp-16] <- r0
14:" 16re3530001 "cmp r3, #1
18:" 16rda00000c "ble 50 <fib+0x50>
1c:" 16re51b3010 "ldr r3, [fp, #-16]
20:" 16re2433001 "sub r3, r3, #1
24:" 16re1a00003 "mov r0, r3
28:" 16rebfffff4 "bl 0 <fib>
2c:" 16re1a04000 "mov r4, r0
30:" 16re51b3010 "ldr r3, [fp, #-16]
34:" 16re2433002 "sub r3, r3, #2
38:" 16re1a00003 "mov r0, r3
3c:" 16rebffffef "bl 0 <fib>
40:" 16re1a03000 "mov r3, r0
44:" 16re0843003 "add r3, r4, r3
48:" 16re2833001 "add r3, r3, #1
4c:" 16rea000000 "b 54 <fib+0x54>
50:" 16re3a03001 "mov r3, #1
54:" 16re1a00003 "mov r0, r3
58:" 16re24bd008 "sub sp, fp, #8
5c:" 16re8bd8810 "pop {r4, fp, pc}")
On Wed, Jul 11, 2012 at 12:47 PM, <commits at source.squeak.org> wrote:
>
> Eliot Miranda uploaded a new version of Cog to project VM Maker:
> http://source.squeak.org/VMMaker/Cog-lw.48.mcz
>
> ==================== Summary ====================
>
> Name: Cog-lw.48
> Author: lw
> Time: 11 July 2012, 9:13:45.865 pm
> UUID: 5ae3e465-4b2c-2349-9b88-77b8f53d5acd
> Ancestors: Cog-eem.47
>
> Added the GdbARMAlien, together with its tests and the plugin.
> Additionally, introduced CogProcessorAlien as a common superclass for
> BochsIA32Alien and GdbARMAlien to increase code reusage.
>
> The same might be possible for the Plugins (BochsIA32/GdbARM), because
> they are also identical.
>
> =============== Diff against Cog-eem.47 ===============
>
> Item was changed:
> + CogProcessorAlien variableByteSubclass: #BochsIA32Alien
> - Alien variableByteSubclass: #BochsIA32Alien
> instanceVariableNames: ''
> classVariableNames: 'OpcodeExceptionMap PostBuildStackDelta'
> poolDictionaries: ''
> category: 'Cog-Processors'!
>
> !BochsIA32Alien commentStamp: '<historical>' prior: 0!
> I am a wrapper around the Bochs C++ IA32 CPU emulator. Note that
> currently I provide no access to the x87/mmx FPU state, only providing
> access to the SSE/xmm registers.
>
> Here is the configure script for the configuration this code assumes.
> Offsets of fields will change with different configurations so they must
> agree.
>
> ----8<---- conf.COG ----8<----
> #!!/bin/sh
>
> # this sets up the compile for Cog. Disable as much inessential stuff
> # as possible leaving only the cpu/fpu & memory interface
>
> set echo
> # CFLAGS="-pipe -O3 -fomit-frame-pointer -finline-functions
> -falign-loops=16 -falign-jumps=16 -falign-functions=16 -falign-labels=16
> -falign-loops-max-skip=15 -falign-jumps-max-skip=15 -fprefetch-loop-arrays
> $CFLAGS"
> CFLAGS="-m32 $CFLAGS"
> CFLAGS="-Dlongjmp=_longjmp -Dsetjmp=_setjmp $CFLAGS"
> CFLAGS="-pipe -O3 -fomit-frame-pointer -finline-functions $CFLAGS"
> CFLAGS="-g $CFLAGS"
> CPATH="/sw/include"
> CPPFLAGS=""
> CXXFLAGS="$CFLAGS"
> LDFLAGS="-L/sw/lib"
>
> export CFLAGS
> export CPATH
> export CPPFLAGS
> export CXXFLAGS
> export LDFLAGS
>
> ./configure --enable-Cog \
> --enable-cpu-level=6 \
> --enable-sse=2 \
> --enable-assert-checks \
> --with-nogui \
> --disable-x86-64 \
> --disable-pae \
> --disable-large-pages \
> --disable-global-pages \
> --disable-mtrr \
> --disable-sb16 \
> --disable-ne2000 \
> --disable-pci \
> --disable-acpi \
> --disable-apic \
> --disable-clgd54xx \
> --disable-usb \
> --disable-plugins \
> ${CONFIGURE_ARGS}
>
> # apic == Advanced programmable Interrupt Controller
> # acpi == Advanced Configuration and Power Interface
> # pci == Peripheral Component Interconnect local bus
> # clgd54xx == Cirrus Logic GD54xx video card
> ----8<---- conf.COG ----8<----!
>
> Item was removed:
> - ----- Method: BochsIA32Alien>>disassembleFrom:to:in:on: (in category
> 'disassembly') -----
> - disassembleFrom: startAddress to: endAddress in: memory on: aStream
> - | address |
> - address := startAddress.
> - [address < endAddress] whileTrue:
> - [[:size :string|
> - aStream nextPutAll: string; cr; flush.
> - address := address + size]
> - valueWithArguments: (self
> -
> primitiveDisassembleAt: address
> -
> inMemory: memory)]!
>
> Item was removed:
> - ----- Method: BochsIA32Alien>>disassembleInstructionAt:In: (in category
> 'disassembly') -----
> - disassembleInstructionAt: pc In: memory
> - ^(self primitiveDisassembleAt: pc inMemory: memory) last!
>
> Item was removed:
> - ----- Method: BochsIA32Alien>>disassembleInstructionAt:In:into: (in
> category 'disassembly') -----
> - disassembleInstructionAt: ip In: memory into: aBlock
> - | lenAndDi |
> - lenAndDi := self primitiveDisassembleAt: ip inMemory: memory.
> - ^aBlock value: lenAndDi last value: lenAndDi first!
>
> Item was removed:
> - ----- Method: BochsIA32Alien>>disassembleNextInstructionIn: (in category
> 'disassembly') -----
> - disassembleNextInstructionIn: memory
> - ^(self primitiveDisassembleAt: self eip inMemory: memory) last!
>
> Item was removed:
> - ----- Method: BochsIA32Alien>>runInMemory: (in category 'execution')
> -----
> - runInMemory: aMemory
> - | result |
> - result := self primitiveRunInMemory: aMemory minimumAddress: 0
> readOnlyBelow: 0.
> - result ~~ self ifTrue:
> - [self error: 'eek!!']!
>
> Item was removed:
> - ----- Method: BochsIA32Alien>>runInMemory:minimumAddress:readOnlyBelow:
> (in category 'execution') -----
> - runInMemory: aMemory minimumAddress: minimumAddress readOnlyBelow:
> minimumWritableAddress
> - | result |
> - result := self primitiveRunInMemory: aMemory
> - minimumAddress: minimumAddress
> - readOnlyBelow: minimumWritableAddress.
> - result ~~ self ifTrue:
> - [self error: 'eek!!']!
>
> Item was removed:
> - ----- Method: BochsIA32Alien>>runInMemory:readExecuteOnlyBelow: (in
> category 'execution') -----
> - runInMemory: aMemory readExecuteOnlyBelow: minWriteMaxExecAddr
> - | result |
> - result := self primitiveRunInMemory: aMemory minimumAddress: 0
> readOnlyBelow: minWriteMaxExecAddr.
> - result ~~ self ifTrue:
> - [self error: 'eek!!']!
>
> Item was removed:
> - ----- Method: BochsIA32Alien>>singleStepIn: (in category 'execution')
> -----
> - singleStepIn: aMemory
> - | result |
> - result := self primitiveSingleStepInMemory: aMemory
> minimumAddress: 0 readOnlyBelow: aMemory size.
> - result ~~ self ifTrue:
> - [self error: 'eek!!']!
>
> Item was removed:
> - ----- Method: BochsIA32Alien>>singleStepIn:minimumAddress:readOnlyBelow:
> (in category 'execution') -----
> - singleStepIn: aMemory minimumAddress: minimumAddress readOnlyBelow:
> minimumWritableAddress
> - | result |
> - result := self primitiveSingleStepInMemory: aMemory
> - minimumAddress: minimumAddress
> - readOnlyBelow: minimumWritableAddress.
> - result ~~ self ifTrue:
> - [self error: 'eek!!']!
>
> Item was removed:
> - ----- Method: BochsIA32Alien>>singleStepIn:readExecuteOnlyBelow: (in
> category 'execution') -----
> - singleStepIn: aMemory readExecuteOnlyBelow: minWriteMaxExecAddr
> - | result |
> - result := self primitiveSingleStepInMemory: aMemory
> minimumAddress: 0 readOnlyBelow: minWriteMaxExecAddr.
> - result ~~ self ifTrue:
> - [self error: 'eek!!']!
>
> Item was added:
> + Alien variableByteSubclass: #CogProcessorAlien
> + instanceVariableNames: ''
> + classVariableNames: ''
> + poolDictionaries: ''
> + category: 'Cog-Processors'!
>
> Item was added:
> + ----- Method: CogProcessorAlien>>abstractInstructionCompilerClass (in
> category 'Cog API') -----
> + abstractInstructionCompilerClass
> + self subclassResponsibility!
>
> Item was added:
> + ----- Method: CogProcessorAlien>>callOpcode (in category 'opcodes') -----
> + callOpcode
> + self subclassResponsibility.!
>
> Item was added:
> + ----- Method: CogProcessorAlien>>disassembleFrom:to:in:on: (in category
> 'disassembly') -----
> + disassembleFrom: startAddress to: endAddress in: memory on: aStream
> + | address |
> + address := startAddress.
> + [address < endAddress] whileTrue:
> + [[:size :string|
> + aStream nextPutAll: string; cr; flush.
> + address := address + size]
> + valueWithArguments: (self
> +
> primitiveDisassembleAt: address
> +
> inMemory: memory)]!
>
> Item was added:
> + ----- Method: CogProcessorAlien>>disassembleInstructionAt:In: (in
> category 'disassembly') -----
> + disassembleInstructionAt: pc In: memory
> + ^(self primitiveDisassembleAt: pc inMemory: memory) last!
>
> Item was added:
> + ----- Method: CogProcessorAlien>>disassembleInstructionAt:In:into: (in
> category 'disassembly') -----
> + disassembleInstructionAt: ip In: memory into: aBlock
> + | lenAndDi |
> + lenAndDi := self primitiveDisassembleAt: ip inMemory: memory.
> + ^aBlock value: lenAndDi last value: lenAndDi first!
>
> Item was added:
> + ----- Method: CogProcessorAlien>>disassembleNextInstructionIn: (in
> category 'disassembly') -----
> + disassembleNextInstructionIn: memory
> + ^(self primitiveDisassembleAt: self pc inMemory: memory) last!
>
> Item was added:
> + ----- Method: CogProcessorAlien>>nopOpcode (in category 'opcodes') -----
> + nopOpcode
> + self subclassResponsibility.!
>
> Item was added:
> + ----- Method: CogProcessorAlien>>printRegisterState:on: (in category
> 'printing') -----
> + printRegisterState: registerStateVector on: aStream
> +
> + self subclassResponsibility.!
>
> Item was added:
> + ----- Method: CogProcessorAlien>>printRegistersOn: (in category
> 'printing') -----
> + printRegistersOn: aStream
> + self printRegisterState: self registerState on: aStream.
> + aStream flush!
>
> Item was added:
> + ----- Method: CogProcessorAlien>>reportPrimitiveFailure (in category
> 'error handling') -----
> + reportPrimitiveFailure
> + | errorAndLog |
> + errorAndLog := self primitiveErrorAndLog.
> + self error: 'Error ', errorAndLog first printString, (errorAndLog
> last ifNil: [''] ifNotNil: [:log| ': ', log])!
>
> Item was added:
> + ----- Method: CogProcessorAlien>>runInMemory: (in category 'execution')
> -----
> + runInMemory: aMemory
> + | result |
> + result := self primitiveRunInMemory: aMemory minimumAddress: 0
> readOnlyBelow: 0.
> + result ~~ self ifTrue:
> + [self error: 'eek!!']!
>
> Item was added:
> + ----- Method:
> CogProcessorAlien>>runInMemory:minimumAddress:readOnlyBelow: (in category
> 'execution') -----
> + runInMemory: aMemory minimumAddress: minimumAddress readOnlyBelow:
> minimumWritableAddress
> + | result |
> + result := self primitiveRunInMemory: aMemory
> + minimumAddress: minimumAddress
> + readOnlyBelow: minimumWritableAddress.
> + result ~~ self ifTrue:
> + [self error: 'eek!!']!
>
> Item was added:
> + ----- Method: CogProcessorAlien>>runInMemory:readExecuteOnlyBelow: (in
> category 'execution') -----
> + runInMemory: aMemory readExecuteOnlyBelow: minWriteMaxExecAddr
> + | result |
> + result := self primitiveRunInMemory: aMemory minimumAddress: 0
> readOnlyBelow: minWriteMaxExecAddr.
> + result ~~ self ifTrue:
> + [self error: 'eek!!']!
>
> Item was added:
> + ----- Method: CogProcessorAlien>>singleStepIn: (in category 'execution')
> -----
> + singleStepIn: aMemory
> + | result |
> + result := self primitiveSingleStepInMemory: aMemory
> minimumAddress: 0 readOnlyBelow: aMemory size.
> + result ~~ self ifTrue:
> + [self error: 'eek!!']!
>
> Item was added:
> + ----- Method:
> CogProcessorAlien>>singleStepIn:minimumAddress:readOnlyBelow: (in category
> 'execution') -----
> + singleStepIn: aMemory minimumAddress: minimumAddress readOnlyBelow:
> minimumWritableAddress
> + | result |
> + result := self primitiveSingleStepInMemory: aMemory
> + minimumAddress: minimumAddress
> + readOnlyBelow: minimumWritableAddress.
> + result ~~ self ifTrue:
> + [self error: 'eek!!']!
>
> Item was added:
> + ----- Method: CogProcessorAlien>>singleStepIn:readExecuteOnlyBelow: (in
> category 'execution') -----
> + singleStepIn: aMemory readExecuteOnlyBelow: minWriteMaxExecAddr
> + | result |
> + result := self primitiveSingleStepInMemory: aMemory
> minimumAddress: 0 readOnlyBelow: minWriteMaxExecAddr.
> + result ~~ self ifTrue:
> + [self error: 'eek!!']!
>
> Item was added:
> + CogProcessorAlien variableByteSubclass: #GdbARMAlien
> + instanceVariableNames: ''
> + classVariableNames: 'OpcodeExceptionMap PostBuildStackDelta'
> + poolDictionaries: ''
> + category: 'Cog-Processors'!
>
> Item was added:
> + ----- Method: GdbARMAlien class>>dataSize (in category 'instance
> creation') -----
> + dataSize
> +
> + ^1536!
>
> Item was added:
> + ----- Method: GdbARMAlien class>>defaultIntegerBaseInDebugger (in
> category 'debugger') -----
> + defaultIntegerBaseInDebugger
> + ^16!
>
> Item was added:
> + ----- Method: GdbARMAlien class>>new (in category 'instance creation')
> -----
> + new
> + ^(self atAddress: self primitiveNewCPU) reset!
>
> Item was added:
> + ----- Method: GdbARMAlien class>>primitiveNewCPU (in category
> 'primitives') -----
> + primitiveNewCPU
> + "Answer the address of a new ARMulator C type ARMul_State
> instance."
> + <primitive: 'primitiveNewCPU' module: 'GdbARMPlugin'>
> + ^self primitiveFailed!
>
> Item was added:
> + ----- Method: GdbARMAlien>>abstractInstructionCompilerClass (in category
> 'Cog API') -----
> + abstractInstructionCompilerClass
> + ^CogARMCompiler!
>
> Item was added:
> + ----- Method: GdbARMAlien>>branchAndLinkOpcodeWithOffset: (in category
> 'opcodes') -----
> + branchAndLinkOpcodeWithOffset: aNumber
> +
> + | offset |
> + offset := (aNumber - 8) asInteger >> 2.
> + (offset bitAnd: 16rFF000000) ~= 0 ifTrue: [self error: 'The offset
> is to far. ARM does not support such far jumps.'].
> + ^ 16reb000000 bitOr: (offset bitAnd: 16r00FFFFFF)!
>
> Item was added:
> + ----- Method: GdbARMAlien>>callOpcode (in category 'opcodes') -----
> + callOpcode
> + "The call command does not generally exist. The most similar would
> be bl <offset>"
> + ^ self branchAndLinkOpcodeWithOffset: 0.!
>
> Item was added:
> + ----- Method: GdbARMAlien>>cflag (in category 'accessing') -----
> + cflag
> + ^self unsignedLongAt: 577!
>
> Item was added:
> + ----- Method: GdbARMAlien>>eflags (in category 'accessing') -----
> + eflags
> +
> + ^ (((self nflag << 5 bitOr: self zflag << 4)
> + bitOr: self cflag << 3)
> + bitOr: self vflag << 2)
> + bitOr: self ifflags!
>
> Item was added:
> + ----- Method:
> GdbARMAlien>>handleExecutionPrimitiveFailureIn:minimumAddress:readOnlyBelow:
> (in category 'error handling') -----
> + handleExecutionPrimitiveFailureIn: memoryArray "<Bitmap|ByteArray>"
> minimumAddress: minimumAddress "<Integer>" readOnlyBelow:
> minimumWritableAddress "<Integer>"
> + "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 pc) between: minimumAddress and: memoryArray byteSize
> - 1) ifTrue:
> + [opcode := memoryArray byteAt: pc + 1.
> + ^self
> + perform: (OpcodeExceptionMap at: opcode + 1)
> + with: pc
> + with: memoryArray
> + with: minimumWritableAddress]."
> + ^self reportPrimitiveFailure!
>
> Item was added:
> + ----- Method: GdbARMAlien>>ifflags (in category 'accessing') -----
> + ifflags
> + ^self unsignedLongAt: 585!
>
> Item was added:
> + ----- Method: GdbARMAlien>>integerRegisterState (in category
> 'accessing-abstract') -----
> + integerRegisterState
> + ^{ self r0. self r1. self r2. self r3. self r4. self r5. self
> r6. self r7. self r8.
> + self r9. self r10. self r11. self r12. self sp. self lr.
> self pc}!
>
> Item was added:
> + ----- Method: GdbARMAlien>>lr (in category 'accessing') -----
> + lr
> + ^self unsignedLongAt: 69!
>
> Item was added:
> + ----- Method: GdbARMAlien>>lr: (in category 'accessing') -----
> + lr: anUnsignedInteger
> +
> + ^self unsignedLongAt: 69 put: anUnsignedInteger!
>
> Item was added:
> + ----- Method: GdbARMAlien>>nflag (in category 'accessing') -----
> + nflag
> + ^self unsignedLongAt: 569!
>
> Item was added:
> + ----- Method: GdbARMAlien>>nopOpcode (in category 'opcodes') -----
> + nopOpcode
> + "mov r0, r0"
> + ^ 16rE1A01001!
>
> Item was added:
> + ----- Method: GdbARMAlien>>pc (in category 'accessing') -----
> + pc
> + ^self unsignedLongAt: 73!
>
> Item was added:
> + ----- Method: GdbARMAlien>>pc: (in category 'accessing') -----
> + pc: anUnsignedInteger
> +
> + ^self unsignedLongAt: 73 put: anUnsignedInteger!
>
> Item was added:
> + ----- Method: GdbARMAlien>>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:
> 'GdbARMPlugin'>
> + ^self primitiveFailed!
>
> Item was added:
> + ----- Method: GdbARMAlien>>primitiveErrorAndLog (in category
> 'primitives') -----
> + primitiveErrorAndLog
> + "Answer an array of the current error code and log contents"
> + <primitive: 'primitiveErrorAndLog' module: 'GdbARMPlugin'>
> + ^self primitiveFailed!
>
> Item was added:
> + ----- Method: GdbARMAlien>>primitiveResetCPU (in category 'primitives')
> -----
> + primitiveResetCPU
> + "Reset the receiver to registers all zero, and protected 32-bit
> mode."
> + <primitive: 'primitiveResetCPU' module: 'GdbARMPlugin'>
> + ^self reportPrimitiveFailure!
>
> Item was added:
> + ----- Method:
> GdbARMAlien>>primitiveRunInMemory:minimumAddress:readOnlyBelow: (in
> category 'primitives') -----
> + primitiveRunInMemory: memoryArray "<Bitmap|ByteArray>" minimumAddress:
> minimumAddress "<Integer>" readOnlyBelow: minimumWritableAddress "<Integer>"
> + "Run the receiver using the argument as the store. Origin the
> argument at 0. i.e. the first byte of the
> + memoryArray is address 0. Make addresses below minimumAddress
> illegal. Convert out-of-range
> + call, jump and memory read/writes into register instructions into
> ProcessorSimulationTrap signals."
> + <primitive: 'primitiveRunInMemoryMinimumAddressReadWrite' module:
> 'GdbARMPlugin' error: ec>
> + ^ec == #'inappropriate operation'
> + ifTrue: [self handleExecutionPrimitiveFailureIn:
> memoryArray
> + minimumAddress: minimumAddress
> + readOnlyBelow:
> minimumWritableAddress]
> + ifFalse: [self reportPrimitiveFailure]
> +
> + "self printRegistersOn: Transcript"!
>
> Item was added:
> + ----- Method:
> GdbARMAlien>>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
> + call, jump and memory read/writes into register instructions into
> ProcessorSimulationTrap signals."
> + <primitive: 'primitiveSingleStepInMemoryMinimumAddressReadWrite'
> module: 'GdbARMPlugin' error: ec>
> + ^ec == #'inappropriate operation'
> + ifTrue: [self handleExecutionPrimitiveFailureIn:
> memoryArray
> + minimumAddress: minimumAddress
> + readOnlyBelow:
> minimumWritableAddress]
> + ifFalse: [self reportPrimitiveFailure]!
>
> Item was added:
> + ----- Method: GdbARMAlien>>printRegisterState:on: (in category
> 'printing') -----
> + printRegisterState: registerStateVector on: aStream
> + | rsvs fields|
> + aStream ensureCr.
> + rsvs := registerStateVector readStream.
> + fields := #( r0 r1 r2 r3 r4 r5 r6 cr r7 r8 r9 r10 r11 r12 cr sp
> lr pc eflags cr).
> + fields withIndexDo:
> + [:sym :index| | val |
> + sym = #cr
> + ifTrue: [aStream cr]
> + ifFalse:
> + [(val := rsvs next) isNil ifTrue: [^self].
> + aStream nextPutAll: sym; nextPut: $:;
> space.
> + val printOn: aStream base: 16 length: 8
> padded: true.
> + #eflags == sym
> + ifTrue:
> + [aStream space.
> + "'FIVCZN'"'--VCZN'
> withIndexDo:
> + [:flag :bitIndex|
> + flag ~= $- ifTrue:
> + [aStream
> nextPut: flag; nextPutAll: 'F='; print: (val bitAnd: 1 << (bitIndex - 1))
> >> (bitIndex - 1); space]]]
> + ifFalse:
> + [val > 16 ifTrue:
> + [aStream space;
> nextPut: $(.
> + val printOn:
> aStream base: 10 length: 1 padded: false.
> + aStream nextPut:
> $)]].
> + (fields at: index + 1) ~~ #cr ifTrue:
> + [aStream tab]]]!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r0 (in category 'accessing') -----
> + r0
> + ^self unsignedLongAt: 13!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r0: (in category 'accessing') -----
> + r0: anUnsignedInteger
> +
> + ^self unsignedLongAt: 13 put: anUnsignedInteger!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r1 (in category 'accessing') -----
> + r1
> + ^self unsignedLongAt: 17!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r10 (in category 'accessing') -----
> + r10
> + ^self unsignedLongAt: 53!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r10: (in category 'accessing') -----
> + r10: anUnsignedInteger
> +
> + ^self unsignedLongAt: 53 put: anUnsignedInteger!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r11 (in category 'accessing') -----
> + r11
> + ^self unsignedLongAt: 57!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r11: (in category 'accessing') -----
> + r11: anUnsignedInteger
> +
> + ^self unsignedLongAt: 57 put: anUnsignedInteger!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r12 (in category 'accessing') -----
> + r12
> + ^self unsignedLongAt: 61!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r12: (in category 'accessing') -----
> + r12: anUnsignedInteger
> +
> + ^self unsignedLongAt: 61 put: anUnsignedInteger!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r1: (in category 'accessing') -----
> + r1: anUnsignedInteger
> +
> + ^self unsignedLongAt: 17 put: anUnsignedInteger!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r2 (in category 'accessing') -----
> + r2
> + ^self unsignedLongAt: 21!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r2: (in category 'accessing') -----
> + r2: anUnsignedInteger
> +
> + ^self unsignedLongAt: 21 put: anUnsignedInteger!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r3 (in category 'accessing') -----
> + r3
> + ^self unsignedLongAt: 25!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r3: (in category 'accessing') -----
> + r3: anUnsignedInteger
> +
> + ^self unsignedLongAt: 25 put: anUnsignedInteger!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r4 (in category 'accessing') -----
> + r4
> + ^self unsignedLongAt: 29!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r4: (in category 'accessing') -----
> + r4: anUnsignedInteger
> +
> + ^self unsignedLongAt: 29 put: anUnsignedInteger!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r5 (in category 'accessing') -----
> + r5
> + ^self unsignedLongAt: 33!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r5: (in category 'accessing') -----
> + r5: anUnsignedInteger
> +
> + ^self unsignedLongAt: 33 put: anUnsignedInteger!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r6 (in category 'accessing') -----
> + r6
> + ^self unsignedLongAt: 37!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r6: (in category 'accessing') -----
> + r6: anUnsignedInteger
> +
> + ^self unsignedLongAt: 37 put: anUnsignedInteger!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r7 (in category 'accessing') -----
> + r7
> + ^self unsignedLongAt: 41!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r7: (in category 'accessing') -----
> + r7: anUnsignedInteger
> +
> + ^self unsignedLongAt: 41 put: anUnsignedInteger!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r8 (in category 'accessing') -----
> + r8
> + ^self unsignedLongAt: 45!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r8: (in category 'accessing') -----
> + r8: anUnsignedInteger
> +
> + ^self unsignedLongAt: 45 put: anUnsignedInteger!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r9 (in category 'accessing') -----
> + r9
> + ^self unsignedLongAt: 49!
>
> Item was added:
> + ----- Method: GdbARMAlien>>r9: (in category 'accessing') -----
> + r9: anUnsignedInteger
> +
> + ^self unsignedLongAt: 49 put: anUnsignedInteger!
>
> Item was added:
> + ----- Method: GdbARMAlien>>registerState (in category
> 'accessing-abstract') -----
> + registerState
> + ^{ self r0. self r1. self r2. self r3. self r4. self r5. self
> r6. self r7.
> + self r8. self r0. self r10. self r11. self r12. self sp.
> self lr. self pc. self eflags }!
>
> Item was added:
> + ----- Method: GdbARMAlien>>reset (in category 'accessing') -----
> + reset
> + self primitiveResetCPU!
>
> Item was added:
> + ----- Method: GdbARMAlien>>retOpcode (in category 'opcodes') -----
> + retOpcode
> + "the ret command does not generally exist. the most similar would
> be mov pc, lr"
> + ^ self halt.!
>
> Item was added:
> + ----- Method: GdbARMAlien>>sflag (in category 'accessing') -----
> + sflag
> + ^self unsignedLongAt: 589!
>
> Item was added:
> + ----- Method: GdbARMAlien>>sp (in category 'accessing') -----
> + sp
> + ^self unsignedLongAt: 65!
>
> Item was added:
> + ----- Method: GdbARMAlien>>sp: (in category 'accessing') -----
> + sp: anUnsignedInteger
> +
> + ^self unsignedLongAt: 65 put: anUnsignedInteger!
>
> Item was added:
> + ----- Method: GdbARMAlien>>vflag (in category 'accessing') -----
> + vflag
> + ^self unsignedLongAt: 581!
>
> Item was added:
> + ----- Method: GdbARMAlien>>zflag (in category 'accessing') -----
> + zflag
> + ^self unsignedLongAt: 573!
>
> Item was added:
> + TestCase subclass: #GdbARMAlienTests
> + instanceVariableNames: 'processor'
> + classVariableNames: ''
> + poolDictionaries: ''
> + category: 'Cog-Processors-Tests'!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>callTrapPerformance: (in category
> 'tests') -----
> + callTrapPerformance: n
> + "Call a function that is out-of-range. Ensure the call is
> trapped."
> + "self new testCallTrap"
> + | memory |
> + "The address is out of range of memory every which way (whether
> relative or absolute and whether big-endian or little."
> + memory := ByteArray new: 1024.
> + memory replaceFrom: 1 to: 5 with: { self processor callOpcode. 0.
> 16r80. 16r80. 0. } asByteArray.
> + self processor
> + eip: 0;
> + esp: (memory size - 4). "Room for return address"
> + 1 to: n do:
> + [:ign|
> + [self processor singleStepIn: memory]
> + on: ProcessorSimulationTrap
> + do: [:ex|]].
> +
> + "QSystemProfiler spyOn: [GdbARMAlienTests new callTrapPerformance:
> 1024*128]"
> + "Time millisecondsToRun: [GdbARMAlienTests new
> callTrapPerformance: 1024*128] 2463"
> + "Time millisecondsToRun: [1 to: 1024*1024*64 do: [:ign| nil
> yourself]] 636"
> + "Time millisecondsToRun: [1 to: 1024*1024*64 do: [:ign| nil
> perform: #ifNotNilDo: with: nil]] 3639"
> + "Time millisecondsToRun: [1 to: 1024*1024*64 do: [:ign| nil
> perform: #ifNotNilDo:ifNil: with: nil with: nil]] 12401"!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>nfib (in category 'accessing') -----
> + nfib
> + "long fib(long n) { return n <= 1 ? 1 : fib(n-1) + fib(n-2) + 1; }
> + as compiled by arm-elf-gnuabi-gcc fib.c -c -marm
> + also, the jumps are changed by hand."
> + "| bat nfib ip |
> + bat := GdbARMAlienTests new.
> + nfib := bat nfib asWordArray.
> + ip := 0.
> + 23 timesRepeat:
> + [bat processor disassembleInstructionAt: ip In: nfib into:
> + [:da :len|
> + Transcript nextPutAll: da; cr; flush.
> + ip := ip + len]]"
> + ^#("00000000 <fib>:
> + 0:" 16re92d4810 "push {r4, fp, lr} fp
> = r11, sp is changed in this command
> + 4:" 16re28db008 "add fp, sp, #8
> now, the frame pointer is changed
> + 8:" 16re24dd00c "sub sp, sp, #12
> + c:" 16re50b0010 "str r0, [fp, #-16]
> + 10:" 16re51b3010 "ldr r3, [fp, #-16] r3
> <- [fp-16] <- r0
> + 14:" 16re3530001 "cmp r3, #1
> + 18:" 16rda00000c "ble 50 <fib+0x50>
> + 1c:" 16re51b3010 "ldr r3, [fp, #-16]
> + 20:" 16re2433001 "sub r3, r3, #1
> + 24:" 16re1a00003 "mov r0, r3
> + 28:" 16rebfffff4 "bl 0 <fib>
> + 2c:" 16re1a04000 "mov r4, r0
> + 30:" 16re51b3010 "ldr r3, [fp, #-16]
> + 34:" 16re2433002 "sub r3, r3, #2
> + 38:" 16re1a00003 "mov r0, r3
> + 3c:" 16rebffffef "bl 0 <fib>
> + 40:" 16re1a03000 "mov r3, r0
> + 44:" 16re0843003 "add r3, r4, r3
> + 48:" 16re2833001 "add r3, r3, #1
> + 4c:" 16rea000000 "b 54 <fib+0x54>
> + 50:" 16re3a03001 "mov r3, #1
> + 54:" 16re1a00003 "mov r0, r3
> + 58:" 16re24bd008 "sub sp, fp, #8
> + 5c:" 16re8bd8810 "pop {r4, fp, pc}")!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>processor (in category 'accessing') -----
> + processor
> + processor ifNil:
> + [processor := GdbARMAlien new].
> + ^processor!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>registerGetters (in category
> 'accessing') -----
> + registerGetters
> + ^#(r0 r1 r2 r3 r4 r5 r6 r7 r8 r9 r10 r11 r12 lr sp pc)!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>registerSetters (in category
> 'accessing') -----
> + registerSetters
> + ^#(r0: r1: r2: r3: r4: r5: r6: r7: r8: r9: r10: r11: r12: lr: sp:
> pc:)!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>runNFib:disassemble:printRegisters: (in
> category 'execution') -----
> + runNFib: n disassemble: disassemble printRegisters: printRegisters
> + "Run nfib wth the argument. Answer the result."
> + "self new runNFib: 5 disassemble: true printRegisters: true"
> + | memory |
> + memory := WordArray new: 1024 * 2 withAll: self processor
> nopOpcode.
> + memory replaceFrom: 1 to: self nfib size with: self nfib
> asWordArray startingAt: 1.
> + self processor
> + r0: n;"argument n"
> + lr: memory size * 2; "return address"
> + pc: 0;
> + sp: (memory size * 4) - 16.
> + printRegisters ifTrue:
> + [self processor printRegistersOn: Transcript.
> + Transcript cr; flush].
> + "run until something goes wrong."
> + self processor runInMemory: memory readExecuteOnlyBelow: memory
> size / 2.
> + printRegisters ifTrue:
> + [self processor printRegistersOn: Transcript.
> + Transcript cr; flush].
> + ^self processor r0!
>
> Item was added:
> + ----- Method:
> GdbARMAlienTests>>singleStepNFib:disassemble:printRegisters: (in category
> 'execution') -----
> + singleStepNFib: n disassemble: disassemble printRegisters: printRegisters
> + "Run nfib wth the argument. Answer the result."
> + "self new runNFib: 5 disassemble: true printRegisters: true"
> + | memory |
> + memory := WordArray new: 1024 * 2 withAll: self processor
> nopOpcode.
> + memory replaceFrom: 1 to: self nfib size with: self nfib
> asWordArray startingAt: 1.
> + self processor
> + r0: n; "argument n"
> + lr: self nfib size * 4; "return address"
> + pc: 0;
> + sp: (memory size * 4 - 12). "Room for return address,
> frame pointer and r4"
> + printRegisters ifTrue:
> + [self processor printRegistersOn: Transcript.
> + Transcript cr; flush].
> + [disassemble ifTrue:
> + [Transcript nextPutAll: (self processor
> disassembleNextInstructionIn: memory); cr; flush].
> + self processor singleStepIn: memory readExecuteOnlyBelow: memory
> size * 4 / 2.
> + printRegisters ifTrue:
> + [self processor printRegistersOn: Transcript.
> + Transcript cr; flush].
> + "stop, once we leave the nfib code and step through the nops after
> that."
> + self processor pc < (self nfib size * 4)] whileTrue.
> + ^self processor r0!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>testCallTrap (in category 'tests') -----
> + testCallTrap
> + "Call a function that is out-of-range. Ensure the call is
> trapped."
> + "self new testCallTrap"
> + | memory |
> + memory := Bitmap new: 256 withAll: self processor nopOpcode.
> + memory longAt: 1 put: (self processor
> branchAndLinkOpcodeWithOffset: 1024) bigEndian: false.
> + memory := memory asByteArray.
> + self processor
> + pc: 0;
> + sp: (memory size - 4); "Room for return address"
> + singleStepIn: memory.
> + "We have to step twice, because the first step
> only changes the pc, but does not fetch anything from the address it points
> to."
> + self should: [self processor singleStepIn: memory]
> + raise: Error
> + withExceptionDo:
> + [:pst|
> + self assert: self processor pc = 1024.
> + self assert: self processor lr = 4.
> + self assert: pst messageText = 'Error 0: Illegal
> Instruction fetch address (0x00000400).'].!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>testDisassembling (in category 'tests')
> -----
> + testDisassembling
> +
> + | memory result |
> + memory := WordArray new: 2.
> + memory at: 1 put: 16rEF200000.
> + result := self processor
> + disassembleInstructionAt: 0
> + In: memory
> + into: [:str :len |
> + self
> + assert: len = 4;
> + assert: str = 'svc 0x00200000'].!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>testExecutionTrap (in category 'tests')
> -----
> + testExecutionTrap
> + "Execute a run of nops. test executing beyond the executable
> limit is trapped."
> + "self new testExecutionTrap"
> + | memory |
> + "The address is out of range of memory every which way (whether
> relative or absolute and whether big-endian or little."
> + memory := (Bitmap new: 1024 * 2 withAll: self processor nopOpcode)
> asByteArray.
> + self processor
> + pc: 0;
> + sp: (memory size - 4). "Room for return address"
> + self should: [self processor runInMemory: memory minimumAddress: 0
> readOnlyBelow: memory size / 2]
> + raise: Error
> + withExceptionDo:
> + [:err|
> + self assert: self processor pc = (memory size / 2).
> + self assert: ('Error 0: Illegal Instruction fetch
> address (0x00001000).' match: err messageText)].
> + self processor pc: 0.
> + self should: [[self processor singleStepIn: memory minimumAddress:
> 0 readOnlyBelow: memory size / 2] repeat]
> + raise: Error
> + withExceptionDo:
> + [:err|
> + self assert: self processor pc = (memory size / 2).
> + self assert: ('Error 0: Illegal Instruction fetch
> address (0x00001000).' match: err messageText)]!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>testFlags (in category 'tests') -----
> + testFlags
> + "self new testFlags"
> + | memory |
> + memory := Bitmap new: 3.
> + memory longAt: 1 put: 16rE3A03001 bigEndian: false. "MOV r3, #1"
> + memory longAt: 5 put: 16rE3530001 bigEndian: false. "CMP r3, #1"
> + memory := memory asByteArray.
> + self processor
> + disassembleInstructionAt: 0
> + In: memory
> + into: [:str :len |
> + self
> + assert: len = 4;
> + assert: str = 'mov r3, #1'].
> + self processor
> + disassembleInstructionAt: 4
> + In: memory
> + into: [:str :len |
> + self
> + assert: len = 4;
> + assert: str = 'cmp r3, #1'].
> + self processor
> + pc: 0;
> + singleStepIn: memory;
> + singleStepIn: memory.
> + self
> + assert: self processor pc = 16r8;
> + assert: self processor r3 = 1;
> + assert: self processor zflag = 1;
> + assert: self processor cflag = 1;
> + assert: self processor vflag = 0;
> + assert: self processor nflag = 0.
> + self processor reset.
> + self assert: self processor eflags = 3. "IFFlags are both set."!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>testMOVSD (in category 'tests') -----
> + testMOVSD
> + "Test MOVSD indirecting through edx."
> + "self new testMOVSD"
> + self processor
> + edx: 0;
> + eip: 0;
> + singleStepIn: {16rF2. 16r0F. 16r10. 16r42. 16r04. 16r90.
> 16r01. 16r02. 16r03. 16r04. 16r05. 16r06} asByteArray "movsd %ds:0x4(%edx),
> %xmm0;nop;garbage".
> + self assert: self processor eip = 5.
> + self assert: self processor xmm0low = 16r0605040302019004!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>testNfib1 (in category 'tests') -----
> + testNfib1
> + "self new testNfib1"
> + self should: [self runNFib: 1 disassemble: false printRegisters:
> true]
> + raise: Error
> + withExceptionDo:
> + [:err| self assert: err messageText = 'Error 0:
> Illegal Instruction fetch address (0x00001000).'].
> + self deny: (self processor pc between: 0 and: self nfib size).
> + self assert: self processor r0 = 1 benchFib!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>testNfib16 (in category 'tests') -----
> + testNfib16
> + "self new testNfib16"
> + self should: [self runNFib: 16 disassemble: false printRegisters:
> false]
> + raise: Error.
> + self deny: (self processor pc between: 0 and: self nfib size).
> + self assert: self processor r0 = 16 benchFib!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>testNfib2 (in category 'tests') -----
> + testNfib2
> + "self new testNfib2"
> + self should: [self runNFib: 2 disassemble: false printRegisters:
> false]
> + raise: Error.
> + self deny: (self processor pc between: 0 and: self nfib size).
> + self assert: self processor r0 = 2 benchFib!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>testNfib4 (in category 'tests') -----
> + testNfib4
> + "self new testNfib4"
> + self should: [self runNFib: 4 disassemble: false printRegisters:
> false]
> + raise: Error.
> + self deny: (self processor pc between: 0 and: self nfib size).
> + self assert: self processor r0 = 4 benchFib!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>testResetCPU (in category 'tests') -----
> + testResetCPU
> + "self new testResetCPU"
> + self registerSetters do:
> + [:setter|
> + self processor perform: setter with: 16r55555555].
> + self registerGetters do:
> + [:getter|
> + self assert: 16r55555555 = (self processor perform:
> getter)].
> + self processor reset.
> + self registerGetters do:
> + [:getter|
> + self assert: 0 = (self processor perform: getter)]!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>testStepNfib1 (in category 'tests') -----
> + testStepNfib1
> + "self new testStepNfib1"
> + self singleStepNFib: 1 disassemble: false printRegisters: false.
> + self assert: self processor pc = (self nfib asWordArray size * 4).
> + self assert: self processor r0 = 1 benchFib!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>testStepNfib2 (in category 'tests') -----
> + testStepNfib2
> + "self new testStepNfib2"
> + self singleStepNFib: 2 disassemble: false printRegisters: false.
> + self assert: self processor pc = (self nfib size * 4).
> + self assert: self processor r0 = 2 benchFib!
>
> Item was added:
> + ----- Method: GdbARMAlienTests>>testStepNfib4 (in category 'tests') -----
> + testStepNfib4
> + "self new testStepNfib4"
> + self singleStepNFib: 4 disassemble: false printRegisters: false.
> + self assert: self processor pc = (self nfib size * 4).
> + self assert: self processor r0 = 4 benchFib!
>
> Item was added:
> + 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 added:
> + ----- Method: GdbARMPlugin class>>declareCVarsIn: (in category
> 'translation') -----
> + declareCVarsIn: aCCodeGenerator
> + "prevInterruptCheckChain lives in sqGdbARMPlugin.c"
> + super declareCVarsIn: aCCodeGenerator.
> + aCCodeGenerator removeVariable: 'prevInterruptCheckChain'!
>
> Item was added:
> + ----- 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 added:
> + ----- Method: GdbARMPlugin>>forceStopOnInterrupt (in category
> 'interruption') -----
> + forceStopOnInterrupt
> + interpreterProxy getInterruptPending ifTrue:
> + [self forceStopRunning]!
>
> Item was added:
> + ----- 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 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: 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 cCode: 'memcpy(logObjData, log, logLen)' inSmalltalk:
> [logObjData. log].
> + interpreterProxy storePointer: 1 ofObject: resultObj
> withValue: logObj].
> + interpreterProxy pop: 1 thenPush: resultObj!
>
> Item was added:
> + ----- 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 added:
> + ----- 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 positive32BitIntegerFor:
> +
> (self cCoerceSimple: cpu
> +
> to: 'unsigned long'))!
>
> Item was added:
> + ----- 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 added:
> + ----- 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."
> + | 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:
> 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 added:
> + ----- 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 + BaseHeaderSize!
>
> Item was added:
> + ----- 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 + BaseHeaderSize + BytesPerOop]
> + ifFalse: [self longAt: rcvr + BaseHeaderSize +
> BytesPerOop]!
>
>
--
best,
Eliot
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20120711/487bd29a/attachment-0001.htm
More information about the Vm-dev
mailing list