VM Maker: VMMakerUI-eem.9.mcz

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

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

Name: VMMakerUI-eem.9
Author: eem
Time: 27 December 2019, 7:48:56.121172 pm
UUID: ae22564e-2f54-4827-b975-fe0864941be7
Ancestors: VMMakerUI-eem.8

CogFrameInspectors: Allow opening a fixed CogFrameInspector on th current frame if clicking on its frame pointer address (in the first line only).

Default CogFrameInspectors's stackPointer so that it is headStackPointer if framePointer is headFramePointer.

Add a proceed action to click-step.

CoInterpreter Utilities Menu:
Prune all the various stack frame printers to just three, all using headFramePointer/headStackPointer.

Add inspect frame...

Priont the break block's code if on already exists when prompting for a break block.

=============== Diff against VMMakerUI-eem.8 ===============

Item was changed:
  ----- Method: CogAbstractFrameInspector>>textForFramePointer:stackPointer: (in category 'accessing - ui') -----
  textForFramePointer: framePointer stackPointer: stackPointer
  "Print and emphasize the frame text as efficiently as possible, deferring as much interpretation until evaluation time."
  | frameString frameText |
  (coInterpreter stackPages apparentlyValidFramePointer: framePointer stackPointer: stackPointer) ifFalse:
  [^('Invalid Frame fp: ', (framePointer isInteger ifTrue: [framePointer hex allButFirst: 3] ifFalse: [framePointer printString]),
  ' sp: ', (framePointer isInteger ifTrue: [framePointer hex allButFirst: 3] ifFalse: [framePointer printString])) asText allBold].
  frameText := (String streamContents: [:fs| coInterpreter printFrame: framePointer WithSP: stackPointer on: fs]) allButFirst asText.
  (frameString := frameText string)
  findTokens: {Character cr}
  indicesDo:
  [:start :stop| | firstColonIndex fieldNameIndex fieldNameEndIndex valueIndex |
  start = 1
  ifTrue:
+ [self windowTitle: (self windowTitleFrom: (frameString copyFrom: 1 to: stop)).
+ frameText
+ addAttribute: (PluggableTextAttribute evalBlock: [(CogFrameInspector on: coInterpreter)
+ framePointer: framePointer;
+ open])
+ from: 1
+ to: (frameString indexOf: Character space startingAt: 4) - 1]
- [self windowTitle: (frameString copyFrom: 1 to: stop)]
  ifFalse:
  [fieldNameIndex := (firstColonIndex := frameString indexOf: $: startingAt: start + 1) + 1.
  [(frameString at: fieldNameIndex) = Character space] whileTrue:
  [fieldNameIndex := fieldNameIndex + 1].
  fieldNameEndIndex := (frameString indexOf: $: startingAt: fieldNameIndex + 1) - 1.
  valueIndex := fieldNameEndIndex + 2.
  [(frameString at: valueIndex) = Character space] whileTrue:
  [valueIndex := valueIndex + 1].
  (self evalAttributeForFieldName: (frameString copyFrom:  fieldNameIndex to: fieldNameEndIndex)
+ framePointer: framePointer
+ value: (frameString copyFrom: valueIndex to: stop)
+ addressString: (frameString copyFrom: start to: firstColonIndex - 1))
- framePointer: framePointer
- value: (frameString copyFrom: valueIndex to: stop)
- addressString: (frameString copyFrom: start to: firstColonIndex - 1))
  ifNotNil:
  [:attribute| frameText addAttribute: attribute from: fieldNameIndex to: fieldNameEndIndex]]].
  ^frameText!

Item was added:
+ ----- Method: CogAbstractFrameInspector>>windowTitleFrom: (in category 'accessing - ui') -----
+ windowTitleFrom: frameString
+ ^frameString!

Item was changed:
  ----- Method: CogFrameInspector>>stackPointer (in category 'accessing') -----
  stackPointer
 
+ ^stackPointer ifNil:
+ [framePointer = cogit headFramePointer
+ ifTrue: [cogit headStackPointer]
+ ifFalse: [framePointer ifNotNil: [:fp| coInterpreter stackPointerForFramePointer: fp]]]!
- ^stackPointer ifNil: [framePointer ifNotNil: [:fp| coInterpreter stackPointerForFramePointer: fp]]!

Item was added:
+ ----- Method: CogHeadFrameInspector>>windowTitleFrom: (in category 'accessing - ui') -----
+ windowTitleFrom: frameString
+ ^'Head: ', frameString!

