The Trunk: Tools-mt.900.mcz

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

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

Name: Tools-mt.900
Author: mt
Time: 7 October 2019, 10:09:09.503231 am
UUID: 800dfa54-5ba0-1041-9bc5-add91e495ce9
Ancestors: Tools-ul.899

Complements System-mt.1112, which fixes and clean-up in the debugger infrastructure.

=============== Diff against Tools-ul.899 ===============

Item was changed:
  CodeHolder subclass: #Debugger
  instanceVariableNames: 'interruptedProcess contextStack contextStackIndex contextStackList receiverInspector contextVariablesInspector externalInterrupt proceedValue selectingPC savedCursor isolationHead failedProject labelString message untilExpression'
+ classVariableNames: 'ContextStackKeystrokes ErrorReportServer FullStackSize InterruptUIProcessIfBlockedOnErrorInBackgroundProcess NotifierStackSize SavedExtent StackSizeLimit WantsAnnotationPane'
- classVariableNames: 'ContextStackKeystrokes ErrorRecursion ErrorRecursionGuard ErrorReportServer FullStackSize InterruptUIProcessIfBlockedOnErrorInBackgroundProcess NotifierStackSize SavedExtent StackSizeLimit 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 removed:
- ----- Method: Debugger class>>clearErrorRecursion (in category 'error recursion') -----
- clearErrorRecursion
- ErrorRecursion := false.!

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!

Item was changed:
  ----- Method: Debugger class>>initialize (in category 'class initialization') -----
  initialize
- ErrorRecursion := false.
- ErrorRecursionGuard := Mutex new.
  ContextStackKeystrokes := Dictionary new
  at: $e put: #send;
  at: $t put: #doStep;
  at: $T put: #stepIntoBlock;
  at: $p put: #proceed;
  at: $r put: #restart;
  at: $f put: #fullStack;
  at: $w put: #where;
  yourself.
  SavedExtent := self new initialExtent
 
  "Debugger initialize"!

Item was removed:
- ----- Method: Debugger class>>lowSpaceChoices (in category 'private') -----
- lowSpaceChoices
- "Return a notifier message string to be presented when space is running low."
-
- ^ 'Warning!! Squeak is almost out of memory!!
-
- Low space detection is now disabled. It will be restored when you close or proceed from this error notifier. Don''t panic, but do proceed with caution.
-
- Here are some suggestions:
-
-  If you suspect an infinite recursion (the same methods calling each other again and again), then close this debugger, and fix the problem.
-
-  If you want this computation to finish, then make more space available (read on) and choose "proceed" in this debugger. Here are some ways to make more space available...
-    > Close any windows that are not needed.
-    > Get rid of some large objects (e.g., images).
-    > Leave this window on the screen, choose "save as..." from the screen menu, quit, restart the Squeak VM with a larger memory allocation, then restart the image you just saved, and choose "proceed" in this window.
-
-  If you want to investigate further, choose "debug" in this window.  Do not use the debugger "fullStack" command unless you are certain that the stack is not very deep. (Trying to show the full stack will definitely use up all remaining memory if the low-space problem is caused by an infinite recursion!!).
-
- '
- !

Item was removed:
- ----- 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
+ "Kind of private. Open a notifier or a full debugger in response to an error, halt, or notify. Opens a project-specific debugger. Decorates that invocation with (1) recursive-error detection and (2) error logging, which are both independent from the active GUI framework, that is, MVC or Morphic.
+
+ Note that clients should debug processes through Process >> #debug instead of calling this method directly."
 
+ | ap |
+ ap := Processor activeProcess.
+
+ "If the active process re-enters this method again, something went wrong with invoking the debugger."
+ ap hasRecursiveError ifTrue: [
+ ap clearErrorRecursionFlag.
+ ^ ToolSet handleRecursiveError: title].
+
+ "Explicitely handle logging exceptions. No need to bother the recursion mechanism here."
+ [Preferences logDebuggerStackToFile
+ ifTrue: [Smalltalk logSqueakError: title inContext: context]
+ ] on: Error do: [:ex |
+ Preferences disable: #logDebuggerStackToFile.
+ ToolSet debugException: ex].
+
+ "If project-specific debuggers mess up, we have to flag that recursion here. Se above."
+ [ap setErrorRecursionFlag.
+
+ self informExistingDebugger: context label: title.
+
+ ^ Project current debuggerClass
+ openOn: process context: context label: title contents: contentsStringOrNil fullView: bool
+
+ ] ensure: [ap clearErrorRecursionFlag].!
- ^ Project current debuggerClass
- openOn: process context: context label: title contents: contentsStringOrNil fullView: bool!

