Vm-dev July 2012

vm-dev@lists.squeakfoundation.org

20 participants
62 discussions

Re: [Pharo-project] can someone explain me this method?
by Eliot Miranda 13 Jul '12

13 Jul '12

On Fri, Jul 13, 2012 at 10:51 AM, Camillo Bruni <camillobruni(a)gmail.com>wrote: > Cool thanks everyone for the references :D > > We will pu that into the sources > > On 2012-07-13, at 19:47, Nicolas Cellier wrote: > > > The first numbers are quite easy to guess without reading any reference : > > if you have a major in astronomy, sure :P > > > - 400 years span 146097 days in gregorian calendar. > > - 100 years span 36524 days, except every 400 years. > > - 4 years span 1461 days, except every 100 years. > > - 1 year span 365 days, except every four years > > well indeed, not that hard :P, but when you're in midst of a mind-boggling > refactoring > you don't waste time to understand these details :P > :) Here's an analogous method in VisualWorks. They don't bother to document seconds per day (86400). TimeZone>>timestampToSeconds: aTimestamp " Convert a Timestamp in to seconds starting from the Smalltalk epoch in UTC. Since we do not know leap-seconds in UTC, Answer the number of seconds since January 1, 1901. Same as 'self asDate asSeconds + self asTime asSeconds' " | yearIndex absDays seconds | yearIndex := aTimestamp year - 1901. absDays := yearIndex * 365 "elapsed years" + (yearIndex // 4) "ordinary leap years" + ((yearIndex + 300) // 400) "leap centuries, first one is 2000, i.e. yearIndex = 99" - (yearIndex // 100) "non-leap centuries" + aTimestamp day - 1 + (aTimestamp firstDayOf: aTimestamp month). seconds := aTimestamp hour * 60 + aTimestamp minute * 60 + aTimestamp second. "do it this way to minimize large arithmetic" ^absDays * 86400 + seconds But I like "Same as 'self asDate asSeconds + self asTime asSeconds'" since Date>asSeconds "Answer the seconds between the time that 1901 began and the same time in the receiver's day." ^self asTimestamp asSeconds and Timestamp>asSeconds "Answer the number of seconds since January 1, 1901." "Same as 'self asDate asSeconds + self asTime asSeconds'" ^TimeZone default timestampToSeconds: self So the documentation still leaves something to be desired :) It is perhaps unfortunate that manifest constants in class variables cost more than literals because of the indirection through the association. I did an inlining scheme in VisualWorks many years ago that depended on automatic recompilation when read-only bindings were changed (since the scope of these bindings is limited its quick to find affected methods). It depended on the method including the binding in its literals even though the compiler inlined the value of the binding, and it depended on access to source (since the points where the variable is inlined are not marked in the bytecode). I still think there's benefit here; even a JIT needs to know what bindings are read-only and a write-barrier to be able to inline the values of globals. But it has a lot of impact for not very much performance (given that in performance-critical parts of the system people have already inlined by hand, as in the above). So I suppose it will remain a fun experiment. > For months and days, the tricks are less trivial... > > > > Nicolas > > > > > > 2012/7/13 Sven Van Caekenberghe <sven(a)beta9.be>: > >> Yeah, but sometimes a clever algorithm comes from a book, so to speak. > >> > >> Giving the variables long names, or the constants names, would not make > that much difference, it would still be pretty hard to understand. > >> > >> ZTimestamp class>>withJdn: jdn dayMonthYearDo: block > >> "Return the value of executing block with the Gregorian Calender > day, month and year as arguments, > >> as computed from my Julian Day Number, jdn. > >> See > http://en.wikipedia.org/wiki/Julian_date#Gregorian_calendar_from_Julian_day… > " > >> > >> | j g dg c dc b db a da y m d | > >> j := jdn + 32044. > >> g := j // 146097. > >> dg := j \\ 146097. > >> c := ((dg // 36524) + 1) * 3 // 4. > >> dc := dg - (c * 36524). > >> b := dc // 1461. > >> db := dc \\ 1461. > >> a := ((db // 365) + 1) * 3 // 4. > >> da := db - (a * 365). > >> y := (g * 400) + (c * 100) + (b * 4) + a. > >> m := ((((da * 5) + 308)) // 153) - 2. > >> d := da - ((m + 4) * 153 // 5) + 122. > >> ^ block > >> value: d + 1 > >> value: ((m + 2) \\ 12) + 1 > >> value: (y - 4800 + ((m * 2) // 12)) > >> > >> On 13 Jul 2012, at 17:53, Camillo Bruni wrote: > >> > >>> comments? decent variable names? no magic numbers? > >>> NOW you can find NONE of that in dayMonthYearDo! > >>> > >>> > >>> ================================================================== > >>> dayMonthYearDo: aBlock > >>> "Evaluation the block with three arguments: day month, year." > >>> > >>> | l n i j dd mm yyyy | > >>> l := jdn + 68569. > >>> n := 4 * l // 146097. > >>> l := l - (146097 * n + 3 // 4). > >>> i := 4000 * (l + 1) // 1461001. > >>> l := l - (1461 * i // 4) + 31. > >>> j := 80 * l // 2447. > >>> dd := l - (2447 * j // 80). > >>> l := j // 11. > >>> mm := j + 2 - (12 * l). > >>> yyyy := 100 * (n - 49) + i + l. > >>> > >>> ^ aBlock > >>> value: dd > >>> value: mm > >>> value: yyyy. > >>> > >>> ================================================================== > >>> > >>> so can anyone explain me the magic numbers here?? > >>> > >> > >> > > > > > -- best, Eliot

1 0

Re: [Vm-dev] VM Maker: Cog-lw.48.mcz
by Eliot Miranda 12 Jul '12

12 Jul '12

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(a)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

2 1

VM Maker: Cog-eem.49.mcz
by commits＠source.squeak.org 11 Jul '12

11 Jul '12

Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.49.mcz ==================== Summary ==================== Name: Cog-eem.49 Author: eem Time: 11 July 2012, 1:03:06.847 pm UUID: 97c68673-8068-4b5b-9978-1c68751ffb13 Ancestors: Cog-lw.48 Remove duplicate methods now moved to superclass and fix a timestamp. =============== Diff against Cog-lw.48 =============== Item was removed: - ----- Method: BochsIA32Alien>>printRegistersOn: (in category 'printing') ----- - printRegistersOn: aStream - self printRegisterState: self registerState on: aStream. - aStream flush! Item was removed: - ----- Method: BochsIA32Alien>>reportPrimitiveFailure (in category 'error handling') ----- - reportPrimitiveFailure - | errorAndLog | - errorAndLog := self primitiveErrorAndLog. - self error: 'Error ', errorAndLog first printString, (errorAndLog last ifNil: [''] ifNotNil: [:log| ' ', log])! Item was changed: ----- Method: CogProcessorAlien>>printRegistersOn: (in category 'printing') ----- printRegistersOn: aStream self printRegisterState: self registerState on: aStream. aStream flush!

1 0

VM Maker: Cog-lw.48.mcz
by commits＠source.squeak.org 11 Jul '12

11 Jul '12

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]!

1 0

VM Maker: VMMaker.oscog-eem.184.mcz
by commits＠source.squeak.org 11 Jul '12

11 Jul '12

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.184.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.184 Author: eem Time: 11 July 2012, 10:59:28.555 am UUID: dc778ede-e64d-4e6c-8d51-53a93e5f80de Ancestors: VMMaker.oscog-eem.183 Parameterize Cogit creation with the ISA to use for Lars Wassermann's ARM work (!!!!). Add some ill-considered fluff about instance-specific behaviours in the new object representation. =============== Diff against VMMaker.oscog-eem.183 =============== Item was changed: VMClass subclass: #CogMemoryManager (excessive size, no diff calculated) Item was removed: - ----- Method: Cogit class>>initializeCompilationConstants (in category 'class initialization') ----- - initializeCompilationConstants - ProcessorClass := BochsIA32Alien. - NumSendTrampolines := 4! Item was added: + ----- Method: Cogit class>>initializeCompilationWithConstantsOptions: (in category 'class initialization') ----- + initializeCompilationWithConstantsOptions: optionsDictionary + ProcessorClass := (optionsDictionary at: #ISA ifAbsent: [#IA32]) caseOf: { + [#IA32] -> [BochsIA32Alien]. + [#ARMV5] -> [GdbARMAlien]. }. + NumSendTrampolines := 4! Item was changed: ----- Method: Cogit class>>initializeWithOptions: (in category 'class initialization') ----- initializeWithOptions: optionsDictionary self initializeMiscConstantsWith: optionsDictionary. "must preceed other initialization." self initializeErrorCodes. self initializeCogMethodConstants. self initializeAnnotationConstants. + self initializeCompilationWithConstantsOptions: optionsDictionary. - self initializeCompilationConstants. self initializeBytecodeTable. self initializePrimitiveTable!

1 0

VM Maker: VMMaker-dtl.278.mcz
by commits＠source.squeak.org 11 Jul '12

11 Jul '12

