The Trunk: ST80-mt.239.mcz

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

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

Name: ST80-mt.239
Author: mt
Time: 17 September 2019, 12:12:30.366406 pm
UUID: 12ae2d50-f913-044f-b35b-cf68e0c69165
Ancestors: ST80-mt.238

Refactoring of process debugging. Complements System-mt.1093

=============== Diff against ST80-mt.238 ===============

Item was removed:
- ----- Method: Debugger class>>context: (in category '*ST80-instance creation') -----
- context: aContext
- "Answer an instance of me for debugging the active process starting with the given context."
- ^ self new
- process: Processor activeProcess
- controller: (ScheduledControllers
- ifNotNil: [:sc |
- "this means we are in an MVC project"
- sc inActiveControllerProcess
- ifTrue: [ScheduledControllers activeController]])
- context: aContext!

Item was removed:
- ----- Method: Debugger class>>mvcOpenOn:context:label:contents:fullView: (in category '*ST80-opening') -----
- mvcOpenOn: 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."
-
- | controller debugger |
- controller := ScheduledControllers activeControllerProcess == process
- ifTrue: [ScheduledControllers activeController].
- [Preferences logDebuggerStackToFile
- ifTrue: [Smalltalk logSqueakError: title inContext: context]] on: Error do: [:ex | ex return: nil].
- [debugger := self new
- process: process
- controller: controller
- context: context.
- bool
- ifTrue: [debugger openFullNoSuspendLabel: title]
- ifFalse: [debugger openNotifierContents: contentsStringOrNil label: title].
- ] on: Error do: [:ex |
- self primitiveError: 'Original error: ' , title asString , '.
- Debugger error: ' , ([ex description]
- on: Error
- do: ['a ' , ex class printString]) , ':'].
- process suspend!

Item was removed:
- ----- Method: Debugger>>mvcResumeProcess: (in category '*ST80-opening') -----
- mvcResumeProcess: aTopView
-
- aTopView erase.
- savedCursor
- ifNotNil: [Cursor currentCursor: savedCursor].
- interruptedProcess isTerminated ifFalse: [
- ScheduledControllers activeControllerNoTerminate: interruptedController andProcess: interruptedProcess].
- "if old process was terminated, just terminate current one"
- interruptedProcess := nil. "Before delete, so release doesn't terminate it"
- aTopView controller closeAndUnscheduleNoErase.
- Smalltalk installLowSpaceWatcher. "restart low space handler"
- Processor terminateActive
- !

Item was added:
+ Debugger subclass: #MVCDebugger
+ instanceVariableNames: 'interruptedController'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ST80-Support'!

Item was added:
+ ----- Method: MVCDebugger class>>openInterrupt:onProcess: (in category 'opening') -----
+ openInterrupt: aString onProcess: interruptedProcess
+ "Open a notifier in response to an interrupt. An interrupt occurs when the user types the interrupt key (cmd-. on Macs, ctrl-c or alt-. on other systems) or when the low-space watcher detects that memory is low."
+
+ | debugger |
+ <primitive: 19> "Simulation guard"
+ debugger := self new.
+ debugger
+ process: interruptedProcess
+ controller: (ScheduledControllers inActiveControllerProcess == interruptedProcess
+ ifTrue: [ScheduledControllers activeController])
+ context: interruptedProcess suspendedContext.
+ debugger externalInterrupt: true.
+
+ Preferences logDebuggerStackToFile ifTrue:
+ [(aString includesSubstring: 'Space') & (aString includesSubstring: 'low')
+ ifTrue: [Smalltalk logError: aString inContext: debugger interruptedContext to: 'LowSpaceDebug.log']
+ "logging disabled for 4.3 release, see
+ http://lists.squeak.org/pipermail/squeak-dev/2011-December/162503.html"
+ "ifFalse: [Smalltalk logSqueakError: aString inContext: debugger interruptedContext]"].
+
+ Preferences eToyFriendly ifTrue: [Project current world stopRunningAll].
+ ^debugger
+ openNotifierContents: nil label: aString;
+ yourself
+ !

