[Vm-dev] VM Maker: VMMaker.oscog-eem.535.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Dec 5 19:29:26 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.535.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.535
Author: eem
Time: 5 December 2013, 11:28:53.014 am
UUID: 7b0d92a3-e58b-49ac-b91f-a69db5b70f20
Ancestors: VMMaker.oscog-eem.534
Fix bounds check in Spur machine-code String at:.
add print call stack of frame to utilities menus, and
printCogMethodsWithPrimtiive: as api and utilities menu.
Make SpurMemoryManager>>lookupAddress: a little safter.
=============== Diff against VMMaker.oscog-eem.534 ===============
Item was added:
+ ----- Method: CogMethodZone>>printCogMethodsWithPrimitive: (in category 'printing') -----
+ printCogMethodsWithPrimitive: primIdx
+ <api>
+ | cogMethod |
+ <var: #cogMethod type: #'CogMethod *'>
+ cogMethod := coInterpreter cCoerceSimple: baseAddress to: #'CogMethod *'.
+ [cogMethod < self limitZony] whileTrue:
+ [(cogMethod cmType ~= CMFree
+ and: [primIdx = (coInterpreter primitiveIndexOfMethod: cogMethod methodObject
+ header: cogMethod methodHeader)]) ifTrue:
+ [coInterpreter printCogMethod: cogMethod].
+ cogMethod := self methodAfter: cogMethod]!
Item was changed:
----- Method: CogObjectRepresentationFor32BitSpur>>genInnerPrimitiveAt: (in category 'primitive generators') -----
genInnerPrimitiveAt: retNoffset
"Implement the guts of primitiveAt; dispatch on size"
| formatReg jumpNotIndexable jumpSmallSize jumpImmediate jumpBadIndex
jumpBytesDone jumpShortsDone jumpWordsDone jumpFixedFieldsDone
jumpIsBytes jumpIsShorts jumpIsWords jumpWordTooBig jumpIsArray jumpHasFixedFields jumpIsContext
jumpBytesOutOfBounds jumpShortsOutOfBounds jumpWordsOutOfBounds jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds |
<inline: true>
"c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
<var: #jumpIsBytes type: #'AbstractInstruction *'>
<var: #jumpIsShorts type: #'AbstractInstruction *'>
<var: #jumpBadIndex type: #'AbstractInstruction *'>
<var: #jumpSmallSize type: #'AbstractInstruction *'>
<var: #jumpIsContext type: #'AbstractInstruction *'>
<var: #jumpImmediate type: #'AbstractInstruction *'>
<var: #jumpBytesDone type: #'AbstractInstruction *'>
<var: #jumpShortsDone type: #'AbstractInstruction *'>
<var: #jumpWordsDone type: #'AbstractInstruction *'>
<var: #jumpWordTooBig type: #'AbstractInstruction *'>
<var: #jumpNotIndexable type: #'AbstractInstruction *'>
<var: #jumpHasFixedFields type: #'AbstractInstruction *'>
<var: #jumpFixedFieldsDone type: #'AbstractInstruction *'>
<var: #jumpArrayOutOfBounds type: #'AbstractInstruction *'>
<var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
<var: #jumpShortsOutOfBounds type: #'AbstractInstruction *'>
<var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
<var: #jumpFixedFieldsOutOfBounds type: #'AbstractInstruction *'>
cogit MoveR: ReceiverResultReg R: TempReg.
jumpImmediate := self genJumpImmediateInScratchReg: TempReg.
cogit MoveR: Arg0Reg R: TempReg.
+ cogit MoveR: Arg0Reg R: Arg1Reg.
jumpBadIndex := self genJumpNotSmallIntegerInScratchReg: TempReg.
+ self genConvertSmallIntegerToIntegerInScratchReg: Arg1Reg.
+ cogit SubCq: 1 R: Arg1Reg. "1-rel => 0-rel"
- self genConvertSmallIntegerToIntegerInScratchReg: Arg0Reg.
- cogit SubCq: 1 R: Arg0Reg. "1-rel => 0-rel"
formatReg := SendNumArgsReg.
cogit
MoveMw: 0 r: ReceiverResultReg R: formatReg; "formatReg := least significant half of self baseHeader: receiver"
MoveR: formatReg R: TempReg;
LogicalShiftRightCq: objectMemory formatShift R: formatReg;
AndCq: objectMemory formatMask R: formatReg. "formatReg := self formatOfHeader: destReg"
"get numSlots into ClassReg."
cogit MoveCq: 0 R: ClassReg. "N.B. MoveMb:r:R: does not zero other bits"
cogit MoveMb: 7 r: ReceiverResultReg R: ClassReg. "MSB of header"
cogit CmpCq: objectMemory numSlotsMask R: ClassReg.
jumpSmallSize := cogit JumpLess: 0.
cogit MoveMw: -8 r: ReceiverResultReg R: ClassReg. "LSW of overflow size header"
"dispatch on format in a combination of highest dynamic frequency order first and convenience.
0 = 0 sized objects (UndefinedObject True False et al)
1 = non-indexable objects with inst vars (Point et al)
2 = indexable objects with no inst vars (Array et al)
3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
4 = weak indexable objects with inst vars (WeakArray et al)
5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
6 unused, reserved for exotic pointer objects?
7 Forwarded Object, 1st field is pointer, rest of fields are ignored
8 unused, reserved for exotic non-pointer objects?
9 (?) 64-bit indexable
10 - 11 32-bit indexable
12 - 15 16-bit indexable
16 - 23 byte indexable
24 - 31 compiled method"
jumpSmallSize jmpTarget:
(cogit CmpCq: objectMemory firstByteFormat R: formatReg).
jumpIsBytes := cogit JumpGreaterOrEqual: 0.
cogit CmpCq: objectMemory arrayFormat R: formatReg.
jumpIsArray := cogit JumpZero: 0.
jumpNotIndexable := cogit JumpLess: 0.
cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
jumpHasFixedFields := cogit JumpLessOrEqual: 0.
cogit CmpCq: objectMemory firstShortFormat R: formatReg.
jumpIsShorts := cogit JumpGreaterOrEqual: 0.
cogit CmpCq: objectMemory firstLongFormat R: formatReg.
jumpIsWords := cogit JumpGreaterOrEqual: 0.
"For now ignore 64-bit indexability."
jumpNotIndexable jmpTarget: cogit Label.
jumpNotIndexable := cogit Jump: 0.
jumpIsBytes jmpTarget:
(cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg).
cogit AndCq: objectMemory wordSize - 1 R: formatReg.
cogit SubR: formatReg R: ClassReg;
+ CmpR: Arg1Reg R: ClassReg.
- CmpR: Arg0Reg R: ClassReg.
jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit AddCq: objectMemory baseHeaderSize R: Arg1Reg.
+ cogit MoveXbr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
- cogit AddCq: objectMemory baseHeaderSize R: Arg0Reg.
- cogit MoveXbr: Arg0Reg R: ReceiverResultReg R: ReceiverResultReg.
self genConvertIntegerToSmallIntegerInScratchReg: ReceiverResultReg.
jumpBytesDone := cogit Jump: 0.
jumpIsShorts jmpTarget:
(cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg).
cogit AndCq: 1 R: formatReg.
cogit SubR: formatReg R: ClassReg;
+ CmpR: Arg1Reg R: ClassReg.
- CmpR: Arg0Reg R: ClassReg.
jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit AddR: Arg1Reg R: ReceiverResultReg.
- cogit AddR: Arg0Reg R: ReceiverResultReg.
cogit MoveM16: objectMemory baseHeaderSize r: ReceiverResultReg R: ReceiverResultReg.
self genConvertIntegerToSmallIntegerInScratchReg: ReceiverResultReg.
jumpShortsDone := cogit Jump: 0.
jumpIsWords jmpTarget:
+ (cogit CmpR: Arg1Reg R: ClassReg).
- (cogit CmpR: Arg0Reg R: ClassReg).
jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
+ cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: TempReg.
+ cogit SubCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
- cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
- cogit MoveXwr: Arg0Reg R: ReceiverResultReg R: TempReg.
- cogit SubCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
jumpWordTooBig := self jumpNotSmallIntegerUnsignedValueInRegister: TempReg.
cogit MoveR: TempReg R: ReceiverResultReg.
self genConvertIntegerToSmallIntegerInScratchReg: ReceiverResultReg.
jumpWordsDone := cogit Jump: 0.
jumpHasFixedFields jmpTarget:
(cogit AndCq: objectMemory classIndexMask R: TempReg).
cogit CmpCq: ClassMethodContextCompactIndex R: TempReg.
cogit MoveR: TempReg R: formatReg.
cogit CmpCq: ClassMethodContextCompactIndex R: TempReg.
jumpIsContext := cogit JumpZero: 0.
cogit PushR: ClassReg.
self genGetClassObjectOfClassIndex: formatReg into: ClassReg scratchReg: TempReg.
self genLoadSlot: InstanceSpecificationIndex sourceReg: ClassReg destReg: formatReg.
cogit PopR: ClassReg.
self genConvertSmallIntegerToIntegerInScratchReg: formatReg.
cogit
AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg;
SubR: formatReg R: ClassReg;
+ CmpR: Arg1Reg R: ClassReg.
- CmpR: Arg0Reg R: ClassReg.
jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ "index is (formatReg (fixed fields) + Arg1Reg (0-rel index)) * wordSize + baseHeaderSize"
+ cogit AddR: formatReg R: Arg1Reg.
+ cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
+ cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
- "index is (formatReg (fixed fields) + Arg0Reg (0-rel index)) * wordSize + baseHeaderSize"
- cogit AddR: formatReg R: Arg0Reg.
- cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
- cogit MoveXwr: Arg0Reg R: ReceiverResultReg R: ReceiverResultReg.
jumpFixedFieldsDone := cogit Jump: 0.
jumpIsArray jmpTarget:
+ (cogit CmpR: Arg1Reg R: ClassReg).
- (cogit CmpR: Arg0Reg R: ClassReg).
jumpArrayOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
+ cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
- cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
- cogit MoveXwr: Arg0Reg R: ReceiverResultReg R: ReceiverResultReg.
jumpFixedFieldsDone jmpTarget:
(jumpWordsDone jmpTarget:
(jumpShortsDone jmpTarget:
(jumpBytesDone jmpTarget:
(cogit RetN: retNoffset)))).
jumpFixedFieldsOutOfBounds jmpTarget:
(jumpArrayOutOfBounds jmpTarget:
(jumpBytesOutOfBounds jmpTarget:
(jumpShortsOutOfBounds jmpTarget:
(jumpWordsOutOfBounds jmpTarget:
(jumpWordTooBig jmpTarget:
(jumpNotIndexable jmpTarget:
+ (jumpIsContext jmpTarget:
+ (jumpBadIndex jmpTarget:
+ (jumpImmediate jmpTarget: cogit Label))))))))).
- (jumpIsContext jmpTarget: cogit Label))))))).
- cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel"
- self genConvertIntegerToSmallIntegerInScratchReg: Arg0Reg.
-
- (jumpBadIndex jmpTarget: (jumpImmediate jmpTarget: cogit Label)).
-
^0!
Item was changed:
----- Method: CogObjectRepresentationFor32BitSpur>>genInnerPrimitiveStringAt: (in category 'primitive generators') -----
genInnerPrimitiveStringAt: retNoffset
"Implement the guts of primitiveStringAt; dispatch on size"
| formatReg jumpNotIndexable jumpSmallSize jumpBadIndex done
jumpIsBytes jumpIsShorts jumpIsWords jumpWordTooBig
jumpBytesOutOfBounds jumpShortsOutOfBounds jumpWordsOutOfBounds |
<inline: true>
"c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
<var: #done type: #'AbstractInstruction *'>
<var: #jumpIsBytes type: #'AbstractInstruction *'>
<var: #jumpIsShorts type: #'AbstractInstruction *'>
<var: #jumpIsWords type: #'AbstractInstruction *'>
<var: #jumpBadIndex type: #'AbstractInstruction *'>
<var: #jumpSmallSize type: #'AbstractInstruction *'>
<var: #jumpWordTooBig type: #'AbstractInstruction *'>
<var: #jumpNotIndexable type: #'AbstractInstruction *'>
<var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
<var: #jumpShortsOutOfBounds type: #'AbstractInstruction *'>
<var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
cogit MoveR: Arg0Reg R: TempReg.
+ cogit MoveR: Arg0Reg R: Arg1Reg.
jumpBadIndex := self genJumpNotSmallIntegerInScratchReg: TempReg.
+ self genConvertSmallIntegerToIntegerInScratchReg: Arg1Reg.
+ cogit SubCq: 1 R: Arg1Reg. "1-rel => 0-rel"
- self genConvertSmallIntegerToIntegerInScratchReg: Arg0Reg.
- cogit SubCq: 1 R: Arg0Reg. "1-rel => 0-rel"
formatReg := SendNumArgsReg.
cogit
MoveMw: 0 r: ReceiverResultReg R: formatReg; "formatReg := least significant half of self baseHeader: receiver"
MoveR: formatReg R: TempReg;
LogicalShiftRightCq: objectMemory formatShift R: formatReg;
AndCq: objectMemory formatMask R: formatReg. "formatReg := self formatOfHeader: destReg"
"get numSlots into ClassReg."
cogit MoveCq: 0 R: ClassReg. "N.B. MoveMb:r:R: does not zero other bits"
cogit MoveMb: 7 r: ReceiverResultReg R: ClassReg. "MSB of header"
cogit CmpCq: objectMemory numSlotsMask R: ClassReg.
jumpSmallSize := cogit JumpLess: 0.
cogit MoveMw: -8 r: ReceiverResultReg R: ClassReg. "LSW of overflow size header"
"dispatch on format in a combination of highest dynamic frequency order first and convenience.
0 = 0 sized objects (UndefinedObject True False et al)
1 = non-indexable objects with inst vars (Point et al)
2 = indexable objects with no inst vars (Array et al)
3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
4 = weak indexable objects with inst vars (WeakArray et al)
5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
6 unused, reserved for exotic pointer objects?
7 Forwarded Object, 1st field is pointer, rest of fields are ignored
8 unused, reserved for exotic non-pointer objects?
9 (?) 64-bit indexable
10 - 11 32-bit indexable
12 - 15 16-bit indexable
16 - 23 byte indexable
24 - 31 compiled method"
jumpSmallSize jmpTarget:
(cogit CmpCq: objectMemory firstByteFormat R: formatReg).
jumpIsBytes := cogit JumpGreaterOrEqual: 0.
cogit CmpCq: objectMemory firstShortFormat R: formatReg.
jumpIsShorts := cogit JumpGreaterOrEqual: 0.
cogit CmpCq: objectMemory firstLongFormat R: formatReg.
jumpIsWords := cogit JumpGreaterOrEqual: 0.
jumpNotIndexable := cogit Jump: 0.
jumpIsBytes jmpTarget:
(cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg).
cogit AndCq: objectMemory wordSize - 1 R: formatReg.
cogit SubR: formatReg R: ClassReg;
+ CmpR: Arg1Reg R: ClassReg.
+ jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit AddCq: objectMemory baseHeaderSize R: Arg1Reg.
+ cogit MoveXbr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
- CmpR: Arg0Reg R: ClassReg.
- jumpBytesOutOfBounds := cogit JumpAboveOrEqual: 0.
- cogit AddCq: objectMemory baseHeaderSize R: Arg0Reg.
- cogit MoveXbr: Arg0Reg R: ReceiverResultReg R: ReceiverResultReg.
done := cogit Label.
self genConvertIntegerToCharacterInScratchReg: ReceiverResultReg.
cogit RetN: retNoffset.
jumpIsShorts jmpTarget:
(cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg).
cogit AndCq: 1 R: formatReg.
cogit SubR: formatReg R: ClassReg;
+ CmpR: Arg1Reg R: ClassReg.
+ jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit AddR: Arg1Reg R: ReceiverResultReg.
- CmpR: Arg0Reg R: ClassReg.
- jumpShortsOutOfBounds := cogit JumpAboveOrEqual: 0.
- cogit AddR: Arg0Reg R: ReceiverResultReg.
cogit MoveM16: objectMemory baseHeaderSize r: ReceiverResultReg R: ReceiverResultReg.
cogit Jump: done.
jumpIsWords jmpTarget:
+ (cogit CmpR: Arg1Reg R: ClassReg).
+ jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
+ cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: TempReg.
+ cogit SubCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
- (cogit CmpR: Arg0Reg R: ClassReg).
- jumpWordsOutOfBounds := cogit JumpAboveOrEqual: 0.
- cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
- cogit MoveXwr: Arg0Reg R: ReceiverResultReg R: TempReg.
- cogit SubCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
jumpWordTooBig := self jumpNotCharacterUnsignedValueInRegister: TempReg.
cogit MoveR: TempReg R: ReceiverResultReg.
cogit Jump: done.
jumpBytesOutOfBounds jmpTarget:
(jumpShortsOutOfBounds jmpTarget:
(jumpWordsOutOfBounds jmpTarget:
(jumpWordTooBig jmpTarget:
+ (jumpNotIndexable jmpTarget:
+ (jumpBadIndex jmpTarget: cogit Label))))).
- (jumpNotIndexable jmpTarget: cogit Label)))).
- cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel"
- self genConvertIntegerToSmallIntegerInScratchReg: Arg0Reg.
-
- jumpBadIndex jmpTarget: cogit Label.
-
^0!
Item was changed:
----- Method: CogVMSimulator>>utilitiesMenu: (in category 'UI') -----
utilitiesMenu: aMenuMorph
aMenuMorph
add: 'toggle transcript' action: #toggleTranscript;
add: 'clone VM' action: #cloneSimulation;
addLine;
add: 'print ext head frame' action: #printExternalHeadFrame;
add: 'print int head frame' action: #printHeadFrame;
add: 'print mc/cog frame' action: [self printFrame: cogit processor fp WithSP: cogit processor sp];
add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP];
add: 'short print mc/cog frame & callers' action: [self shortPrintFrameAndCallers: cogit processor fp];
add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
add: 'long print mc/cog frame & callers' action: [self printFrameAndCallers: cogit processor fp SP: cogit processor sp];
add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]];
add: 'print call stack' action: #printCallStack;
add: 'print stack call stack' action: #printStackCallStack;
add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]];
+ add: 'print call stack of frame...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printCallStackFP: fp]];
add: 'print all stacks' action: #printAllStacks;
add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP.
self writeBackHeadFramePointers];
add: 'write back mc ptrs' action: [stackPointer := cogit processor sp. framePointer := cogit processor fp. instructionPointer := cogit processor eip.
self writeBackHeadFramePointers];
addLine;
add: 'print registers' action: [cogit processor printRegistersOn: transcript];
add: 'print register map' action: [cogit printRegisterMapOn: transcript];
add: 'disassemble method/trampoline...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit disassembleCodeAt: pc]];
add: 'disassemble method/trampoline at pc' action: [cogit disassembleCodeAt: cogit processor pc];
add: 'disassemble ext head frame method' action: [cogit disassembleMethod: (self frameMethod: framePointer)];
add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]];
add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]];
addLine;
add: 'inspect object memory' target: objectMemory action: #inspect;
add: 'inspect cointerpreter' action: #inspect;
add: 'inspect cogit' target: cogit action: #inspect;
add: 'inspect method zone' target: cogit methodZone action: #inspect.
self isThreadedVM ifTrue:
[aMenuMorph add: 'inspect thread manager' target: self threadManager action: #inspect].
aMenuMorph
addLine;
add: 'print cog methods' target: cogMethodZone action: #printCogMethods;
+ add: 'print cog methods with prim...' action: [(self promptNum: 'prim index') ifNotNil: [:pix| cogMethodZone printCogMethodsWithPrimitive: pix]];
add: 'print trampoline table' target: cogit action: #printTrampolineTable;
add: 'print prim trace log' action: #dumpPrimTraceLog;
add: 'report recent instructions' target: cogit action: #reportLastNInstructions;
add: 'set break pc...' action: [(self promptHex: 'break pc') ifNotNil: [:bpc| cogit breakPC: bpc]];
add: (cogit singleStep
ifTrue: ['no single step']
ifFalse: ['single step'])
action: [cogit singleStep: cogit singleStep not];
add: (cogit printRegisters
ifTrue: ['no print registers each instruction']
ifFalse: ['print registers each instruction'])
action: [cogit printRegisters: cogit printRegisters not];
add: (cogit printInstructions
ifTrue: ['no print instructions each instruction']
ifFalse: ['print instructions each instruction'])
action: [cogit printInstructions: cogit printInstructions not];
addLine;
add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'.
s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]];
add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'.
s notEmpty ifTrue: [self setBreakSelector: s]];
add: 'set break block...' action: [|s| s := UIManager default request: 'break block'.
s notEmpty ifTrue: [self setBreakBlockFromString: s]];
add: (printBytecodeAtEachStep
ifTrue: ['no print bytecode each bytecode']
ifFalse: ['print bytecode each bytecode'])
action: [self ensureDebugAtEachStepBlock.
printBytecodeAtEachStep := printBytecodeAtEachStep not];
add: (printFrameAtEachStep
ifTrue: ['no print frame each bytecode']
ifFalse: ['print frame each bytecode'])
action: [self ensureDebugAtEachStepBlock.
printFrameAtEachStep := printFrameAtEachStep not].
^aMenuMorph!
Item was changed:
----- Method: SpurMemoryManager>>lookupAddress: (in category 'simulation only') -----
lookupAddress: address
"If address appears to be that of a Symbol or a few well-known objects (such as classes) answer it, otherwise answer nil.
For code disassembly"
<doNotGenerate>
| fmt size string class classSize maybeThisClass classNameIndex thisClassIndex |
+ ((self addressCouldBeObj: address)
+ and: [(self classIndexOf: address) > 0]) ifFalse:
- (self addressCouldBeObj: address) ifFalse:
[^address = scavengeThreshold ifTrue:
['scavengeThreshold']].
address - self baseHeaderSize = hiddenRootsObj ifTrue:
[^'(hiddenRootsObj+baseHeaderSize)'].
fmt := self formatOf: address.
size := self lengthOf: address baseHeader: (self baseHeader: address) format: fmt.
size = 0 ifTrue:
[^address caseOf: { [nilObj] -> ['nil']. [trueObj] -> ['true']. [falseObj] -> ['false'] } otherwise: []].
((fmt between: self firstByteFormat and: self firstCompiledMethodFormat - 1) "indexable byte fields"
and: [(size between: 1 and: 64)
and: [Scanner isLiteralSymbol: (string := (0 to: size - 1) collect: [:i| Character value: (self fetchByte: i ofObject: address)])]]) ifTrue:
[^'#', (ByteString withAll: string)].
class := self fetchClassOfNonImm: address.
(class isNil or: [class = nilObj]) ifTrue:
[^nil].
"address is either a class or a metaclass, or an instance of a class or invalid. determine which."
classNameIndex := coInterpreter classNameIndex.
thisClassIndex := coInterpreter thisClassIndex.
((classSize := self numSlotsOf: class) <= (classNameIndex max: thisClassIndex)
or: [classSize > 255]) ifTrue:
[^nil].
"Address could be a class or a metaclass"
(fmt = 1 and: [size >= classNameIndex]) ifTrue:
["Is address a class? If so class's thisClass is address."
(self lookupAddress: (self fetchPointer: classNameIndex ofObject: address)) ifNotNil:
[:maybeClassName|
(self fetchPointer: thisClassIndex ofObject: class) = address ifTrue:
[^maybeClassName allButFirst]].
"Is address a Metaclass? If so class's name is Metaclass and address's thisClass holds the class name"
((self isBytes: (self fetchPointer: classNameIndex ofObject: class))
and: [(self lookupAddress: (self fetchPointer: classNameIndex ofObject: class)) = '#Metaclass'
and: [size >= thisClassIndex]]) ifTrue:
[maybeThisClass := self fetchPointer: thisClassIndex ofObject: address.
(self lookupAddress: (self fetchPointer: classNameIndex ofObject: maybeThisClass)) ifNotNil:
[:maybeThisClassName| ^maybeThisClassName allButFirst, ' class']]].
^(self lookupAddress: (self fetchPointer: classNameIndex ofObject: class)) ifNotNil:
[:maybeClassName| 'a(n) ', maybeClassName allButFirst]!
Item was changed:
----- Method: StackInterpreterSimulator>>utilitiesMenu: (in category 'UI') -----
utilitiesMenu: aMenuMorph
aMenuMorph
add: 'toggle transcript' action: #toggleTranscript;
add: 'clone VM' action: #cloneSimulation;
addLine;
add: 'print ext head frame' action: #printExternalHeadFrame;
add: 'print int head frame' action: #printHeadFrame;
add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP];
add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]];
add: 'print call stack' action: #printCallStack;
add: 'print stack call stack' action: #printStackCallStack;
add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]];
+ add: 'print call stack of frame...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printCallStackFP: fp]];
add: 'print all stacks' action: #printAllStacks;
add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP.
self writeBackHeadFramePointers];
add: 'print prim trace log' action: #dumpPrimTraceLog;
addLine;
add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]];
add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]];
addLine;
add: 'inspect object memory' target: objectMemory action: #inspect;
add: 'inspect cointerpreter' action: #inspect;
addLine;
add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'.
s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]];
add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'.
s notEmpty ifTrue: [self setBreakSelector: s]];
add: (printSends
ifTrue: ['no print sends']
ifFalse: ['print sends'])
action: [self ensureDebugAtEachStepBlock.
printSends := printSends not];
"currently printReturns does nothing"
"add: (printReturns
ifTrue: ['no print returns']
ifFalse: ['print returns'])
action: [self ensureDebugAtEachStepBlock.
printReturns := printReturns not];"
add: (printBytecodeAtEachStep
ifTrue: ['no print bytecode each bytecode']
ifFalse: ['print bytecode each bytecode'])
action: [self ensureDebugAtEachStepBlock.
printBytecodeAtEachStep := printBytecodeAtEachStep not];
add: (printFrameAtEachStep
ifTrue: ['no print frame each bytecode']
ifFalse: ['print frame each bytecode'])
action: [self ensureDebugAtEachStepBlock.
printFrameAtEachStep := printFrameAtEachStep not].
^aMenuMorph!
Item was added:
+ ----- Method: VMClass>>promptNum: (in category 'simulation support') -----
+ promptNum: string
+ <doNotGenerate>
+ | s |
+ s := UIManager default request: string, ' (dec)'.
+ s := s withBlanksTrimmed.
+ ^s notEmpty ifTrue:
+ [Number readFrom: s readStream]!
More information about the Vm-dev
mailing list