The Trunk: Tools-mt.892.mcz

Marcel Taeumel uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-mt.892.mcz

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

Name: Tools-mt.892
Author: mt
Time: 17 September 2019, 12:11:05.849406 pm
UUID: 73ccd884-b6b6-4c48-8912-09b6c911ac8e
Ancestors: Tools-mt.891

Refactoring of process debugging. Complements System-mt.1093

=============== Diff against Tools-mt.891 ===============

Item was changed:
  CodeHolder subclass: #Debugger
+ instanceVariableNames: 'interruptedProcess contextStack contextStackIndex contextStackList receiverInspector contextVariablesInspector externalInterrupt proceedValue selectingPC savedCursor isolationHead failedProject labelString message untilExpression'
- instanceVariableNames: 'interruptedProcess interruptedController contextStack contextStackIndex contextStackList receiverInspector contextVariablesInspector externalInterrupt proceedValue selectingPC savedCursor isolationHead failedProject errorWasInUIProcess labelString message untilExpression'
  classVariableNames: 'ContextStackKeystrokes ErrorRecursion ErrorRecursionGuard ErrorReportServer InterruptUIProcessIfBlockedOnErrorInBackgroundProcess SavedExtent WantsAnnotationPane'
  poolDictionaries: ''
  category: 'Tools-Debugger'!
 
  !Debugger commentStamp: '<historical>' prior: 0!
  I represent the machine state at the time of an interrupted process. I also represent a query path into the state of the process. The debugger is typically viewed through a window that views the stack of suspended contexts, the code for, and execution point in, the currently selected message, and inspectors on both the receiver of the currently selected message, and the variables in the current context.
 
  Special note on recursive errors:
  Some errors affect Squeak's ability to present a debugger.  This is normally an unrecoverable situation.  However, if such an error occurs in an isolation layer, Squeak will attempt to exit from the isolation layer and then present a debugger.  Here is the chain of events in such a recovery.
 
  * A recursive error is detected.
  * The current project is queried for an isolationHead
  * Changes in the isolationHead are revoked
  * The parent project of isolated project is returned to
  * The debugger is opened there and execution resumes.
 
  If the user closes that debugger, execution continues in the outer project and layer.  If, after repairing some damage, the user proceeds from the debugger, then the isolationHead is re-invoked, the failed project is re-entered, and execution resumes in that world. !

Item was changed:
  ----- Method: Debugger class>>informExistingDebugger:label: (in category 'instance creation') -----
  informExistingDebugger: aContext label: aString
  "Walking the context chain, we try to find out if we're in a debugger stepping situation.
  If we find the relevant contexts, we must rearrange them so they look just like they would
  if the methods were executed outside of the debugger.
  hmm 8/3/2001 13:05"
  | ctx quickStepMethod oldSender baseContext |
  ctx := thisContext.
  quickStepMethod := Context
  compiledMethodAt: #quickSend:to:with:lookupIn:
  ifAbsent: [Context compiledMethodAt: #quickSend:to:with:super:].
  [ctx sender == nil or: [ctx sender method == quickStepMethod]] whileFalse:
  [ctx := ctx sender].
  ctx sender ifNil: [^self].
  baseContext := ctx.
  "baseContext is now the context created by the #quickSend... method."
  oldSender := ctx := ctx sender home sender.
  "oldSender is the context which originally sent the #quickSend... method"
  [ctx == nil or: [(ctx objectClass: ctx receiver) includesBehavior: self]] whileFalse:
  [ctx := ctx sender].
  ctx ifNil: [^self].
  "ctx is the context of the Debugger method #doStep"
  ctx receiver
  labelString: aString;
  externalInterrupt: false;
  proceedValue: aContext receiver.
  baseContext swapSender: baseContext sender sender sender. "remove intervening contexts"
  thisContext swapSender: oldSender. "make myself return to debugger"
+ ^ aContext!
- ErrorRecursion := false.
- ^aContext!

Item was added:
+ ----- Method: Debugger class>>openInterrupt:onProcess: (in category 'opening') -----
+ openInterrupt: aString onProcess: interruptedProcess
+
+ ^ Project current debuggerClass
+ openInterrupt: aString onProcess: interruptedProcess!

Item was changed:
  ----- Method: Debugger class>>openOn:context:label:contents:fullView: (in category 'opening') -----
  openOn: process context: context label: title contents: contentsStringOrNil fullView: bool
- "Open a notifier in response to an error, halt, or notify. A notifier view just shows a short
- view of the sender stack and provides a menu that lets the user open a full debugger.
- Dispatch the request to a method appropriate for the active project.
- The two versions for mvc & morphic are very close and can surely be merged so that this can be simplified"
 
+ ^ Project current debuggerClass
+ openOn: process context: context label: title contents: contentsStringOrNil fullView: bool!
- ^ Project uiManager openDebugger: self on: process context: context label: title contents: contentsStringOrNil fullView: bool
- !

Item was added:
+ ----- Method: Debugger class>>openOnMethod:forReceiver:inContext: (in category 'opening') -----
+ openOnMethod: aCompiledMethod forReceiver: anObject inContext: aContextOrNil
+
+ ^ Project current debuggerClass
+ openOnMethod: aCompiledMethod forReceiver: anObject inContext: aContextOrNil!

Item was added:
+ ----- Method: Debugger>>context: (in category 'initialize') -----
+ context: aContext
+
+ self
+ process: Processor activeProcess
+ context: aContext.!

Item was removed:
- ----- Method: Debugger>>errorWasInUIProcess: (in category 'initialize') -----
- errorWasInUIProcess: boolean
-
- errorWasInUIProcess := boolean!

Item was added:
+ ----- Method: Debugger>>initialize (in category 'initialize') -----
+ initialize
+
+ super initialize.
+
+ Smalltalk at: #MessageTally ifPresentAndInMemory: [ :tally |
+ tally terminateTimerProcess].
+
+ externalInterrupt := false.
+ selectingPC := true.!