Item was changed:
  ----- Method: CogVMSimulator>>utilitiesMenu: (in category '*VMMakerUI-user interface') -----
  utilitiesMenu: aMenuMorph
  aMenuMorph
  add: 'toggle transcript' action: #toggleTranscript;
  add: 'clone VM' action: #cloneSimulationWindow;
  addLine;
+ add: 'print head frame' action: [self printFrame: cogit headFramePointer WithSP: cogit headStackPointer];
+ add: 'short print head frame & callers' action: [self shortPrintFrameAndCallers: cogit headFramePointer];
+ add: 'long print head frame & callers' action: [self printFrameAndCallers: cogit headFramePointer SP: cogit headFramePointer];
- add: 'print ext head frame' action: #printExternalHeadFrame;
- add: 'print int head frame' action: #printHeadFrame;
- add: 'print mc/cog head frame' action: [self printFrame: cogit processor fp WithSP: cogit processor sp];
- add: 'short print ext head frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
- add: 'short print int head frame & callers' action: [self shortPrintFrameAndCallers: localFP];
- add: 'short print mc/cog head frame & callers' action: [self shortPrintFrameAndCallers: cogit processor fp];
- add: 'long print ext head frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
- add: 'long print int head frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
- add: 'long print mc/cog head 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: 'inspect frame...' action: [(self promptHex: 'inspect frame') ifNotNil: [:fp| (CogFrameInspector on: self) framePointer: fp; open]];
  add: 'print call stack' action: #printCallStack;
  add: 'print stack call stack' action: #printStackCallStack;
  add: 'print stack call stack of...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printStackCallStackOf: fp]];
  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 pc.
  self externalWriteBackHeadFramePointers];
  addLine;
  add: 'print rump C stack' action: [objectMemory printMemoryFrom: cogit processor sp to: CFramePointer];
  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 codeEntryFor: cogit processor pc) isNil
   and: [(cogit methodZone methodFor: cogit processor pc) = 0])
  ifTrue: [instructionPointer]
  ifFalse: [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]];
  add: 'print context...' action: [(self promptHex: 'print context') ifNotNil: [:oop| self printContext: oop]];
  add: 'symbolic method...' action: [(self promptHex: 'method bytecodes') ifNotNil: [:oop| self symbolicMethod: oop]];
  addLine;
  add: 'inspect object memory' target: objectMemory action: #inspect;
  add: 'run leak checker' action: [Cursor execute showWhile: [self runLeakChecker]];
  add: 'inspect cointerpreter' action: #inspect;
  add: 'inspect cogit' target: cogit action: #inspect;
  add: 'inspect method zone' target: cogit methodZone action: #inspect;
  add: 'inspect head frame' action: [CogHeadFrameInspector openFor: self];
  add: 'inspect processor' action: [CogProcessorAlienInspector openFor: self].
  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 cog methods with selector...' action:
  [|s| s := UIManager default request: 'selector'.
  s notEmpty ifTrue:
  [s = 'nil' ifTrue: [s := nil].
  cogMethodZone methodsDo:
  [:m|
  (s ifNil: [m selector = objectMemory nilObject]
  ifNotNil: [(objectMemory numBytesOf: m selector) = s size
  and: [(self strncmp: s
  _: (m selector + objectMemory baseHeaderSize)
  _: (objectMemory numBytesOf: m selector)) = 0]]) ifTrue:
  [cogit printCogMethod: m]]]];
  add: 'print cog methods with method...' action:
  [(self promptHex: 'method') ifNotNil: [:methodOop| cogMethodZone printCogMethodsWithMethod: methodOop]];
  add: 'print cog method for...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit printCogMethodFor: pc]];
  add: 'print cog method header for...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit printCogMethodHeaderFor: pc]];
  add: 'print trampoline table' target: cogit action: #printTrampolineTable;
  add: 'print prim trace log' action: #dumpPrimTraceLog;
  add: 'report recent instructions' target: cogit action: #reportLastNInstructions;
  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: (cogit singleStep
  ifTrue: ['no single step']
  ifFalse: ['single step'])
  action: [cogit singleStep: cogit singleStep not];
  add: 'click step' action: [cogit setClickStepBreakBlock];
  add: 'set break pc', cogit breakPC menuPrompt, '...-ve to disable or remove' action: [cogit promptForBreakPC];
  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 (MNU:foo for MNU)'.
  s notEmpty ifTrue:
  [(s size > 4 and: [s beginsWith: 'MNU:'])
  ifTrue: [self setBreakMNUSelector: (s allButFirst: 4)]
  ifFalse: [self setBreakSelector: s]]];
