The Trunk: Morphic-mt.1557.mcz

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

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

Name: Morphic-mt.1557
Author: mt
Time: 7 October 2019, 10:10:54.021231 am
UUID: 07c77a57-5636-aa41-9823-4db4fd4ff43f
Ancestors: Morphic-pre.1556

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

=============== Diff against Morphic-pre.1556 ===============

Item was removed:
- ----- Method: MorphicDebugger class>>openDrawingErrors: (in category 'opening') -----
- openDrawingErrors: errors
- "Open debuggers for all different errors found. DO NOT suspend the active process because drawing errors got caught gracefully already to keep the system running. The debuggers are only for exploration."
-
- self setErrorRecursion.
- errors do: [:processToLabel |
- (self new process: processToLabel key context: processToLabel key suspendedContext)
- errorWasInUIProcess: Processor activeProcess = Project current uiProcess;
- openNotifierNoSuspendContents: nil label: processToLabel value].
-
- "Try to draw the debuggers or else there will be no chance to escape from this catch-drawing-error loop."
- Project current world displayWorld.
- self clearErrorRecursion.!

Item was removed:
- ----- Method: MorphicDebugger 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."
-
- | errorWasInUIProcess debugger message |
- <primitive: 19> "Simulation guard"
-
- Processor activeProcess == Project current uiProcess
- ifTrue: [^ self notify: 'You cannot interrupt from within the UI process. Use a helper process instead.\\This interrupt request will be aborted.' withCRs translated].
-
- errorWasInUIProcess := Project current spawnNewProcessIfThisIsUI: interruptedProcess.
-
- debugger := self new.
- debugger
- process: interruptedProcess
- context: interruptedProcess suspendedContext.
- debugger
- externalInterrupt: true;
- errorWasInUIProcess: errorWasInUIProcess.
-
- ((aString includesSubstring: 'Space') and: [aString includesSubstring: 'low'])
- ifTrue: [
- "Space is low!! See SmalltalkImage >> #lowSpaceWatcher."
- message := self lowSpaceChoices.
- Preferences logDebuggerStackToFile ifTrue: [
- Smalltalk logError: aString inContext: debugger interruptedContext to: 'LowSpaceDebug.log']]
- ifFalse: [
- Preferences logDebuggerStackToFile ifTrue: [
- Smalltalk logSqueakError: aString inContext: debugger interruptedContext]].
-
- ^ debugger
- openNotifierNoSuspendContents: message label: aString;
- yourself
- !

Item was changed:
  ----- Method: MorphicDebugger class>>openOn:context:label:contents:fullView: (in category 'opening') -----
+ openOn: processToDebug context: context label: title contents: contentsStringOrNil fullView: full
- openOn: process context: context label: title contents: contentsStringOrNil fullView: full
- "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."
 
+ | debugger uiBlock |
+ debugger := self new
+ process: processToDebug context: context;
+ errorWasInUIProcess: (Project current spawnNewProcessIfThisIsUI: processToDebug).
+
+ uiBlock := [
+ full
+ ifTrue: [debugger openFullNoSuspendLabel: title]
+ ifFalse: [debugger openNotifierNoSuspendContents: contentsStringOrNil label: title].
+
+ "Try drawing the debugger tool at least once to avoid freeze."
+ debugger topView ifNotNil: [:window | window world displayWorld. "Not safely!!"].
+ ].
- ErrorRecursionGuard critical: [
 
+ "Schedule debugging in a deferred UI message if necessary. Note that only the ui process should execute ui code."
+ (Project current uiProcess isActiveProcess not or: [processToDebug isActiveProcess])
+ ifTrue: [Project current addDeferredUIMessage: uiBlock]
+ ifFalse: uiBlock.
- | errorWasInUIProcess debugger |
- ErrorRecursion ifTrue: [
- "self assert: process == Project current uiProcess -- DOCUMENTATION ONLY"
- self clearErrorRecursion.
- ^ Project current handleFatalDrawingError: title].
-
- [ErrorRecursion not & Preferences logDebuggerStackToFile
- ifTrue: [Smalltalk logSqueakError: title inContext: context]]
- on: Error
- do: [:ex | ex return: nil].
-
- errorWasInUIProcess := Project current spawnNewProcessIfThisIsUI: process.
-
- "Schedule debugging in deferred UI message because
- 1) If process is the current UI process, it is already broken.
- 2) If process is some other process, it must not execute UI code"
- Project current addDeferredUIMessage: [
- ErrorRecursionGuard critical: [
- self setErrorRecursion.
-
- self informExistingDebugger: context label: title.
-
- debugger := self new process: process context: context.
- full
- ifTrue: [debugger openFullNoSuspendLabel: title]
- ifFalse: [debugger openNotifierNoSuspendContents: contentsStringOrNil label: title].
- debugger errorWasInUIProcess: errorWasInUIProcess.
-
- "Try drawing the debugger tool at least once to avoid freeze."
- Project current world displayWorldSafely.
-
- self clearErrorRecursion] ]].
 
