--- a/DebugView.st Mon Oct 10 04:15:21 1994 +0100
+++ b/DebugView.st Mon Oct 10 04:16:24 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -12,15 +12,16 @@
StandardSystemView subclass:#DebugView
instanceVariableNames:'busy haveControl exitAction canContinue
- contextView codeView
- receiverInspector contextInspector
- contextArray selectedContext
- catchBlock grabber traceView tracing
- bigStep steppedContextAddress canAbort
- abortButton terminateButton continueButton
- stepButton sendButton returnButton restartButton
- exclusive inspecting nChainShown
- processList'
+ contextView codeView
+ receiverInspector contextInspector
+ contextArray selectedContext
+ catchBlock grabber traceView tracing
+ bigStep steppedContextAddress canAbort
+ abortButton terminateButton continueButton
+ stepButton sendButton returnButton restartButton
+ exclusive inspecting nChainShown
+ inspectedProcess updateProcess
+ monitorToggle'
classVariableNames:'CachedDebugger CachedExclusive'
poolDictionaries:''
category:'Interface-Debugger'
@@ -28,9 +29,9 @@
DebugView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.13 1994-08-22 18:07:04 claus Exp $
+$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.14 1994-10-10 03:15:25 claus Exp $
'!
!DebugView class methodsFor:'documentation'!
@@ -38,7 +39,7 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -51,7 +52,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.13 1994-08-22 18:07:04 claus Exp $
+$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.14 1994-10-10 03:15:25 claus Exp $
"
!
@@ -92,21 +93,21 @@
(ProcessorScheduler isPureEventDriven
or:[(active priority > Processor userSchedulingPriority)
or:[active nameOrId endsWith:'dispatcher']]) ifTrue:[
- CachedExclusive isNil ifTrue:[
- debugger := self newExclusive
- ] ifFalse:[
- debugger := CachedExclusive.
- CachedExclusive := nil.
- ].
+ CachedExclusive isNil ifTrue:[
+ debugger := self newExclusive
+ ] ifFalse:[
+ debugger := CachedExclusive.
+ CachedExclusive := nil.
+ ].
] ifFalse:[
- CachedDebugger isNil ifTrue:[
- debugger := super new.
- debugger label:'Debugger'.
- debugger icon:(Form fromFile:'Debugger.xbm' resolution:100).
- ] ifFalse:[
- debugger := CachedDebugger.
- CachedDebugger := nil.
- ]
+ CachedDebugger isNil ifTrue:[
+ debugger := super new.
+ debugger label:'Debugger'.
+ debugger icon:(Form fromFile:'Debugger.xbm' resolution:100).
+ ] ifFalse:[
+ debugger := CachedDebugger.
+ CachedDebugger := nil.
+ ]
].
^ debugger
!
@@ -137,7 +138,7 @@
error- and halt messages"
thisContext isRecursive ifTrue:[
- ^ MiniDebugger enterWithMessage:aString
+ ^ MiniDebugger enterWithMessage:aString
].
^ self enter:(thisContext sender) withMessage:aString
@@ -165,7 +166,7 @@
|aDebugger|
thisContext isRecursive ifTrue:[
- ^ MiniDebugger enterWithMessage:'recursive error'.
+ ^ MiniDebugger enterWithMessage:'recursive error'.
].
StepInterruptPending := nil.
@@ -186,9 +187,9 @@
aDebugger := super new.
aDebugger icon:(Form fromFile:'Debugger.xbm' resolution:100).
aProcess notNil ifTrue:[
- label := 'inspecting Debugger (' , aProcess nameOrId , ')'.
+ label := 'process Debugger (' , aProcess nameOrId , ')'.
] ifFalse:[
- label := 'no process'
+ label := 'no process'
].
aDebugger label:label.
aDebugger iconLabel:'Debugger'.
@@ -199,7 +200,7 @@
!DebugView methodsFor:'initialization'!
initialize
- |v panel hpanel bpanel|
+ |v panel hpanel bpanel dummy|
super initialize.
@@ -214,46 +215,52 @@
canAbort := false.
bpanel := HorizontalPanelView
- origin:(0.0 @ 0.0)
- extent:(1.0 @ (font height * 2))
- in:self.
+ origin:(0.0 @ 0.0)
+ extent:(1.0 @ (font height * 2))
+ in:self.
bpanel layout:#left.
terminateButton := Button
- label:(resources at:'terminate')
- action:[terminateButton turnOffWithoutRedraw. self doTerminate]
- in:bpanel.
+ label:(resources at:'terminate')
+ action:[terminateButton turnOffWithoutRedraw. self doTerminate]
+ in:bpanel.
+ dummy := View extent:(20 @ 5) in:bpanel.
+
abortButton := Button
- label:(resources at:'abort')
- action:[abortButton turnOffWithoutRedraw. self doAbort]
- in:bpanel.
+ label:(resources at:'abort')
+ action:[abortButton turnOffWithoutRedraw. self doAbort]
+ in:bpanel.
returnButton := Button
- label:(resources at:'return')
- action:[returnButton turnOff. self doReturn]
- in:bpanel.
+ label:(resources at:'return')
+ action:[returnButton turnOff. self doReturn]
+ in:bpanel.
restartButton := Button
- label:(resources at:'restart')
- action:[restartButton turnOff. self doRestart]
- in:bpanel.
+ label:(resources at:'restart')
+ action:[restartButton turnOff. self doRestart]
+ in:bpanel.
+
+ dummy := View extent:(20 @ 5) in:bpanel.
continueButton := Button
- label:(resources at:'continue')
- action:[continueButton turnOffWithoutRedraw. self doContinue]
- in:bpanel.
+ label:(resources at:'continue')
+ action:[continueButton turnOffWithoutRedraw. self doContinue]
+ in:bpanel.
+ dummy := View extent:(20 @ 5) in:bpanel.
+
stepButton := Button
- label:(resources at:'step')
- action:[stepButton turnOff. self doStep]
- in:bpanel.
+ label:(resources at:'step')
+ action:[stepButton turnOff. self doStep]
+ in:bpanel.
sendButton := Button
- label:(resources at:'send')
- action:[sendButton turnOff. self doSend]
- in:bpanel.
+ label:(resources at:'send')
+ action:[sendButton turnOff. self doSend]
+ in:bpanel.
panel := VariableVerticalPanel
- origin:(0.0 @ bpanel height)
- corner:(1.0 @ 1.0)
- in:self.
+ origin:(0.0 @ bpanel height)
+ corner:(1.0 @ 1.0)
+ in:self.
v := ScrollableView for:SelectionInListView in:panel.
v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25).
@@ -270,71 +277,83 @@
hpanel origin:(0.0 @ 0.75) corner:(1.0 @ 1.0).
receiverInspector := InspectorView
- origin:(0.0 @ 0.0) corner:(0.5 @ 1.0)
- in:hpanel.
+ origin:(0.0 @ 0.0) corner:(0.5 @ 1.0)
+ in:hpanel.
contextInspector := ContextInspectorView
- origin:(0.5 @ 0.0) corner:(1.0 @ 1.0)
- in:hpanel
+ origin:(0.5 @ 0.0) corner:(1.0 @ 1.0)
+ in:hpanel
!
initializeMiddleButtonMenu
- |labels|
+ |labels m|
labels := resources array:#(
- 'show more'
- '-'
+ 'show more'
+ '-'
"
- 'continue'
- 'terminate'
- 'abort'
- '-'
- 'step'
- 'send'
- '-'
- 'return'
- 'restart'
- '-'
+ 'continue'
+ 'terminate'
+ 'abort'
+ '-'
+ 'step'
+ 'send'
+ '-'
+ 'return'
+ 'restart'
+ '-'
"
- 'remove breakpoint'
- '-'
- 'implementors ...'
- 'senders ...'
- '-'
- 'inspect context'
- '-'
- 'exit smalltalk'
- ).
+ 'remove breakpoint'
+ '-'
+ 'implementors ...'
+ 'senders ...'
+ '-'
+ 'inspect context'
+ '-'
+ 'quickTerminate'
+ '-'
+ 'exit smalltalk'
+ ).
- contextView
- middleButtonMenu:(PopUpMenu
- labels:labels
- selectors:#(
- doShowMore
- nil
+ m := (PopUpMenu
+ labels:labels
+ selectors:#(
+ doShowMore
+ nil
+"
+ doContinue
+ doTerminate
+ doAbort
+ nil
+ doStep
+ doSend
+ nil
+ doReturn
+ doRestart
+ nil
"
- doContinue
- doTerminate
- doAbort
- nil
- doStep
- doSend
- nil
- doReturn
- doRestart
- nil
-"
- doRemoveBreakpoint
- nil
- doImplementors
- doSenders
- nil
- doInspectContext
- nil
- doExit
- )
- receiver:self
- for:contextView).
+ doRemoveBreakpoint
+ nil
+ doImplementors
+ doSenders
+ nil
+ doInspectContext
+ nil
+ doQuickTerminate
+ nil
+ doExit
+ )
+ receiver:self
+ for:contextView).
+
+ contextView middleButtonMenu:m.
+
+ inspecting ifTrue:[
+ m notNil ifTrue:[
+ m disable:#doTraceStep.
+ m disable:#doRemoveBreakpoint.
+ ].
+ ]
!
addToCurrentProject
@@ -350,8 +369,13 @@
realize
super realize.
exclusive ifTrue:[
- windowGroup := nil
+ windowGroup := nil
].
+
+ inspectedProcess notNil ifTrue:[
+ Processor activeProcess
+ priority:(inspectedProcess priority + 2 min:16).
+ ]
! !
!DebugView methodsFor:'interrupt handling'!
@@ -373,108 +397,108 @@
wrappedMethod := nil.
5 timesRepeat:[
"/ where selector printNL.
- method := where method.
- (method notNil and:[method isWrapped]) ifTrue:[
- "
- in a wrapper method
- "
- wrappedMethod ~~ method ifTrue:[
- wrappedMethod := method.
- lastWrappedConAddr := ObjectMemory addressOf:where.
- where sender receiver == method originalMethod ifFalse:[
- isWrap := true.
- ]
- ] ifFalse:[
- (ObjectMemory addressOf:where) == steppedContextAddress ifTrue:[
+ method := where method.
+ (method notNil and:[method isWrapped]) ifTrue:[
+ "
+ in a wrapper method
+ "
+ wrappedMethod ~~ method ifTrue:[
+ wrappedMethod := method.
+ lastWrappedConAddr := ObjectMemory addressOf:where.
+ where sender receiver == method originalMethod ifFalse:[
+ isWrap := true.
+ ]
+ ] ifFalse:[
+ (ObjectMemory addressOf:where) == steppedContextAddress ifTrue:[
"/ 'change stepCon from: ' print.
"/ (steppedContextAddress printStringRadix:16)print.
"/ ' to: ' print.
"/ (lastWrappedConAddr printStringRadix:16)printNL.
- steppedContextAddress := lastWrappedConAddr
- ]
- ]
- ].
- where := where sender
+ steppedContextAddress := lastWrappedConAddr
+ ]
+ ]
+ ].
+ where := where sender
].
isWrap ifTrue:[
"/ 'ignore wrap' printNL.
- "
- ignore, while in wrappers hidden setup
- "
- where := nil. here := nil.
- ObjectMemory flushInlineCaches.
- StepInterruptPending := true.
- InterruptPending := true.
- InStepInterrupt := nil.
- ^ nil
+ "
+ ignore, while in wrappers hidden setup
+ "
+ where := nil. here := nil.
+ ObjectMemory flushInlineCaches.
+ StepInterruptPending := true.
+ InterruptPending := true.
+ InStepInterrupt := nil.
+ ^ nil
].
"
is this for a send or a step ?
"
bigStep ifTrue:[
- "
- a step - ignore all contexts below the interresting one
- "
- where := here. "the interrupted context"
- (ObjectMemory addressOf:where) == steppedContextAddress ifFalse:[
- where := where sender.
+ "
+ a step - ignore all contexts below the interresting one
+ "
+ where := here. "the interrupted context"
+ (ObjectMemory addressOf:where) == steppedContextAddress ifFalse:[
+ where := where sender.
"/ 'look for ' print.
"/ (steppedContextAddress printStringRadix:16)print. '' printNL.
- (ObjectMemory addressOf:where) == steppedContextAddress ifFalse:[
- "
- check if we are in a context below steppedContext
- (i.e. if steppedContext can be reached from
- interrupted context. Not using context-ref but its
- address to avoid creation of many useless contexts.)
- "
- [where notNil] whileTrue:[
+ (ObjectMemory addressOf:where) == steppedContextAddress ifFalse:[
+ "
+ check if we are in a context below steppedContext
+ (i.e. if steppedContext can be reached from
+ interrupted context. Not using context-ref but its
+ address to avoid creation of many useless contexts.)
+ "
+ [where notNil] whileTrue:[
"/ ((ObjectMemory addressOf:where) printStringRadix:16)print. ' ' print.
"/ where selector printNL.
- (ObjectMemory addressOf:where) == steppedContextAddress ifTrue:[
+ (ObjectMemory addressOf:where) == steppedContextAddress ifTrue:[
"/ 'found it - below' printNL.
- "
- found the interresting context somwehere up in the
- chain. We seem to be still below the interresting one ...
- "
- tracing == true ifTrue:[
- here printString printNewline
- ].
- where := nil. here := nil.
- "
- yes, a context below
- - continue and schedule another stepInterrupt.
- Must flush caches since optimized methods not always
- look for pending interrupts
- "
- ObjectMemory flushInlineCaches.
- StepInterruptPending := true.
- InterruptPending := true.
- InStepInterrupt := nil.
- ^ nil
- ].
- where := where sender
- ].
- s := 'left stepped method'
- ] ifTrue:[
+ "
+ found the interresting context somwehere up in the
+ chain. We seem to be still below the interresting one ...
+ "
+ tracing == true ifTrue:[
+ here printString printNewline
+ ].
+ where := nil. here := nil.
+ "
+ yes, a context below
+ - continue and schedule another stepInterrupt.
+ Must flush caches since optimized methods not always
+ look for pending interrupts
+ "
+ ObjectMemory flushInlineCaches.
+ StepInterruptPending := true.
+ InterruptPending := true.
+ InStepInterrupt := nil.
+ ^ nil
+ ].
+ where := where sender
+ ].
+ s := 'left stepped method'
+ ] ifTrue:[
"/ 'found it right in sender' printNL.
- s := 'after step'
- ].
- ] ifTrue:[
+ s := 'after step'
+ ].
+ ] ifTrue:[
"/ 'found it right away' printNL.
- s := 'after step'
- ].
- tracing := false.
- bigStep := false.
+ s := 'after step'
+ ].
+ tracing := false.
+ bigStep := false.
] ifFalse:[
- "
- a send
- "
- steppedContextAddress := nil.
- s := 'after send'
+ "
+ a send
+ "
+ steppedContextAddress := nil.
+ s := 'after send'
].
name := Processor activeProcess nameOrId.
@@ -497,10 +521,10 @@
where := thisContext. "enter"
where := where sender. "the calling context"
where notNil ifTrue:[
- (where receiver == DebugView) ifTrue:[
- where := where sender
- ]
- "where is now interrupted methods context"
+ (where receiver == DebugView) ifTrue:[
+ where := where sender
+ ]
+ "where is now interrupted methods context"
].
^ self enter:where
!
@@ -509,10 +533,11 @@
"enter the debugger - get and display the context, then start an
exclusive event loop on top of eveything else"
- |con selection|
+ |con selection m|
busy := true.
inspecting := false.
+ inspectedProcess := nil.
bigStep := false.
nChainShown := 50.
@@ -521,31 +546,33 @@
us here
"
ActiveGrab notNil ifTrue:[
- grabber := ActiveGrab.
- ActiveGrab device ungrabPointer.
- ActiveGrab device synchronizeOutput.
- ActiveGrab := nil
+ grabber := ActiveGrab.
+ ActiveGrab device ungrabPointer.
+ ActiveGrab device synchronizeOutput.
+ ActiveGrab := nil
] ifFalse:[
- grabber := nil
+ grabber := nil
].
+ terminateButton enable.
+
drawableId notNil ifTrue:[
- "not the first time - realize at old position"
- terminateButton turnOffWithoutRedraw.
- continueButton turnOffWithoutRedraw.
- abortButton turnOffWithoutRedraw.
- stepButton turnOffWithoutRedraw.
- sendButton turnOffWithoutRedraw.
- self rerealize
+ "not the first time - realize at old position"
+ terminateButton turnOffWithoutRedraw.
+ continueButton turnOffWithoutRedraw.
+ abortButton turnOffWithoutRedraw.
+ stepButton turnOffWithoutRedraw.
+ sendButton turnOffWithoutRedraw.
+ self rerealize
] ifFalse:[
- exclusive ifFalse:[
- windowGroup isNil ifTrue:[
- windowGroup := WindowGroup new.
- windowGroup addTopView:self.
- ].
- ].
- self realize.
- self iconLabel:'Debugger'.
+ exclusive ifFalse:[
+ windowGroup isNil ifTrue:[
+ windowGroup := WindowGroup new.
+ windowGroup addTopView:self.
+ ].
+ ].
+ self realize.
+ self iconLabel:'Debugger'.
].
"
@@ -563,44 +590,47 @@
and find one to show
"
steppedContextAddress isNil ifTrue:[
- "
- preselect a more interresting context, (where halt/raise was ...)
- "
- selection := self interrestingContextFrom:aContext.
+ "
+ preselect a more interresting context, (where halt/raise was ...)
+ "
+ selection := self interrestingContextFrom:aContext.
] ifFalse:[
- "
- if we came here by a big-step, show the method where we are
- "
- steppedContextAddress notNil ifTrue:[
- (ObjectMemory addressOf:aContext) == steppedContextAddress ifTrue:[
- selection := 1
- ] ifFalse:[
- (ObjectMemory addressOf:aContext sender) == steppedContextAddress ifTrue:[
- selection := 2
- ]
- ]
- ]
+ "
+ if we came here by a big-step, show the method where we are
+ "
+ steppedContextAddress notNil ifTrue:[
+ (ObjectMemory addressOf:aContext) == steppedContextAddress ifTrue:[
+ selection := 1
+ ] ifFalse:[
+ (ObjectMemory addressOf:aContext sender) == steppedContextAddress ifTrue:[
+ selection := 2
+ ]
+ ]
+ ]
].
selection notNil ifTrue:[
- self showSelection:selection.
- contextView selection:selection
+ self showSelection:selection.
+ contextView selection:selection
].
- canAbort := Object abortSignal isHandled.
- canAbort ifTrue:[
- abortButton enable.
- contextView middleButtonMenu enable:#doAbort.
- ] ifFalse:[
- abortButton disable.
- contextView middleButtonMenu disable:#doAbort.
- ].
- exclusive ifTrue:[
- terminateButton disable.
- contextView middleButtonMenu disable:#doTerminate.
- ] ifFalse:[
- terminateButton enable.
- contextView middleButtonMenu enable:#doTerminate.
+ m := contextView middleButtonMenu.
+ m notNil ifTrue:[
+ canAbort := inspecting or:[Object abortSignal isHandled].
+ canAbort ifTrue:[
+ abortButton enable.
+ m enable:#doAbort.
+ ] ifFalse:[
+ abortButton disable.
+ m disable:#doAbort.
+ ].
+ exclusive ifTrue:[
+ terminateButton disable.
+ m disable:#doTerminate.
+ ] ifFalse:[
+ terminateButton enable.
+ m enable:#doTerminate.
+ ]
].
"
@@ -614,70 +644,110 @@
contextInspector release.
(exitAction == #step) ifFalse:[
- self unrealize.
- device synchronizeOutput.
- (exitAction == #abort) ifTrue:[
- selectedContext := nil.
- InInterrupt := nil.
- busy := false.
- exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
- Object abortSignal raise.
- 'abort failed' errorPrintNewline
- ].
- (exitAction == #return) ifTrue:[
- selectedContext notNil ifTrue:[
- con := selectedContext.
- selectedContext := nil.
- InInterrupt := nil.
- busy := false.
- exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
- con unwind.
- 'cannot return selected context' errorPrintNewline
- ]
- ] ifFalse:[
- (exitAction == #restart) ifTrue:[
- selectedContext notNil ifTrue:[
- con := selectedContext.
- selectedContext := nil.
- InInterrupt := nil.
- busy := false.
- exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
- con restart.
- 'cannot restart selected context' errorPrintNewline
- ]
- ] ifFalse:[
- (exitAction == #terminate) ifTrue:[
- selectedContext := nil.
- InInterrupt := nil.
- busy := false.
- exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
- Processor activeProcess terminate.
- 'cannot terminate process' errorPrintNewline
- ]
- ]
- ]
+ self unrealize.
+ device synchronizeOutput.
+ (exitAction == #abort) ifTrue:[
+ selectedContext := nil.
+ InInterrupt := nil.
+ busy := false.
+ exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
+ "
+ have to catch errors occuring in unwind-blocks
+ "
+ Object errorSignal handle:[:ex |
+ 'ignored error while unwinding: ' errorPrint.
+ ex errorString errorPrintNL.
+ ex proceed
+ ] do:[
+ Object abortSignal raise.
+ ].
+ 'abort failed' errorPrintNewline
+ ].
+ (exitAction == #return) ifTrue:[
+ selectedContext notNil ifTrue:[
+ con := selectedContext.
+ selectedContext := nil.
+ InInterrupt := nil.
+ busy := false.
+ exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
+ "
+ have to catch errors occuring in unwind-blocks
+ "
+ Object errorSignal handle:[:ex |
+ 'ignored error while unwinding: ' errorPrint.
+ ex errorString errorPrintNL.
+ ex proceed
+ ] do:[
+ con unwind.
+ ].
+ 'cannot return selected context' errorPrintNewline
+ ]
+ ] ifFalse:[
+ (exitAction == #restart) ifTrue:[
+ selectedContext notNil ifTrue:[
+ con := selectedContext.
+ selectedContext := nil.
+ InInterrupt := nil.
+ busy := false.
+ exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
+ "
+ have to catch errors occuring in unwind-blocks
+ "
+ Object errorSignal handle:[:ex |
+ 'ignored error while unwinding: ' errorPrint.
+ ex errorString errorPrintNL.
+ ex proceed
+ ] do:[
+ con restart.
+ ].
+ 'cannot restart selected context' errorPrintNewline
+ ]
+ ] ifFalse:[
+ ((exitAction == #terminate) or:[exitAction == #quickTerminate]) ifTrue:[
+ selectedContext := nil.
+ InInterrupt := nil.
+ busy := false.
+ exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
+ exitAction == #quickTerminate ifTrue:[
+ Processor activeProcess terminateNoSignal
+ ] ifFalse:[
+ "
+ have to catch errors occuring in unwind-blocks
+ "
+ Object errorSignal handle:[:ex |
+ 'ignored error while unwinding: ' errorPrint.
+ ex errorString errorPrintNL.
+ ex proceed
+ ] do:[
+ Processor activeProcess terminate.
+ ].
+ ].
+ 'cannot terminate process' errorPrintNewline
+ ]
+ ]
+ ]
].
selectedContext := nil.
grabber notNil ifTrue:[
- grabber device grabPointerIn:(grabber id).
- ActiveGrab := grabber
+ grabber device grabPointerIn:(grabber id).
+ ActiveGrab := grabber
].
(exitAction == #step) ifTrue:[
- "scedule another stepInterrupt
- - must flush caches since optimized methods not always
- look for pending interrupts"
- ObjectMemory flushInlineCaches.
+ "scedule another stepInterrupt
+ - must flush caches since optimized methods not always
+ look for pending interrupts"
+ ObjectMemory flushInlineCaches.
- ObjectMemory stepInterruptHandler:self.
- StepInterruptPending := true.
- InterruptPending := true.
- InStepInterrupt := nil
+ ObjectMemory stepInterruptHandler:self.
+ StepInterruptPending := true.
+ InterruptPending := true.
+ InStepInterrupt := nil
] ifFalse:[
- busy := false.
- exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self]
+ busy := false.
+ exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self]
]
!
@@ -688,53 +758,71 @@
Also, we do not run on top of the debugger process, but as a separate
one. (think of it as an inspector showing more detail)"
+ |bpanel updateButton stopButton dummy|
+
busy := true.
bigStep := false.
inspecting := true.
+ inspectedProcess := aProcess.
nChainShown := 50.
+ bpanel := abortButton superView.
+
+ stopButton := Button new.
+ stopButton label:(resources at:'stop');
+ action:[self doStop].
+ bpanel addSubView:stopButton after:continueButton.
+
+ dummy := View extent:(20 @ 5) in:bpanel.
+
+"/ stepButton destroy.
+"/ sendButton destroy.
+
+ updateButton := Button
+ label:(resources at:'update')
+ action:[self updateContext]
+ in:bpanel.
+ monitorToggle := Toggle in:bpanel.
+ monitorToggle label:(resources at:'monitor').
+ monitorToggle pressAction:[self autoUpdateOn].
+ monitorToggle releaseAction:[self autoUpdateOff].
+
"can only look into process - context chain is not active"
canContinue := true.
- abortButton disable.
+ terminateButton enable.
+ abortButton enable.
+
sendButton disable.
stepButton disable.
- continueButton disable.
- returnButton disable.
- restartButton disable.
-
- self initializeMiddleButtonMenu.
- contextView middleButtonMenu disable:#doAbort.
- contextView middleButtonMenu disable:#doSend.
- contextView middleButtonMenu disable:#doStep.
- contextView middleButtonMenu disable:#doContinue.
- contextView middleButtonMenu disable:#doReturn.
- contextView middleButtonMenu disable:#doRestart.
- contextView middleButtonMenu disable:#doTraceStep.
- contextView middleButtonMenu disable:#doTerminate.
- contextView middleButtonMenu disable:#doRemoveBreakpoint.
- contextView middleButtonMenu disable:#doImplementors.
- contextView middleButtonMenu disable:#doSenders.
- contextView middleButtonMenu disable:#doInspectContext.
+"/ continueButton disable.
+"/ returnButton disable.
+"/ restartButton disable.
aProcess isNil ifTrue:[
- terminateButton disable.
+ terminateButton disable.
+ abortButton disable.
+ continueButton disable.
+ returnButton disable.
+ restartButton disable.
] ifFalse:[
- aProcess suspendedContext isNil ifTrue:[
- terminateButton disable.
- contextView middleButtonMenu disable:#doTerminate.
- ].
+ aProcess suspendedContext isNil ifTrue:[
+ terminateButton disable.
+ ].
- self setContext:aProcess suspendedContext.
+ self setContext:aProcess suspendedContext.
- catchBlock := [
- contextArray := nil.
- selectedContext := nil.
- (exitAction == #terminate) ifTrue:[
- aProcess terminate.
- ].
- super destroy
- ].
+ catchBlock := [
+ contextArray := nil.
+ selectedContext := nil.
+ (exitAction == #terminate) ifTrue:[
+ aProcess terminate.
+ ].
+ (exitAction == #quickTerminate) ifTrue:[
+ aProcess terminateNoSignal.
+ ].
+ super destroy
+ ].
].
self open
! !
@@ -743,13 +831,13 @@
controlLoop
"this is a kludge:
- start a dispatchloop which exits when
- either continue, return or step is pressed
+ start a dispatchloop which exits when
+ either continue, return or step is pressed
"
haveControl := true.
[haveControl] whileTrue:[
- self controlLoopCatchingErrors
+ self controlLoopCatchingErrors
].
catchBlock := nil.
@@ -765,26 +853,27 @@
catchBlock := [^ nil].
exclusive ifTrue:[
- "if we do not have multiple processes or its a system process
- we start another dispatch loop, which exits when
- either continue, return or step is pressed
- or (via the catchBlock) if an error occurs.
- Since our display is an extra exclusive one (ModalDisplay)
- all processing for normal views stops here ...
- "
- device dispatchModalWhile:[haveControl]
+ "if we do not have multiple processes or its a system process
+ we start another dispatch loop, which exits when
+ either continue, return or step is pressed
+ or (via the catchBlock) if an error occurs.
+ Since our display is an extra exclusive one (ModalDisplay)
+ all processing for normal views stops here ...
+ "
+ device dispatchModalWhile:[haveControl]
] ifFalse:[
- "we do have multiple processes -
- simply enter the DebugViews-Windowgroup event loop.
- effectively suspending event processing for the currently
- active group.
- "
- SignalSet anySignal handle:[:ex |
- 'error within debugger ignored' errorPrintNewline.
- ex return.
- ] do:[
- windowGroup eventLoopWhile:[true]
- ]
+ "we do have multiple processes -
+ simply enter the DebugViews-Windowgroup event loop.
+ effectively suspending event processing for the currently
+ active group.
+ "
+ SignalSet anySignal handle:[:ex |
+ 'ignored error in debugger: ' errorPrint.
+ ex errorString errorPrintNL.
+ ex return.
+ ] do:[
+ windowGroup eventLoopWhile:[true]
+ ]
]
! !
@@ -808,16 +897,16 @@
c := aContext.
1 to:5 do:[:i |
- c isNil ifTrue:[^ 1 "^ nil"].
- sel := c selector.
- ((sel == #raise)
- or:[(sel == #raiseRequestWith:)
- or:[(sel == #raiseRequestWith:errorString:)]])
- ifTrue:[
- offset := i.
- found := c
- ].
- c := c sender.
+ c isNil ifTrue:[^ 1 "^ nil"].
+ sel := c selector.
+ ((sel == #raise)
+ or:[(sel == #raiseRequestWith:)
+ or:[(sel == #raiseRequestWith:errorString:)]])
+ ifTrue:[
+ offset := i.
+ found := c
+ ].
+ c := c sender.
].
(c := found) isNil ifTrue:[^ 1 "nil"].
@@ -836,31 +925,31 @@
if raise implementation reuses raise code ...
"
[
- #( raise raiseRequestWith: #raiseRequestWith:errorString: )
- includes:c selector
+ #( raise raiseRequestWith: #raiseRequestWith:errorString: )
+ includes:c selector
] whileTrue:[
- (c := c sender) isNil ifTrue:[^ offset].
- offset := offset + 1.
+ (c := c sender) isNil ifTrue:[^ offset].
+ offset := offset + 1.
].
"
if the sender of the raise is one of objects error methods ...
"
( #( halt halt:
- error error:
- doesNotUnderstand:
- subclassResponsibility
- primitiveFailed) includes:c selector)
+ error error:
+ doesNotUnderstand:
+ subclassResponsibility
+ primitiveFailed) includes:c selector)
ifTrue:[
- c selector == #doesNotUnderstand: ifTrue:[
- "
- one more up, to get to the originating context
- "
- (c := c sender) isNil ifTrue:[^ offset].
- offset := offset + 1.
- ].
- (c := c sender) isNil ifTrue:[^ offset].
- offset := offset + 1.
+ c selector == #doesNotUnderstand: ifTrue:[
+ "
+ one more up, to get to the originating context
+ "
+ (c := c sender) isNil ifTrue:[^ offset].
+ offset := offset + 1.
+ ].
+ (c := c sender) isNil ifTrue:[^ offset].
+ offset := offset + 1.
].
^ offset
@@ -869,67 +958,96 @@
setContext:aContext
"show calling chain from aContext in the walk-back listview"
- |con text method caller caller2|
+ |con text method caller caller2 m|
+
+ m := contextView middleButtonMenu.
+ m notNil ifTrue:[
+ m disable:#doShowMore.
+ ].
aContext isNil ifTrue:[
- text := Array with:'** no context **'.
- contextArray := nil.
- contextView middleButtonMenu disable:#doShowMore.
+ text := Array with:'** no context **'.
+ contextArray := nil.
] ifFalse:[
- text := OrderedCollection new:nChainShown.
- contextArray := OrderedCollection new:nChainShown.
- con := aContext.
+ text := OrderedCollection new:nChainShown.
+ contextArray := OrderedCollection new:nChainShown.
+ con := aContext.
- "
- get them all
- "
- [con notNil and:[contextArray size <= nChainShown]] whileTrue:[
- contextArray add:con.
- text add:(con printString).
+ "
+ get them all
+ "
+ [con notNil and:[contextArray size <= nChainShown]] whileTrue:[
+ contextArray add:con.
+ (Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[
+ text add:(((ObjectMemory addressOf:con) printStringRadix:16) , ' ' , con printString).
+ ] ifFalse:[
+ text add:con printString.
+ ].
- method := con method.
- (method notNil and:[method isWrapped]) ifTrue:[
- "
- kludge: if its a wrapped method, then hide the wrap-call
- "
- caller := con sender.
- (caller notNil and:[caller receiver == method originalMethod]) ifTrue:[
- caller2 := caller sender.
- (caller2 notNil and:[caller2 method == method]) ifTrue:[
- con := caller2
- ]
- ].
- caller := caller2 := nil
- ].
- con := con sender
- ].
+ method := con method.
+ (method notNil and:[method isWrapped]) ifTrue:[
+ "
+ kludge: if its a wrapped method, then hide the wrap-call
+ "
+ caller := con sender.
+ (caller notNil and:[caller receiver == method originalMethod]) ifTrue:[
+ caller2 := caller sender.
+ (caller2 notNil and:[caller2 method == method]) ifTrue:[
+ con := caller2
+ ]
+ ].
+ caller := caller2 := nil
+ ].
+ con := con sender
+ ].
- "
- did we reach the end ?
- "
- con isNil ifTrue:[
- contextView middleButtonMenu disable:#doShowMore.
+ "
+ did we reach the end ?
+ "
+ (con isNil or:[con sender isNil]) ifTrue:[
- "
- the very last one is the startup context
- (in main) - it has nil as receiver and nil as selector
- "
- contextArray last selector isNil ifTrue:[
- contextArray removeLast.
- text removeLast
- ]
- ] ifFalse:[
- contextView middleButtonMenu enable:#doShowMore.
- ].
+ "
+ the very last one is the startup context
+ (in main) - it has nil as receiver and nil as selector
+ "
+ contextArray last selector isNil ifTrue:[
+ contextArray removeLast.
+ text removeLast
+ ]
+ ] ifFalse:[
+ m notNil ifTrue:[
+ m enable:#doShowMore.
+ text add:(resources string:'*** more walkback follows - click here to see them ***')
+ ].
+ ].
].
contextView setList: "list:" text.
receiverInspector release.
contextInspector release.
- contextView middleButtonMenu disable:#doRemoveBreakpoint.
- contextView middleButtonMenu disable:#doImplementors.
- contextView middleButtonMenu disable:#doSenders.
+ m notNil ifTrue:[
+ m disable:#doRemoveBreakpoint.
+ m disable:#doImplementors.
+ m disable:#doSenders.
+ ].
+!
+
+updateContext
+ |oldContext idx|
+
+ oldContext := selectedContext.
+ self setContext:(inspectedProcess suspendedContext).
+ oldContext notNil ifTrue:[
+ contextArray notNil ifTrue:[
+ idx := contextArray identityIndexOf:oldContext.
+ idx ~~ 0 ifTrue:[
+ self showSelection:idx
+ ] ifFalse:[
+ codeView contents:('** context returned **')
+ ]
+ ]
+ ]
! !
!DebugView methodsFor:'user interaction'!
@@ -938,65 +1056,79 @@
"user clicked on a header line - show selected code in textView"
|con homeContext sel method code
- implementorClass lineNrInMethod rec|
+ implementorClass lineNrInMethod rec m line|
contextArray notNil ifTrue:[
- con := contextArray at:lineNr.
- lineNrInMethod := con lineNumber.
- con isBlockContext ifTrue:[
- homeContext := con methodHome
- ] ifFalse:[
- homeContext := con
- ].
- contextInspector inspect:con.
- homeContext notNil ifTrue:[
- sel := homeContext selector.
- sel notNil ifTrue:[
- implementorClass := homeContext searchClass whichClassImplements:sel.
- implementorClass isNil ifTrue:[
- codeView contents:'** no method - no source **'
- ] ifFalse:[
- method := implementorClass compiledMethodAt:sel.
- code := method source.
- code isNil ifTrue:[
- method sourceFileName notNil ifTrue:[
- codeView contents:('** no sourcefile: ' ,
- method sourceFileName ,
- ' **')
- ] ifFalse:[
- codeView contents:'** no source **'
- ]
- ]
- ].
- code isNil ifTrue:[
- codeView acceptAction:nil.
- ] ifFalse:[
- codeView contents:code.
- (lineNrInMethod notNil and:[lineNrInMethod ~~ 0]) ifTrue:[
- lineNrInMethod > codeView list size ifTrue:[
- lineNrInMethod := codeView list size + 1
- ].
- codeView selectLine:lineNrInMethod.
- codeView makeSelectionVisible
- ].
- codeView acceptAction:[:code | self codeAccept:code asString]
- ].
+ lineNr <= contextArray size ifTrue:[
+ con := contextArray at:lineNr.
+ ].
+ "
+ clicking on the '** ...'-line shows more ...
+ "
+ con isNil ifTrue:[
+ line := contextView list at:lineNr.
+ (line startsWith:'**') ifTrue:[
+ self doShowMore.
+ contextView selection:lineNr.
+ con := contextArray at:lineNr
+ ]
+ ].
+ lineNrInMethod := con lineNumber.
+ con isBlockContext ifTrue:[
+ homeContext := con methodHome
+ ] ifFalse:[
+ homeContext := con
+ ].
+ contextInspector inspect:con.
+ homeContext notNil ifTrue:[
+ sel := homeContext selector.
+ sel notNil ifTrue:[
+ implementorClass := homeContext searchClass whichClassImplements:sel.
+ implementorClass isNil ifTrue:[
+ codeView contents:(resources string:'** no method - no source **')
+ ] ifFalse:[
+ method := implementorClass compiledMethodAt:sel.
+ code := method source.
+ code isNil ifTrue:[
+ method sourceFileName notNil ifTrue:[
+ codeView contents:(resources
+ string:'** no sourcefile: %1 **'
+ with:method sourceFileName)
+ ] ifFalse:[
+ codeView contents:(resources string:'** no source **')
+ ]
+ ]
+ ].
+ code isNil ifTrue:[
+ codeView acceptAction:nil.
+ ] ifFalse:[
+ codeView contents:code.
+ (lineNrInMethod notNil and:[lineNrInMethod ~~ 0]) ifTrue:[
+ lineNrInMethod > codeView list size ifTrue:[
+ lineNrInMethod := codeView list size + 1
+ ].
+ codeView selectLine:lineNrInMethod.
+ codeView makeSelectionVisible
+ ].
+ codeView acceptAction:[:code | self codeAccept:code asString]
+ ].
- "fetch rec here - so we wont need con in doItAction"
- rec := homeContext receiver.
- receiverInspector inspect:rec.
- codeView doItAction:[:theCode |
- rec class compiler
- evaluate:theCode
- in:nil
- receiver:rec
- notifying:codeView
- logged:true
- ifFail:nil
- ]
- ]
- ].
- selectedContext := homeContext
+ "fetch rec here - so we wont need context in doItAction"
+ rec := homeContext receiver.
+ ]
+ ].
+ receiverInspector inspect:rec.
+ codeView doItAction:[:theCode |
+ rec class compiler
+ evaluate:theCode
+ in:nil
+ receiver:rec
+ notifying:codeView
+ logged:true
+ ifFail:nil
+ ].
+
+ selectedContext := homeContext
].
"clear out locals to prevent keeping around unneeded contexts (due to the
block held in codeView).
@@ -1005,14 +1137,17 @@
con := nil.
homeContext := nil.
- contextView middleButtonMenu enable:#doImplementors.
- contextView middleButtonMenu enable:#doSenders.
- contextView middleButtonMenu enable:#doInspectContext.
+ m := contextView middleButtonMenu.
+ m notNil ifTrue:[
+ m enable:#doImplementors.
+ m enable:#doSenders.
+ m enable:#doInspectContext.
- (method notNil and:[method isWrapped]) ifTrue:[
- contextView middleButtonMenu enable:#doRemoveBreakpoint.
- ] ifFalse:[
- contextView middleButtonMenu disable:#doRemoveBreakpoint.
+ (method notNil and:[method isWrapped]) ifTrue:[
+ m enable:#doRemoveBreakpoint.
+ ] ifFalse:[
+ m disable:#doRemoveBreakpoint.
+ ]
]
!
@@ -1027,38 +1162,39 @@
codeView cursor:Cursor execute.
+ "
+ find the method-home context for this one
+ "
con := selectedContext.
top := con.
[con notNil] whileTrue:[
- (con methodHome == selectedContext) ifTrue:[
- top := con
- ].
- con := con sender
+ (con methodHome == selectedContext) ifTrue:[
+ top := con
+ ].
+ con := con sender
].
"now, remove everything up to and including top from context chain"
-"
- self setContext:(top sender).
-"
-
sel := selectedContext selector.
implementorClass := selectedContext searchClass whichClassImplements:sel.
method := implementorClass compiledMethodAt:sel.
newMethod := implementorClass compiler compile:someCode
- forClass:implementorClass
- inCategory:(method category)
- notifying:codeView.
+ forClass:implementorClass
+ inCategory:(method category)
+ notifying:codeView.
- "if it worked, remove everything up to and including top
- from context chain"
+ inspecting ifFalse:[
+ "if it worked, remove everything up to and including top
+ from context chain"
- (newMethod notNil and:[newMethod ~~ #Error]) ifTrue:[
- self setContext:(top sender).
+ (newMethod notNil and:[newMethod ~~ #Error]) ifTrue:[
+ self setContext:(top sender).
- "continue/step is no longer possible"
- canContinue := false.
- self showSelection:1.
- exitAction := #return
+ "continue/step is no longer possible"
+ canContinue := false.
+ self showSelection:1.
+ exitAction := #return
+ ].
].
codeView cursor:Cursor normal
!
@@ -1070,13 +1206,15 @@
receiverInspector release.
contextInspector release.
inspecting ifFalse:[
- canAbort ifTrue:[
- self doAbort.
- 'oops, abort failed' errorPrintNewline.
- ] ifFalse:[
- self doContinue
- ]
+ canAbort ifTrue:[
+ self doAbort.
+ 'oops, abort failed' errorPrintNewline.
+ ] ifFalse:[
+ self doContinue
+ ]
].
+ self autoUpdateOff.
+ inspectedProcess := nil.
super destroy
!
@@ -1092,12 +1230,12 @@
|implementorClass method|
implementorClass := selectedContext searchClass
- whichClassImplements:selectedContext selector.
+ whichClassImplements:selectedContext selector.
implementorClass notNil ifTrue:[
- method := implementorClass compiledMethodAt:selectedContext selector.
- (method notNil and:[method isWrapped]) ifTrue:[
- MessageTracer unwrapMethod:method
- ]
+ method := implementorClass compiledMethodAt:selectedContext selector.
+ (method notNil and:[method isWrapped]) ifTrue:[
+ MessageTracer unwrapMethod:method
+ ]
].
contextView middleButtonMenu disable:#doRemoveBreakpoint.
!
@@ -1106,7 +1244,7 @@
"open a browser on the senders"
selectedContext notNil ifTrue:[
- SystemBrowser browseAllCallsOn:selectedContext selector.
+ SystemBrowser browseAllCallsOn:selectedContext selector.
]
!
@@ -1114,7 +1252,7 @@
"open a browser on the implementors"
selectedContext notNil ifTrue:[
- SystemBrowser browseImplementorsOf:selectedContext selector.
+ SystemBrowser browseImplementorsOf:selectedContext selector.
]
!
@@ -1124,10 +1262,10 @@
|oldSelection|
contextArray notNil ifTrue:[
- oldSelection := contextView selection.
- nChainShown := nChainShown * 2.
- self setContext:contextArray first.
- contextView selection:oldSelection.
+ oldSelection := contextView selection.
+ nChainShown := nChainShown * 2.
+ self setContext:contextArray first.
+ contextView selection:oldSelection.
]
!
@@ -1137,16 +1275,16 @@
inspecting ifTrue:[^ self].
canContinue ifTrue:[
- steppedContextAddress := nil.
- haveControl := false.
- exitAction := #step.
- ProcessorScheduler isPureEventDriven ifFalse:[
- "exit private event-loop"
- catchBlock notNil ifTrue:[catchBlock value].
- 'oops, send failed' errorPrintNewline.
- self warn:'send failed'.
- sendButton turnOff; disable.
- ].
+ steppedContextAddress := nil.
+ haveControl := false.
+ exitAction := #step.
+ ProcessorScheduler isPureEventDriven ifFalse:[
+ "exit private event-loop"
+ catchBlock notNil ifTrue:[catchBlock value].
+ 'oops, send failed' errorPrintNewline.
+ self warn:'send failed'.
+ sendButton turnOff; disable.
+ ].
]
!
@@ -1156,21 +1294,21 @@
inspecting ifTrue:[^ self].
canContinue ifTrue:[
- selectedContext notNil ifTrue:[
- steppedContextAddress := ObjectMemory addressOf:selectedContext
- ] ifFalse:[
- steppedContextAddress := ObjectMemory addressOf:(contextArray at:2)
- ].
- bigStep := true.
- haveControl := false.
- exitAction := #step.
- ProcessorScheduler isPureEventDriven ifFalse:[
- "exit private event-loop"
- catchBlock notNil ifTrue:[catchBlock value].
- 'oops, step failed' errorPrintNewline.
- self warn:'step failed'.
- stepButton turnOff; disable.
- ].
+ selectedContext notNil ifTrue:[
+ steppedContextAddress := ObjectMemory addressOf:selectedContext
+ ] ifFalse:[
+ steppedContextAddress := ObjectMemory addressOf:(contextArray at:2)
+ ].
+ bigStep := true.
+ haveControl := false.
+ exitAction := #step.
+ ProcessorScheduler isPureEventDriven ifFalse:[
+ "exit private event-loop"
+ catchBlock notNil ifTrue:[catchBlock value].
+ 'oops, step failed' errorPrintNewline.
+ self warn:'step failed'.
+ stepButton turnOff; disable.
+ ].
]
!
@@ -1178,89 +1316,169 @@
"tracestep - not implemented yet"
canContinue ifTrue:[
- tracing := true.
- self doStep
+ tracing := true.
+ self doStep
]
!
doAbort
"abort from menu"
- inspecting ifTrue:[^ self].
+ inspecting ifTrue:[
+ inspectedProcess id isNil ifTrue:[
+ codeView contents:(resources string:'** process has terminated **')
+ ] ifFalse:[
+ inspectedProcess interruptWith:[Object abortSignal raise].
+ "
+ give it a chance to run, then update
+ "
+ (Delay forSeconds:0.2) wait.
+ self setContext:(inspectedProcess suspendedContext).
+ ].
+ ^ self
+ ].
steppedContextAddress := nil.
haveControl := false.
exitAction := #abort.
ProcessorScheduler isPureEventDriven ifFalse:[
- "exit private event-loop"
- catchBlock notNil ifTrue:[
- abortButton turnOff.
- catchBlock value.
- 'oops, abort failed' errorPrintNewline.
- self warn:'unwind failed'.
- abortButton disable.
- ]
+ "exit private event-loop"
+ catchBlock notNil ifTrue:[
+ abortButton turnOff.
+ catchBlock value.
+ 'oops, abort failed' errorPrintNewline.
+ self warn:'unwind failed'.
+ abortButton disable.
+ ]
].
^ self.
"obsolete ..."
Processor activeProcess id == 0 ifTrue:[
- "dont allow termination of main-thread"
- exitAction := #abort
+ "dont allow termination of main-thread"
+ exitAction := #abort
] ifFalse:[
- exitAction := #terminate
+ exitAction := #terminate
]
!
doTerminate
"terminate from menu"
+ inspecting ifTrue:[
+ inspectedProcess id isNil ifTrue:[
+ codeView contents:(resources string:'** process has already terminated **')
+ ] ifFalse:[
+ inspectedProcess terminate.
+ "
+ give it a chance to run, then update
+ "
+ (Delay forSeconds:0.2) wait.
+ self setContext:(inspectedProcess suspendedContext).
+ ].
+ ^ self
+ ].
+
steppedContextAddress := nil.
haveControl := false.
exitAction := #terminate.
ProcessorScheduler isPureEventDriven ifFalse:[
- "exit private event-loop"
- catchBlock notNil ifTrue:[catchBlock value].
- inspecting ifFalse:[
- 'oops, terminate failed' errorPrintNewline.
- self warn:'terminate failed'.
- ].
- terminateButton turnOff; disable.
+ "exit private event-loop"
+ catchBlock notNil ifTrue:[catchBlock value].
+ inspecting ifFalse:[
+ 'oops, terminate failed' errorPrintNewline.
+ self warn:'terminate failed'.
+ ].
+ terminateButton turnOff; disable.
].
!
+doQuickTerminate
+ "terminate from menu"
+
+ inspecting ifTrue:[
+ inspectedProcess id isNil ifTrue:[
+ codeView contents:(resources string:'** process has already terminated **')
+ ] ifFalse:[
+ inspectedProcess terminateNoSignal.
+ "
+ give it a chance to run, then update
+ "
+ (Delay forSeconds:0.2) wait.
+ self setContext:(inspectedProcess suspendedContext).
+ ].
+ ^ self
+ ].
+
+ steppedContextAddress := nil.
+ haveControl := false.
+ exitAction := #quickTerminate.
+ ProcessorScheduler isPureEventDriven ifFalse:[
+ "exit private event-loop"
+ catchBlock notNil ifTrue:[catchBlock value].
+ inspecting ifFalse:[
+ 'oops, terminate failed' errorPrintNewline.
+ self warn:'terminate failed'.
+ ].
+ terminateButton turnOff; disable.
+ ].
+!
doReturn
"return from menu"
- inspecting ifTrue:[^ self].
+ inspecting ifTrue:[
+ inspectedProcess id isNil ifTrue:[
+ codeView contents:(resources string:'** process has terminated **')
+ ] ifFalse:[
+ inspectedProcess interruptWith:[selectedContext return].
+ "
+ give it a chance to run, then update
+ "
+ (Delay forSeconds:0.2) wait.
+ self setContext:(inspectedProcess suspendedContext).
+ ].
+ ^ self
+ ].
steppedContextAddress := nil.
haveControl := false.
exitAction := #return.
ProcessorScheduler isPureEventDriven ifFalse:[
- "exit private event-loop"
- catchBlock notNil ifTrue:[catchBlock value].
- 'oops, return failed' errorPrintNewline.
- self warn:'return failed'.
- returnButton turnOff; disable.
+ "exit private event-loop"
+ catchBlock notNil ifTrue:[catchBlock value].
+ 'oops, return failed' errorPrintNewline.
+ self warn:'return failed'.
+ returnButton turnOff; disable.
].
!
doRestart
"restart from menu"
- inspecting ifTrue:[^ self].
+ inspecting ifTrue:[
+ inspectedProcess id isNil ifTrue:[
+ codeView contents:(resources string:'** process has terminated **')
+ ] ifFalse:[
+ inspectedProcess interruptWith:[selectedContext restart].
+ "
+ give it a chance to run, then update
+ "
+ (Delay forSeconds:0.2) wait.
+ self setContext:(inspectedProcess suspendedContext).
+ ].
+ ^ self
+ ].
steppedContextAddress := nil.
haveControl := false.
exitAction := #restart.
ProcessorScheduler isPureEventDriven ifFalse:[
- "exit private event-loop"
- catchBlock notNil ifTrue:[catchBlock value].
- 'oops, restart failed' errorPrintNewline.
- self warn:'restart failed'.
- restartButton turnOff; disable
+ "exit private event-loop"
+ catchBlock notNil ifTrue:[catchBlock value].
+ 'oops, restart failed' errorPrintNewline.
+ self warn:'restart failed'.
+ restartButton turnOff; disable
].
!
@@ -1273,21 +1491,21 @@
false ifTrue:[
traceView isNil ifTrue:[
- v := StandardSystemView on:Display.
- v label:'Debugger-Trace'.
- v icon:icon.
+ v := StandardSystemView on:Display.
+ v label:'Debugger-Trace'.
+ v icon:icon.
- b := Button label:'untrace' in:v.
- b origin:(0 @ 0) extent:(1.0 @ (b height)).
- b action:[
- StepInterruptPending := false.
- tracing := false.
- v unrealize.
- traceView := nil
- ].
- traceView := ScrollableView for:TextCollector in:v.
- traceView origin:(0 @ (b height))
- extent:[v width @ (v height - b height)]
+ b := Button label:'untrace' in:v.
+ b origin:(0 @ 0) extent:(1.0 @ (b height)).
+ b action:[
+ StepInterruptPending := false.
+ tracing := false.
+ v unrealize.
+ traceView := nil
+ ].
+ traceView := ScrollableView for:TextCollector in:v.
+ traceView origin:(0 @ (b height))
+ extent:[v width @ (v height - b height)]
].
v realize.
].
@@ -1296,40 +1514,102 @@
doNoTrace
traceView notNil ifTrue:[
- traceView topView destroy.
- traceView := nil.
+ traceView topView destroy.
+ traceView := nil.
].
tracing := false
!
+doStop
+ "stop the process (if its running, otherwise this is a no-op)"
+
+ inspecting ifTrue:[
+ inspectedProcess id isNil ifTrue:[
+ codeView contents:(resources string:'** process has terminated **')
+ ] ifFalse:[
+ inspectedProcess suspend.
+ self setContext:(inspectedProcess suspendedContext).
+ ].
+ ^ self
+ ].
+!
+
doContinue
"continue from menu"
+ inspecting ifTrue:[
+ inspectedProcess id isNil ifTrue:[
+ codeView contents:(resources string:'** process has terminated **')
+ ] ifFalse:[
+ inspectedProcess resume.
+ "
+ give it a chance to run, then update
+ "
+ (Delay forSeconds:0.2) wait.
+ self setContext:(inspectedProcess suspendedContext).
+ ].
+ ^ self
+ ].
canContinue ifTrue:[
- steppedContextAddress := nil.
- tracing := false.
- haveControl := false.
- exitAction := #continue.
- ProcessorScheduler isPureEventDriven ifFalse:[
- "exit private event-loop"
- catchBlock notNil ifTrue:[catchBlock value].
- 'oops, continue failed' errorPrintNewline.
- self warn:'continue failed'.
- continueButton turnOff; disable
- ].
+ steppedContextAddress := nil.
+ tracing := false.
+ haveControl := false.
+ exitAction := #continue.
+ ProcessorScheduler isPureEventDriven ifFalse:[
+ "exit private event-loop"
+ catchBlock notNil ifTrue:[catchBlock value].
+ 'oops, continue failed' errorPrintNewline.
+ self warn:'continue failed'.
+ continueButton turnOff; disable
+ ].
] ifFalse:[
- inspecting ifFalse:[
- 'resuming top context' errorPrintNewline.
- self showSelection:1.
- self doReturn
- ]
+ inspecting ifFalse:[
+ 'resuming top context' errorPrintNewline.
+ self showSelection:1.
+ self doReturn
+ ]
]
!
doInspectContext
"launch an inspector on the currently selected context"
- selectedContext notNil ifTrue:[
- selectedContext inspect
+ contextView selection notNil ifTrue:[
+ (contextView selectionValue startsWith:'**') ifFalse:[
+ (contextArray at:(contextView selection)) inspect.
+ ]
+ ]
+!
+
+autoUpdateOff
+ updateProcess notNil ifTrue:[
+ monitorToggle lampColor:(Color yellow).
+ updateProcess terminate.
+ updateProcess := nil
]
+!
+
+autoUpdateOn
+ updateProcess isNil ifTrue:[
+ updateProcess :=
+ [
+ [true] whileTrue:[
+ monitorToggle showLamp ifTrue:[
+ monitorToggle lampColor:(Color yellow).
+ ] ifFalse:[
+ monitorToggle activeForegroundColor:Color black.
+ ].
+ (Delay forSeconds:0.25) wait.
+ self updateContext.
+ monitorToggle showLamp ifTrue:[
+ monitorToggle lampColor:(Color red).
+ ] ifFalse:[
+ monitorToggle activeForegroundColor:Color red.
+ ].
+ (Delay forSeconds:0.25) wait.
+ self updateContext.
+ ]
+ ] forkAt:(Processor activePriority - 1)
+ ]
+
! !