[squeak-dev] The Trunk: Morphic-mt.1521.mczcommits at source.squeak.org commits at source.squeak.orgTue Sep 17 10:11:58 UTC 2019
Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1521.mcz ==================== Summary ==================== Name: Morphic-mt.1521 Author: mt Time: 17 September 2019, 12:11:44.272406 pm UUID: 8f7a9d88-4010-8947-a9a1-7a6174c8e3c9 Ancestors: Morphic-mt.1520 Refactoring of process debugging. Complements System-mt.1093 =============== Diff against Morphic-mt.1520 =============== Item was removed: - ----- Method: Debugger class>>morphicOpenOn:context:label:contents:fullView: (in category '*Morphic-opening') ----- - morphicOpenOn: 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." - - ErrorRecursionGuard critical: [ - - | 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: [ - self setErrorRecursion. - - debugger := self new process: process controller: nil context: context. - full - ifTrue: [debugger openFullNoSuspendLabel: title] - ifFalse: [debugger openNotifierContents: contentsStringOrNil label: title]. - debugger errorWasInUIProcess: errorWasInUIProcess. - - "Try drawing the debugger tool at least once to avoid freeze." - Project current world displayWorldSafely. - - self clearErrorRecursion]]. - - process suspend.! Item was removed: - ----- Method: Debugger class>>openContext:label:contents: (in category '*Morphic-opening') ----- - openContext: aContext label: aString contents: contentsStringOrNil - "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." - "Simulation guard" - <primitive: 19> - ErrorRecursionGuard critical: - [ ErrorRecursion not & Preferences logDebuggerStackToFile ifTrue: - [ Smalltalk - logSqueakError: aString - inContext: aContext ]. - ErrorRecursion ifTrue: - [ ErrorRecursion := false. - self primitiveError: aString ]. - ErrorRecursion := true. - self - informExistingDebugger: aContext - label: aString. - (Debugger context: aContext) - openNotifierContents: contentsStringOrNil - label: aString. - ErrorRecursion := false]. - Processor activeProcess suspend ! Item was removed: - ----- Method: Debugger class>>openInterrupt:onProcess: (in category '*Morphic-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 - ifNotNil: [:sc | - "this means we are in an MVC project" - sc 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 removed: - ----- Method: Debugger>>morphicResumeProcess: (in category '*Morphic-opening') ----- - morphicResumeProcess: aTopView - - | processToResume | - processToResume := interruptedProcess. - interruptedProcess := nil. "Before delete, so release doesn't terminate it" - aTopView 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 resumeProcess: processToResume] - ifFalse: [processToResume resume]]. - "if old process was terminated, just terminate current one" - errorWasInUIProcess == false - ifFalse: [Processor terminateActive]! Item was added: + Debugger subclass: #MorphicDebugger + instanceVariableNames: 'errorWasInUIProcess' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Support'! Item was added: + ----- Method: MorphicDebugger class>>openDrawingErrors: (in category 'opening') ----- + openDrawingErrors: errors + "Open debuggers for all different errors found." + + self setErrorRecursion. + errors do: [:processToLabel | + (MorphicDebugger new process: processToLabel key context: processToLabel key suspendedContext) + errorWasInUIProcess: Processor activeProcess = Project current uiProcess; + openNotifierContents: 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 added: + ----- 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 | + <primitive: 19> "Simulation guard" + + errorWasInUIProcess := Project current spawnNewProcessIfThisIsUI: interruptedProcess. + debugger := self new. + debugger + process: interruptedProcess + context: interruptedProcess suspendedContext. + debugger + externalInterrupt: true; + errorWasInUIProcess: errorWasInUIProcess. + + 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: MorphicDebugger class>>openOn:context:label:contents:fullView: (in category 'opening') ----- + 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." + + ErrorRecursionGuard critical: [ + + | 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: [ + self setErrorRecursion. + + self informExistingDebugger: context label: title. + + debugger := self new process: process context: context. + full + ifTrue: [debugger openFullNoSuspendLabel: title] + ifFalse: [debugger openNotifierContents: contentsStringOrNil label: title]. + debugger errorWasInUIProcess: errorWasInUIProcess. + + "Try drawing the debugger tool at least once to avoid freeze." + Project current world displayWorldSafely. + + self clearErrorRecursion]]. + + process suspend.! Item was added: + ----- Method: MorphicDebugger 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 + 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 delete. + UIManager default inform: 'Nothing to debug; expression is optimized'. + ^self]. + debugger send]! Item was added: + ----- Method: MorphicDebugger>>errorWasInUIProcess (in category 'accessing') ----- + errorWasInUIProcess + + ^ errorWasInUIProcess! Item was added: + ----- Method: MorphicDebugger>>errorWasInUIProcess: (in category 'accessing') ----- + errorWasInUIProcess: boolean + + errorWasInUIProcess := boolean! Item was added: + ----- Method: MorphicDebugger>>initialize (in category 'initialize') ----- + initialize + + super initialize. + + errorWasInUIProcess := false.! Item was added: + ----- Method: MorphicDebugger>>resumeProcess: (in category 'private') ----- + 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 resumeProcess: processToResume] + ifFalse: [processToResume resume]]. + "if old process was terminated, just terminate current one" + errorWasInUIProcess == false + ifFalse: [Processor terminateActive]! Item was added: + ----- Method: MorphicDebugger>>windowIsClosing (in category 'initialize') ----- + windowIsClosing + "Keep track of last debugger extent." + + 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" ] ]. + + super windowIsClosing.! Item was changed: + ----- Method: MorphicProject>>addDeferredUIMessage: (in category 'scheduling & debugging') ----- - ----- Method: MorphicProject>>addDeferredUIMessage: (in category 'scheduling') ----- addDeferredUIMessage: valuableObject "Arrange for valuableObject to be evaluated at a time when the user interface is in a coherent state." + self flag: #discuss. "mt: Why are deferred UI messages shared among all Morphic projects? That's not the case for MVC projects..." WorldState addDeferredUIMessage: valuableObject! Item was removed: - ----- Method: MorphicProject>>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: nil - 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 delete. - UIManager default inform: 'Nothing to debug; expression is optimized'. - ^self]. - debugger send]! Item was added: + ----- Method: MorphicProject>>debuggerClass (in category 'scheduling & debugging') ----- + debuggerClass + + ^ Smalltalk classNamed: #MorphicDebugger! Item was changed: + ----- Method: MorphicProject>>interruptName: (in category 'scheduling & debugging') ----- - ----- Method: MorphicProject>>interruptName: (in category 'scheduling') ----- interruptName: labelString "Create a Notifier on the active scheduling process with the given label." ^ self interruptName: labelString preemptedProcess: nil! Item was changed: + ----- Method: MorphicProject>>interruptName:preemptedProcess: (in category 'scheduling & debugging') ----- - ----- Method: MorphicProject>>interruptName:preemptedProcess: (in category 'utilities') ----- interruptName: labelString preemptedProcess: theInterruptedProcess "Create a Notifier on the active scheduling process with the given label." | preemptedProcess projectProcess | 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. + + ToolSet + debugInterruptedProcess: preemptedProcess + label: labelString.! - ToolSet interrupt: preemptedProcess label: labelString.! Item was added: + ----- Method: MorphicProject>>syntaxError: (in category 'scheduling & debugging') ----- + syntaxError: aSyntaxErrorNotification + + | compilerProcess errorWasInUIProcess debugger | + debugger := (super syntaxError: aSyntaxErrorNotification) model debugger. + + compilerProcess := Processor activeProcess. + errorWasInUIProcess := self spawnNewProcessIfThisIsUI: compilerProcess. + + debugger errorWasInUIProcess: errorWasInUIProcess. + compilerProcess suspend.! Item was removed: - ----- Method: SyntaxError class>>buildMorphicViewOn: (in category '*Morphic-Support') ----- - buildMorphicViewOn: aSyntaxError - "Answer an Morphic view on the given SyntaxError." - | window | - window := (SystemWindow labelled: 'Syntax Error') model: aSyntaxError. - - window addMorph: (PluggableListMorph on: aSyntaxError list: #list - selected: #listIndex changeSelected: nil menu: #listMenu:) - frame: (0 at 0 corner: 1 at 0.15). - - window addMorph: ((PluggableTextMorphPlus on: aSyntaxError text: #contents - accept: #contents:notifying: readSelection: #contentsSelection - menu: #codePaneMenu:shifted:) - useDefaultStyler; updateStyleNow; - selectionInterval: aSyntaxError errorMessageInterval; - yourself) - frame: (0 at 0.15 corner: 1 at 1). - - ^ window openInWorldExtent: 380 at 220! Item was removed: - ----- Method: SyntaxError class>>morphicOpen: (in category '*Morphic-Support') ----- - morphicOpen: aSyntaxError - "Answer a view whose model is an instance of me." - - self buildMorphicViewOn: aSyntaxError. - Project current spawnNewProcessIfThisIsUI: Processor activeProcess. - ^ Processor activeProcess suspend! 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 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 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." 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. ]]. + errors ifNotNil: [MorphicDebugger openDrawingErrors: errors].! - "Open debuggers for all different errors found." - errors ifNotNil: [ - Debugger setErrorRecursion. - errors do: [:ea | - (Debugger new process: ea key controller: nil context: ea key suspendedContext) - errorWasInUIProcess: Processor activeProcess = Project current uiProcess; - openNotifierContents: nil label: ea value]. - "Try to draw the debuggers or else there will be no chance to escape from this catch-drawing-error loop." - ActiveWorld displayWorld. - Debugger clearErrorRecursion].!
More information about the Squeak-dev mailing list |