Item was removed:
- ----- 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 removed:
- ----- Method: Debugger class>>setErrorRecursion (in category 'error recursion') -----
- setErrorRecursion
- ErrorRecursion := true.!

Item was changed:
  ----- Method: Debugger>>abandon (in category 'context stack menu') -----
  abandon
  "abandon the debugger from its pre-debug notifier"
+
+ self close.!
- self abandon: self topView!

Item was removed:
- ----- Method: Debugger>>abandon: (in category 'context stack menu') -----
- abandon: aTopView
- "abandon the notifier represented by aTopView"
-
- self subclassResponsibility.!

Item was changed:
  ----- Method: Debugger>>buildNotifierWith:label:message: (in category 'toolbuilder') -----
  buildNotifierWith: builder label: label message: messageString
  | windowSpec listSpec textSpec panelSpec quads |
  windowSpec := builder pluggableWindowSpec new
  model: self;
  extent: self initialExtentForNotifier;
  label: label;
  children: OrderedCollection new.
 
  panelSpec := builder pluggablePanelSpec new.
  panelSpec children: OrderedCollection new.
  quads := self preDebugButtonQuads.
  (self interruptedContext selector == #doesNotUnderstand:) ifTrue: [
  quads := quads copyWith:
  { 'Create'. #createMethod. #magenta. 'create the missing method' }
  ].
  (#(#notYetImplemented #shouldBeImplemented #requirement) includes: self interruptedContext selector) ifTrue: [
  quads := quads copyWith:
  { 'Create'. #createImplementingMethod. #magenta. 'implement the marked method' }
  ].
  (self interruptedContext selector == #subclassResponsibility) ifTrue: [
  quads := quads copyWith:
  { 'Create'. #createOverridingMethod. #magenta. 'create the missing overriding method' }
  ].
  quads do:[:spec| | buttonSpec |
  buttonSpec := builder pluggableButtonSpec new.
  buttonSpec model: self.
  buttonSpec label: spec first.
  buttonSpec action: spec second.
  buttonSpec help: spec fourth.
+ spec size >= 5 ifTrue: [buttonSpec enabled: spec fifth].
  panelSpec children add: buttonSpec.
  ].
  panelSpec layout: #horizontal. "buttons"
  panelSpec frame: self preDebugButtonQuadFrame.
  windowSpec children add: panelSpec.
 
  Preferences eToyFriendly | messageString notNil ifFalse:[
  listSpec := builder pluggableListSpec new.
  listSpec
  model: self;
  list: #contextStackList;
  getIndex: #contextStackIndex;
  setIndex: #debugAt:;
  icon: #messageIconAt:;
  helpItem: #messageHelpAt:;
  frame: self contextStackFrame.
  windowSpec children add: listSpec.
  ] ifTrue:[
  message := messageString.
  textSpec := builder pluggableTextSpec new.
  textSpec
  model: self;
  getText: #preDebugMessageString;
  setText: nil;
  selection: nil;
  menu: #debugProceedMenu:;
  frame: self contextStackFrame.
  windowSpec children add: textSpec.
  ].
 
  ^windowSpec!

Item was added:
+ ----- Method: Debugger>>close (in category 'initialize') -----
+ close
+ "Close and delete this debugger. Try to trigger the close request through the UI first, do manually of not in the UI."
+
+ self flag: #refactor. "mt: Maybe move this up to model?"
+ self topView
+ ifNotNil: [self changed: #close]
+ ifNil: [
+ self okToClose ifTrue: [
+ self windowIsClosing; release]].!

Item was changed:
  ----- Method: Debugger>>customButtonSpecs (in category 'initialize') -----
  customButtonSpecs
  "Answer an array of elements of the form wording, selector, help-message, that characterize the custom button row of a debugger."
 
  | list |
+ list := #(('Proceed' proceed 'Close the debugger and proceed.' interruptedProcessShouldResume)
+ ('Restart' restart 'Reset this context to its start.')
+ ('Into' stepInto 'step Into message sends' interruptedProcessIsActive)
+ ('Over' stepOver 'step Over message sends' interruptedProcessIsActive)
+ ('Through' stepThrough 'step into a block' interruptedProcessIsActive)
+ ('Full Stack' showFullStack 'show full stack')
+ ('Where' showWhere 'select current pc range')
+ ('Tally It' tally 'evaluate current selection and measure the time')).
+ (Preferences restartAlsoProceeds and: [self interruptedProcessShouldResume]) ifTrue:
- list := #(('Proceed' proceed 'close the debugger and proceed.')
- ('Restart' restart 'reset this context to its start.')
- ('Into' send 'step Into message sends' interruptedProcessIsActive)
- ('Over' doStep 'step Over message sends' interruptedProcessIsActive)
- ('Through' stepIntoBlock 'step into a block' interruptedProcessIsActive)
- ('Full Stack' fullStack 'show full stack')
- ('Where' where 'select current pc range')
- ('Tally' tally 'time in milliseconds to execute')).
- Preferences restartAlsoProceeds ifTrue:
  [list := list collect: [:each |
  each second == #restart
+ ifTrue: [each copy
+ at: 1 put: 'Proceed Here';
+ at: 3 put: 'Proceed from the beginning of this context.';
+ yourself]
+ ifFalse: [each second == #proceed
+ ifTrue: [each copy
+ at: 1 put: 'Proceed Top';
+ at: 3 put: 'Proceed from the current top context.';
+ yourself]
+ ifFalse: [each]]]].
- ifTrue: [each copy at: 3 put: 'proceed from the beginning of this context.'; yourself]
- ifFalse: [each]]].
  ^ list!