Item was changed:
  ----- Method: Debugger>>openNotifierContents:label: (in category 'initialize') -----
  openNotifierContents: msgString label: label
  "Create, schedule and answer a notifier view with the given label and message. A notifier view shows just the message or the first several lines of the stack, with a menu that allows the user to open a full debugger if so desired."
  "NOTE: When this method returns, a new process has been scheduled to run the windows, and thus this notifier, but the previous active process has not been suspended.  The sender will do this."
  | msg builder spec |
 
  Sensor flushKeyboard.
  savedCursor := Cursor currentCursor.
  Cursor currentCursor: Cursor normal.
  msg := (label beginsWith: 'Space is low')
  ifTrue: [self lowSpaceChoices, (msgString ifNil: [String empty])]
  ifFalse: [msgString].
  builder := ToolBuilder default.
  spec := self buildNotifierWith: builder label: label message: msg.
  self expandStack.
+ ^ builder openDebugger: spec!
- ^[builder openDebugger: spec] ensure:
- [errorWasInUIProcess := Project current spawnNewProcessIfThisIsUI: interruptedProcess]
- !

Item was added:
+ ----- Method: Debugger>>process:context: (in category 'initialize') -----
+ process: aProcess context: aContext
+
+ interruptedProcess := aProcess.
+
+ self newStack: (aContext stackOfSize: 1).
+ contextStackIndex := 1.!

Item was removed:
- ----- Method: Debugger>>process:controller:context: (in category 'private') -----
- process: aProcess controller: aController context: aContext
-
- super initialize.
- Smalltalk at: #MessageTally ifPresentAndInMemory: [ :tally |
- tally terminateTimerProcess].
- contents := nil.
- interruptedProcess := aProcess.
- interruptedController := aController.
- self newStack: (aContext stackOfSize: 1).
- contextStackIndex := 1.
- externalInterrupt := false.
- selectingPC := true.
- Smalltalk isMorphic ifTrue:
- [errorWasInUIProcess := false]!

Item was changed:
  ----- Method: Debugger>>resumeProcess: (in category 'private') -----
  resumeProcess: aTopView
+ "Close this debugger's view and resume the process."
+
+ interruptedProcess resume.!
-
- ^ Project uiManager resumeDebugger: self process: aTopView!

Item was changed:
  ----- Method: Debugger>>windowIsClosing (in category 'initialize') -----
  windowIsClosing