David T. Lewis uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker-dtl.278.mcz ==================== Summary ==================== Name: VMMaker-dtl.278 Author: dtl Time: 10 July 2012, 7:21:34.41 pm UUID: ccf0949c-e240-4a8f-ae48-9745e5f04894 Ancestors: VMMaker-dtl.277 VMMaker 4.9.6 Add new primitives from oscog: InterpreterPrimitives>>primitiveSetIdentityHash (primitive 161) InterpreterPrimitives>>primitiveBehaviorHash (primitive 175) InterpreterPrimitives>>primitiveMaxIdentityHash (primitive 176) Add primitives from oscog, moving them to StackInterpreterPrimitives InterpreterPrimitives>>primitiveEnterCriticalSection InterpreterPrimitives>>primitiveExitCriticalSection InterpreterPrimitives>>primitiveTestAndSetOwnershipOfCriticalSection Add primitives from oscog, move to StackInterpreterPrimitives, make abstract in InterpreterPrimitives, and add a new implementation for Interpreter: InterpreterPrimitives>>primitiveFloatAt InterpreterPrimitives>>primitiveFloatAtPut InterpreterPrimitives>>primitivePerformWithArgs InterpreterPrimitives>>primitivePerformInSuperclass InterpreterPrimitives>>primitiveClosureValue InterpreterPrimitives>>primitiveClosureValueWithArgs InterpreterPrimitives>>primitiveClosureValueNoContextSwitch Make InterpreterPrimitives>>primitiveResume abstract with separate implementations in Interpreter and StackInterpreterPrimitives. Make InterpreterPrimitives>>primitiveInvokeObjectAsMethod abstract with separate implementations in Interpreter and StackInterpreterPrimitives. Add enough code generator changes from oscog to enable generation structure definitions for a stack interpreter. No functional changes to code generation for standard interpreter. Add bitClear: to the C translation dictionary. If assert has not been defined by the build system e.g. using sqAssert.h, then include <assert.h> in CCodeGenerator>>emitDefaultMacrosOn: Fix code generation for #cPreprocessorDirective: (do not add trailing $; ) =============== Diff against VMMaker-dtl.277 =============== Item was changed: ----- Method: CCodeGenerator>>emitCCodeOn:doAssertions: (in category 'C code generator') ----- emitCCodeOn: aStream doAssertions: assertionFlag "Emit C code for all methods in the code base onto the given stream. All inlined method calls should already have been expanded." self emitCHeaderOn: aStream. + self emitCTypesOn: aStream. self emitCConstantsOn: aStream. self emitCFunctionPrototypes: preparedMethodList on: aStream. self emitCVariablesOn: aStream. 'Writing Translated Code...' displayProgressAt: Sensor cursorPoint from: 0 to: methods size during: [:bar | preparedMethodList doWithIndex: [ :m :i | bar value: i. m emitCCodeOn: aStream generator: self. ]]. self emitExportsOn: aStream. ! Item was added: + ----- Method: CCodeGenerator>>emitCTypesOn: (in category 'C code generator') ----- + emitCTypesOn: aStream + "Store local type declarations on the given stream." + vmClass ifNotNil: + [vmClass ancilliaryStructClasses do: + [:structClass| + (vmClass shouldGenerateTypedefFor: structClass) ifTrue: + [structClass printTypedefOn: aStream. + aStream cr; cr]]]! Item was changed: ----- Method: CCodeGenerator>>emitDefaultMacrosOn: (in category 'C code generator') ----- emitDefaultMacrosOn: aStream "Emit macros to provide default implementations of certain functions used by the interpreter. If not previously defined in config.h they will be defined here. The definitions will be available to any module that includes sqMemoryAccess.h. The default macros are chosen for backward compatibility with existing platform support code." "Reduce the obscurity of these macros by flagging some selectors to make this method show up as a sender." + self flag: #assert:. + "If assert() has not been defined e.g. by sqAssert.h, then use the standard clib version" + aStream cr; + nextPutAll: '#ifndef assert'; cr; + nextPutAll: ' #include <assert.h>'; cr; + nextPutAll: '#endif'; cr. + self flag: #allocateMemory:minimum:imageFile:headerSize:. aStream cr; nextPutAll: '#ifndef allocateMemoryMinimumImageFileHeaderSize'; cr; nextPutAll: ' /* Called by Interpreter>>allocateMemory:minimum:imageFile:headerSize: */'; cr; nextPutAll: ' /* Default definition if not previously defined in config.h */'; cr; nextPutAll: ' #define allocateMemoryMinimumImageFileHeaderSize(', 'heapSize, minimumMemory, fileStream, headerSize) \'; cr; nextPutAll: ' sqAllocateMemory(minimumMemory, heapSize)'; cr; nextPutAll: '#endif'; cr. self flag: #sqImage:read:size:length:. aStream cr; nextPutAll: '#ifndef sqImageFileReadEntireImage'; cr; nextPutAll: ' /* Called by Interpreter>>sqImage:read:size:length: */'; cr; nextPutAll: ' /* Default definition if not previously defined in config.h */'; cr; nextPutAll: ' #define sqImageFileReadEntireImage(memoryAddress, ', 'elementSize, length, fileStream) \'; cr; nextPutAll: ' sqImageFileRead(memoryAddress, elementSize, length, fileStream)'; cr; nextPutAll: '#endif'; cr. self flag: #error:. aStream cr; nextPutAll: '#ifndef error'; cr; nextPutAll: ' /* error() function called from Interpreter */'; cr; nextPutAll: ' /* Default definition if not previously defined in config.h */'; cr; nextPutAll: ' #define error(str) defaultErrorProc(str)'; cr; nextPutAll: '#endif'; cr. self flag: #primitiveMicrosecondClock; flag: #ioMicroSecondClock. aStream cr; nextPutAll: '#ifndef ioMicroSecondClock'; cr; nextPutAll: ' /* Called by Interpreter>>primitiveMicrosecondClock and GC methods */'; cr; nextPutAll: ' /* Default definition if not previously defined in config.h */'; cr; nextPutAll: ' #define ioMicroSecondClock ioMSecs'; cr; nextPutAll: '#endif'; cr. self flag: #primitiveUtcWithOffset; flag: #setMicroSeconds:andOffset:. aStream cr; nextPutAll: '#ifndef ioUtcWithOffset'; cr; nextPutAll: ' /* Called by Interpreter>>primitiveUtcWithOffset */'; cr; nextPutAll: ' /* Default definition if not previously defined in config.h */'; cr; nextPutAll: ' #define ioUtcWithOffset(clock, offset) setMicroSecondsandOffset(clock, offset)'; cr; nextPutAll: '#endif'; cr. ! Item was added: + ----- Method: CCodeGenerator>>generateBitClear:on:indent: (in category 'C translation') ----- + generateBitClear: msgNode on: aStream indent: level + "Generate the C code for this message onto the given stream." + + aStream next: 2 put: $(. + self emitCExpression: msgNode receiver on: aStream. + aStream nextPutAll: ' | '. + self emitCExpression: msgNode args first on: aStream. + aStream nextPutAll: ') - '. + self emitCExpression: msgNode args first on: aStream. + aStream nextPut: $)! Item was changed: ----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation') ----- initializeCTranslationDictionary "Initialize the dictionary mapping message names to actions for C code generation." | pairs | translationDict := Dictionary new: 200. pairs := #( #& #generateAnd:on:indent: #| #generateOr:on:indent: #and: #generateSequentialAnd:on:indent: #or: #generateSequentialOr:on:indent: #not #generateNot:on:indent: #+ #generatePlus:on:indent: #- #generateMinus:on:indent: #negated #generateNegated:on:indent: #* #generateTimes:on:indent: #/ #generateDivide:on:indent: #// #generateDivide:on:indent: #\\ #generateModulo:on:indent: #<< #generateShiftLeft:on:indent: #>> #generateShiftRight:on:indent: #min: #generateMin:on:indent: #max: #generateMax:on:indent: #between:and: #generateBetweenAnd:on:indent: #bitAnd: #generateBitAnd:on:indent: #bitOr: #generateBitOr:on:indent: #bitXor: #generateBitXor:on:indent: #bitShift: #generateBitShift:on:indent: #signedBitShift: #generateSignedBitShift:on:indent: #bitInvert32 #generateBitInvert32:on:indent: + #bitClear: #generateBitClear:on:indent: #< #generateLessThan:on:indent: #<= #generateLessThanOrEqual:on:indent: #= #generateEqual:on:indent: #> #generateGreaterThan:on:indent: #>= #generateGreaterThanOrEqual:on:indent: #~= #generateNotEqual:on:indent: #== #generateEqual:on:indent: #~~ #generateNotEqual:on:indent: #isNil #generateIsNil:on:indent: #notNil #generateNotNil:on:indent: #whileTrue: #generateWhileTrue:on:indent: #whileFalse: #generateWhileFalse:on:indent: #whileTrue #generateDoWhileTrue:on:indent: #whileFalse #generateDoWhileFalse:on:indent: #to:do: #generateToDo:on:indent: #to:by:do: #generateToByDo:on:indent: #repeat #generateRepeat:on:indent: #ifTrue: #generateIfTrue:on:indent: #ifFalse: #generateIfFalse:on:indent: #ifTrue:ifFalse: #generateIfTrueIfFalse:on:indent: #ifFalse:ifTrue: #generateIfFalseIfTrue:on:indent: #at: #generateAt:on:indent: #at:put: #generateAtPut:on:indent: #basicAt: #generateAt:on:indent: #basicAt:put: #generateAtPut:on:indent: #integerValueOf: #generateIntegerValueOf:on:indent: #integerObjectOf: #generateIntegerObjectOf:on:indent: #isIntegerObject: #generateIsIntegerObject:on:indent: #cCode: #generateInlineCCode:on:indent: #cCode:inSmalltalk: #generateInlineCCode:on:indent: #cPreprocessorDirective: #generateInlineCPreprocessorDirective:on:indent: #preprocessorExpression: #generateInlineCppDirective:on:indent: #isDefined:inSmalltalk:comment:ifTrue: #generateInlineCppIfDef:on:indent: #isDefined:inSmalltalk:comment:ifTrue:ifFalse: #generateInlineCppIfDefElse:on:indent: #isDefinedTrueExpression:inSmalltalk:comment:ifTrue:ifFalse: #generateInlineCppIfElse:on:indent: #cCoerce:to: #generateCCoercion:on:indent: #cCoerceSimple:to: #generateCCoercion:on:indent: #addressOf: #generateAddressOf:on:indent: #signedIntFromLong #generateSignedIntFromLong:on:indent: #signedIntToLong #generateSignedIntToLong:on:indent: #signedIntFromShort #generateSignedIntFromShort:on:indent: #signedIntToShort #generateSignedIntToShort:on:indent: #preIncrement #generatePreIncrement:on:indent: #preDecrement #generatePreDecrement:on:indent: #inline: #generateInlineDirective:on:indent: #asFloat #generateAsFloat:on:indent: #asInteger #generateAsInteger:on:indent: #asUnsignedInteger #generateAsUnsignedInteger:on:indent: #asSymbol #generateAsSymbol:on:indent: #anyMask: #generateBitAnd:on:indent: #raisedTo: #generateRaisedTo:on:indent: #touch: #generateTouch:on:indent: #bytesPerWord #generateBytesPerWord:on:indent: #baseHeaderSize #generateBaseHeaderSize:on:indent: #sharedCodeNamed:inCase: #generateSharedCodeDirective:on:indent: #perform: #generatePerform:on:indent: #perform:with: #generatePerform:on:indent: #perform:with:with: #generatePerform:on:indent: #perform:with:with:with: #generatePerform:on:indent: #perform:with:with:with:with: #generatePerform:on:indent: #perform:with:with:with:with:with: #generatePerform:on:indent: #shouldNotImplement #generateSmalltalkMetaError:on:indent: #shouldBeImplemented #generateSmalltalkMetaError:on:indent: ). 1 to: pairs size by: 2 do: [:i | translationDict at: (pairs at: i) put: (pairs at: i + 1)]. pairs := #( #ifTrue: #generateIfTrueAsArgument:on:indent: #ifFalse: #generateIfFalseAsArgument:on:indent: #ifTrue:ifFalse: #generateIfTrueIfFalseAsArgument:on:indent: #ifFalse:ifTrue: #generateIfFalseIfTrueAsArgument:on:indent: #cCode: #generateInlineCCodeAsArgument:on:indent: #cCode:inSmalltalk: #generateInlineCCodeAsArgument:on:indent: ). asArgumentTranslationDict := Dictionary new: 8. 1 to: pairs size by: 2 do: [:i | asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)]. ! Item was added: + ----- Method: CCodeGenerator>>structTargetKindForVariableName: (in category 'C code generator') ----- + structTargetKindForVariableName: varName "<String>" + ^VMStructType structTargetKindForDeclaration: (self typeOfVariable: varName)! Item was added: + ----- Method: CCodeGenerator>>vmClass (in category 'public') ----- + vmClass + "Answer the interpreter classs if any. This is nil other than for the core VM." + ^vmClass! Item was added: + ----- Method: CCodeGenerator>>vmClass: (in category 'public') ----- + vmClass: aClass + "Set the interpreter class if any. This is nil other than for the core VM." + vmClass := aClass! Item was changed: ----- Method: Interpreter class>>initializePrimitiveTable (in category 'initialization') ----- initializePrimitiveTable "This table generates a C function address table use in primitiveResponse along with dispatchFunctionPointerOn:in:" "NOTE: The real limit here is 2047 because of the method header layout but there is no point in going over the needed size" MaxPrimitiveIndex := 575. PrimitiveTable := Array new: MaxPrimitiveIndex + 1. self table: PrimitiveTable from: #( "Integer Primitives (0-19)" (0 primitiveFail) (1 primitiveAdd) (2 primitiveSubtract) (3 primitiveLessThan) (4 primitiveGreaterThan) (5 primitiveLessOrEqual) (6 primitiveGreaterOrEqual) (7 primitiveEqual) (8 primitiveNotEqual) (9 primitiveMultiply) (10 primitiveDivide) (11 primitiveMod) (12 primitiveDiv) (13 primitiveQuo) (14 primitiveBitAnd) (15 primitiveBitOr) (16 primitiveBitXor) (17 primitiveBitShift) (18 primitiveMakePoint) (19 primitiveFail) "Guard primitive for simulation -- *must* fail" "LargeInteger Primitives (20-39)" (20 primitiveFail) (21 primitiveAddLargeIntegers) (22 primitiveSubtractLargeIntegers) (23 primitiveLessThanLargeIntegers) (24 primitiveGreaterThanLargeIntegers) (25 primitiveLessOrEqualLargeIntegers) (26 primitiveGreaterOrEqualLargeIntegers) (27 primitiveEqualLargeIntegers) (28 primitiveNotEqualLargeIntegers) (29 primitiveMultiplyLargeIntegers) (30 primitiveDivideLargeIntegers) (31 primitiveModLargeIntegers) (32 primitiveDivLargeIntegers) (33 primitiveQuoLargeIntegers) (34 primitiveBitAndLargeIntegers) (35 primitiveBitOrLargeIntegers) (36 primitiveBitXorLargeIntegers) (37 primitiveBitShiftLargeIntegers) - (38 primitiveFail) - (39 primitiveFail) + "Float Primitives (38-59)" + (38 primitiveFloatAt) + (39 primitiveFloatAtPut) - "Float Primitives (40-59)" (40 primitiveAsFloat) (41 primitiveFloatAdd) (42 primitiveFloatSubtract) (43 primitiveFloatLessThan) (44 primitiveFloatGreaterThan) (45 primitiveFloatLessOrEqual) (46 primitiveFloatGreaterOrEqual) (47 primitiveFloatEqual) (48 primitiveFloatNotEqual) (49 primitiveFloatMultiply) (50 primitiveFloatDivide) (51 primitiveTruncated) (52 primitiveFractionalPart) (53 primitiveExponent) (54 primitiveTimesTwoPower) (55 primitiveSquareRoot) (56 primitiveSine) (57 primitiveArctan) (58 primitiveLogN) (59 primitiveExp) "Subscript and Stream Primitives (60-67)" (60 primitiveAt) (61 primitiveAtPut) (62 primitiveSize) (63 primitiveStringAt) (64 primitiveStringAtPut) (65 primitiveFail) "was primitiveNext which no longer pays its way (normal Smalltalk code is faster)" (66 primitiveFail) "was primitiveNextPut which no longer pays its way (normal Smalltalk code is faster)" (67 primitiveFail) "was primitiveAtEnd which no longer pays its way (normal Smalltalk code is faster)" "StorageManagement Primitives (68-79)" (68 primitiveObjectAt) (69 primitiveObjectAtPut) (70 primitiveNew) (71 primitiveNewWithArg) (72 primitiveArrayBecomeOneWay) "Blue Book: primitiveBecome" (73 primitiveInstVarAt) (74 primitiveInstVarAtPut) (75 primitiveAsOop) (76 primitiveStoreStackp) "Blue Book: primitiveAsObject" (77 primitiveSomeInstance) (78 primitiveNextInstance) (79 primitiveNewMethod) "Control Primitives (80-89)" (80 primitiveBlockCopy) (81 primitiveValue) (82 primitiveValueWithArgs) (83 primitivePerform) (84 primitivePerformWithArgs) (85 primitiveSignal) (86 primitiveWait) (87 primitiveResume) (88 primitiveSuspend) (89 primitiveFlushCache) "Input/Output Primitives (90-109)" (90 primitiveMousePoint) (91 primitiveTestDisplayDepth) "Blue Book: primitiveCursorLocPut" (92 primitiveSetDisplayMode) "Blue Book: primitiveCursorLink" (93 primitiveInputSemaphore) (94 primitiveGetNextEvent) "Blue Book: primitiveSampleInterval" (95 primitiveInputWord) (96 primitiveFail) "primitiveCopyBits" (97 primitiveSnapshot) (98 primitiveStoreImageSegment) (99 primitiveLoadImageSegment) (100 primitivePerformInSuperclass) "Blue Book: primitiveSignalAtTick" (101 primitiveBeCursor) (102 primitiveBeDisplay) (103 primitiveScanCharacters) (104 primitiveFail) "primitiveDrawLoop" (105 primitiveStringReplace) (106 primitiveScreenSize) (107 primitiveMouseButtons) (108 primitiveKbdNext) (109 primitiveKbdPeek) "System Primitives (110-119)" (110 primitiveIdentical) (111 primitiveClass) (112 primitiveBytesLeft) (113 primitiveQuit) (114 primitiveExitToDebugger) (115 primitiveChangeClass) "Blue Book: primitiveOopsLeft" (116 primitiveFlushCacheByMethod) (117 primitiveExternalCall) (118 primitiveDoPrimitiveWithArgs) (119 primitiveFlushCacheSelective) "Squeak 2.2 and earlier use 119. Squeak 2.3 and later use 116. Both are supported for backward compatibility." "Miscellaneous Primitives (120-127)" (120 primitiveCalloutToFFI) (121 primitiveImageName) (122 primitiveNoop) "Blue Book: primitiveImageVolume" (123 primitiveValueUninterruptably) "@@@: Remove this when all VMs have support" (124 primitiveLowSpaceSemaphore) (125 primitiveSignalAtBytesLeft) "Squeak Primitives Start Here" "Squeak Miscellaneous Primitives (128-149)" (126 primitiveDeferDisplayUpdates) (127 primitiveShowDisplayRect) (128 primitiveArrayBecome) (129 primitiveSpecialObjectsOop) (130 primitiveFullGC) (131 primitiveIncrementalGC) (132 primitiveObjectPointsTo) (133 primitiveSetInterruptKey) (134 primitiveInterruptSemaphore) (135 primitiveMillisecondClock) (136 primitiveSignalAtMilliseconds) (137 primitiveSecondsClock) (138 primitiveSomeObject) (139 primitiveNextObject) (140 primitiveBeep) (141 primitiveClipboardText) (142 primitiveVMPath) (143 primitiveShortAt) (144 primitiveShortAtPut) (145 primitiveConstantFill) "NOTE: When removing the obsolete indexed primitives, the following two should go become #primitiveIntegerAt / atPut" (146 primitiveFail) "primitiveReadJoystick" (147 primitiveFail) "primitiveWarpBits" (148 primitiveClone) (149 primitiveGetAttribute) "File Primitives (150-169) - NO LONGER INDEXED" (150 159 primitiveFail) (160 primitiveAdoptInstance) + (161 primitiveSetIdentityHash) "CogMemoryManager primitives" + (162 164 primitiveFail) - (161 164 primitiveFail) (165 primitiveIntegerAt) "hacked in here for now" (166 primitiveIntegerAtPut) (167 primitiveYield) (168 primitiveCopyObject) (169 primitiveNotIdentical) "Sound Primitives (170-199) - NO LONGER INDEXED" + (170 174 primitiveFail) - (170 185 primitiveFail) + "CogMemoryManager primitives" + (175 primitiveBehaviorHash) + (176 primitiveMaxIdentityHash) + (177 185 primitiveFail) + "Old closure primitives" (186 primitiveFail) "was primitiveClosureValue" (187 primitiveFail) "was primitiveClosureValueWithArgs" "Perform method directly" (188 primitiveExecuteMethodArgsArray) (189 primitiveExecuteMethod) "Sound Primitives (continued) - NO LONGER INDEXED" (190 194 primitiveFail) "Unwind primitives" (195 primitiveFindNextUnwindContext) (196 primitiveTerminateTo) (197 primitiveFindHandlerContext) (198 primitiveMarkUnwindMethod) (199 primitiveMarkHandlerMethod) "new closure primitives (were Networking primitives)" (200 primitiveClosureCopyWithCopiedValues) (201 primitiveClosureValue) "value" (202 primitiveClosureValue) "value:" (203 primitiveClosureValue) "value:value:" (204 primitiveClosureValue) "value:value:value:" (205 primitiveClosureValue) "value:value:value:value:" (206 primitiveClosureValueWithArgs) "valueWithArguments:" (207 209 primitiveFail) "reserved for Cog primitives" (210 primitiveAt) "Compatibility with Cog StackInterpreter Context primitives" (211 primitiveAtPut) "Compatibility with Cog StackInterpreter Context primitives" (212 primitiveSize) "Compatibility with Cog StackInterpreter Context primitives" (213 219 primitiveFail) "reserved for Cog primitives" (220 primitiveFail) "reserved for Cog primitives" (221 primitiveClosureValueNoContextSwitch) "valueNoContextSwitch" (222 primitiveClosureValueNoContextSwitch) "valueNoContextSwitch:" (223 229 primitiveFail) "reserved for Cog primitives" (230 primitiveRelinquishProcessor) (231 primitiveForceDisplayUpdate) (232 primitiveFormPrint) (233 primitiveSetFullScreen) (234 primitiveFail) "primBitmapdecompressfromByteArrayat" (235 primitiveFail) "primStringcomparewithcollated" (236 primitiveFail) "primSampledSoundconvert8bitSignedFromto16Bit" (237 primitiveFail) "primBitmapcompresstoByteArray" (238 241 primitiveFail) "serial port primitives" (242 primitiveFail) (243 primitiveFail) "primStringtranslatefromtotable" (244 primitiveFail) "primStringfindFirstInStringinSetstartingAt" (245 primitiveFail) "primStringindexOfAsciiinStringstartingAt" (246 primitiveFail) "primStringfindSubstringinstartingAtmatchTable" (247 primitiveSnapshotEmbedded) (248 primitiveInvokeObjectAsMethod) (249 primitiveArrayBecomeOneWayCopyHash) "VM Implementor Primitives (250-255)" (250 clearProfile) (251 dumpProfile) (252 startProfiling) (253 stopProfiling) (254 primitiveVMParameter) (255 primitiveFail) "primitiveInstVarsPutFromStack. Never used except in Disney tests. Remove after 2.3 release." "Quick Push Const Methods" (256 primitivePushSelf) (257 primitivePushTrue) (258 primitivePushFalse) (259 primitivePushNil) (260 primitivePushMinusOne) (261 primitivePushZero) (262 primitivePushOne) (263 primitivePushTwo) "Quick Push Const Methods" (264 519 primitiveLoadInstVar) "These ranges used to be used by obsiolete indexed primitives." (520 529 primitiveFail) (530 539 primitiveFail) (540 549 primitiveFail) (550 559 primitiveFail) (560 569 primitiveFail) "External primitive support primitives" (570 primitiveFlushExternalPrimitives) (571 primitiveUnloadModule) (572 primitiveListBuiltinModule) (573 primitiveListExternalModule) (574 primitiveFail) "reserved for addl. external support prims" "Unassigned Primitives" (575 primitiveFail)). ! Item was changed: ----- Method: Interpreter class>>requiredMethodNames (in category 'translation') ----- requiredMethodNames "return the list of method names that should be retained for export or other support reasons" | requiredList | requiredList := Set new:400. "A number of methods required by VM support code, jitter, specific platforms etc" + requiredList addAll: #(fullDisplayUpdate interpret printCallStack printAllStacks readImageFromFile:HeapSize:StartingAt: success: readableFormat: getCurrentBytecode characterForAscii: findClassOfMethod:forReceiver: findSelectorOfMethod:forReceiver: loadInitialContext nullCompilerHook setCompilerInitialized: getFullScreenFlag getInterruptCheckCounter getInterruptKeycode getInterruptPending getNextWakeupTick getSavedWindowSize setFullScreenFlag: setInterruptCheckCounter: setInterruptKeycode: setInterruptPending: setNextWakeupTick: setSavedWindowSize: forceInterruptCheck getThisSessionID setMicroSeconds:andOffset:). - requiredList addAll: #(fullDisplayUpdate interpret printCallStack printAllStacks readImageFromFile:HeapSize:StartingAt: success: readableFormat: getCurrentBytecode characterForAscii: findClassOfMethod:forReceiver: findSelectorOfMethod:forReceiver: loadInitialContext nullCompilerHook primitiveFlushExternalPrimitives setCompilerInitialized: getFullScreenFlag getInterruptCheckCounter getInterruptKeycode getInterruptPending getNextWakeupTick getSavedWindowSize setFullScreenFlag: setInterruptCheckCounter: setInterruptKeycode: setInterruptPending: setNextWakeupTick: setSavedWindowSize: forceInterruptCheck getThisSessionID setMicroSeconds:andOffset:). "Nice to actually have all the primitives available" requiredList addAll: self primitiveTable. "InterpreterProxy is the internal analogue of sqVirtualMachine.c, so make sure to keep all those" InterpreterProxy organization categories do: [:cat | ((cat ~= 'initialize') and: [cat ~= 'private']) ifTrue: [ requiredList addAll: (InterpreterProxy organization listAtCategoryNamed: cat)]]. ^requiredList! Item was added: + ----- Method: Interpreter>>primitiveFloatAt (in category 'indexing primitives') ----- + primitiveFloatAt + "Provide platform-independent access to 32-bit words comprising + a Float. Map index 1 onto the most significant word and index 2 + onto the least significant word." + | rcvr index result | + <var: #result type: #usqInt> + self initPrimCall. + rcvr := self stackValue: 1. + index := self stackTop. + index = ConstOne ifTrue: + [result := self positive32BitIntegerFor: + (objectMemory fetchLong32: 0 + ofObject: rcvr). + ^self pop: 2 thenPush: result]. + index = ConstTwo ifTrue: + [result := self positive32BitIntegerFor: + (objectMemory fetchLong32: 1 + ofObject: rcvr). + ^self pop: 2 thenPush: result]. + self primitiveFailFor: ((objectMemory isIntegerObject: index) + ifTrue: [PrimErrBadIndex] + ifFalse: [PrimErrBadArgument])! Item was added: + ----- Method: Interpreter>>primitiveFloatAtPut (in category 'indexing primitives') ----- + primitiveFloatAtPut + "Provide platform-independent access to 32-bit words comprising + a Float. Map index 1 onto the most significant word and index 2 + onto the least significant word." + | rcvr index oopToStore valueToStore | + <var: #result type: #usqInt> + self initPrimCall. + oopToStore := self stackTop. + valueToStore := self positive32BitValueOf: oopToStore. + self successful ifFalse: + [^self primitiveFailFor: PrimErrBadArgument]. + rcvr := self stackValue: 2. + index := self stackValue: 1. + index = ConstOne ifTrue: + [objectMemory storeLong32: 0 + ofObject: rcvr + withValue: valueToStore. + ^self pop: 3 thenPush: oopToStore]. + index = ConstTwo ifTrue: + [objectMemory storeLong32: 1 + ofObject: rcvr + withValue: valueToStore. + ^self pop: 3 thenPush: oopToStore]. + self primitiveFailFor: ((objectMemory isIntegerObject: index) + ifTrue: [PrimErrBadIndex] + ifFalse: [PrimErrBadArgument])! Item was added: + ----- Method: Interpreter>>primitiveResume (in category 'process primitives') ----- + primitiveResume + "Put this process on the scheduler's lists thus allowing it to proceed next + time there is a chance for processes of its priority level" + + | proc | + proc := self stackTop. "rcvr" + "self success: ((self fetchClassOf: proc) = (self splObj: ClassProcess))." + self successful ifTrue: [ self resume: proc ].! Item was added: + ----- Method: InterpreterPrimitives>>primitiveBehaviorHash (in category 'object access primitives') ----- + primitiveBehaviorHash + | hashOrError | + self assert: (objectMemory isIntegerObject: self stackTop) not. + hashOrError := objectMemory ensureBehaviorHash: self stackTop. + hashOrError >= 0 + ifTrue: [self pop: 1 thenPushInteger: hashOrError] + ifFalse: [self primitiveFailFor: hashOrError negated]! Item was added: + ----- Method: InterpreterPrimitives>>primitiveClosureValue (in category 'control primitives') ----- + primitiveClosureValue + self subclassResponsibility! Item was added: + ----- Method: InterpreterPrimitives>>primitiveClosureValueNoContextSwitch (in category 'control primitives') ----- + primitiveClosureValueNoContextSwitch + "An exact clone of primitiveClosureValue except that this version will not + check for interrupts on stack overflow. It may invoke the garbage collector + but will not switch processes. See checkForInterruptsMayContextSwitch:" + self subclassResponsibility! Item was added: + ----- Method: InterpreterPrimitives>>primitiveClosureValueWithArgs (in category 'control primitives') ----- + primitiveClosureValueWithArgs + self subclassResponsibility! Item was added: + ----- Method: InterpreterPrimitives>>primitiveFloatAt (in category 'indexing primitives') ----- + primitiveFloatAt + "Provide platform-independent access to 32-bit words comprising + a Float. Map index 1 onto the most significant word and index 2 + onto the least significant word." + + self subclassResponsibility + ! Item was added: + ----- Method: InterpreterPrimitives>>primitiveFloatAtPut (in category 'indexing primitives') ----- + primitiveFloatAtPut + "Provide platform-independent access to 32-bit words comprising + a Float. Map index 1 onto the most significant word and index 2 + onto the least significant word." + + self subclassResponsibility + ! Item was added: + ----- Method: InterpreterPrimitives>>primitiveInvokeObjectAsMethod (in category 'control primitives') ----- + primitiveInvokeObjectAsMethod + "Primitive. 'Invoke' an object like a function, sending the special message + run: originalSelector with: arguments in: aReceiver. + " + self subclassResponsibility! Item was added: + ----- Method: InterpreterPrimitives>>primitiveMaxIdentityHash (in category 'object access primitives') ----- + primitiveMaxIdentityHash + self pop: 1 thenPushInteger: objectMemory maxIdentityHash! Item was added: + ----- Method: InterpreterPrimitives>>primitivePerformInSuperclass (in category 'control primitives') ----- + primitivePerformInSuperclass + self subclassResponsibility! Item was added: + ----- Method: InterpreterPrimitives>>primitivePerformWithArgs (in category 'control primitives') ----- + primitivePerformWithArgs + self subclassResponsibility! Item was changed: ----- Method: InterpreterPrimitives>>primitiveResume (in category 'process primitives') ----- primitiveResume + "Put this process on the scheduler's lists thus allowing it to proceed next + time there is a chance for processes of its priority level" + + self subclassResponsibility + ! - "put this process on the scheduler's lists thus allowing it to proceed next time there is a chance for processes of it's priority level" - | proc | - proc := self stackTop. "rcvr" - "self success: ((self fetchClassOf: proc) = (self splObj: ClassProcess))." - self successful ifTrue: [ self resume: proc ].! Item was added: + ----- Method: InterpreterPrimitives>>primitiveSetIdentityHash (in category 'object access primitives') ----- + primitiveSetIdentityHash + | hash oldHash thisReceiver | + hash := self stackIntegerValue: 0. + thisReceiver := self stackObjectValue: 1. + self successful ifTrue: + [oldHash := objectMemory hashBitsOf: thisReceiver. + objectMemory setHashBitsOf: thisReceiver to: hash. + self pop: argumentCount + 1 thenPushInteger: oldHash]! Item was changed: + VMStructType subclass: #InterpreterStackPage - ProtoObject subclass: #InterpreterStackPage instanceVariableNames: 'stackLimit headSP headFP baseFP baseAddress realStackLimit lastAddress trace nextPage prevPage' classVariableNames: 'LargeContextBytes' poolDictionaries: 'VMBasicConstants VMSqueakV3BytecodeConstants' category: 'VMMaker-Interpreter'! !InterpreterStackPage commentStamp: '<historical>' prior: 0! I am a class that helps organize the StackInterpreter's collection of stack pages. I represent the control block for a single stack page in the collection of stack pages represented by an InterpreterStackPages instance.! Item was added: + ----- Method: ObjectMemory>>ensureBehaviorHash: (in category 'header access') ----- + ensureBehaviorHash: oop + + ^self hashBitsOf: oop! Item was added: + ----- Method: ObjectMemory>>maxIdentityHash (in category 'forward compatibility') ----- + maxIdentityHash + ^HashMaskUnshifted! Item was added: + ----- Method: ObjectMemory>>setHashBitsOf:to: (in category 'header access') ----- + setHashBitsOf: oop to: hash + self longAt: oop + put: (((self baseHeader: oop) bitClear: HashBits) + bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset)! Item was added: + ----- Method: SlangTest>>testIvarShouldNotBeRedeclaredAsLocal (in category 'testing variable declaration') ----- + testIvarShouldNotBeRedeclaredAsLocal + "Document a bug in some versions of the code generator. If an instance variable is + referenced in the generated code, that variable should not be declared as a local + in the function." + + | s | + s := SlangTestSupportInterpreter asCString: #setBreakSelector: . + self deny: (s includesSubString: 'sqInt breakSelector;') + ! Item was changed: ObjectMemory subclass: #SlangTestSupportInterpreter + instanceVariableNames: 'primFailCode aVarWithOneReference aVarWithTwoReferences objectMemory aVariable breakSelector' - instanceVariableNames: 'primFailCode aVarWithOneReference aVarWithTwoReferences objectMemory aVariable' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-Tests'! !SlangTestSupportInterpreter commentStamp: 'dtl 9/19/2010 21:36' prior: 0! SlangTestSupport implements translatable methods for use in SlangTest unit tests. "VMMaker clearCacheEntriesFor: SlangTestSupportInterpreter. SlangTestSupportInterpreter asCString"! Item was added: + ----- Method: SlangTestSupportInterpreter>>setBreakSelector: (in category 'local and instance vars') ----- + setBreakSelector: aString + "breakSelector is an instance variable and should not be declared as a local in + the generated code" + breakSelector := aString! Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveClosureCopyWithCopiedValues (in category 'control primitives') ----- primitiveClosureCopyWithCopiedValues | newClosure numArgs | numArgs := self stackIntegerValue: 1. self successful ifFalse: [^self primitiveFail]. newClosure := self closureIn: (self stackValue: 2) numArgs: numArgs "greater by 1 due to preIncrement of localIP" + instructionPointer: instructionPointer + 2 - (method + self baseHeaderSize) - instructionPointer: instructionPointer + 2 - (method+BaseHeaderSize) copiedValues: self stackTop. self pop: 3 thenPush: newClosure! Item was added: + ----- Method: StackInterpreterPrimitives>>primitiveClosureValue (in category 'control primitives') ----- + primitiveClosureValue + | blockClosure numArgs closureMethod outerContext | + blockClosure := self stackValue: argumentCount. + numArgs := self argumentCountOfClosure: blockClosure. + argumentCount = numArgs ifFalse: + [^self primitiveFail]. + + "Somewhat paranoiac checks we need while debugging that we may be able to discard + in a robust system." + outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure. + (self isContext: outerContext) ifFalse: + [^self primitiveFail]. + closureMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext. + "Check if the closure's method is actually a CompiledMethod." + (objectMemory isOopCompiledMethod: closureMethod) ifFalse: + [^self primitiveFail]. + + "Note we use activateNewMethod, not executeNewMethod, to avoid + quickCheckForInterrupts. Don't check until we have a full activation." + self activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: true! Item was added: + ----- Method: StackInterpreterPrimitives>>primitiveClosureValueNoContextSwitch (in category 'control primitives') ----- + primitiveClosureValueNoContextSwitch + "An exact clone of primitiveClosureValue except that this version will not + check for interrupts on stack overflow. It may invoke the garbage collector + but will not switch processes. See checkForInterruptsMayContextSwitch:" + | blockClosure numArgs closureMethod outerContext | + blockClosure := self stackValue: argumentCount. + numArgs := self argumentCountOfClosure: blockClosure. + argumentCount = numArgs ifFalse: + [^self primitiveFail]. + + "Somewhat paranoiac checks we need while debugging that we may be able to discard + in a robust system." + outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure. + (self isContext: outerContext) ifFalse: + [^self primitiveFail]. + closureMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext. + "Check if the closure's method is actually a CompiledMethod." + (objectMemory isOopCompiledMethod: closureMethod) ifFalse: + [^self primitiveFail]. + + "Note we use activateNewMethod, not executeNewMethod, to avoid + quickCheckForInterrupts. Don't check until we have a full activation." + self activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: false! Item was added: + ----- Method: StackInterpreterPrimitives>>primitiveClosureValueWithArgs (in category 'control primitives') ----- + primitiveClosureValueWithArgs + | argumentArray arraySize blockClosure numArgs closureMethod index outerContext | + argumentArray := self stackTop. + (objectMemory isArray: argumentArray) ifFalse: + [^self primitiveFail]. + + "Check for enough space in thisContext to push all args" + arraySize := objectMemory fetchWordLengthOf: argumentArray. + (self roomToPushNArgs: arraySize) ifFalse: + [^self primitiveFail]. + + blockClosure := self stackValue: argumentCount. + numArgs := self argumentCountOfClosure: blockClosure. + arraySize = numArgs ifFalse: + [^self primitiveFail]. + + "Somewhat paranoiac checks we need while debugging that we may be able to discard + in a robust system." + outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure. + (self isContext: outerContext) ifFalse: + [^self primitiveFail]. + closureMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext. + "Check if the closure's method is actually a CompiledMethod." + (objectMemory isOopCompiledMethod: closureMethod) ifFalse: + [^self primitiveFail]. + + self popStack. + + "Copy the arguments to the stack, and activate" + index := 1. + [index <= numArgs] + whileTrue: + [self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray). + index := index + 1]. + + "Note we use activateNewMethod, not executeNewMethod, to avoid + quickCheckForInterrupts. Don't check until we have a full activation." + self activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: true! Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveDoNamedPrimitiveWithArgs (in category 'plugin primitives') ----- primitiveDoNamedPrimitiveWithArgs "Simulate an primitiveExternalCall invocation (e.g. for the Debugger). Do not cache anything. e.g. ContextPart>>tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments" | argumentArray arraySize methodArg methodHeader moduleName functionName moduleLength functionLength spec addr primRcvr ctxtRcvr | <var: #addr declareC: 'void (*addr)()'> argumentArray := self stackTop. (objectMemory isArray: argumentArray) ifFalse: [^self primitiveFailFor: -2]. "invalid args" arraySize := objectMemory fetchWordLengthOf: argumentArray. self success: (self roomToPushNArgs: arraySize). methodArg := self stackObjectValue: 2. self successful ifFalse: [^self primitiveFailFor: -2]. "invalid args" (objectMemory isOopCompiledMethod: methodArg) ifFalse: [^self primitiveFailFor: -2]. "invalid args" methodHeader := self headerOf: methodArg. (self literalCountOfHeader: methodHeader) > 2 ifFalse: [^self primitiveFailFor: -3]. "invalid methodArg state" (self assertClassOf: (spec := objectMemory fetchPointer: 1 "first literal" ofObject: methodArg) is: (objectMemory splObj: ClassArray) compactClassIndex: ClassArrayCompactIndex). (self successful and: [(objectMemory lengthOf: spec) = 4 and: [(self primitiveIndexOfMethodHeader: methodHeader) = 117]]) ifFalse: [^self primitiveFailFor: -3]. "invalid methodArg state" (self argumentCountOfMethodHeader: methodHeader) = arraySize ifFalse: [^self primitiveFailFor: -2]. "invalid args (Array args wrong size)" "The function has not been loaded yet. Fetch module and function name." moduleName := objectMemory fetchPointer: 0 ofObject: spec. moduleName = objectMemory nilObject ifTrue: [moduleLength := 0] ifFalse: [self success: (objectMemory isBytes: moduleName). moduleLength := objectMemory lengthOf: moduleName. self cCode: '' inSmalltalk: [ (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: (self stringOf: moduleName)) "??" ifTrue: [moduleLength := 0 "Cause all of these to fail"]]]. functionName := objectMemory fetchPointer: 1 ofObject: spec. self success: (objectMemory isBytes: functionName). functionLength := objectMemory lengthOf: functionName. self successful ifFalse: [^self primitiveFailFor: -3]. "invalid methodArg state" + addr := self ioLoadExternalFunction: functionName + self baseHeaderSize - addr := self ioLoadExternalFunction: functionName + BaseHeaderSize OfLength: functionLength + FromModule: moduleName + self baseHeaderSize - FromModule: moduleName + BaseHeaderSize OfLength: moduleLength. addr = 0 ifTrue: [^self primitiveFailFor: -1]. "could not find function; answer generic failure (see below)" "Cannot fail this primitive from now on. Can only fail the external primitive." objectMemory pushRemappableOop: (argumentArray := self popStack). objectMemory pushRemappableOop: (primRcvr := self popStack). objectMemory pushRemappableOop: self popStack. "the method" objectMemory pushRemappableOop: self popStack. "the context receiver" self push: primRcvr. "replace context receiver with actual receiver" argumentCount := arraySize. 1 to: arraySize do: [:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)]. "Run the primitive (sets primFailCode)" lkupClass := objectMemory nilObject. self callExternalPrimitive: addr. ctxtRcvr := objectMemory popRemappableOop. methodArg := objectMemory popRemappableOop. primRcvr := objectMemory popRemappableOop. argumentArray := objectMemory popRemappableOop. self successful ifFalse: "If primitive failed, then restore state for failure code" [self pop: arraySize + 1. self push: ctxtRcvr. self push: methodArg. self push: primRcvr. self push: argumentArray. argumentCount := 3. "Hack. A nil prim error code (primErrorCode = 1) is interpreted by the image as meaning this primitive is not implemented. So to pass back nil as an error code we use -1 to indicate generic failure." primFailCode = 1 ifTrue: [primFailCode := -1]]! Item was added: + ----- Method: StackInterpreterPrimitives>>primitiveEnterCriticalSection (in category 'process primitives') ----- + primitiveEnterCriticalSection + "Attempt to enter a CriticalSection/Mutex. If not owned, set the owner to the current + process and answer false. If owned by the current process answer true. Otherwise + suspend the process. Answer if the receiver is owned by the current process. + For simulation if there is an argument it is taken to be the effective activeProcess + (see Process>>effectiveProcess)." + | criticalSection owningProcessIndex owningProcess activeProc | + argumentCount > 0 + ifTrue: + [criticalSection := self stackValue: 1. "rcvr" + activeProc := self stackTop] + ifFalse: + [criticalSection := self stackTop. "rcvr" + activeProc := self activeProcess]. + owningProcessIndex := ExcessSignalsIndex. "CriticalSections are laid out like Semaphores" + owningProcess := objectMemory fetchPointer: owningProcessIndex ofObject: criticalSection. + owningProcess = objectMemory nilObject ifTrue: + [objectMemory storePointer: owningProcessIndex + ofObject: criticalSection + withValue: activeProc. + ^self pop: argumentCount + 1 thenPush: objectMemory falseObject]. + owningProcess = activeProc ifTrue: + [^self pop: argumentCount + 1 thenPush: objectMemory trueObject]. + "Arrange to answer false (unowned) when the process is resumed." + self pop: argumentCount + 1 thenPush: objectMemory falseObject. + self addLastLink: activeProc toList: criticalSection. + self transferTo: self wakeHighestPriority! Item was added: + ----- Method: StackInterpreterPrimitives>>primitiveExitCriticalSection (in category 'process primitives') ----- + primitiveExitCriticalSection + "Exit the critical section. + This may change the active process as a result." + | criticalSection owningProcessIndex owningProcess | + criticalSection := self stackTop. "rcvr" + owningProcessIndex := ExcessSignalsIndex. "CriticalSections are laid out like Semaphores" + (self isEmptyList: criticalSection) + ifTrue: + [objectMemory storePointerUnchecked: owningProcessIndex + ofObject: criticalSection + withValue: objectMemory nilObject] + ifFalse: + [owningProcess := self removeFirstLinkOfList: criticalSection. + "store check unnecessary because criticalSection referred to owningProcess + via its FirstLinkIndex slot before owningProcess was removed." + objectMemory storePointerUnchecked: owningProcessIndex + ofObject: criticalSection + withValue: owningProcess. + "Note that resume: isn't fair; it won't suspend the active process. + For fairness we must do the equivalent of a primitiveYield, but that + may break old code, so we stick with unfair resume:." + self resume: owningProcess preemptedYieldingIf: preemptionYields]! Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveExternalCall (in category 'plugin primitives') ----- primitiveExternalCall "Call an external primitive. External primitive methods first literals are an array of * The module name (String | Symbol) * The function name (String | Symbol) * The session ID (SmallInteger) [OBSOLETE] * The function index (Integer) in the externalPrimitiveTable For fast interpreter dispatch in subsequent invocations the primitiveFunctionPointer in the method cache is rewritten, either to the function itself, or to zero if the external function is not found. This allows for fast responses as long as the method stays in the cache. The cache rewrite relies on lastMethodCacheProbeWrite which is set in addNewMethodToCache:. Now that the VM flushes function addresses from its tables, the session ID is obsolete, but it is kept for backward compatibility. Also, a failed lookup is reported specially. If a method has been looked up and not been found, the function address is stored as -1 (i.e., the SmallInteger -1 to distinguish from 16rFFFFFFFF which may be returned from lookup), and the primitive fails with PrimErrNotFound." | lit addr moduleName functionName moduleLength functionLength index | <var: #addr declareC: 'void (*addr)()'> "Fetch the first literal of the method" (self literalCountOf: newMethod) > 0 ifFalse: [^self primitiveFailFor: PrimErrBadMethod]. lit := self literal: 0 ofMethod: newMethod. "Check if it's an array of length 4" ((objectMemory isArray: lit) and: [(objectMemory lengthOf: lit) = 4]) ifFalse: [^self primitiveFailFor: PrimErrBadMethod]. "Look at the function index in case it has been loaded before" index := objectMemory fetchPointer: 3 ofObject: lit. (objectMemory isIntegerObject: index) ifFalse: [^self primitiveFailFor: PrimErrBadMethod]. index := objectMemory integerValueOf: index. "Check if we have already looked up the function and failed." index < 0 ifTrue: ["Function address was not found in this session, Void the primitive function." self rewriteMethodCacheEntryForExternalPrimitiveToFunction: 0. ^self primitiveFailFor: PrimErrNotFound]. "Try to call the function directly" (index > 0 and: [index <= MaxExternalPrimitiveTableSize]) ifTrue: [addr := externalPrimitiveTable at: index - 1. addr ~= 0 ifTrue: [self rewriteMethodCacheEntryForExternalPrimitiveToFunction: (self cCode: 'addr' inSmalltalk: [1000 + index]). self callExternalPrimitive: addr. ^nil]. "if we get here, then an index to the external prim was kept on the ST side although the underlying prim table was already flushed" ^self primitiveFailFor: PrimErrNamedInternal]. "Clean up session id and external primitive index" objectMemory storePointerUnchecked: 2 ofObject: lit withValue: ConstZero. objectMemory storePointerUnchecked: 3 ofObject: lit withValue: ConstZero. "The function has not been loaded yet. Fetch module and function name." moduleName := objectMemory fetchPointer: 0 ofObject: lit. moduleName = objectMemory nilObject ifTrue: [moduleLength := 0] ifFalse: [(objectMemory isBytes: moduleName) ifFalse: [self primitiveFailFor: PrimErrBadMethod]. moduleLength := objectMemory lengthOf: moduleName]. functionName := objectMemory fetchPointer: 1 ofObject: lit. (objectMemory isBytes: functionName) ifFalse: [self primitiveFailFor: PrimErrBadMethod]. functionLength := objectMemory lengthOf: functionName. + addr := self ioLoadExternalFunction: functionName + self baseHeaderSize - addr := self ioLoadExternalFunction: functionName + BaseHeaderSize OfLength: functionLength + FromModule: moduleName + self baseHeaderSize - FromModule: moduleName + BaseHeaderSize OfLength: moduleLength. addr = 0 ifTrue: [index := -1] ifFalse: ["add the function to the external primitive table" index := self addToExternalPrimitiveTable: addr]. "Store the index (or -1 if failure) back in the literal" objectMemory storePointerUnchecked: 3 ofObject: lit withValue: (objectMemory integerObjectOf: index). "If the function has been successfully loaded cache and call it" index >= 0 ifTrue: [self rewriteMethodCacheEntryForExternalPrimitiveToFunction: (self cCode: [addr] inSmalltalk: [1000 + index]). self callExternalPrimitive: addr] ifFalse: ["Otherwise void the primitive function and fail" self rewriteMethodCacheEntryForExternalPrimitiveToFunction: 0. ^self primitiveFailFor: PrimErrNotFound]! Item was added: + ----- Method: StackInterpreterPrimitives>>primitiveFloatAt (in category 'indexing primitives') ----- + primitiveFloatAt + "Provide platform-independent access to 32-bit words comprising + a Float. Map index 1 onto the most significant word and index 2 + onto the least significant word." + | rcvr index result | + <var: #result type: #usqInt> + self initPrimCall. + rcvr := self stackValue: 1. + index := self stackTop. + index = ConstOne ifTrue: + [result := self positive32BitIntegerFor: + (objectMemory fetchLong32: (VMBIGENDIAN ifTrue: [0] ifFalse: [1]) + ofObject: rcvr). + ^self pop: 2 thenPush: result]. + index = ConstTwo ifTrue: + [result := self positive32BitIntegerFor: + (objectMemory fetchLong32: (VMBIGENDIAN ifTrue: [1] ifFalse: [0]) + ofObject: rcvr). + ^self pop: 2 thenPush: result]. + self primitiveFailFor: ((objectMemory isIntegerObject: index) + ifTrue: [PrimErrBadIndex] + ifFalse: [PrimErrBadArgument])! Item was added: + ----- Method: StackInterpreterPrimitives>>primitiveFloatAtPut (in category 'indexing primitives') ----- + primitiveFloatAtPut + "Provide platform-independent access to 32-bit words comprising + a Float. Map index 1 onto the most significant word and index 2 + onto the least significant word." + | rcvr index oopToStore valueToStore | + <var: #result type: #usqInt> + self initPrimCall. + oopToStore := self stackTop. + valueToStore := self positive32BitValueOf: oopToStore. + self successful ifFalse: + [^self primitiveFailFor: PrimErrBadArgument]. + rcvr := self stackValue: 2. + index := self stackValue: 1. + index = ConstOne ifTrue: + [objectMemory storeLong32: (VMBIGENDIAN ifTrue: [0] ifFalse: [1]) + ofObject: rcvr + withValue: valueToStore. + ^self pop: 3 thenPush: oopToStore]. + index = ConstTwo ifTrue: + [objectMemory storeLong32: (VMBIGENDIAN ifTrue: [1] ifFalse: [0]) + ofObject: rcvr + withValue: valueToStore. + ^self pop: 3 thenPush: oopToStore]. + self primitiveFailFor: ((objectMemory isIntegerObject: index) + ifTrue: [PrimErrBadIndex] + ifFalse: [PrimErrBadArgument])! Item was added: + ----- Method: StackInterpreterPrimitives>>primitiveInvokeObjectAsMethod (in category 'control primitives') ----- + primitiveInvokeObjectAsMethod + "Primitive. 'Invoke' an object like a function, sending the special message + run: originalSelector with: arguments in: aReceiver. + " + <returnTypeC: #void> + | runReceiver runArgs lookupClass | + runArgs := objectMemory eeInstantiateClass: (objectMemory splObj: ClassArray) indexableSize: argumentCount. + argumentCount - 1 to: 0 by: -1 do: + [:i| objectMemory storePointerUnchecked: i ofObject: runArgs withValue: self popStack]. + + runReceiver := self popStack. + "setup send of newMethod run: originalSelector with: runArgs in: runReceiver" + self push: newMethod. "newReceiver" + self push: messageSelector "original selector". + self push: runArgs. + self push: runReceiver. + + "stack is clean here" + + messageSelector := objectMemory splObj: SelectorRunWithIn. + argumentCount := 3. + lookupClass := objectMemory fetchClassOf: newMethod. + self findNewMethodInClass: lookupClass. + self executeNewMethod. "Recursive xeq affects successFlag" + self initPrimCall! Item was changed: ----- Method: StackInterpreterPrimitives>>primitivePerform (in category 'control primitives') ----- primitivePerform <returnTypeC: #void> | performSelector newReceiver lookupClass performMethod | performSelector := messageSelector. performMethod := newMethod. messageSelector := self stackValue: argumentCount - 1. newReceiver := self stackValue: argumentCount. "NOTE: the following lookup may fail and be converted to #doesNotUnderstand:, so we must adjust argumentCount and slide args now, so that will work." "Slide arguments down over selector" argumentCount := argumentCount - 1. argumentCount to: 1 by: -1 do: [:i| stackPages longAt: stackPointer + (i * BytesPerWord) put: (stackPages longAt: stackPointer + ((i - 1) * BytesPerWord))]. self pop: 1. lookupClass := objectMemory fetchClassOf: newReceiver. + self sendBreak: messageSelector + self baseHeaderSize - self sendBreak: messageSelector + BaseHeaderSize point: (objectMemory lengthOf: messageSelector) receiver: newReceiver. self findNewMethodInClass: lookupClass. "Only test CompiledMethods for argument count - other objects will have to take their chances" ((objectMemory isOopCompiledMethod: newMethod) and: [(self argumentCountOf: newMethod) = argumentCount]) ifFalse: ["Slide the args back up (sigh) and re-insert the selector." self unPop: 1. 1 to: argumentCount by: 1 do: [:i | stackPages longAt: stackPointer + ((i - 1) * BytesPerWord) put: (stackPages longAt: stackPointer + (i * BytesPerWord))]. stackPages longAt: stackPointer + (argumentCount * BytesPerWord) put: messageSelector. argumentCount := argumentCount + 1. newMethod := performMethod. messageSelector := performSelector. ^self primitiveFail]. self executeNewMethod. "Recursive xeq affects primErrorCode" self initPrimCall! Item was added: + ----- Method: StackInterpreterPrimitives>>primitivePerformInSuperclass (in category 'control primitives') ----- + primitivePerformInSuperclass + | lookupClass rcvr currentClass | + lookupClass := self stackTop. + rcvr := self stackValue: 3. + currentClass := objectMemory fetchClassOf: rcvr. + [currentClass ~= lookupClass] whileTrue: + [currentClass := self superclassOf: currentClass. + currentClass = objectMemory nilObject ifTrue: [^self primitiveFailFor: PrimErrBadArgument]]. + + self primitiveObject: rcvr "a.k.a. self stackValue: 3" + perform: (self stackValue: 2) + withArguments: (self stackValue: 1) + lookedUpIn: lookupClass "a.k.a. self stackTop"! Item was added: + ----- Method: StackInterpreterPrimitives>>primitivePerformWithArgs (in category 'control primitives') ----- + primitivePerformWithArgs + + | lookupClass rcvr | + rcvr := self stackValue: 2. + lookupClass := objectMemory fetchClassOf: rcvr. + + self primitiveObject: rcvr "a.k.a. self stackValue: 2" + perform: (self stackValue: 1) + withArguments: self stackTop + lookedUpIn: lookupClass! Item was added: + ----- Method: StackInterpreterPrimitives>>primitiveResume (in category 'process primitives') ----- + primitiveResume + "Put this process on the scheduler's lists thus allowing it to proceed next time there is + a chance for processes of it's priority level. It must go to the back of its run queue so + as not to preempt any already running processes at this level. If the process's priority + is higher than the current process, preempt the current process." + | proc | + proc := self stackTop. "rcvr" + (self isContext: (objectMemory fetchPointer: SuspendedContextIndex ofObject: proc)) ifFalse: + [^self primitiveFail]. + self resume: proc preemptedYieldingIf: preemptionYields + + "Personally I would like to check MyList, which should not be one of the elements of the scheduler lists. + But there are awful race conditions in things like should:notTakeMoreThan: that mean we can't. + eem 9/27/2010 23:08. e.g. + + | proc myList classLinkedList | + proc := self stackTop. + myList := objectMemory fetchPointer: MyListIndex ofObject: proc. + classLinkedList := self superclassOf: (objectMemory splObj: ClassSemaphore). + ((self fetchClassOfNonInt: myList) ~= classLinkedList + and: [self isContext: (objectMemory fetchPointer: SuspendedContextIndex ofObject: proc)]) ifFalse: + [^self primitiveFail]. + self resume: proc preemptedYieldingIf: preemptionYields"! Item was added: + ----- Method: StackInterpreterPrimitives>>primitiveTestAndSetOwnershipOfCriticalSection (in category 'process primitives') ----- + primitiveTestAndSetOwnershipOfCriticalSection + "Attempt to test-and-set the ownership of the critical section. If not owned, + set the owner to the current process and answer false. If owned by the + current process answer true. If owned by some other process answer nil. + For simulation if there is an argument it is taken to be the effective activeProcess + (see Process>>effectiveProcess)." + | criticalSection owningProcessIndex owningProcess activeProc | + argumentCount > 0 + ifTrue: + [criticalSection := self stackValue: 1. "rcvr" + activeProc := self stackTop] + ifFalse: + [criticalSection := self stackTop. "rcvr" + activeProc := self activeProcess]. + owningProcessIndex := ExcessSignalsIndex. "CriticalSections are laid out like Semaphores" + owningProcess := objectMemory fetchPointer: owningProcessIndex ofObject: criticalSection. + owningProcess = objectMemory nilObject ifTrue: + [objectMemory storePointer: owningProcessIndex + ofObject: criticalSection + withValue: activeProc. + ^self pop: argumentCount + 1 thenPush: objectMemory falseObject]. + owningProcess = activeProc ifTrue: + [^self pop: argumentCount + 1 thenPush: objectMemory trueObject]. + self pop: argumentCount + 1 thenPush: objectMemory nilObject! Item was removed: - ----- Method: TAssignmentNode>>isStructTarget: (in category 'testing') ----- - isStructTarget: aCodeGen - "Answer if the recever evaluates to a struct pointer - and hence can be dereferenced using ->" - ^variable isStructTarget: aCodeGen! Item was added: + ----- Method: TAssignmentNode>>structTargetKind: (in category 'testing') ----- + structTargetKind: aCodeGen + "Answer if the recever evaluates to a struct or struct pointer + and hence can be dereferenced using . or ->. Answer any of + #struct #pointer or nil" + ^variable structTargetKind: aCodeGen! Item was changed: ----- Method: TMethod>>emitCFunctionPrototype:generator: (in category 'C code generation') ----- emitCFunctionPrototype: aStream generator: aCodeGen "Emit a C function header for this method onto the given stream." + properties ifNotNil: + [(properties at: #api: ifAbsent: []) ifNotNil: + [:pragma| + aStream nextPutAll: (pragma argumentAt: 1). + ^self]]. + self emitCFunctionPrototype: aStream generator: aCodeGen newlineBeforeName: false! - | arg | - export - ifTrue:[aStream nextPutAll:'EXPORT('; nextPutAll: returnType; nextPutAll:') '] - ifFalse:[(self isStaticIn: aCodeGen) - ifTrue:[aStream nextPutAll:'static ']. - aStream nextPutAll: returnType; space]. - aStream nextPutAll: (aCodeGen cFunctionNameFor: self selectorForCodeGeneration), '('. - args isEmpty ifTrue: [ aStream nextPutAll: 'void' ]. - 1 to: args size do: [ :i | - arg := args at: i. - (declarations includesKey: arg) ifTrue: [ - aStream nextPutAll: (declarations at: arg). - ] ifFalse: [ - aStream nextPutAll: 'sqInt ', (args at: i). - ]. - i < args size ifTrue: [ aStream nextPutAll: ', ' ]. - ]. - aStream nextPutAll: ')'.! Item was added: + ----- Method: TMethod>>emitCFunctionPrototype:generator:newlineBeforeName: (in category 'C code generation') ----- + emitCFunctionPrototype: aStream generator: aCodeGen newlineBeforeName: newlineBeforeName "<Boolean>" + "Emit a C function header for this method onto the given stream." + + export + ifTrue:[aStream nextPutAll: 'EXPORT('; nextPutAll: returnType; nextPut: $)] + ifFalse:[(self isStaticIn: aCodeGen) ifTrue:[aStream nextPutAll: 'static ']. + aStream nextPutAll: returnType]. + newlineBeforeName ifTrue: [aStream cr] ifFalse: [aStream space]. + (returnType last = $) + and: [returnType includesSubString: (aCodeGen cFunctionNameFor: self selectorForCodeGeneration)]) ifTrue: + ["Hack fix for e.g. <returnTypeC: 'void (*setInterruptCheckChain(void (*aFunction)(void)))()'>" + ^self]. + aStream + nextPutAll: (aCodeGen cFunctionNameFor: self selectorForCodeGeneration); + nextPut: $(. + args isEmpty + ifTrue: [aStream nextPutAll: #void] + ifFalse: + [args + do: [:arg| aStream nextPutAll: (self declarationAt: arg)] + separatedBy: [ aStream nextPutAll: ', ' ]]. + aStream nextPut: $)! Item was added: + ----- Method: TMethod>>extractExpandCaseDirective (in category 'transformations') ----- + extractExpandCaseDirective + "Scan the top-level statements for an inlining directive of the form: + self expandCases + and remove the directive from the method body. Answer whether + there was such a directive." + + ^self + extractDirective: #expandCases + valueBlock: [:sendNode| true] + default: false! Item was changed: ----- Method: TMethod>>extractStaticDirective (in category 'transformations') ----- extractStaticDirective "Scan the top-level statements for an inlining directive of the form: self static: <boolean> + and remove the directive from the method body. Answer the argument of the + directive. If there is no static directive, answer true if this is an api method, + otherwise answer nil for undefined. The code generator may determine the + static declaration when undefined." - and remove the directive from the method body. Return the argument of the directive or true if there is no static directive." - | result newStatements methodDirectiveFound default | - result := true. - methodDirectiveFound := false. - newStatements := OrderedCollection new: parseTree statements size. - parseTree statements do: [ :stmt | - (stmt isSend and: [stmt selector = #static:]) ifTrue: [ - methodDirectiveFound := true. - result := stmt args first value ~= false. - ] ifFalse: [ - newStatements add: stmt. - ]. - ]. - parseTree setStatements: newStatements asArray. - methodDirectiveFound ifTrue: [^ result]. - "No method declaration was used, so check for a pragma declaration. - If not explicitly specified, default is nil and may be determined by the - code generator." - default := (export - or: [(properties includesKey: #api) - or: [properties includesKey: #api:]]) - ifTrue: [false]. ^self extractDirective: #static: valueBlock: [:sendNode| sendNode args first value ~= false] + default: (((properties includesKey: #api) or: [properties includesKey: #api:]) + ifTrue: [false] "api methods cannot be declared static" + ifFalse: [nil]) "undefined, defer to the code generator for default"! - default: default - ! Item was added: + ----- Method: TMethod>>static: (in category 'accessing') ----- + static: aBoolean + static := aBoolean! Item was removed: - ----- Method: TParseNode>>isStructTarget: (in category 'testing') ----- - isStructTarget: aCodeGen - "Answer if the recever evaluates to a struct pointer - and hence can be dereferenced using ->" - ^false! Item was added: + ----- Method: TParseNode>>structTargetKind: (in category 'testing') ----- + structTargetKind: aCodeGen + "Answer if the recever evaluates to a struct or struct pointer + and hence can be dereferenced using . or ->. Answer any of + #struct #pointer or nil" + ^nil! Item was changed: + ----- Method: TSendNode>>copyTree (in category 'accessing') ----- - ----- Method: TSendNode>>copyTree (in category 'as yet unclassified') ----- copyTree ^self class new setSelector: selector receiver: receiver copyTree arguments: (arguments collect: [ :arg | arg copyTree ]) isBuiltInOp: isBuiltinOperator! Item was changed: + ----- Method: TSendNode>>inlineMethodsUsing: (in category 'C code generation') ----- - ----- Method: TSendNode>>inlineMethodsUsing: (in category 'as yet unclassified') ----- inlineMethodsUsing: aDictionary arguments := arguments collect: [ :arg | arg inlineMethodsUsing: aDictionary. ]. "xxx inline this message if it is in the dictionary xxx"! Item was changed: + ----- Method: TSendNode>>isDirective (in category 'testing') ----- - ----- Method: TSendNode>>isDirective (in category 'as yet unclassified') ----- isDirective "Preprocessor directive, e.g. a cpp macro" ^ { #preprocessorExpression: . #isDefined:inSmalltalk:comment:ifTrue:ifFalse: . #isDefined:inSmalltalk:comment:ifTrue: . + #isDefinedTrueExpression:inSmalltalk:comment:ifTrue:ifFalse: . + #cPreprocessorDirective: - #isDefinedTrueExpression:inSmalltalk:comment:ifTrue:ifFalse: } identityIncludes: selector! Item was changed: ----- Method: TSendNode>>isStructSend: (in category 'testing') ----- isStructSend: aCodeGen "Answer if the recever is a send of a structure accessor. This is tricky. We want foo bar => foo->bar + foo bar => foo.bar foo bar: expr => foo->bar = expr + foo bar: expr => foo.bar = expr + depending on whether foo is a struct or a pointer to a struct, but only if both foo is a struct type and bar is a field accessor. The tricky cases are self-sends within struct class methods. Here we need to distinguish between self-sends of ordinary methods from self sends of accessors." ^arguments size <= 1 + and: [(receiver structTargetKind: aCodeGen) notNil - and: [(receiver isStructTarget: aCodeGen) and: [(aCodeGen methodNamed: selector) ifNil: [false] ifNotNil: [:method| method isStructAccessor]]]! Item was removed: - ----- Method: TSendNode>>isStructTarget: (in category 'testing') ----- - isStructTarget: aCodeGen - "Answer if the recever evaluates to a struct pointer - and hence can be dereferenced using ->" - selector == #cCoerceSimple:to: ifTrue: - [^aCodeGen isTypePointerToStruct: arguments last value]. - - ^aCodeGen selectorReturnsPointerToStruct: selector! Item was changed: + ----- Method: TSendNode>>printOn:level: (in category 'testing') ----- - ----- Method: TSendNode>>printOn:level: (in category 'as yet unclassified') ----- printOn: aStream level: level | keywords | receiver printOn: aStream level: level. arguments size = 0 ifTrue: [ aStream space; nextPutAll: selector. ^self ]. keywords := selector keywords. 1 to: keywords size do: [ :i | aStream space. aStream nextPutAll: (keywords at: i); space. (arguments at: i) printOn: aStream level: level + 1. ].! Item was changed: + ----- Method: TSendNode>>requiresCLineTerminator (in category 'testing') ----- - ----- Method: TSendNode>>requiresCLineTerminator (in category 'as yet unclassified') ----- requiresCLineTerminator ^ (self isComment or: [self isDirective]) not ! Item was added: + ----- Method: TSendNode>>structTargetKind: (in category 'testing') ----- + structTargetKind: aCodeGen + "Answer if the recever evaluates to a struct or struct pointer + and hence can be dereferenced using . or ->. Answer any of + #struct #pointer or nil. Right now we don't need or support + structure return so this method answers either #pointer or nil." + selector == #cCoerceSimple:to: ifTrue: + [^(VMStructType isTypePointerToStruct: arguments last value) ifTrue: + [#pointer]]. + + ^(aCodeGen selectorReturnsPointerToStruct: selector) ifTrue: + [#pointer]! Item was removed: - ----- Method: TVariableNode>>isStructTarget: (in category 'testing') ----- - isStructTarget: aCodeGen - "Answer if the recever is a struct pointer - and hence can be dereferenced using ->" - ^aCodeGen isPointerToStructVariableName: name! Item was added: + ----- Method: TVariableNode>>structTargetKind: (in category 'testing') ----- + structTargetKind: aCodeGen + "Answer if the recever evaluates to a struct or struct pointer + and hence can be dereferenced using . or ->. Answer any of + #struct #pointer or nil" + ^aCodeGen structTargetKindForVariableName: name! Item was added: + ----- Method: VMClass class>>ancilliaryClasses (in category 'translation') ----- + ancilliaryClasses + "Answer any extra classes to be included in the translation." + ^#()! Item was added: + ----- Method: VMClass class>>ancilliaryStructClasses (in category 'translation') ----- + ancilliaryStructClasses + ^#()! Item was changed: ----- Method: VMMaker class>>versionString (in category 'version testing') ----- versionString "VMMaker versionString" + ^'4.9.6'! - ^'4.9.5'! Item was changed: ----- Method: VMMaker>>generateInterpreterFile (in category 'generate sources') ----- generateInterpreterFile "Translate the Smalltalk description of the virtual machine into C. If 'self doInlining' is true, small method bodies are inlined to reduce procedure call overhead. On the PPC, this results in a factor of three speedup with only 30% increase in code size. Subclasses can use specialised versions of CCodeGenerator and interpreterClass." | cg | self needsToRegenerateInterpreterFile ifFalse: [^nil]. self interpreterClass initialize. ObjectMemory initializeConstants. Interpreter initializeInterpreterSourceVersion. cg := self createCodeGenerator. cg declareMethodsStatic: false. self interpreterClass initializeCodeGenerator: cg. + cg vmClass: self interpreterClass. cg storeHeaderFor: interpreterClassName onFile: self interpreterHeaderPath. cg storeCodeOnFile: self interpreterFilePath doInlining: self doInlining. self interpreterClass additionalHeadersDo: [:headerName :headerContents| | filePath | filePath := self coreVMDirectory fullNameFor: headerName. (cg needToGenerateHeader: headerName file: filePath contents: headerContents) ifTrue: [cg storeHeaderOnFile: filePath contents: headerContents]]. self interpreterClass apiExportHeaderName ifNotNil: [cg storeAPIExportHeader: self interpreterClass apiExportHeaderName OnFile: (self sourceFilePathFor: self interpreterClass apiExportHeaderName)]. ! Item was changed: ----- Method: VMStructType class>>printTypedefOn: (in category 'translation') ----- printTypedefOn: aStream aStream nextPutAll: 'typedef struct '. self needsTypeTag ifTrue: [aStream nextPutAll: self structTagName; space]. aStream nextPut: ${; cr. self instVarNamesAndTypesForTranslationDo: + [:ivn :typeArg| | type | - [:ivn :typeArg| | type index | type := typeArg. - (index := type indexOf: #BytesPerWord ifAbsent: 0) > 0 ifTrue: - [type := (type at: index + 1) = BytesPerWord ifTrue: - [type := type copyReplaceFrom: index to: index + 1 with: #(). - type size = 1 ifTrue: [type first] ifFalse: [type]]]. type ifNotNil: [type isArray ifTrue: [aStream tab: 1. aStream nextPutAll: type first. (type first last isSeparator or: [type first last = $*]) ifFalse: [aStream tab: 2]. aStream nextPutAll: ivn. type last first = $: ifTrue: [aStream space]. aStream nextPutAll: type last; nextPut: $;; cr] ifFalse: [aStream tab: 1. aStream nextPutAll: type. (type last isSeparator or: [type last = $*]) ifFalse: [aStream tab: 1]. aStream nextPutAll: ivn; nextPut: $;; cr]]]. aStream nextPutAll: ' } '; nextPutAll: self structTypeName; nextPut: $;; cr. self name ~= self structTypeName ifTrue: [aStream cr; nextPutAll: '#define '; nextPutAll: self name; space; nextPutAll: self structTypeName; cr]. aStream flush!