+ add: 'set break block...' action: [| s |
+ s := UIManager default
+ request: 'break block'
+ initialAnswer: (cogit breakBlock
+ ifNotNil: [:bb| bb sourceString copyReplaceAll: 't1' with: 'address']
+ ifNil: '[:address| false]').
- add: 'set break block...' action: [|s| s := UIManager default request: 'break block' initialAnswer: '[:address| false]'.
  s notEmpty ifTrue: [self setBreakBlockFromString: s]];
  add: 'set cogit break method...' action: [(self promptHex: 'cogit breakMethod') ifNotNil: [:bm| cogit setBreakMethod: bm]];
  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: Cogit>>promptClickStep (in category '*VMMakerUI-user interface') -----
+ promptClickStep
+ <doNotGenerate>
+ ^UserDialogBoxMorph
+ confirm: 'step?'
+ orExtraValue: #proceed
+ label: 'proceed'
+ title: 'Click step'
+ at: nil!

Item was changed:
  ----- Method: Cogit>>setClickStepBreakBlock (in category '*VMMakerUI-user interface') -----
  setClickStepBreakBlock
  "Set the break block to present a confirmer, breaking if true, and restoring the previous break block.
  If an open debugger on the receiver can be found, proceed it."
  <doNotGenerate>
+ | previousBreakBlock previousAtEachStepBlock previousBreakPC previousSingleStep previousClickConfirm result |
- | previousBreakBlock previousAtEachStepBlock previousBreakPC previousSingleStep previousClickConfirm |
  (breakBlock isNil or: [breakBlock method ~~ thisContext method]) ifTrue:
  [previousBreakBlock := breakBlock.
  previousAtEachStepBlock := coInterpreter atEachStepBlock.
  previousBreakPC := breakPC.
  previousSingleStep := singleStep.
  previousClickConfirm := clickConfirm.
  breakBlock := [:ign|
  (processor pc ~= previousBreakPC
+ and: [(result := self promptClickStep) == true])
- and: [UIManager confirm: 'step?'])
  ifTrue: [false]
  ifFalse: [breakBlock := previousBreakBlock.
  coInterpreter atEachStepBlock: previousAtEachStepBlock.
  breakPC := previousBreakPC.
  singleStep := previousSingleStep.
  clickConfirm := previousClickConfirm.
  true]].
  coInterpreter atEachStepBlock:
  [previousAtEachStepBlock value.
  (coInterpreter localIP ~= previousBreakPC
   and: [UIManager confirm: 'step?']) ifFalse:
  [breakBlock := previousBreakBlock.
  coInterpreter atEachStepBlock: previousAtEachStepBlock.
  breakPC := previousBreakPC.
  singleStep := previousSingleStep.
  clickConfirm := previousClickConfirm.
  self halt]].
+ singleStep := breakPC := clickConfirm := result ~~ #proceed].
- singleStep := breakPC := clickConfirm := true].
  (World submorphs
  detect:
  [:m|
  m model isDebugger
  and: [(m model interruptedProcess suspendedContext findContextSuchThat:
  [:ctxt|
  (ctxt receiver == self
  and: [ctxt selector == #simulateCogCodeAt:])
  or: [ctxt receiver == coInterpreter
  and: [ctxt selector == #interpret]]]) notNil]]
  ifNone: []) ifNotNil:
  [:debuggerWindow|
  WorldState addDeferredUIMessage:
  [debuggerWindow model proceed]]!

Item was added:
+ ----- Method: UserDialogBoxMorph class>>confirm:orExtraValue:label:title:at: (in category '*VMMakerUI-user interface') -----
+ confirm: aString orExtraValue: extraValue label: extraLabel title: titleString at: aPointOrNil
+
+ (self new
+ title: titleString;
+ message: aString;
+ createButton: 'Yes' translated value: true;
+ createButton: 'No' translated  value: false;
+ createButton: extraLabel translated value: extraValue;
+ selectedButtonIndex: 1; "YES"
+ registerKeyboardShortcuts;
+ yourself) in:
+ [:dialog |
+ ^ aPointOrNil
+ ifNil: [dialog getUserResponseAtHand]
+ ifNotNil: [
+ dialog preferredPosition: aPointOrNil.
+ dialog getUserResponse]]!