Item was changed:
+ ----- Method: Debugger>>interruptedProcessIsActive (in category 'testing') -----
- ----- Method: Debugger>>interruptedProcessIsActive (in category 'user interface') -----
  interruptedProcessIsActive
  ^interruptedProcess isTerminated not!

Item was added:
+ ----- Method: Debugger>>interruptedProcessShouldResume (in category 'testing') -----
+ interruptedProcessShouldResume
+ ^ interruptedProcess shouldResumeFromDebugger!

Item was added:
+ ----- Method: Debugger>>isFull (in category 'testing') -----
+ isFull
+
+ ^ self isNotifier not!

Item was added:
+ ----- Method: Debugger>>isNotifier (in category 'testing') -----
+ isNotifier
+
+ ^ receiverInspector isNil!

Item was changed:
  ----- Method: Debugger>>preDebugButtonQuads (in category 'initialize') -----
  preDebugButtonQuads
 
  ^Preferences eToyFriendly
  ifTrue: [
  {
  {'Send error report' translated. #sendReport. #blue. 'send a report of the encountered problem to the Squeak developers' translated}.
  {'Abandon' translated. #abandon. #black. 'abandon this execution by closing this window' translated}.
  {'Debug' translated. #debug. #red. 'bring up a debugger' translated}}]
  ifFalse: [
  {
+ {'Proceed' translated. #proceed. #blue. 'continue execution' translated. #interruptedProcessShouldResume}.
- {'Proceed' translated. #proceed. #blue. 'continue execution' translated}.
  {'Abandon' translated. #abandon. #black. 'abandon this execution by closing this window' translated}.
  {'Debug' translated. #debug. #red. 'bring up a debugger' translated}}]
  !

Item was changed:
  ----- Method: Debugger>>proceed (in category 'context stack menu') -----
  proceed
+ "Proceed from the interrupted state of the currently selected context. The argument is the topView of the receiver. That view is closed. The active process usually suspends (or terminates) after this call."
- "Proceed execution of the receiver's model, starting after the expression at
- which an interruption occurred."
 
+ | processToResume canResume |
+
+ Smalltalk okayToProceedEvenIfSpaceIsLow ifFalse: [^ self].
+
+ self okToChange ifFalse: [^ self].
+ self checkContextSelection.
+
+ processToResume := interruptedProcess.
+ canResume := self interruptedProcessShouldResume.
+
+ interruptedProcess := nil. "Before delete, so release doesn't terminate it"
+ self close.
+
+ savedCursor ifNotNil: [Cursor currentCursor: savedCursor].
+ Project current restoreDisplay.
+
+ Smalltalk installLowSpaceWatcher. "restart low space handler"
+
+ canResume
+ ifTrue: [self resumeProcess: processToResume]
+ ifFalse: [self notify: 'This process should not resume.\Debugger will close now.' withCRs].!
- Smalltalk okayToProceedEvenIfSpaceIsLow ifTrue: [
- self proceed: self topView].
- !

Item was removed:
- ----- Method: Debugger>>proceed: (in category 'context stack menu') -----
- proceed: aTopView
- "Proceed from the interrupted state of the currently selected context. The
- argument is the topView of the receiver. That view is closed."
-
- self okToChange ifFalse: [^ self].
- self checkContextSelection.
- self resumeProcess: aTopView!

Item was changed:
  ----- Method: Debugger>>restart (in category 'context stack menu') -----
  restart
  "Proceed from the initial state of the currently selected context. The
  argument is a controller on a view of the receiver. That view is closed."
  "Closing now depends on a preference #restartAlsoProceeds - hmm 9/7/2001 16:46"
 
  | ctxt noUnwindError |
  self okToChange ifFalse: [^ self].
  self checkContextSelection.
  ctxt := interruptedProcess popTo: self selectedContext.
  noUnwindError := false.
  ctxt == self selectedContext ifTrue: [
  noUnwindError := true.
  interruptedProcess restartTop; stepToSendOrReturn].
  self resetContext: ctxt.
+ ((Preferences restartAlsoProceeds
+ and: [noUnwindError])
+ and: [self interruptedProcessShouldResume]) ifTrue: [self proceed].
- (Preferences restartAlsoProceeds and: [noUnwindError]) ifTrue: [self proceed].
  !

Item was changed:
  ----- Method: Debugger>>resumeProcess: (in category 'private') -----
+ resumeProcess: aProcess
+ "Subclusses may override this to avoid having duplicate UI processes."
- resumeProcess: aTopView
- "Close this debugger's view and resume the process."
 
+ aProcess resume.!
- interruptedProcess resume.!

Item was added:
+ ----- Method: Debugger>>showFullStack (in category 'actions - convenience') -----
+ showFullStack
+
+ self fullStack.!

Item was added:
+ ----- Method: Debugger>>showWhere (in category 'actions - convenience') -----
+ showWhere
+ "Select the PC range"
+
+ self where.!

Item was changed:
+ ----- Method: Debugger>>step (in category 'stepping - morphic') -----
- ----- Method: Debugger>>step (in category 'dependents access') -----
  step
  "Update the inspectors."
 
  receiverInspector ifNotNil: [receiverInspector step].
  contextVariablesInspector ifNotNil: [contextVariablesInspector step].
  !

Item was added:
+ ----- Method: Debugger>>stepInto (in category 'actions - convenience') -----
+ stepInto
+
+ self send.!

Item was added:
+ ----- Method: Debugger>>stepOver (in category 'actions - convenience') -----
+ stepOver
+
+ self doStep.!

Item was added:
+ ----- Method: Debugger>>stepThrough (in category 'actions - convenience') -----
+ stepThrough
+
+ self stepIntoBlock.!

Item was changed:
+ ----- Method: Debugger>>updateInspectors (in category 'stepping - morphic') -----
- ----- Method: Debugger>>updateInspectors (in category 'dependents access') -----
  updateInspectors
  "Update the inspectors on the receiver's variables."
 
  receiverInspector == nil ifFalse: [receiverInspector update].
  contextVariablesInspector == nil ifFalse: [contextVariablesInspector update]!

Item was changed:
+ ----- Method: Debugger>>wantsSteps (in category 'stepping - morphic') -----
- ----- Method: Debugger>>wantsSteps (in category 'dependents access') -----
  wantsSteps
   
  ^ true!

Item was added:
+ ----- Method: StandardToolSet class>>debugException: (in category 'debugging') -----
+ debugException: anException
+ "For convenience. Construct a helper process to debug an exception that occurred in the active process later on so that the active process can (try to) resume. Uses a temporary variable to access and copy the signaler context now before it gets GC'ed."
+
+ | helperProcess |
+ helperProcess := (Process
+ forContext: anException signalerContext copyStack
+ priority: Processor activeProcess priority)
+ shouldResumeFromDebugger: false;
+ yourself.
+
+ Project current addDeferredUIMessage: [
+ helperProcess
+ debugWithTitle: anException description
+ full: false].!

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

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

Item was changed:
  ----- Method: StandardToolSet class>>debugProcess:context:label:contents:fullView: (in category 'debugging') -----
  debugProcess: aProcess context: aContext label: aString contents: contents fullView: aBool
 
+ (aProcess isTerminated and: [aString beginsWith: 'Debug it']) ifTrue: [
+ ^ Project uiManager inform: 'Nothing to debug. Process has terminated.\Expression optimized.' withCRs].
+
  ^ Debugger
  openOn: aProcess
  context: aContext
  label: aString
  contents: contents
  fullView: aBool!

Item was added:
+ ----- Method: StandardToolSet class>>handleRecursiveError: (in category 'debugging - handlers') -----
+ handleRecursiveError: description
+
+ ^ Project current recursiveError: description!

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

Item was changed:
  ----- Method: SyntaxError>>proceed (in category 'menu') -----
  proceed
+ "The user has has edited and presumably fixed the syntax error and the filein can now proceed. The active process usually suspends (or terminates) after this call."
- "The user has has edited and presumably fixed the syntax error and the filein can now proceed."
 
+ [debugger proceed]
+ ensure: [self changed: #close].!
- debugger proceed: self topView.
- !