1 0

[GSoC] Progress on the GdbARMPlugin
by Lars 09 Jul '12

09 Jul '12

Hello squeak-dev, in the last weeks, based on my simple code examples, I tried to copy the BochsIA32Plugin structures and adapt it to ARMulator/libopcodes. So far, I am able to run code sequentially with memory bounds checks. The (copied) test testExecutionTrap and testResetCPU are green. The testCallTrap might also be green, once I figured out what the correspondent of the IA32 call opcode in ARM is. The code for library tests and the c-part of the plugin is accessible on Github[1]. For these tests, I implemented an alternative memory interface (armulmem.c). The problem with bounds checking and especially execution bounds was the prefetching emulation: Whenever an instruction is executed, the next two words are read from memory, too. Because of that, it is not possible to quit with the appropriate error code in the memory interface. The current solution uses a custom Software Interrupt (0x200000). The memory interface returns the 'SWI 0x200000' opcode whenever it is asked for an instruction at an invalid address. This is implemented in ARMul_ReLoadInstr. For random memory access, the corresponding functions are GetWord and PutWord, which stop simulation immediately. An interesting detail about the ARMulator is, that it is also the base for the ARM-Emulator used in Skyeye, beside being used in gdb. In case anybody wants to try using my code examples, it is very important to compile libsim.a with -DMODET (which is default on my system) or disabling that flag in GdbARMPlugin.h. That little flag took me at least two days, because it changes multiple offsets in the main struct ARMul_State. What still is not included on that site is reporting. The Bochs test cases show that there should be string-errors. The ARMulator does not provide those strings, and since so far this is the only error, I put no additional effort into that. The next step is getting the testNfib* green. These compute the Fibonacci function for different arguments. For that, I need to understand the ARM ABI[2]. I'd be grateful if anybody can recommend a more abstract source for the ARM ABI. Enjoy your evening, Lars [1] https://github.com/mas7ermind/gdb-arm-tests https://github.com/mas7ermind/squeakvm-armulator-plugin [2] http://infocenter.arm.com/help/index.jsp?topic=/com.arm.doc.ihi0036b/index.…