Item was added:
+ ----- Method: MVCDebugger 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."
+
+ | controller debugger |
+ controller := ScheduledControllers activeControllerProcess == process
+ ifTrue: [ScheduledControllers activeController].
+ [Preferences logDebuggerStackToFile
+ ifTrue: [Smalltalk logSqueakError: title inContext: context]] on: Error do: [:ex | ex return: nil].
+ [debugger := self new
+ process: process
+ controller: controller
+ context: context.
+ bool
+ ifTrue: [debugger openFullNoSuspendLabel: title]
+ ifFalse: [debugger openNotifierContents: contentsStringOrNil label: title].
+ ] on: Error do: [:ex |
+ self primitiveError: 'Original error: ' , title asString , '.
+ Debugger error: ' , ([ex description]
+ on: Error
+ do: ['a ' , ex class printString]) , ':'].
+ process suspend!

Item was added:
+ ----- Method: MVCDebugger class>>openOnMethod:forReceiver:inContext: (in category 'opening') -----
+ openOnMethod: aCompiledMethod forReceiver: anObject inContext: aContextOrNil
+
+ | guineaPig debugger debuggerWindow context |
+ guineaPig :=
+ [aCompiledMethod
+ valueWithReceiver: anObject
+ arguments: (aContextOrNil ifNil: [ #() ] ifNotNil: [ { aContextOrNil } ]).
+ guineaPig := nil "spot the return from aCompiledMethod"] newProcess.
+ context := guineaPig suspendedContext.
+ debugger := self new
+ process: guineaPig
+ controller: (ScheduledControllers inActiveControllerProcess ifTrue:
+ [ScheduledControllers activeController])
+ context: context.
+ debuggerWindow := debugger openFullNoSuspendLabel: 'Debug it'.
+ "Now step into the expression.  But if it is quick (is implemented as a primtiive, e.g. `0')
+ it will return immediately back to the block that is sent newProcess above.  Guard
+ against that with the check for home being thisContext."
+ [debugger interruptedContext method == aCompiledMethod]
+ whileFalse:
+ [(guineaPig isNil
+  and: [debugger interruptedContext home == thisContext]) ifTrue:
+ [debuggerWindow controller closeAndUnschedule.
+ UIManager default inform: 'Nothing to debug; expression is optimized'.
+ ^self].
+ debugger send]!

Item was added:
+ ----- Method: MVCDebugger>>context: (in category 'initialize') -----
+ context: aContext
+
+ self
+ process: Processor activeProcess
+ controller: (ScheduledControllers inActiveControllerProcess
+ ifTrue: [ScheduledControllers activeController])
+ context: aContext.!

Item was added:
+ ----- Method: MVCDebugger>>process:controller:context: (in category 'initialize') -----
+ process: aProcess controller: aController context: aContext
+
+ self process: aProcess context: aContext.
+
+ interruptedController := aController.!

Item was added:
+ ----- Method: MVCDebugger>>resumeProcess: (in category 'private') -----
+ resumeProcess: aTopView
+
+ aTopView erase.
+ savedCursor
+ ifNotNil: [Cursor currentCursor: savedCursor].
+ interruptedProcess isTerminated ifFalse: [
+ ScheduledControllers activeControllerNoTerminate: interruptedController andProcess: interruptedProcess].
+ "if old process was terminated, just terminate current one"
+ interruptedProcess := nil. "Before delete, so release doesn't terminate it"
+ aTopView controller closeAndUnscheduleNoErase.
+ Smalltalk installLowSpaceWatcher. "restart low space handler"
+ Processor terminateActive
+ !

Item was added:
+ ----- Method: MVCDebugger>>windowIsClosing (in category 'initialize') -----
+ windowIsClosing
+
+ super windowIsClosing.
+
+ interruptedController := nil.!

Item was changed:
+ ----- Method: MVCProject>>addDeferredUIMessage: (in category 'scheduling & debugging') -----
- ----- Method: MVCProject>>addDeferredUIMessage: (in category 'scheduling') -----
  addDeferredUIMessage: valuableObject
  "Arrange for valuableObject to be evaluated at a time when the user interface
  is in a coherent state."
 
  world activeController
  ifNotNil: [:controller | controller addDeferredUIMessage: valuableObject]!

Item was removed:
- ----- Method: MVCProject>>debugMethod:forReceiver:inContext: (in category 'debugging') -----
- debugMethod: aCompiledMethod forReceiver: anObject inContext: aContextOrNil
-
- | guineaPig debugger debuggerWindow context |
- guineaPig :=
- [aCompiledMethod
- valueWithReceiver: anObject
- arguments: (aContextOrNil ifNil: [ #() ] ifNotNil: [ { aContextOrNil } ]).
- guineaPig := nil "spot the return from aCompiledMethod"] newProcess.
- context := guineaPig suspendedContext.
- debugger := Debugger new
- process: guineaPig
- controller: (world inActiveControllerProcess ifTrue:
- [world activeController])
- context: context.
- debuggerWindow := debugger openFullNoSuspendLabel: 'Debug it'.
- "Now step into the expression.  But if it is quick (is implemented as a primtiive, e.g. `0')
- it will return immediately back to the block that is sent newProcess above.  Guard
- against that with the check for home being thisContext."
- [debugger interruptedContext method == aCompiledMethod]
- whileFalse:
- [(guineaPig isNil
-  and: [debugger interruptedContext home == thisContext]) ifTrue:
- [debuggerWindow controller closeAndUnschedule.
- UIManager default inform: 'Nothing to debug; expression is optimized'.
- ^self].
- debugger send]!

Item was added:
+ ----- Method: MVCProject>>debuggerClass (in category 'scheduling & debugging') -----
+ debuggerClass
+
+ ^ Smalltalk classNamed: #MVCDebugger!

Item was changed:
+ ----- Method: MVCProject>>interruptName: (in category 'scheduling & debugging') -----
- ----- Method: MVCProject>>interruptName: (in category 'utilities') -----
  interruptName: labelString
  "Create a Notifier on the active scheduling process with the given label. Make the Notifier the active controller."
 
  ^ self
  interruptName: labelString
  preemptedProcess: self uiProcess!

Item was changed:
+ ----- Method: MVCProject>>interruptName:preemptedProcess: (in category 'scheduling & debugging') -----
- ----- Method: MVCProject>>interruptName:preemptedProcess: (in category 'utilities') -----
  interruptName: labelString preemptedProcess: theInterruptedProcess
  "Create a Notifier on the interrupted process with the given label. Make the Notifier the active controller."
 
  theInterruptedProcess suspend.
 
  (world activeController ~~ nil and: [world activeController ~~ world screenController]) ifTrue: [
  theInterruptedProcess == self uiProcess
  ifTrue: [
  "Carefully de-emphasis the current window."
  world activeController view topView deEmphasizeForDebugger]
  ifFalse: [
  world activeController controlTerminate]].
 
  "This will just scheduleNoTerminate the newly built controller"
+ ToolSet
+ debugInterruptedProcess: theInterruptedProcess
+ label: labelString.
- Debugger
- openInterrupt: labelString
- onProcess: theInterruptedProcess.
 
  world searchForActiveController.!

Item was added:
+ ----- Method: MVCProject>>syntaxError: (in category 'scheduling & debugging') -----
+ syntaxError: aSyntaxErrorNotification
+
+ super syntaxError: aSyntaxErrorNotification.
+ Cursor normal show.
+ Processor activeProcess suspend.!

Item was removed:
- ----- Method: SyntaxError class>>buildMVCViewOn: (in category '*ST80-Support') -----
- buildMVCViewOn: aSyntaxError
- "Answer an MVC view on the given SyntaxError."
-
- | topView aListView aCodeView |
- topView := StandardSystemView new
- model: aSyntaxError;
- label: 'Syntax Error';
- minimumSize: 380@220.
-
- aListView := PluggableListView on: aSyntaxError
- list: #list
- selected: #listIndex
- changeSelected: nil
- menu: #listMenu:.
- aListView window: (0@0 extent: 380@20).
- topView addSubView: aListView.
-
- aCodeView := PluggableTextView on: aSyntaxError
- text: #contents
- accept: #contents:notifying:
- readSelection: #contentsSelection
- menu: #codePaneMenu:shifted:.
- aCodeView window: (0@0 extent: 380@200).
- topView addSubView: aCodeView below: aListView.
-
- ^ topView
- !

Item was removed:
- ----- Method: SyntaxError class>>mvcOpen: (in category '*ST80-Support') -----
- mvcOpen: aSyntaxError
- "Answer a standard system view whose model is an instance of me."
-
- | topView |
- topView := self buildMVCViewOn: aSyntaxError.
- topView controller openNoTerminateDisplayAt: Display extent // 2.
- Cursor normal show.
- Processor activeProcess suspend
- !