+ "My window is being closed; clean up. Restart the low space watcher."
+
+ interruptedProcess == nil ifTrue: [^ self].
- "My window is being closed; if debugging save its extent.  Clean up.  Restart the low space watcher."
- interruptedProcess ifNil: [ ^ self ].
- SavedExtent ifNotNil:
- [ self dependents
- detect:
- [ : each | each isWindowForModel: self ]
- ifFound:
- [ : topWindow | | isDebuggerNotNotifier |
- isDebuggerNotNotifier := self dependents anySatisfy:
- [ : each | each isTextView ].
- isDebuggerNotNotifier ifTrue: [
- SavedExtent := (topWindow extent / RealEstateAgent scaleFactor) rounded ] ]
- ifNone: [ "do nothing" ] ].
  interruptedProcess terminate.
+ interruptedProcess := nil.
+
+ contextStack := nil.
+ receiverInspector := nil.
+ contextVariablesInspector := nil.
+ Smalltalk installLowSpaceWatcher.  "restart low space handler"
+ !
- interruptedProcess := interruptedController := contextStack := receiverInspector := contextVariablesInspector := nil.
- "Restart low space watcher."
- Smalltalk installLowSpaceWatcher!

Item was removed:
- ----- Method: StandardToolSet class>>debug:context:label:contents:fullView: (in category 'debugging') -----
- debug: aProcess context: aContext label: aString contents: contents fullView: aBool
- "Open a debugger on the given process and context."
- ^Debugger openOn: aProcess context: aContext label: aString contents: contents fullView: aBool!

Item was removed:
- ----- Method: StandardToolSet class>>debugContext:label:contents: (in category 'debugging') -----
- debugContext: aContext label: aString contents: contents
- "Open a debugger on the given process and context."
- ^Debugger openContext: aContext label: aString contents: contents!

Item was removed:
- ----- Method: StandardToolSet class>>debugError: (in category 'debugging') -----
- debugError: anError
- "Handle an otherwise unhandled error"
- ^Processor activeProcess
- debug: anError signalerContext
- title: anError description!

Item was added:
+ ----- Method: StandardToolSet class>>debugInterruptedProcess:label: (in category 'debugging') -----
+ debugInterruptedProcess: aSuspendedProcess label: aString
+
+ ^ Debugger
+ openInterrupt: aString
+ onProcess: aSuspendedProcess!

Item was changed:
  ----- Method: StandardToolSet class>>debugMethod:forReceiver:inContext: (in category 'debugging') -----
  debugMethod: aCompiledMethod forReceiver: anObject inContext: aContext
 
+ ^ Debugger
+ openOnMethod: aCompiledMethod
+ forReceiver: anObject
+ inContext: aContext!
- ^ Project current debugMethod: aCompiledMethod forReceiver: anObject inContext: aContext!

Item was added:
+ ----- Method: StandardToolSet class>>debugProcess:context:label:contents:fullView: (in category 'debugging') -----
+ debugProcess: aProcess context: aContext label: aString contents: contents fullView: aBool
+
+ ^ Debugger
+ openOn: aProcess
+ context: aContext
+ label: aString
+ contents: contents
+ fullView: aBool!

Item was changed:
  ----- Method: StandardToolSet class>>debugSyntaxError: (in category 'debugging') -----
  debugSyntaxError: aSyntaxErrorNotification
+
+ ^ SyntaxError open: aSyntaxErrorNotification!
- "Handle a syntax error"
- | notifier |
- notifier :=  SyntaxError new setNotification: aSyntaxErrorNotification.
- SyntaxError open: notifier.!

Item was added:
+ ----- Method: StandardToolSet class>>handleError: (in category 'debugging - handlers') -----
+ handleError: anError
+ "Double dispatch. Let the active process take care of that error, which usually calls back here to #debugProcess:..."
+
+ ^ Processor activeProcess
+ debug: anError signalerContext
+ title: anError description!

Item was added:
+ ----- Method: StandardToolSet class>>handleSyntaxError: (in category 'debugging - handlers') -----
+ handleSyntaxError: aSyntaxErrorNotification
+ "Double dispatch. Let the current project manage processes, which usually calls back into #debugSyntaxError:."
+
+ ^ Project current syntaxError: aSyntaxErrorNotification!