2 2

Issue with certificate on ci.lille.inria.fr preventing newImage.sh to work for iOSVM build
by phil＠highoctane.be 08 Jul '12

08 Jul '12

I was recording a screencast to show how to create the iOS VM but there was an issue. I did a git clone git://gitorious.org/~estebanlm/cogvm/cog-osx.git Then, inside cog-osx/image, I did a ./newImage.sh and got PhilMac:image philippeback$ ./newImage.sh LOADING PREBUILT IMAGE https://ci.lille.inria.fr/pharo/job/Cog%20Git%20Tracker/lastSuccessfulBuild… --2012-07-07 21:41:12-- https://ci.lille.inria.fr/pharo/job/Cog%20Git%20Tracker/lastSuccessfulBuild… Résolution de ci.lille.inria.fr (ci.lille.inria.fr)... 193.49.213.180 Connexion vers ci.lille.inria.fr (ci.lille.inria.fr )|193.49.213.180|:443...connecté. ERREUR : le certificat de «ci.lille.inria.fr» n'est pas digne de confiance. ERREUR : le certificat «ci.lille.inria.fr» n'est pas d'un émetteur connu. FETCHING FRESH IMAGE https://ci.lille.inria.fr/pharo/job/Pharo%201.4/lastSuccessfulBuild/artifac… --2012-07-07 21:41:12-- https://ci.lille.inria.fr/pharo/job/Pharo%201.4/lastSuccessfulBuild/artifac… Résolution de ci.lille.inria.fr (ci.lille.inria.fr)... 193.49.213.180 Connexion vers ci.lille.inria.fr (ci.lille.inria.fr )|193.49.213.180|:443...connecté. ERREUR : le certificat de «ci.lille.inria.fr» n'est pas digne de confiance. ERREUR : le certificat «ci.lille.inria.fr» n'est pas d'un émetteur connu. UNZIPPING /Users/philippeback/Documents/Smalltalk/2-MyWorkspaces/workspaceVMiOS/cog-osx/image/image.zip Archive: image.zip End-of-central-directory signature not found. Either this file is not a zipfile, or it constitutes one disk of a multi-part archive. In the latter case the central directory and zipfile comment will be found on the last disk(s) of this archive. unzip: cannot find zipfile directory in one of image.zip or image.zip.zip, and cannot find image.zip.ZIP, period. PhilMac:image philippeback$ There is something wrong with the certificate over there. Could this be fixed? TIA -- Philippe Back