+ processToDebug suspend.
+
+ "Get here only if active process is not the process-to-debug. So in tests, use a helper process if you want to access this return value."
+ ^ debugger!
- process suspend.!

Item was removed:
- ----- Method: MorphicDebugger class>>openOnMethod:forReceiver:inContext: (in category 'opening') -----
- openOnMethod: aCompiledMethod forReceiver: anObject inContext: aContextOrNil
-
- | guineaPig debugger 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
- context: context.
- debugger initializeFull.
-
- "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: [^ Project uiManager inform: 'Nothing to debug; expression is optimized'].
- debugger send].
-
- debugger openFullNoSuspendLabel: 'Debug it'.!

Item was removed:
- ----- Method: MorphicDebugger>>abandon: (in category 'initialize') -----
- abandon: myWindow
-
- myWindow delete.!

Item was changed:
  ----- Method: MorphicDebugger>>resumeProcess: (in category 'private') -----
+ resumeProcess: processToResume
- resumeProcess: debuggerWindow
 
- | processToResume |
- processToResume := interruptedProcess.
-
- interruptedProcess := nil. "Before delete, so release doesn't terminate it"
- debuggerWindow delete.
-
- Project current world displayWorld. "We have to redraw *before* resuming the old process."
- Smalltalk installLowSpaceWatcher. "restart low space handler"
-
- savedCursor
- ifNotNil: [Cursor currentCursor: savedCursor].
  processToResume isTerminated ifFalse: [
+ errorWasInUIProcess ifTrue: [Project current uiProcess: processToResume].
+ processToResume resume.
+ errorWasInUIProcess ifTrue: [Processor terminateActive]].!
- errorWasInUIProcess
- ifTrue: [Project resumeProcess: processToResume]
- ifFalse: [processToResume resume]].
- "if old process was terminated, just terminate current one"
- errorWasInUIProcess == false
- ifFalse: [Processor terminateActive]!

Item was added:
+ ----- Method: MorphicProject>>fatalDrawingError: (in category 'scheduling & debugging') -----
+ fatalDrawingError: errMsg
+ "Morphic drawing failed and could not be recovered. So we end up here."
+
+ self primitiveError: errMsg.
+
+ "Hm... we should jump into a 'safe' worldState here, but how do we find it?!!"!

Item was changed:
  ----- Method: MorphicProject>>interruptCleanUpFor: (in category 'scheduling & debugging') -----
  interruptCleanUpFor: interruptedProcess
  "Clean up things in case of a process interrupt."
 
  super interruptCleanUpFor: interruptedProcess.
+
+ self uiProcess == interruptedProcess ifTrue: [
+ ActiveHand ifNotNil: [ActiveHand interrupted].
+ ActiveWorld := world. "reinstall active globals"
+ ActiveHand := world primaryHand.
+ ActiveHand interrupted. "make sure this one's interrupted too"
+ ActiveEvent := nil.
+
+ Preferences eToyFriendly
+ ifTrue: [Project current world stopRunningAll]].!
-
- (Preferences eToyFriendly and: [interruptedProcess == self uiProcess])
- ifTrue: [Project current world stopRunningAll].!

Item was removed:
- ----- Method: MorphicProject>>interruptName: (in category 'scheduling & debugging') -----
- interruptName: labelString
- "Create a Notifier on the active scheduling process with the given label."
-
- ^ self interruptName: labelString preemptedProcess: nil!

Item was removed:
- ----- Method: MorphicProject>>interruptName:preemptedProcess: (in category 'scheduling & debugging') -----
- interruptName: labelString preemptedProcess: theInterruptedProcess
- "Create a Notifier on the active scheduling process with the given label."
-
- | preemptedProcess projectProcess |
- self uiProcess == Processor activeProcess ifTrue: [
- ^ self inform: 'You cannot interrupt from within the UI process.\Use a helper process instead.' withCRs translated].
-
- ActiveHand ifNotNil:[ActiveHand interrupted].
- ActiveWorld := world. "reinstall active globals"
- ActiveHand := world primaryHand.
- ActiveHand interrupted. "make sure this one's interrupted too"
- ActiveEvent := nil.
-
- projectProcess := self uiProcess. "we still need the accessor for a while"
- preemptedProcess := theInterruptedProcess ifNil: [Processor preemptedProcess].
- "Only debug preempted process if its priority is >= projectProcess' priority"
- preemptedProcess priority < projectProcess priority
- ifTrue:[preemptedProcess := projectProcess].
-
- preemptedProcess suspend.
- self interruptCleanUpFor: preemptedProcess.
-
- ToolSet
- debugInterruptedProcess: preemptedProcess
- label: labelString.!