Item was added:
+ ----- Method: StandardToolSet class>>handleUserInterruptRequest: (in category 'debugging - handlers') -----
+ handleUserInterruptRequest: aString
+ "Double dispatch. Let the current project manage processes, which usually calls back here into #debugInterruptedProcess:label:."
+
+ ^ Project current interruptName: aString!

Item was added:
+ ----- Method: StandardToolSet class>>handleWarning: (in category 'debugging - handlers') -----
+ handleWarning: aWarning
+ "Double dispatch. Let the active process take care of that warning, which usually calls back here to #debugProcess:..."
+
+ ^ Processor activeProcess
+ debug: aWarning signalerContext
+ title: 'Warning' translated
+ full: false
+ contents: aWarning messageText , '\\Select Proceed to continue, or close this window to cancel the operation.' withCRs translated!

Item was removed:
- ----- Method: StandardToolSet class>>interrupt:label: (in category 'debugging') -----
- interrupt: aProcess label: aString
- "Open a debugger on the given process and context."
- Debugger
- openInterrupt: aString
- onProcess: aProcess!

Item was changed:
  ----- Method: SyntaxError class>>open: (in category 'instance creation') -----
+ open: aSyntaxErrorNotification
- open: aSyntaxError
- "Answer a standard system view whose model is an instance of me."
 
+ ^ ToolBuilder default openDebugger: (self new setNotification: aSyntaxErrorNotification; yourself)!
- <primitive: 19> "Simulation guard"
- ^ Project uiManager openSyntaxError: aSyntaxError
- !

Item was added:
+ ----- Method: SyntaxError>>buildWith: (in category 'toolbuilder') -----
+ buildWith: builder
+
+ | windowSpec listSpec textSpec |
+ windowSpec := builder pluggableWindowSpec new
+ model: self;
+ label: 'Syntax Error';
+ children: OrderedCollection new.
+
+ listSpec := builder pluggableListSpec new.
+ listSpec
+ model: self;
+ list: #list;
+ getIndex: #listIndex;
+ setIndex: nil;
+ menu: #listMenu:;
+ frame: (0@0 corner: 1@0.15).
+ windowSpec children add: listSpec.
+
+ textSpec := builder pluggableCodePaneSpec new.
+ textSpec
+ model: self;
+ getText: #contents;
+ setText: #contents:notifying:;
+ selection: #contentsSelection;
+ menu: #codePaneMenu:shifted:;
+ frame: (0@0.15 corner: 1@1).
+ windowSpec children add: textSpec.
+
+ ^ builder build: windowSpec!

Item was added:
+ ----- Method: SyntaxError>>contentsSelection (in category 'accessing') -----
+ contentsSelection
+
+ ^ notification ifNil: [1 to: 0] ifNotNil: [self errorMessageInterval]!

Item was added:
+ ----- Method: SyntaxError>>debugger (in category 'accessing') -----
+ debugger
+
+ ^ debugger!

Item was added:
+ ----- Method: SyntaxError>>initialExtent (in category 'initialize-release') -----
+ initialExtent
+
+ ^ 380@220!

Item was changed:
  ----- Method: SyntaxError>>setNotification: (in category 'accessing') -----
  setNotification: aSyntaxErrorNotification
 
  | types printables badChar code |
  notification := aSyntaxErrorNotification.
  class := aSyntaxErrorNotification errorClass.
+
+ debugger := Project current debuggerClass new.
+ debugger context: aSyntaxErrorNotification signalerContext.
+
- debugger := Debugger context: aSyntaxErrorNotification signalerContext.
  code := aSyntaxErrorNotification errorCode.
  selector := class newParser parseSelector: code.
  types := Scanner classPool at: #TypeTable. "dictionary"
  printables := '!!@#$%&*-_=+<>{}?/\,·£¢§¶ªº–—“‘”’…Úæگ׿«»`~`' asSet.
  badChar := code detect: [:aChar | (types at: aChar asciiValue ifAbsent: [#xLetter]) == #xBinary and: [
  (printables includes: aChar) not]] ifNone: [nil].
  contents := badChar
  ifNil: [code]
  ifNotNil: ['<<<This string contains a character (ascii value ',
  badChar asciiValue printString,
+ ') that is not normally used in code>>> ', code].
+
+ self changed: #contentsSelection.!
- ') that is not normally used in code>>> ', code].!