[Vm-dev] VM Maker: VMMaker.oscog-eem.3093.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Oct 18 01:03:22 UTC 2021
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3093.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3093
Author: eem
Time: 17 October 2021, 6:03:10.670295 pm
UUID: 227cf68c-c73a-4827-99f6-55816c9d221d
Ancestors: VMMaker.oscog-eem.3092
Simulation: add arnges to the breakpoint types.
Have CoInterpreter;s atEachStepBlock check for breakpoints via breakPC.
Fix printOop: and longPrintOop: for CompiledMethod, removing a long time wart.
=============== Diff against VMMaker.oscog-eem.3092 ===============
Item was changed:
----- Method: Array>>addBreakpoint: (in category '*VMMaker-breakpoints') -----
addBreakpoint: bkpt
+ (self size > 0
+ and: [self allSatisfy: #isInteger]) ifTrue:
+ [(bkpt >= self last and: [bkpt - self first <= self size]) ifTrue:
+ [^self first to: bkpt].
+ (bkpt <= self first and: [self last - bkpt <= self size]) ifTrue:
+ [^bkpt to: self last]].
^self, {bkpt}!
Item was changed:
----- Method: BlockClosure>>shouldStopIfAtPC: (in category '*VMMaker-interpreter simulator') -----
shouldStopIfAtPC: address
<primitive: 202>
+ ^self cull: address!
- ^self value: address!
Item was changed:
----- Method: CogVMSimulator>>ensureDebugAtEachStepBlock (in category 'testing') -----
ensureDebugAtEachStepBlock
atEachStepBlock := [printFrameAtEachStep ifTrue:
[self printFrame: localFP WithSP: localSP].
printBytecodeAtEachStep ifTrue:
[self printCurrentBytecodeOn: transcript].
byteCount = breakCount ifTrue:
+ ["printFrameAtEachStep :=" printBytecodeAtEachStep := true].
+ cogit clickStepping ifFalse:
+ [((cogit breakPC isBreakpointFor: localIP)
+ and: [thisContext closure == atEachStepBlock]) ifTrue:
+ [self halt: 'bytecode breakpoint at ', (localIP hex allButFirst: 3)]]]!
- ["printFrameAtEachStep :=" printBytecodeAtEachStep := true]]!
Item was changed:
CogClass subclass: #Cogit
(excessive size, no diff calculated)
Item was changed:
----- Method: Cogit class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
| backEnd |
backEnd := CogCompilerClass basicNew.
#( 'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation'
'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass' 'nsSendCacheSurrogateClass'
'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses' 'ioHighResClock'
'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters'
+ 'processorFrameValid' 'printRegisters' 'printInstructions' 'clickConfirm' 'clickStepping' 'singleStep'
- 'processorFrameValid' 'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep'
'codeZoneIsExecutableNotWritable' 'debugAPISelector' 'shortCutTrampolineBlocks'
'perMethodProfile' 'instructionProfile') do:
[:simulationVariableUnusedByRealVM|
aCCodeGenerator removeVariable: simulationVariableUnusedByRealVM].
NewspeakVM ifFalse:
[#( 'selfSendTrampolines' 'dynamicSuperSendTrampolines'
'implicitReceiverSendTrampolines' 'outerSendTrampolines'
'ceEnclosingObjectTrampoline' 'numIRCs' 'indexOfIRC' 'theIRCs') do:
[:variableNotNeededInNormalVM|
aCCodeGenerator removeVariable: variableNotNeededInNormalVM]].
aCCodeGenerator removeConstant: #COGMTVM. "this should be defined at compile time"
"N.B. We *do not* include sq.h; it pulls in conflicting definitions now that sqVirtualMachine.h
declares cointerp's functions, and declares some of them inaccurately for histrical reasons.
We pull in CoInterpreter's api via cointerp.h which is accurate."
aCCodeGenerator
addHeaderFile:'"sqConfig.h"'; "config.h must be first on linux"
addHeaderFile:'<stddef.h>'; "for e.g. offsetof"
addHeaderFile:'<stdio.h>';
addHeaderFile:'<stdlib.h>';
addHeaderFile:'<string.h>';
addHeaderFile:'"sqPlatformSpecific.h"'; "e.g. solaris overrides things for sqCogStackAlignment.h"
addHeaderFile:'"sqMemoryAccess.h"';
addHeaderFile:'"sqCogStackAlignment.h"';
addHeaderFile:'"dispdbg.h"'; "must precede cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up"
addHeaderFile:'"cogmethod.h"'.
NewspeakVM ifTrue:
[aCCodeGenerator addHeaderFile:'"nssendcache.h"'].
aCCodeGenerator
addHeaderFile:'#if COGMTVM';
addHeaderFile:'"cointerpmt.h"';
addHeaderFile:'#else';
addHeaderFile:'"cointerp.h"';
addHeaderFile:'#endif';
addHeaderFile:'"cogit.h"'.
aCCodeGenerator
var: #ceGetFP
declareC: 'usqIntptr_t (*ceGetFP)(void)';
var: #ceGetSP
declareC: 'usqIntptr_t (*ceGetSP)(void)';
var: #ceCaptureCStackPointers
declareC: 'void (*ceCaptureCStackPointers)(void)';
var: #ceInvokeInterpret
declareC: 'void (*ceInvokeInterpret)(void)';
var: #ceEnterCogCodePopReceiverReg
declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)';
var: #realCEEnterCogCodePopReceiverReg
declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)';
var: #ceCallCogCodePopReceiverReg
declareC: 'void (*ceCallCogCodePopReceiverReg)(void)';
var: #realCECallCogCodePopReceiverReg
declareC: 'void (*realCECallCogCodePopReceiverReg)(void)';
var: #ceCallCogCodePopReceiverAndClassRegs
declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)';
var: #realCECallCogCodePopReceiverAndClassRegs
declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)';
var: #postCompileHook
declareC: 'void (*postCompileHook)(CogMethod *)';
var: #openPICList declareC: 'CogMethod *openPICList = 0';
var: #maxMethodBefore type: #'CogBlockMethod *';
var: 'enumeratingCogMethod' type: #'CogMethod *'.
aCCodeGenerator
var: #ceTryLockVMOwner
declareC: '#if COGMTVM\usqIntptr_t (*ceTryLockVMOwner)(usqIntptr_t)\#endif'.
backEnd numICacheFlushOpcodes > 0 ifTrue:
[aCCodeGenerator
var: #ceFlushICache
declareC: 'static void (*ceFlushICache)(usqIntptr_t from, usqIntptr_t to)'].
aCCodeGenerator
var: #ceFlushDCache
declareC: '#if DUAL_MAPPED_CODE_ZONE\static void (*ceFlushDCache)(usqIntptr_t from, usqIntptr_t to)\#endif';
var: #codeToDataDelta
declareC: '#if DUAL_MAPPED_CODE_ZONE\static sqInt codeToDataDelta\#else\# define codeToDataDelta 0\#endif';
var: #cFramePointerInUse
declareC: '#if !!defined(cFramePointerInUse)\sqInt cFramePointerInUse\#endif'.
aCCodeGenerator
declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel"
var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel';
var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel'.
self declareC: #(abstractOpcodes stackCheckLabel
blockEntryLabel blockEntryNoContextSwitch
stackOverflowCall sendMiss
entry noCheckEntry selfSendEntry dynSuperEntry
fullBlockNoContextSwitchEntry fullBlockEntry
picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1 cPICEndOfCodeLabel)
as: #'AbstractInstruction *'
in: aCCodeGenerator.
aCCodeGenerator
declareVar: #cPICPrototype type: #'CogMethod *';
declareVar: #blockStarts type: #'BlockStart *';
declareVar: #fixups type: #'BytecodeFixup *';
declareVar: #methodZoneBase type: #usqInt.
aCCodeGenerator
var: #ordinarySendTrampolines
declareC: 'sqInt ordinarySendTrampolines[NumSendTrampolines]';
var: #superSendTrampolines
declareC: 'sqInt superSendTrampolines[NumSendTrampolines]'.
BytecodeSetHasDirectedSuperSend ifTrue:
[aCCodeGenerator
var: #directedSuperSendTrampolines
declareC: 'sqInt directedSuperSendTrampolines[NumSendTrampolines]';
var: #directedSuperBindingSendTrampolines
declareC: 'sqInt directedSuperBindingSendTrampolines[NumSendTrampolines]'].
NewspeakVM ifTrue:
[aCCodeGenerator
var: #selfSendTrampolines
declareC: 'sqInt selfSendTrampolines[NumSendTrampolines]';
var: #dynamicSuperSendTrampolines
declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]';
var: #implicitReceiverSendTrampolines
declareC: 'sqInt implicitReceiverSendTrampolines[NumSendTrampolines]';
var: #outerSendTrampolines
declareC: 'sqInt outerSendTrampolines[NumSendTrampolines]'].
aCCodeGenerator
addConstantForBinding: self bindingForNumTrampolines;
var: #trampolineAddresses
declareC: 'static char *trampolineAddresses[NumTrampolines*2]';
var: #objectReferencesInRuntime
declareC: 'static usqInt objectReferencesInRuntime[NumObjRefsInRuntime+1]';
var: #labelCounter
type: #int;
var: #traceFlags
declareC: 'int traceFlags = 8 /* prim trace log on by default */';
var: #cStackAlignment
declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'.
aCCodeGenerator
declareVar: #minValidCallAddress type: #'usqIntptr_t'.
aCCodeGenerator vmClass generatorTable ifNotNil:
[:bytecodeGenTable|
aCCodeGenerator
var: #generatorTable
declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size printString, ']',
(self tableInitializerFor: bytecodeGenTable
in: aCCodeGenerator)].
"In C the abstract opcode names clash with the Smalltalk generator syntactic sugar.
Most of the syntactic sugar is inlined, but alas some remains. Rename the syntactic
sugar to avoid the clash."
(self organization listAtCategoryNamed: #'abstract instructions') do:
[:s|
aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)].
aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg'.
self declareFlagVarsAsByteIn: aCCodeGenerator!
Item was removed:
- ----- Method: Cogit>>breakAt: (in category 'simulation only') -----
- breakAt: address
- ((breakPC isBreakpointFor: address)
- and: [breakBlock shouldStopIfAtPC: address]) ifTrue:
- [coInterpreter changed: #byteCountText.
- self halt: 'machine code breakpoint at ', address]!
Item was added:
+ ----- Method: Cogit>>breakpointFrom: (in category 'simulation only') -----
+ breakpointFrom: string
+ | s |
+ s := string.
+ ^(s includes: $r)
+ ifTrue:
+ [Number readFrom: s readStream]
+ ifFalse:
+ [(#('0x' '-0x') detect: [:prefix| s beginsWith: prefix] ifNone: []) ifNotNil:
+ [:prefix|
+ s := s allButFirst: prefix size.
+ prefix first = $- ifTrue: [s := '-', s]].
+ Integer readFrom: s readStream base: 16].!
Item was added:
+ ----- Method: Cogit>>clickStepping (in category 'simulation only') -----
+ clickStepping
+ <doNotGenerate>
+ ^clickStepping!
Item was changed:
----- Method: Cogit>>promptForBreakPC (in category 'simulation only') -----
promptForBreakPC
<doNotGenerate>
+ | s first bkpt idx |
- | s first bkpt |
s := UIManager default request: 'Break pc (hex, + to add, - to remove)'.
s := s withBlanksTrimmed.
s isEmpty ifTrue: [^self].
('+-' includes: s first) ifTrue: [first := s first. s := s allButFirst].
(s isEmpty and: [first = $-]) ifTrue:
[^self breakPC: nil].
+ bkpt := self breakpointFrom: s.
+ (idx := s indexOfSubCollection: ' to: ') > 0
+ ifTrue:
+ [| end |
+ (end := self breakpointFrom: (s allButFirst: idx + 4)) > bkpt ifTrue:
+ [bkpt := bkpt to: end]]
+ ifFalse:
+ [((methodZone addressIsLikelyCogMethod: bkpt)
+ and: [UIManager confirm: 'pc is method; break anywhere within method?']) ifTrue:
+ [bkpt := methodZone methodFor: bkpt]].
- bkpt := (s includes: $r)
- ifTrue:
- [Number readFrom: s readStream]
- ifFalse:
- [(#('0x' '-0x') detect: [:prefix| s beginsWith: prefix] ifNone: []) ifNotNil:
- [:prefix|
- s := s allButFirst: prefix size.
- prefix first = $- ifTrue: [s := '-', s]].
- Integer readFrom: s readStream base: 16].
- ((methodZone addressIsLikelyCogMethod: bkpt)
- and: [UIManager confirm: 'pc is method; break anywhere within method?']) ifTrue:
- [bkpt := methodZone methodFor: bkpt].
first = $+ ifTrue:
[^self breakPC: (breakPC addBreakpoint: bkpt)].
first = $- ifTrue:
[^self breakPC: (breakPC removeBreakpoint: bkpt)].
+ self breakPC: bkpt.
+ breakPC isActiveBreakpoint ifTrue:
+ [coInterpreter ensureDebugAtEachStepBlock]!
- self breakPC: bkpt!
Item was changed:
----- Method: Cogit>>setInterpreter: (in category 'initialization') -----
setInterpreter: aCoInterpreter
"Initialization of the code generator in the simulator.
These objects already exist in the generated C VM
or are used only in the simulation."
<doNotGenerate>
coInterpreter := aCoInterpreter.
objectMemory := aCoInterpreter objectMemory.
methodZone := self class methodZoneClass new.
objectRepresentation := objectMemory objectRepresentationClass
forCogit: self methodZone: methodZone.
methodZone setInterpreter: aCoInterpreter
objectRepresentation: objectRepresentation
cogit: self.
generatorTable := self class generatorTable.
processor := ProcessorClass new.
simulatedAddresses := Dictionary new.
coInterpreter class clusteredVariableNames do:
[:cvn| self simulatedAddressFor: (cvn first = $C ifTrue: ['get', cvn] ifFalse: [cvn]) asSymbol].
simulatedTrampolines := Dictionary new.
simulatedVariableGetters := Dictionary new.
simulatedVariableSetters := Dictionary new.
traceStores := 0.
traceFlags := (InitializationOptions at: #linkedSendTrace ifAbsent: [false])
ifTrue: [257 "compileSendTrace + print"]
ifFalse:
[(InitializationOptions at: #recordPrimTrace ifAbsent: [true])
ifTrue: [8] "record prim trace on by default (see Cogit class>>decareCVarsIn:)"
ifFalse: [0]].
+ singleStep := printRegisters := printInstructions := clickConfirm := clickStepping := false.
- singleStep := printRegisters := printInstructions := clickConfirm := false.
backEnd := CogCompilerClass for: self.
methodLabel := CogCompilerClass for: self.
(literalsManager := backEnd class literalsManagerClass new) cogit: self.
ordinarySendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
superSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
BytecodeSetHasDirectedSuperSend ifTrue:
[directedSuperSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
directedSuperBindingSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
directedSendUsesBinding := false].
NewspeakVM ifTrue:
[selfSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
dynamicSuperSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
implicitReceiverSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
outerSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines)].
"debug metadata"
objectReferencesInRuntime := CArrayAccessor on: (Array new: NumObjRefsInRuntime).
runtimeObjectRefIndex := 0.
"debug metadata"
trampolineAddresses := CArrayAccessor on: (Array new: NumTrampolines * 2).
trampolineTableIndex := 0.
extA := numExtB := extB := 0.
compilationTrace ifNil: [compilationTrace := self class initializationOptions at: #compilationTrace ifAbsent: [0]].
debugOpcodeIndices := self class initializationOptions at: #debugOpcodeIndices ifAbsent: [Set new].
debugBytecodePointers := self class initializationOptions at: #debugBytecodePointers ifAbsent: [Set new].
self class initializationOptions at: #breakPC ifPresent: [:pc| breakPC := pc]!
Item was changed:
----- Method: FullBlockClosure>>shouldStopIfAtPC: (in category '*VMMaker-interpreter simulator') -----
shouldStopIfAtPC: address
<primitive: 207>
+ ^self cull: address!
- ^self value: address!
Item was added:
+ ----- Method: Interval>>addBreakpoint: (in category '*VMMaker-breakpoints') -----
+ addBreakpoint: bkpt
+ bkpt = (stop + 1) ifTrue:
+ [^start to: bkpt].
+ bkpt = (start - 1) ifTrue:
+ [^bkpt to: stop].
+ ^{self}, {bkpt}!
Item was added:
+ ----- Method: Interval>>isActiveBreakpoint (in category '*VMMaker-breakpoints') -----
+ isActiveBreakpoint
+ ^stop > start!
Item was added:
+ ----- Method: Interval>>isBreakpointFor: (in category '*VMMaker-breakpoints') -----
+ isBreakpointFor: address
+ ^address >= start and: [address <= stop]!
Item was added:
+ ----- Method: Interval>>menuPrompt (in category '*VMMaker-breakpoints') -----
+ menuPrompt
+ ^' ', start hex, ' to: ', stop hex!
Item was added:
+ ----- Method: Interval>>removeBreakpoint: (in category '*VMMaker-breakpoints') -----
+ removeBreakpoint: bkpt
+ (self includes: bkpt) ifFalse:
+ [^self].
+ bkpt = start ifTrue:
+ [^bkpt = (stop - 1)
+ ifTrue: [stop]
+ ifFalse: [bkpt + 1 to: stop]].
+ bkpt = stop ifTrue:
+ [^bkpt = (start + 1)
+ ifTrue: [start]
+ ifFalse: [start to: bkpt - 1]].
+ ^self asArray copyWithout: bkpt!
Item was added:
+ ----- Method: Interval>>singleStepRequiredToTriggerIn: (in category '*VMMaker-breakpoints') -----
+ singleStepRequiredToTriggerIn: aCogit
+ ^(start between: aCogit cogCodeBase and: aCogit methodZone limitZony)
+ or: [(stop between: aCogit cogCodeBase and: aCogit methodZone limitZony)
+ or: [stop < aCogit cogCodeBase and: [stop > aCogit methodZone limitZony]]]!
Item was changed:
----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') -----
longPrintOop: oop
<export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h"
| fmt lastIndex startIP column cls |
(objectMemory isImmediate: oop) ifTrue:
[^objectMemory printImmediateObject: oop on: transcript].
(objectMemory addressCouldBeObj: oop) ifFalse:
[^objectMemory printCantBeObject: oop on: transcript].
(objectMemory isFreeObject: oop) ifTrue:
[^objectMemory printFreeObject: oop on: transcript].
(objectMemory isForwarded: oop) ifTrue:
[^objectMemory printForwarder: oop on: transcript].
(cls := objectMemory fetchClassOfNonImm: oop)
ifNil: ['16r%lx has a nil class!!!!\n' f: transcript printf: oop]
ifNotNil:
[| className length |
className := self nameOfClass: cls lengthInto: (self addressOf: length put: [:v| length := v]).
'16r%lx: a(n) %.*s' f: transcript printf: {oop. length. className }.
objectMemory hasSpurMemoryManagerAPI ifTrue:
['(%lx=>16r%lx)' f: transcript printf: { objectMemory compactClassIndexOf: oop. cls }]].
fmt := objectMemory formatOf: oop.
' format %lx' f: transcript printf: fmt.
fmt > objectMemory lastPointerFormat
ifTrue: [' nbytes %ld' f: transcript printf: (objectMemory numBytesOf: oop)]
ifFalse: [(objectMemory isIndexableFormat: fmt) ifTrue:
[| len |
len := objectMemory lengthOf: oop.
' size %ld' f: transcript printf: len - (objectMemory fixedFieldsOf: oop format: fmt length: len)]].
objectMemory printHeaderTypeOf: oop on: transcript.
self print: ' hash '; printHexnp: (objectMemory rawHashBitsOf: oop).
self cr.
(fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
["This will answer false if splObj: ClassAlien is nilObject"
(self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue:
[^' datasize %ld %s @ %p\n' f: transcript printf:
{objectMemory sizeFieldOfAlien: oop.
(self isIndirectAlien: oop)
ifTrue: ['indirect']
ifFalse:
[(self isPointerAlien: oop)
ifTrue: ['pointer']
ifFalse: ['direct']].
(self startOfAlienData: oop) asUnsignedInteger }].
(self is: oop KindOfClass: (self superclassOf: (objectMemory splObj: ClassString))) ifTrue:
[^objectMemory printStringDataOf: oop on: transcript].
^objectMemory printNonPointerDataOf: oop on: transcript].
+ startIP := fmt >= objectMemory firstCompiledMethodFormat
+ ifTrue: [(self startPCOfMethod: oop) / objectMemory wordSize]
+ ifFalse: [objectMemory numSlotsOf: oop].
- "this is nonsense. apologies."
- startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory bytesPerOop.
lastIndex := 256 min: startIP.
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:i| | fieldOop |
fieldOop := objectMemory fetchPointer: i - 1 ofObject: oop.
self space; printNum: i - 1; space; printHex: fieldOop; space.
(i = 1 and: [objectMemory isCompiledMethod: oop])
ifTrue: [self printMethodHeaderOop: fieldOop]
ifFalse: [self printOopShortInner: fieldOop].
self cr]].
(objectMemory isCompiledMethod: oop)
ifFalse:
[startIP > lastIndex ifTrue: [self print: '...'; cr]]
ifTrue:
+ [startIP := (self startPCOfMethod: oop) + 1.
- [startIP := startIP * objectMemory wordSize + 1.
lastIndex := objectMemory lengthOf: oop.
+ lastIndex - startIP > 256 ifTrue:
+ [lastIndex := startIP + 256].
- lastIndex - startIP > 100 ifTrue:
- [lastIndex := startIP + 100].
column := 1.
startIP to: lastIndex do:
[:index| | byte |
column = 1 ifTrue:
+ [(self cCode: ['%08p: '] inSmalltalk: ['16r%08x: '])
+ f: transcript
+ printf: (oop+BaseHeaderSize+index-1) asUnsignedIntegerPtr].
- ['16r%08p: ' f: transcript printf: (oop + BaseHeaderSize + index - 1) asVoidPointer].
byte := objectMemory fetchByte: index - 1 ofObject: oop.
'%02x/%-3d%c'
f: transcript
printf: { byte. byte. column = 8 ifTrue: [Character cr] ifFalse: [Character space] }.
(column := column + 1) > 8 ifTrue: [column := 1]].
+ (objectMemory lengthOf: oop) > lastIndex ifTrue:
+ [self print: '...'].
(column between: 2 and: 7) ifTrue:
[self cr]]!
Item was changed:
----- Method: StackInterpreter>>printOop: (in category 'debug printing') -----
printOop: oop
<export: true> "use export: not api, so it won't be written to cointerp.h"
| cls fmt lastIndex startIP bytecodesPerLine column className length |
<inline: false>
(objectMemory isImmediate: oop) ifTrue:
[^objectMemory printImmediateObject: oop on: transcript].
(objectMemory addressCouldBeObj: oop) ifFalse:
[^objectMemory printCantBeObject: oop on: transcript].
(objectMemory isFreeObject: oop) ifTrue:
[^objectMemory printFreeObject: oop on: transcript].
(objectMemory isForwarded: oop) ifTrue:
[^objectMemory printForwarder: oop on: transcript].
(cls := objectMemory fetchClassOfNonImm: oop) ifNil:
[^'16r%lx has a nil class!!!!\n' f: transcript printf: oop].
className := self nameOfClass: cls lengthInto: (self addressOf: length put: [:v| length := v]).
'16r%lx: a(n) %.*s' f: transcript printf: {oop. length. className }.
cls = (objectMemory splObj: ClassFloat) ifTrue:
[^'\n%g\n' f: transcript printf: (objectMemory dbgFloatValueOf: oop)].
fmt := objectMemory formatOf: oop.
fmt > objectMemory lastPointerFormat ifTrue:
[' nbytes %ld' f: transcript printf: (objectMemory numBytesOf: oop)].
self cr.
(fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
["This will answer false if splObj: ClassAlien is nilObject"
(self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue:
[^' datasize %ld %s @ %p\n' f: transcript printf:
{objectMemory sizeFieldOfAlien: oop.
(self isIndirectAlien: oop)
ifTrue: ['indirect']
ifFalse:
[(self isPointerAlien: oop)
ifTrue: ['pointer']
ifFalse: ['direct']].
(self startOfAlienData: oop) asUnsignedInteger }].
(self is: oop KindOfClass: (self superclassOf: (objectMemory splObj: ClassString))) ifTrue:
[^objectMemory printStringDataOf: oop on: transcript].
^objectMemory printNonPointerDataOf: oop on: transcript].
+ startIP := fmt >= objectMemory firstCompiledMethodFormat
+ ifTrue: [(self startPCOfMethod: oop) / objectMemory wordSize]
+ ifFalse: [objectMemory numSlotsOf: oop].
- "this is nonsense. apologies."
- startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory bytesPerOop.
lastIndex := 256 min: startIP.
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:index|
self cCode: [self printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space]
inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space.
self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))].
(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
[self cr]].
(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
[self cr]].
(objectMemory isCompiledMethod: oop)
ifFalse:
[startIP > 64 ifTrue: [self print: '...'; cr]]
ifTrue:
+ [startIP := (self startPCOfMethod: oop) + 1.
- [startIP := startIP * objectMemory wordSize + 1.
lastIndex := objectMemory lengthOf: oop.
+ lastIndex - startIP > 256 ifTrue:
+ [lastIndex := startIP + 256].
- lastIndex - startIP > 100 ifTrue:
- [lastIndex := startIP + 100].
bytecodesPerLine := 8.
column := 1.
startIP to: lastIndex do:
[:index| | byte |
column = 1 ifTrue:
+ [(self cCode: ['%08p: '] inSmalltalk: ['16r%08x: '])
+ f: transcript
+ printf: (oop+BaseHeaderSize+index-1) asUnsignedIntegerPtr].
- ['0x%08p: ' f: transcript printf: (oop+BaseHeaderSize+index-1) asUnsignedIntegerPtr].
byte := objectMemory fetchByte: index - 1 ofObject: oop.
+ ' %02x/%-3d' f: transcript printf: { self cCoerceSimple: byte to: #int. self cCoerceSimple: byte to: #int }.
- self cCode: 'printf(" %02x/%-3d", (int)byte,(int)byte)'
- inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
column := column + 1.
column > bytecodesPerLine ifTrue:
[column := 1. self cr]].
+ (objectMemory lengthOf: oop) > lastIndex ifTrue:
+ [self print: '...'].
column = 1 ifFalse:
[self cr]]!
More information about the Vm-dev
mailing list