Item was added:
+ ----- Method: MorphicProject>>recursiveError: (in category 'scheduling & debugging') -----
+ recursiveError: msg
+
+ "1a) If the recursion happens in a non-ui process, make sure to escalate it in the ui process."
+ Processor activeProcess == self uiProcess ifFalse: [
+ self addDeferredUIMessage: [super recursiveError: msg].
+ ^ Processor activeProcess suspend].
+
+ "1b) Normal escalation of error recursion in the ui process."
+ ^ super recursiveError: msg!

Item was changed:
  ----- Method: TextEditor>>debugIt (in category 'do-its') -----
  debugIt
 
+ | receiver context helperProcess |
- | receiver context |
  self lineSelectAndEmptyCheck: [^self].
 
  (model respondsTo: #debugExpression:)
  ifTrue: [^ model perform: #debugExpression: with: self selection].
 
  receiver := (model respondsTo: #doItReceiver)
  ifTrue: [model doItReceiver]
  ifFalse: [nil].
 
  context := (model respondsTo: #doItContext)
  ifTrue: [model doItContext]
  ifFalse: [nil].
 
+ (self compileSelectionFor: receiver in: context) ifNotNil: [:doItMethod |
+ helperProcess := context
+ ifNil: [self assert: doItMethod selector = #DoIt.
+ Process forMethod: doItMethod receiver: receiver]
+ ifNotNil: [self assert: doItMethod selector = #DoItIn:.
+ Process forMethod: doItMethod receiver: receiver arguments: {context}].
+ helperProcess debugWithTitle: 'Debug it'].!
- (self compileSelectionFor: receiver in: context) ifNotNil: [:method |
- ToolSet debugMethod: method forReceiver: receiver inContext: context].!

Item was changed:
  ----- Method: WorldState>>displayWorldSafely: (in category 'update cycle') -----
  displayWorldSafely: aWorld
  "Update this world's display and keep track of errors during draw methods."
 
+ | finished classesWithErrors |
- | finished errors previousClasses |
  finished := false.
- errors := nil.
 
  [finished] whileFalse: [
  [aWorld displayWorld. finished := true] on: Error do: [:ex |
  "Handle a drawing error"
  | err rcvr errCtx errMorph |
  err := ex description.
  rcvr := ex receiver.
 
  errCtx := thisContext.
  [
  errCtx := errCtx sender.
  "Search the sender chain to find the morph causing the problem"
  [errCtx notNil and:[(errCtx receiver isMorph) not]]
  whileTrue:[errCtx := errCtx sender].
  "If we're at the root of the context chain then we have a fatal drawing problem"
+ errCtx ifNil:[^Project current fatalDrawingError: err].
- errCtx ifNil:[^Project current handleFatalDrawingError: err].
  errMorph := errCtx receiver.
  "If the morph causing the problem has already the #drawError flag set,
  then search for the next morph above in the caller chain."
  errMorph hasProperty: #errorOnDraw
  ] whileTrue.
  errMorph setProperty: #errorOnDraw toValue: true.
 
  "Catch all errors, one for each receiver class."
+ classesWithErrors ifNil: [classesWithErrors := IdentitySet new].
+ (classesWithErrors includes: rcvr class) ifFalse: [
+ classesWithErrors add: rcvr class.
+ ToolSet debugException: ex].
- errors ifNil: [errors := OrderedCollection new].
- previousClasses ifNil: [previousClasses := IdentitySet new].
- (previousClasses includes: rcvr class) ifFalse: [
- previousClasses add: rcvr class.
- errors add: (Process forContext: ex signalerContext copyStack priority: Processor activeProcess priority) -> err].
- aWorld fullRepaintNeeded.
- ]].
 
+ "Repaint all to catch all errors now and not if the debugger will appear."
+ aWorld fullRepaintNeeded.
+ ]].!
- errors ifNotNil: [MorphicDebugger openDrawingErrors: errors].!