3 4

VM Maker: CMakeVMMaker-IgorStasenko.171.mcz
by commits＠source.squeak.org 05 Jul '12

05 Jul '12

Igor Stasenko uploaded a new version of CMakeVMMaker to project VM Maker: http://source.squeak.org/VMMaker/CMakeVMMaker-IgorStasenko.171.mcz ==================== Summary ==================== Name: CMakeVMMaker-IgorStasenko.171 Author: IgorStasenko Time: 5 July 2012, 5:43:02.685 pm UUID: 542b4f30-481c-754e-adc6-df26d22df280 Ancestors: CMakeVMMaker-EstebanLorenzano.170 - added configuration for ssl plugin on windows (but it doesn't builds on my mingw installation, a lot of missing definitions in Wincrypt.h ) To try it, use ------- CogWindowsConfig new addExternalPlugins: #( SqueakSSLPlugin ); generateSources; generate =============== Diff against CMakeVMMaker-EstebanLorenzano.170 =============== Item was added: + ----- Method: CogFamilyWindowsConfig>>configureSqueakSSLPlugin: (in category 'plugin extra rules') ----- + configureSqueakSSLPlugin: maker + maker addPlatformSources: #('sqWin32SSL.c'). + + maker addExternalLibraries: + #( + 'secur32' + 'crypt32' + )!

1 0

VM Maker: VMMaker.oscog-eem.183.mcz
by commits＠source.squeak.org 04 Jul '12

04 Jul '12

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.183.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.183 Author: eem Time: 4 July 2012, 6:25:44.228 am UUID: b044afd7-a1c6-4f20-ae81-96ceffa744e7 Ancestors: VMMaker.oscog-eem.182 Fix the simulated memcpy which used strncmp and hence stopped at a null byte. =============== Diff against VMMaker.oscog-eem.182 =============== Item was changed: ----- Method: VMClass>>mem:cp:y: (in category 'C library simulation') ----- mem: aString cp: bString y: n <doNotGenerate> "implementation of memcpy(3)" + aString isString + ifTrue: + [1 to: n do: + [:i| | v | + v := bString isString + ifTrue: [bString at: i] + ifFalse: [Character value: (self byteAt: bString + i - 1)]. + aString at: i put: v]] + ifFalse: + [1 to: n do: + [:i| | v | + v := bString isString + ifTrue: [(bString at: i) asInteger] + ifFalse: [self byteAt: bString + i - 1]. + self byteAt: aString + i - 1 put: v]]. + ^aString! - ^self st: aString rn: bString cpy: n!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev July 2012