"
COPYRIGHT (c) 1989 by Claus Gittinger
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
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
StandardSystemView subclass:#DebugView
instanceVariableNames:'busy haveControl exitAction canContinue contextView codeView
receiverInspector contextInspector contextArray selectedContext
catchBlock grabber traceView tracing bigStep skipLineNr
steppedContextAddress abortButton terminateButton continueButton
stepButton nextButton nextOverButton nextOutButton sendButton
returnButton restartButton exclusive inspecting nChainShown
inspectedProcess updateProcess stopButton updateButton
monitorToggle stepping steppedContextLineno stepForReturn
actualContext inWrap stackInspector steppedContext wrapperContext
verboseBacktrace firstContext stepHow cachable'
classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail
DebuggingDebugger VerboseBacktraceDefault DefaultIcon
InitialNCHAINShown'
poolDictionaries:''
category:'Interface-Debugger'
!
!DebugView class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
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
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
This class implements a graphical debugger interface.
The debugger usually sits on top of the faulting process,
taking over its event processing. Thus only the 'stopped' process is affected;
other processes continue to respond to events.
The one exception is when an error occurs within the dispatcher process
or in one of the eventhandler processes - in this case, the debugger
will sit on an exclusive display connection.
The whole debugging will be changed, once the required process primitives
are available, which allow control of another processes execution
(i.e. single-step, restart & return). The setup will be changed then,
to have the debugger control the debuggee (i.e. two processes)
See additional information in 'doc/misc/debugger.doc'.
Notice: the DebugView class caches the last used debugger in a class
variable. It may happen, that a malfunctioning debugger (for example,
a halfway destroyed one) is kept there. You will notice this, if a
debugger comes up without showing any contents. In this case, close
(or destroy) the broken debugView, and execute
Debugger newDebugger
which removes the cached debugger and forces creation of a new one the
next time. This is a temporary workaround - the debugger will be fixed to
avoid this problem.
[author:]
Claus Gittinger
[see also:]
Exception Signal
Process
"
! !
!DebugView class methodsFor:'initialization'!
initialize
InitialNCHAINShown := 20.
"Created: 20.3.1997 / 16:53:37 / cg"
"Modified: 20.3.1997 / 16:54:32 / cg"
!
reinitialize
self newDebugger
! !
!DebugView class methodsFor:'instance creation'!
enter
"another way of entering the debugger"
^ self enter:(thisContext sender) withMessage:'Debugger'
"Debugger enter"
!
enter:aContext
"enter the debugger on aContext"
^ self enter:aContext withMessage:'Debugger'
!
enter:aContext withMessage:aString
"enter a debugger; if this is a recursive invocation, enter
a MiniDebugger instead.
This is the standard way of entering the debugger;
sent from error- and halt messages."
|active found c|
StepInterruptPending := nil.
thisContext isRecursive ifTrue:[
"/ care for the special case, were the Debugger was autoloaded.
"/ in this case, thisContext IS recursive, but thats no error
"/ condition.
found := false.
c := thisContext sender.
[found not
and:[c notNil
and:[c selector ~~ #enter:withMessage:]]] whileTrue:[
c selector == #noByteCode ifTrue:[
found := true
].
c := c sender
].
found ifFalse:[
('DebugView [warning]: reentered with: ', aString) errorPrintCR.
^ MiniDebugger
enterWithMessage:'DebugView [error]: recursive error (in debugger)'.
]
].
"
well, it could be a stepping or sending debugger up there;
in this case, return to it. This happens, when a stepping process
runs into an error (for example, a halt). In this case, we want the
stepping debugger to come up again instead of a new one.
"
OpenDebuggers notNil ifTrue:[
active := Processor activeProcess.
OpenDebuggers do:[:aDebugger |
(aDebugger notNil and:[aDebugger ~~ 0]) ifTrue:[
(aDebugger inspectedProcess == active) ifTrue:[
"/ 'entering stepping debugger again' printNL.
aDebugger unstep.
aDebugger setLabelFor:aString in:active.
^ aDebugger enter:aContext select:nil.
]
]
]
].
^ self enterUnconditional:aContext withMessage:aString
"Modified: / 30.10.1997 / 21:09:12 / cg"
!
enterUnconditional:aContext withMessage:aString
"enter a debugger - do not check for recursive invocation"
|aDebugger breakpointSignal proc|
StepInterruptPending := nil.
proc := Processor activeProcess.
(MessageTracer notNil and:[MessageTracer isLoaded]) ifTrue:[
breakpointSignal := MessageTracer breakpointSignal.
].
breakpointSignal notNil ifTrue:[
breakpointSignal handle:[:ex |
'DebugView [info]: breakpoint in debugger ignored' infoPrintCR.
ex proceed
] do:[
aDebugger := self new.
aDebugger setLabelFor:aString in:proc.
aDebugger enter:aContext select:nil.
]
] ifFalse:[
aDebugger := self new.
aDebugger setLabelFor:aString in:proc.
aDebugger enter:aContext select:nil.
].
^ nil
"nil halt"
"Modified: / 30.10.1997 / 21:10:55 / cg"
!
enterWithMessage:aString
"the standard way of entering the debugger - sent from Objects
error- and halt messages"
^ self enter:(thisContext sender) withMessage:aString
"Debugger enterWithMessage:'hi there'"
!
new
"return a new DebugView - return a cached debugger if it already
exists"
|debugger|
"
need a blocking debugger if no processes or
or if its a timing/interrupt process
(because otherwise we would not get any events here ...
"
Processor activeProcessIsSystemProcess ifTrue:[
(CachedExclusive isNil
or:[CachedExclusive device ~~ Screen current]) ifTrue:[
debugger := self newExclusive
] ifFalse:[
debugger := CachedExclusive.
CachedExclusive := nil.
].
] ifFalse:[
CachedDebugger notNil ifTrue:[
(CachedDebugger device ~~ Screen current
or:[CachedDebugger device isOpen not]) ifTrue:[
CachedDebugger := nil
]
].
CachedDebugger isNil ifTrue:[
Screen current isOpen ifFalse:[
DeviceWorkstation currentScreenQuerySignal handle:[:ex |
ex proceedWith:Display
] do:[
debugger := super new.
]
] ifTrue:[
debugger := super new.
].
debugger label:'Debugger'.
debugger icon:self defaultIcon.
] ifFalse:[
debugger := CachedDebugger.
CachedDebugger := nil.
]
].
^ debugger
"Modified: 31.7.1997 / 21:20:27 / cg"
!
newExclusive
"return a debugger for exclusive display access"
|debugger|
debugger := super new.
debugger label:'Debugger'.
debugger icon:self defaultIcon.
debugger exclusive:true.
^ debugger
"Modified: 1.1.1970 / 23:27:06 / cg"
!
openOn:aProcess
"start a debugger on aProcess
(actually not more than a good-looking inspector)"
|aDebugger label nm|
aDebugger := super new.
aDebugger icon:self defaultIcon.
aProcess notNil ifTrue:[
nm := aProcess name.
nm notNil ifTrue:[
nm := (nm contractTo:17) , '-' , aProcess id printString
] ifFalse:[
nm := aProcess id printString
].
label := 'Debugger [' , nm , ']'.
] ifFalse:[
label := 'no process'
].
aDebugger label:label iconLabel:'Debugger'.
aDebugger openOn:aProcess.
^ nil
"Modified: 4.4.1997 / 16:22:36 / cg"
! !
!DebugView class methodsFor:'cleanup'!
lowSpaceCleanup
"in low memory situations, give up cached debuggers"
CachedDebugger := nil.
CachedExclusive := nil.
OpenDebuggers := nil.
"
DebugView lowSpaceCleanup
"
"Modified: 18.4.1996 / 16:48:03 / cg"
!
newDebugger
"force creation of a new debugger"
CachedDebugger := nil.
CachedExclusive := nil.
OpenDebuggers := nil.
"
DebugView newDebugger
"
! !
!DebugView class methodsFor:'defaults'!
defaultIcon
"return the debuggers default window icon"
<resource: #style (#ICON #ICON_FILE)>
|nm i|
(i := DefaultIcon) isNil ifTrue:[
i := self classResources at:'ICON' default:nil.
i isNil ifTrue:[
nm := ClassResources at:'ICON_FILE' default:'Debugger.xbm'.
i := Image fromFile:nm resolution:100.
i isNil ifTrue:[
i := Image fromFile:('bitmaps/' , nm) resolution:100.
i isNil ifTrue:[
i := StandardSystemView defaultIcon
]
]
].
i notNil ifTrue:[
DefaultIcon := i := i on:Display
]
].
^ i
"Modified: 19.3.1997 / 20:48:34 / ca"
"Modified: 18.4.1997 / 15:16:27 / cg"
!
defaultVerboseBacktrace
^ VerboseBacktraceDefault
"Created: 11.1.1997 / 12:14:35 / cg"
!
defaultVerboseBacktrace:aBoolean
VerboseBacktraceDefault := aBoolean
"Created: 11.1.1997 / 12:14:44 / cg"
! !
!DebugView class methodsFor:'misc'!
interestingContextFrom:aContext
"return an interesting contexts offset, or nil.
This is the context initially shown in the walkback.
We move up the calling chain, skipping all intermediate Signal
and Exception contexts, to present the context in which the error
actually occured.
Just for your convenience :-)"
|delta con|
delta := self interestingContextIndexFrom:aContext.
con := aContext.
[con notNil and:[delta > 1]] whileTrue:[
con := con sender.
delta := delta - 1.
].
con isNil ifTrue:[
^ aContext
].
^ con
"Modified: 11.1.1997 / 17:58:44 / cg"
!
interestingContextIndexFrom:aContext
"return an interesting contexts offset, or nil.
This is the context initially shown in the walkback.
We move up the calling chain, skipping all intermediate Signal
and Exception contexts, to present the context in which the error
actually occured.
Just for your convenience :-)"
|c found offset sel prev ex|
aContext isNil ifTrue:[^ 1].
aContext isBlockContext ifTrue:[^ 1].
VerboseBacktraceDefault == true ifTrue:[^ 1].
"/ somewhere, at the bottom, there must be a raise ...
"/ find the exception
c := aContext.
1 to:5 do:[:i |
c isNil ifTrue:[^ 1].
sel := c selector.
((sel == #raise)
or:[sel == #raiseRequest]) ifTrue:[
(c receiver isKindOf:Exception) ifTrue:[
ex := c receiver.
offset := i.
found := c
] ifFalse:[
(c receiver isSignal) ifTrue:[
offset := i.
found := c
]
]
].
c := c sender.
].
"
if this is a noHandler exception, skip forward
to the erronous context
"
ex notNil ifTrue:[
ex signal == Signal noHandlerSignal ifTrue:[
c := ex suspendedContext
]
].
(c := found) isNil ifTrue:[
"/ this is a kludge, but convenient.
"/ show the place where the divisionByZero happend,
"/ not where the signal was raised.
sel := aContext selector.
(sel == #//
or:[sel == #/
or:[sel == #\\]]) ifTrue:[
^ 2
].
^ 1
].
"
got it; move up, skipping all intermediate Signal and
Exception contexts
"
prev := nil.
[
((c receiver isSignal)
or:[(c receiver isKindOf:Exception)])
] whileTrue:[
prev := c.
(c := c sender) isNil ifTrue:[^ offset].
offset := offset + 1.
].
"
now, we are one above the raising context
"
"
if the sender-method of the raise is one of objects error methods ...
"
( #( halt halt:
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.
] ifFalse:[
"
ok, got the raise - if its a BreakPoint, look for the sender
"
(MessageTracer notNil
and:[MessageTracer isLoaded
and:[prev receiver == MessageTracer breakpointSignal]]) ifTrue:[
offset := offset + 1
].
].
^ offset
"Created: 7.1.1997 / 21:26:05 / cg"
"Modified: 27.3.1997 / 18:24:59 / cg"
! !
!DebugView methodsFor:'basic'!
enter
"enter the debugger - on the sending context"
|where|
busy := true.
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"
].
^ self enter:where select:nil
"Modified: / 30.10.1997 / 21:11:29 / cg"
!
enter:aContext select:initialSelectionOrNil
"enter the debugger - get and display the context, then start an
exclusive event loop on top of eveything else"
|con selection m idx retval enteredByInterrupt sel con1 con2|
verboseBacktrace := VerboseBacktraceDefault ? false.
busy := cachable := true.
inspecting := false.
inspectedProcess := Processor activeProcess.
stepping := false.
bigStep := false.
stepHow := nil.
nChainShown := InitialNCHAINShown.
"if debugger is entered while a box has grabbed the
pointer, we must ungrab - otherwise X wont talk to
us here
"
"/ (grabber := device activePointerGrab) notNil ifTrue:[
"/ device ungrabPointer.
"/ device ungrabKeyboard.
"/ ].
"/ on a multiUser system, better ungrab all of them ...
Screen allScreens do:[:aScreen |
aScreen ungrabPointer.
aScreen ungrabKeyboard.
].
("inspectedProcess suspendedContext isNil
or:["inspectedProcess isSystemProcess"]") ifTrue:[
terminateButton disable.
] ifFalse:[
terminateButton enable.
abortButton enable.
].
drawableId notNil ifTrue:[
"
not the first time - disable buttons & menus
from previous life
"
terminateButton turnOffWithoutRedraw.
continueButton turnOffWithoutRedraw.
returnButton turnOffWithoutRedraw.
restartButton turnOffWithoutRedraw.
abortButton turnOffWithoutRedraw.
nextButton turnOffWithoutRedraw.
stepButton turnOffWithoutRedraw.
sendButton turnOffWithoutRedraw.
m := contextView middleButtonMenu.
m notNil ifTrue:[
m disableAll:#(showMore skip skipForReturn inspectContext).
].
verboseBacktrace
ifTrue:[self showVerboseBacktrace]
ifFalse:[self showDenseBacktrace].
] ifFalse:[
self iconLabel:'Debugger'.
].
windowGroup isNil ifTrue:[
windowGroup := WindowGroup new.
windowGroup addTopView:self.
].
exclusive ifFalse:[
"/ create a (modal) windowGroup for myself
windowGroup setModal:true.
] ifTrue:[
"/ create a windowGroup with a synchronous sensor for me
windowGroup sensor:(SynchronousWindowSensor new).
].
windowGroup setProcess:Processor activeProcess.
"
get the walkback list; clear inspectors if we did not come here by single stepping)
"
self setContext:aContext releaseInspectors:(exitAction ~~ #step).
initialSelectionOrNil notNil ifTrue:[
selection := initialSelectionOrNil
] ifFalse:[
"
and find the one context to show initially
- if we came here by a send (single step), its the top context;
- if we came here by a step (i.e. bigStep), its the top context
(for ifs and whiles) or the sender (for regular sends).
- otherwise, we came here by some signal raise, and we are interested
in the context where the raise actually occured.
"
con1 := (contextArray at:1 ifAbsent:nil).
con2 := (contextArray at:2 ifAbsent:nil).
exitAction == #step ifTrue:[
selection := 1.
steppedContext notNil ifTrue:[
"
if we came here by a big-step, show the method where we are
"
con1 == steppedContext ifTrue:[
selection := 1
] ifFalse:[
con2 == steppedContext ifTrue:[
selection := 2
]
].
"
for bigStep, we could also be in a block below the actual method ...
"
(con1 home notNil
and:[con1 home == steppedContext]) ifTrue:[
selection := 1
] ifFalse:[
(con2 home notNil
and:[con2 home == steppedContext]) ifTrue:[
selection := 2
]
].
]
] ifFalse:[
steppedContext isNil ifTrue:[
"
preselect a more interesting context, (where halt/raise was ...)
"
selection := self class interestingContextIndexFrom:aContext.
] ifFalse:[
"
if we came here by a big-step, show the method where we are
"
con1 == steppedContext ifTrue:[
selection := 1
] ifFalse:[
con2 == steppedContext ifTrue:[
selection := 2
]
]
]
].
con1 := nil.
con2 := nil.
].
selection notNil ifTrue:[
self showSelection:selection.
contextView setSelection:selection.
selection > 1 ifTrue:[
contextView scrollToLine:(selection - 1)
]
].
m := contextView middleButtonMenu.
m notNil ifTrue:[
(inspecting or:[Object abortSignal isHandled]) 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.
]
].
"
drawableId is nil, if this is a new debugger. Then do a realize.
Otherwise, its probably better to do a map, which shows the
view at the previous position, without a need for the user to set the
position again
"
drawableId notNil ifTrue:[
self remap.
] ifFalse:[
self realize.
].
self realizeAllSubViews.
exclusive ifTrue:[
self showError:'
Debugging system process `' , (inspectedProcess nameOrId) printString , '''.
This is a modal debugger - all event processing is stopped..
Therefore, you cannot interact with other views or
open any other tools while this debugger is active.
Also, there is no event processing (redraw) for other views.'
].
"/
"/ bring us to the top
"/
self raise.
"/
"/ wait until realized ...
"/ - kludge; I have (currently) no idea, why this is needed ...
"/
windowGroup eventLoopWhile:[self shown not] onLeave:[].
self withAllSubViewsDo:[:v | v invalidate].
canContinue := true.
exitAction := nil.
"
enter private event handling loop. This is left (and we come back here again)
when any button was pressed which requires continuation of the debuggee or
closedown of the debugger.
"
[self controlLoop] valueOnUnwindDo:[
windowGroup notNil ifTrue:[
windowGroup setProcess:nil.
].
self destroy
].
"
release all context stuff.
This is required to avoid keeping references to the debuggees objects
forever. (since the debugger is reused for faster startup next time)
"
contextArray := nil.
contextView contents:nil.
codeView acceptAction:nil.
codeView doItAction:nil.
"/ codeView contents:nil.
(exitAction ~~ #step) ifTrue:[
receiverInspector release.
contextInspector release.
self unmap.
device flush.
(exitAction == #abort) ifTrue:[
self cacheMyself.
"
have to catch errors occuring in unwind-blocks
"
ErrorSignal handle:[:ex |
'DebugView [info]: ignored error while unwinding: ' infoPrint.
ex errorString infoPrintCR.
ex proceed
] do:[
Object abortSignal raise.
].
'DebugView [warning]: abort failed' errorPrintCR
].
(exitAction == #return) ifTrue:[
selectedContext notNil ifTrue:[
"
if there is a selection in the codeView,
evaluate it and use the result as return value
"
"/ disabled for now, there is almost always a selection (the current line)
"/ and that is syntactically incorrect ...
"/ ... leading to a popup warning from the codeView
"/
"/ codeView hasSelection ifTrue:[
"/ Object errorSignal handle:[:ex |
"/ 'DebugView [warning]: error - returning nil' errorPrintCR.
"/ retval := nil.
"/ ex return
"/ ] do:[
"/ |s|
"/
"/ s := codeView selection asString.
"/ retval := codeView doItAction value:s.
"/ ].
"/ ].
con := selectedContext.
self cacheMyself.
"
have to catch errors occuring in unwind-blocks
"
Object errorSignal handle:[:ex |
'DebugView [info]: ignored error while unwinding: ' errorPrint.
ex errorString errorPrintCR.
ex proceed
] do:[
con unwind:retval.
].
'DebugView [warning]: cannot return from selected context' errorPrintCR
]
].
(exitAction == #restart) ifTrue:[
selectedContext notNil ifTrue:[
con := selectedContext.
self cacheMyself.
"
have to catch errors occuring in unwind-blocks
"
Object errorSignal handle:[:ex |
'DebugView [info]: ignored error while unwinding: ' infoPrint.
ex errorString infoPrintCR.
ex proceed
] do:[
con unwindAndRestart.
].
'DebugView [warning]: cannot restart selected context' errorPrintCR
]
].
(exitAction == #quickTerminate) ifTrue:[
self cacheMyself.
Processor activeProcess terminateNoSignal
].
(exitAction == #terminate) ifTrue:[
self cacheMyself.
"
have to catch errors occuring in unwind-blocks
"
Object errorSignal handle:[:ex |
'DebugView [info]: ignored error while unwinding: ' infoPrint.
ex errorString infoPrintCR.
ex proceed
] do:[
Processor activeProcess terminate.
].
'DebugView [warning]: cannot terminate process' errorPrintCR
]
].
selectedContext := actualContext := firstContext := nil.
grabber notNil ifTrue:[
device grabPointerInView:grabber.
grabber := nil.
].
(exitAction == #step) ifTrue:[
"
schedule another stepInterrupt
- must enter myself into the collection of open debuggers,
in case the stepping process comes back again via a halt or signal
before the step is finished. In this case, the stepping debugger should
come up (instead of a new one)
- must flush caches since optimized methods not always
look for pending interrupts
"
"/
"/ also must care for stepping into a return
"/
steppedContext notNil ifTrue:[
Processor activeProcess forceInterruptOnReturnOf:steppedContext.
].
OpenDebuggers isNil ifTrue:[
OpenDebuggers := WeakArray with:self
] ifFalse:[
(OpenDebuggers includes:self) ifFalse:[
idx := OpenDebuggers identityIndexOf:nil.
idx == 0 ifTrue:[
idx := OpenDebuggers identityIndexOf:0
].
idx ~~ 0 ifTrue:[
OpenDebuggers at:idx put:self
] ifFalse:[
OpenDebuggers := OpenDebuggers copyWith:self
]
]
].
self label:'single stepping - please wait ...'.
stepping := true.
ObjectMemory stepInterruptHandler:self.
Context singleStepInterruptRequest isHandled ifTrue:[
"bigStep" steppedContextLineno notNil ifTrue:[
Context singleStepInterruptRequest raiseWith:#next
] ifFalse:[
Context singleStepInterruptRequest raiseWith:#step
]
] ifFalse:[
"/ see if we came here through an interrupt-action
"/ (i.e. aProcess interruptWith:...)
enteredByInterrupt := false.
con := thisContext findNextContextWithSelector:#timerInterrupt or:#ioInterrupt or:nil.
[enteredByInterrupt not
and:[con notNil
and:[con ~~ aContext]]] whileTrue:[
((sel := con selector) == #timerInterrupt
or:[sel == #ioInterrupt]) ifTrue:[
enteredByInterrupt := true.
] ifFalse:[
con := con findNextContextWithSelector:#timerInterrupt or:#ioInterrupt or:nil.
].
].
ObjectMemory flushInlineCaches.
DebuggingDebugger == true ifTrue:[
enteredByInterrupt printCR.
].
enteredByInterrupt ifTrue:[
"/ dont want to step through all intermediate
"/ (scheduler-) contexts; place a return-trap on the
"/ one right below the interesting one
"/ 'special unwind return' printCR.
con unwindThenDo:[
ObjectMemory stepInterruptHandler:self.
InStepInterrupt := nil.
StepInterruptPending := 1.
InterruptPending := 1].
] ifFalse:[
"/ 'normal step return' printCR.
skipLineNr ~~ #return ifTrue:[
StepInterruptPending := 1.
InterruptPending := 1.
] ifFalse:[
"/ 'step for return' printCR.
]
].
InStepInterrupt := nil
]
] ifFalse:[
OpenDebuggers notNil ifTrue:[
idx := OpenDebuggers identityIndexOf:self.
idx ~~ 0 ifTrue:[
OpenDebuggers at:idx put:nil
]
].
self cacheMyself.
]
"Modified: / 17.4.1997 / 13:01:32 / stefan"
"Created: / 30.10.1997 / 21:08:18 / cg"
"Modified: / 5.2.1998 / 17:14:17 / cg"
!
openOn:aProcess
"enter the debugger on a process -
in this case, we are just inspecting the context chain of the process,
not running on top of the debugged process, but as a separate
one. (think of it as an inspector showing more detail, and offering
some more control operations)"
|bpanel dummy w|
verboseBacktrace := VerboseBacktraceDefault ? false.
busy := true.
bigStep := false.
stepHow := nil.
inspecting := true.
inspectedProcess := aProcess.
nChainShown := InitialNCHAINShown.
bpanel := abortButton superView.
bpanel ignoreInvisibleComponents:true.
"/ get the max size & freeze button
continueButton label:(resources at:'continue').
w := continueButton preferredExtent x.
continueButton label:(resources at:'stop').
w := w max:(continueButton preferredExtent x).
continueButton preferredExtent:(w @ continueButton preferredExtent y).
aProcess state == #run ifTrue:[
device hasColors ifTrue:[
continueButton foregroundColor:Color red darkened.
].
continueButton label:(resources at:'stop').
continueButton action:[self doStop].
] ifFalse:[
device hasColors ifTrue:[
continueButton foregroundColor:Color green darkened darkened.
].
continueButton label:(resources at:'continue').
continueButton action:[self doContinue].
].
returnButton disable.
restartButton disable.
dummy := View extent:(10 @ 5) in:bpanel.
dummy borderWidth:0; level:0.
"/ 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.
terminateButton enable.
abortButton enable.
sendButton disable.
sendButton beInvisible.
stepButton disable.
stepButton beInvisible.
nextButton disable.
nextButton beInvisible.
nextOverButton disable.
nextOverButton beInvisible.
nextOutButton disable.
nextOutButton beInvisible.
aProcess isNil ifTrue:[
terminateButton disable.
abortButton disable.
continueButton disable.
returnButton disable.
restartButton disable.
] ifFalse:[
(aProcess suspendedContext isNil
or:[aProcess isSystemProcess]) ifTrue:[
terminateButton disable.
].
self setContextSkippingInterruptContexts:aProcess suspendedContext.
catchBlock := [
catchBlock := nil.
contextArray := nil.
selectedContext := actualContext := firstContext := nil.
steppedContext := wrapperContext := nil.
(exitAction == #terminate) ifTrue:[
aProcess terminate.
].
(exitAction == #quickTerminate) ifTrue:[
aProcess terminateNoSignal.
].
super destroy
].
].
self open
"Modified: 20.3.1997 / 16:53:56 / cg"
"Modified: 17.4.1997 / 13:01:57 / stefan"
! !
!DebugView methodsFor:'help'!
helpTextFor:aComponent
|s|
aComponent == abortButton ifTrue:[
s := 'HELP_ABORT'
].
aComponent == terminateButton ifTrue:[
s := 'HELP_TERMINATE'
].
aComponent == continueButton ifTrue:[
continueButton label = (resources string:'stop') ifTrue:[
s := 'HELP_STOP'
] ifFalse:[
s := 'HELP_CONTINUE'
]
].
aComponent == stepButton ifTrue:[
s := 'HELP_STEP'
].
aComponent == nextButton ifTrue:[
s := 'HELP_NEXT'
].
aComponent == nextOverButton ifTrue:[
s := 'HELP_NEXTOVER'
].
aComponent == nextOutButton ifTrue:[
s := 'HELP_NEXTOUT'
].
aComponent == stepButton ifTrue:[
s := 'HELP_STEP'
].
aComponent == sendButton ifTrue:[
s := 'HELP_SEND'
].
aComponent == returnButton ifTrue:[
s := 'HELP_RETURN'
].
aComponent == restartButton ifTrue:[
s := 'HELP_RESTART'
].
aComponent == contextView ifTrue:[
s := 'HELP_WALKBACK'
].
aComponent == codeView ifTrue:[
s := 'HELP_CODEVIEW'
].
aComponent == monitorToggle ifTrue:[
s := 'HELP_MONITOR'
].
aComponent == updateButton ifTrue:[
s := 'HELP_UPDATE'
].
"/ aComponent == stopButton ifTrue:[
"/ s := 'HELP_STOP'
"/ ].
(aComponent isComponentOf:receiverInspector) ifTrue:[
s := 'HELP_REC_INSP'
].
(aComponent isComponentOf:contextInspector) ifTrue:[
s := 'HELP_CON_INSP'
].
s notNil ifTrue:[
^ resources string:s
].
^ nil
"Modified: 29.8.1995 / 23:38:54 / claus"
"Modified: 4.3.1997 / 01:54:03 / cg"
! !
!DebugView methodsFor:'initialization'!
addToCurrentProject
"ignored here"
^ self
!
initialize
|v panel hpanel bpanel separator img|
super initialize.
font := font on:device.
verboseBacktrace := VerboseBacktraceDefault ? false.
busy := false.
exclusive := false.
inspecting := false.
exitAction := nil.
bigStep := false.
stepHow := nil.
canContinue := false.
bpanel := HorizontalPanelView
"/ origin:(0.0 @ 0.0)
"/ extent:(1.0 @ (font height * 2))
in:self.
bpanel horizontalLayout:#left.
bpanel verticalLayout:#centerMax.
bpanel verticalSpace:ViewSpacing // 2.
abortButton := Button
label:(resources at:'abort')
action:[abortButton turnOffWithoutRedraw. self doAbort]
in:bpanel.
separator := View extent:(10 @ 5) in:bpanel.
separator borderWidth:0; level:0.
continueButton := Button
label:(resources at:'continue')
action:[continueButton turnOffWithoutRedraw. self doContinue]
in:bpanel.
separator := View extent:(10 @ 5) in:bpanel.
separator borderWidth:0; level:0.
returnButton := Button
label:(resources at:'return')
action:[returnButton turnOff. self doReturn]
in:bpanel.
restartButton := Button
label:(resources at:'restart')
action:[restartButton turnOff. self doRestart]
in:bpanel.
separator := View extent:(10 @ 5) in:bpanel.
separator borderWidth:0; level:0.
img := Image fromFile:'bitmaps/stepIn.xpm'.
img isNil ifTrue:[
img := (resources at:'next')
].
nextButton := Button
label:img
action:[stepButton turnOff. self doNext]
in:bpanel.
img := Image fromFile:'bitmaps/stepOver.xpm'.
img isNil ifTrue:[
img := (resources at:'over')
].
nextOverButton := Button
label:img
action:[stepButton turnOff. self doNextOver]
in:bpanel.
img := Image fromFile:'bitmaps/stepOut.xpm'.
img isNil ifTrue:[
img := (resources at:'out')
].
nextOutButton := Button
label:img
action:[stepButton turnOff. self doNextOut]
in:bpanel.
stepButton := Button
label:(resources at:'step')
action:[stepButton turnOff. self doStep]
in:bpanel.
sendButton := Button
label:(resources at:'send')
action:[sendButton turnOff. self doSend]
in:bpanel.
separator := View extent:(30 @ 5) in:bpanel.
separator borderWidth:0; level:0.
terminateButton := Button
label:(resources at:'terminate')
action:[terminateButton turnOffWithoutRedraw. self doTerminate]
in:bpanel.
bpanel origin:(0.0 @ 0.0)
extent:(1.0 @ (bpanel preferredExtent y)).
panel := VariableVerticalPanel
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).
contextView := v scrolledView.
contextView action:[:lineNr | self showSelection:lineNr].
contextView doubleClickAction:[:line | self browse].
v := HVScrollableView
for:CodeView
miniScrollerH:true
miniScrollerV:false
in:panel.
v origin:(0.0 @ 0.25) corner:(1.0 @ 0.75).
"/ v autoHideScrollBars:true.
codeView := v scrolledView.
hpanel := VariableHorizontalPanel in:panel.
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.
receiverInspector label:'receiver'.
contextInspector := ContextInspectorView
origin:(0.5 @ 0.0) corner:(1.0 @ 1.0)
in:hpanel.
contextInspector label:'context'.
"Modified: / 16.1.1998 / 23:29:44 / cg"
!
initializeMiddleButtonMenu
<resource: #programMenu >
|labels selectors m|
exclusive ifTrue:[
labels := resources array:#(
'show more'
'show verbose backtrace'
'-'
'remove breakpoint'
'remove all trace & breakpoints'
'-'
'copy walkback text'
'-'
'quickTerminate'
'='
'exit smalltalk (no confirmation)'
).
selectors := #(
showMore
showVerboseBacktrace
nil
removeBreakpoint
removeAllBreakpoints
nil
copyWalkbackText
nil
quickTerminate
nil
exit
)
] ifFalse:[
labels := resources array:#(
'show more'
'show verbose backtrace'
'-'
'skip'
'step out'
'-'
"
'continue'
'terminate'
'abort'
'-'
'step'
'send'
'-'
'return'
'restart'
'-'
"
'remove breakpoint'
'remove all trace & breakpoints'
'-'
'browse'
'browse class'
'browse class hierarchy'
'browse full class protocol'
'implementors'
'senders'
'-'
'inspect context'
'copy walkback text'
'-'
'quickTerminate'
'='
'exit smalltalk (no confirmation)'
).
selectors := #(
showMore
showVerboseBacktrace
nil
skip
skipForReturn
nil
"
doContinue
doTerminate
doAbort
nil
doStep
doSend
nil
doReturn
doRestart
nil
"
removeBreakpoint
removeAllBreakpoints
nil
browse
browseClass
browseClassHierarchy
browseFullClassProtocol
implementors
senders
nil
inspectContext
copyWalkbackText
nil
quickTerminate
nil
exit
).
].
m := PopUpMenu
labels:(resources array:labels)
selectors:selectors
receiver:self
for:contextView.
verboseBacktrace ifTrue:[
m labelAt:#showVerboseBacktrace put:(resources string:'show dense backtrace').
m selectorAt:#showVerboseBacktrace put:#showDenseBacktrace
].
contextView middleButtonMenu:m.
inspecting ifTrue:[
m notNil ifTrue:[
m disableAll:#(doTraceStep removeBreakpoint browse browseClass
browseClassHierarchy browseFullClassProtocol
implementors senders inspectContext skip doStepOut).
].
]
"Modified: / 29.10.1997 / 03:40:16 / cg"
!
postRealize
super postRealize.
inspecting ifTrue:[
inspectedProcess notNil ifTrue:[
"
set prio somewhat higher (by 2, to allow walkBack-update process
to run between mine and the debugged processes prio)
"
Processor activeProcess
priority:(inspectedProcess priority + 2 min:16).
]
]
"Created: 24.7.1997 / 18:17:44 / cg"
!
setLabelFor:aMessage in:aProcess
|l nm|
l := aMessage , ' ('.
Object errorSignal handle:[:ex |
l := l , '???'
] do:[
nm := aProcess name.
nm notNil ifTrue:[
l := l , (nm contractTo:17) , ''.
].
l := l , '[' , aProcess id printString , ']'.
].
l := l , ')'.
self label:l.
! !
!DebugView methodsFor:'interrupt handling'!
contextInterrupt
DebuggingDebugger == true ifTrue:[
'contextIRQ' printCR.
].
^ self stepOrNext
"Modified: / 30.10.1997 / 21:22:25 / cg"
!
stepInterrupt
DebuggingDebugger == true ifTrue:[
'stepIRQ' printCR.
].
Processor yield.
^ self stepOrNext
"Modified: / 13.1.1998 / 21:14:11 / cg"
!
stepOrNext
|where here s isWrap method lastWrappedConAddr wrappedMethod
inBlock left ignore contextBelow lastWrappedContext
leftWrap enteredWrap anyStepBlocks belowSteppedContext
oneMore initiallyShown|
"/ DebuggingDebugger := true
"/ DebuggingDebugger := false
skipLineNr == #return ifTrue:[
name := Processor activeProcess nameOrId.
self label:('stepping context returned ' , ' (process: ' , name , ')').
here := thisContext sender sender.
here setLineNumber:nil.
here := nil.
self enter:(thisContext sender sender sender) select:nil.
^ self
].
"/ "/
"/ "/ should no longer happen
"/ "/
"/ stepForReturn == true ifTrue:[
"/"/'stepForreturn' printCR.
"/ self enter:thisContext sender.
"/ ^ self
"/ ].
Processor activeProcess ~~ inspectedProcess ifTrue:[
'DebugView [info]: stray step interrupt' infoPrintCR.
^ self
].
here := thisContext. "stepInterrupt"
here := here sender. "the caller; step- or contextIRQ"
here := here sender. "the interrupted context"
DebuggingDebugger == true ifTrue:[
'*******' printNL.
'here in ' print.
inWrap ifTrue:['(wrap) ' print.].
((ObjectMemory addressOf:here) printStringRadix:16) print. ' ' print.
here selector printNL.
].
"
kludge to hide breakpoint wrappers in the context list:
check if we are in a wrapper methods hidden setup-sequence
if so, ignore the interrupt and continue single sending
"
isWrap := false.
left := false.
leftWrap := enteredWrap := false.
where := here.
inWrap ifTrue:[
wrappedMethod := nil.
5 timesRepeat:[
(where notNil and:[where isBlockContext not]) ifTrue:[
method := where method.
(method notNil and:[method isWrapped]) ifTrue:[
"
in a wrapper method
"
wrappedMethod ~~ method ifTrue:[
wrappedMethod := method.
lastWrappedContext := where.
where sender receiver == method originalMethod ifFalse:[
isWrap := true.
]
] ifFalse:[
where == steppedContext ifTrue:[
DebuggingDebugger == true ifTrue:[
'change stepCon from: ' print.
steppedContext print.
' to lastWrapped: ' print.
lastWrappedContext printNL.
].
inWrap := false.
leftWrap := true.
wrapperContext := steppedContext.
steppedContext := lastWrappedContext
]
]
].
where := where sender
]
].
].
isWrap ifTrue:[
DebuggingDebugger == true ifTrue:[
'ignore wrap' printNL.
].
"/
"/ ignore, while in wrappers hidden setup
"/
where := nil. here := nil.
ObjectMemory flushInlineCaches.
skipLineNr == #return ifTrue:[
DebuggingDebugger == true ifTrue:[
'skipRet in wrap' printCR.
]
].
StepInterruptPending := 1.
InterruptPending := 1.
InStepInterrupt := nil.
^ nil
].
inBlock := false.
anyStepBlocks := false.
"/
"/ is this for a send or a step/next ?
"/
(bigStep
and:[steppedContext notNil]) ifTrue:[
"
a step or next - ignore all contexts below the interesting one
"
where := here. "the interrupted context"
contextBelow := nil.
where home notNil ifTrue:[
"/
"/ in a block called by 'our' context ?
"/
where home == steppedContext ifTrue:[
"/ '*block*' printNL.
inBlock := true
]
].
where == steppedContext ifFalse:[
where := where sender.
where notNil ifTrue:[
where home == steppedContext ifTrue:[
"/ '*block*' printNL.
inBlock := true.
]
].
"/ 'looking for ' print.
"/ (steppedContextAddress printStringRadix:16)print. '' printNL.
"/where print. ' ' print. ((ObjectMemory addressOf:where)printStringRadix:16) printCR.
"/steppedContext print. ' ' print. ((ObjectMemory addressOf:steppedContext)printStringRadix:16) printCR.
where == steppedContext 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.)
inBlock ifFalse:[
[where notNil] whileTrue:[
"/ if either the receiver or any arg of this context
"/ is a block of the steppedContext, we must really
"/ do a single step. Otherwise, stepping through a
"/ do:-loop would be very difficult.
(where receiver isBlock
and:[where receiver home == steppedContext])
ifTrue:[
anyStepBlocks := true.
] ifFalse:[
where args do:[:arg |
(arg isBlock
and:[arg home == steppedContext])
ifTrue:[
anyStepBlocks := true.
]
]
].
DebuggingDebugger == true ifTrue:[
((ObjectMemory addressOf:where) printStringRadix:16)print. ' ' print.
where selector printNL.
].
where == steppedContext ifTrue:[
"/ 'found it - below; ignore' printNL.
"
found the interesting context somwehere up in the
chain. We seem to be still below the interesting one ...
"
tracing == true ifTrue:[
here printString printCR
].
"
yes, a context below
- continue and schedule another stepInterrupt.
Must flush caches since optimized methods not always
look for pending interrupts
"
contextBelow notNil ifTrue:[
"/ 'prepare for unwind-catch' printNL.
"/ 'con= ' print. contextBelow printCR.
contextBelow selector notNil ifTrue:[
self label:'single stepping - please wait ...(' , contextBelow selector , ')'.
].
DebuggingDebugger == true ifTrue:[
'below stepCon; continue until unwind of: ' print.
contextBelow printCR.
].
Processor activeProcess forceInterruptOnReturnOf:contextBelow.
StepInterruptPending := nil.
] ifFalse:[
ObjectMemory flushInlineCaches.
here selector notNil ifTrue:[
self label:'single stepping - please wait ...(' , here selector , ')'.
].
DebuggingDebugger == true ifTrue:[
'in stepCon; continue single stepping' printCR.
].
StepInterruptPending := 1.
InterruptPending := 1.
].
where := nil. here := nil.
InStepInterrupt := nil.
^ nil
].
(steppedContext notNil and:[
where methodHome == steppedContext methodHome]) ifTrue:[
inBlock := true.
].
anyStepBlocks ifFalse:[
inBlock ifFalse:[
contextBelow := where
]
].
where := where sender
].
s := 'context returned'.
left := true.
].
] ifTrue:[
"/ 'found it right in sender' printNL.
s := 'after step'
].
] ifTrue:[
"/ 'found it right away' printNL.
s := 'after step'
].
] ifFalse:[
"/ ' send' printNL.
"
a send
"
DebuggingDebugger == true ifTrue:[
'clear steppedContext' printCR.
].
steppedContext := nil.
s := 'after send'
].
ignore := false.
(inBlock and:[stepHow == #nextOver or:[stepHow == #nextOut]]) ifTrue:[
ignore := true.
].
"/ handle the case, when a subBlock leaves;
"/ continue stepping in the home context.
left ifTrue:[
steppedContext home notNil ifTrue:[
steppedContext := steppedContext home.
s := 'after step'.
left := false.
"/ DebugView enterUnconditional:thisContext withMessage:'debug'.
]
].
"
kludge to hide breakpoint wrappers in the context list:
check if we are in a wrapper methods hidden exit-sequence
if so, ignore the interrupt and continue single sending
"
(where isNil
and:[wrapperContext notNil])
ifTrue:[
"/ did not find our steppedContext along the chain;
"/ could be in a wrappedMethods exitBlock ...
leftWrap ifFalse:[
where := here.
wrappedMethod := nil.
5 timesRepeat:[
where notNil ifTrue:[
where isBlockContext ifFalse:[
method := where method.
(method notNil and:[method isWrapped]) ifTrue:[
where == wrapperContext ifTrue:[
DebuggingDebugger == true ifTrue:[
'change stepCon fromWrapped: ' print.
steppedContext print.
' to: ' print.
wrapperContext printNL.
].
inWrap := true.
enteredWrap := true.
steppedContext := wrapperContext.
wrapperContext := nil.
]
].
].
where := where sender
]
].
].
enteredWrap ifTrue:[
ignore := true
]
].
"/
left ifTrue:[
"/ special care for stepInterrupt in send,
"/ when created a dummy context (lineNr == 1)
steppedContext lineNumber isNil ifTrue:[
steppedContext selector == here sender selector ifTrue:[
left := false.
s := 'after step'.
steppedContext := here sender.
].
].
oneMore := true
].
inBlock ifTrue:[
"/ 'inBlock' printNL.
s := 'in block'.
].
DebuggingDebugger == true ifTrue:[
where notNil ifTrue:[
'(' print. steppedContextLineno print. ') ' print.
where print.
'[' print. where lineNumber print. ']' printNL.
].
].
ignore ifFalse:[
(bigStep
and:[steppedContextLineno notNil
and:[where notNil
and:[where lineNumber == steppedContextLineno]]]) ifTrue:[
(here isBlockContext
and:[(here methodHome == steppedContext)
or:[here home == steppedContext]]) ifTrue:[
DebuggingDebugger == true ifTrue:[
'same line but in block' printNL.
].
steppedContext := actualContext := here.
steppedContextLineno := here lineNumber.
] ifFalse:[
DebuggingDebugger == true ifTrue:[
'same line - ignored' printNL.
].
ignore := true
].
].
(left not
and:[skipLineNr notNil
and:[where notNil
and:[where lineNumber < skipLineNr]]]) ifTrue:[
DebuggingDebugger == true ifTrue:[
'skip (' print. skipLineNr print. ' unreached - ignored' printNL.
].
ignore := true
].
(steppedContextLineno isNil
and:[skipLineNr isNil
and:[thisContext sender selector == #contextInterrupt]]) ifTrue:[
DebuggingDebugger == true ifTrue:[
'same line2 (after conIRQ) - ignored' printNL.
].
ignore := true
].
].
ignore ifTrue:[
"/' ' printNL.
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 := 1.
InterruptPending := 1.
InStepInterrupt := nil.
^ nil
].
"/ ' ' printNL.
name := Processor activeProcess nameOrId.
self label:(s , ' (process: ' , name , ')').
tracing := false.
bigStep := false.
"release refs to context"
where := nil. here := nil.
"/'enter' printCR.
DebuggingDebugger == true ifTrue:[
'==> enter on: ' print. thisContext sender sender printCR.
].
initiallyShown := nil.
(oneMore == true) ifTrue:[
thisContext sender sender lineNumber <= 1 ifTrue:[
initiallyShown := 2
] ifFalse:[
initiallyShown := 1
]
].
self enter:(thisContext sender sender) select:initiallyShown
"Created: / 14.10.1996 / 12:53:39 / cg"
"Modified: / 3.4.1998 / 21:09:16 / cg"
! !
!DebugView methodsFor:'menu / button actions'!
autoUpdateOff
"stop the update process"
updateProcess notNil ifTrue:[
monitorToggle lampColor:(Color yellow).
updateProcess terminate.
updateProcess := nil
]
!
autoUpdateOn
"fork a subprocess which updates the contextList in regular intervals"
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)
]
!
browse
|mthd who sel cls|
selectedContext isNil ifTrue:[^ self].
mthd := selectedContext method.
mthd notNil ifTrue:[
who := selectedContext method who.
who notNil ifTrue:[
cls := who methodClass.
sel := who methodSelector.
]
].
cls isNil ifTrue:[
"/ class not found - try receiver
cls := selectedContext receiver class
].
cls browserClass openInClass:cls selector:sel.
"Created: / 22.11.1995 / 21:27:01 / cg"
"Modified: / 3.2.1998 / 19:46:40 / cg"
!
browseClass
|cls|
selectedContext isNil ifTrue:[^ self].
cls := selectedContext method containingClass.
cls browserClass browseClass:cls
"Modified: / 3.2.1998 / 20:23:36 / cg"
!
browseClassHierarchy
|cls|
selectedContext isNil ifTrue:[^ self].
cls := selectedContext method containingClass.
cls browserClass browseClassHierarchy:cls.
"Modified: / 3.2.1998 / 20:23:40 / cg"
!
browseFullClassProtocol
|cls|
selectedContext isNil ifTrue:[^ self].
cls := selectedContext method containingClass.
cls browserClass browseFullClassProtocol:cls.
"Modified: / 3.2.1998 / 20:23:44 / cg"
!
copyWalkbackText
"place the contents of the walkback view into the copy-paste buffer.
This allows pasting it into some other view for printing ..."
self setTextSelection:(contextArray collect:[:con | con fullPrintString]) asStringCollection
"Modified: 28.8.1995 / 15:31:59 / claus"
!
doAbort
"abort - send Object>>abortSignal, which is usually caught
at save places (for example: in the event loop) and returns back
from whatever the process is doing, but does not terminate it."
inspecting ifTrue:[
inspectedProcess isDead ifTrue:[
self showTerminated.
^ self
].
(Object abortSignal isHandledIn:inspectedProcess suspendedContext) ifFalse:[
self showError:'** the process does not handle the abort signal **'
] ifTrue:[
self interruptProcessWith:[Object abortSignal raise].
].
^ self
].
steppedContext := wrapperContext := nil.
haveControl := false.
exitAction := #abort.
"exit private event-loop"
catchBlock notNil ifTrue:[
abortButton turnOff.
catchBlock value.
"/ not reached
'DebugView [warning]: abort failed' errorPrintCR.
].
^ self.
"Modified: 10.1.1997 / 17:38:28 / cg"
!
doContinue
"continue from menu"
inspecting ifTrue:[
device hasColors ifTrue:[
continueButton foregroundColor:Color red darkened.
].
continueButton label:(resources string:'stop').
continueButton action:[self doStop].
self processPerform:#resume.
^ self
].
canContinue ifTrue:[
steppedContext := wrapperContext := nil.
tracing := false.
haveControl := false.
exitAction := #continue.
"exit private event-loop"
catchBlock notNil ifTrue:[catchBlock value].
"/ not reached.
'DebugView [warning]: continue failed' errorPrintCR.
continueButton turnOff.
] ifFalse:[
inspecting ifFalse:[
'DebugView [info]: resuming top context' infoPrintCR.
self showSelection:1.
self doReturn
]
]
"Modified: 10.1.1997 / 17:38:34 / cg"
!
doMicroSend
"single send; reenter with next message send"
inspecting ifTrue:[^ self].
canContinue ifTrue:[
steppedContext := wrapperContext := nil.
haveControl := false.
exitAction := #step.
"exit private event-loop"
catchBlock notNil ifTrue:[catchBlock value].
"/ not reached
'DebugView [warning]: send failed' errorPrintCR.
sendButton turnOff.
]
"Modified: 10.1.1997 / 17:38:41 / cg"
"Created: 6.3.1997 / 21:09:36 / cg"
!
doNext
"skip for next source-code line; entering blocks"
stepHow := #nextIn.
self doStep:nil
"Modified: 7.3.1997 / 18:38:41 / cg"
!
doNextOut
"skip for next source-code line; leaving blocks"
stepHow := #nextOut.
self doStep:nil
"Created: 3.3.1997 / 21:31:22 / cg"
"Modified: 7.3.1997 / 18:38:49 / cg"
!
doNextOver
"skip for next source-code line; skip over blocks"
stepHow := #nextOver.
self doStep:nil
"Created: 3.3.1997 / 20:50:38 / cg"
"Modified: 7.3.1997 / 18:39:00 / cg"
!
doNoTrace
traceView notNil ifTrue:[
traceView topView destroy.
traceView := nil.
].
tracing := false
!
doRestart
"restart - the selected context will be restarted"
inspecting ifTrue:[
selectedContext isNil ifTrue:[
^ self showError:'** select a context first **'
].
self interruptProcessWith:[selectedContext unwindAndRestart].
^ self
].
steppedContext := wrapperContext := nil.
haveControl := false.
exitAction := #restart.
"exit private event-loop"
catchBlock notNil ifTrue:[catchBlock value].
"/ not reached
'DebugView [warning]: restart failed' errorPrintCR.
restartButton turnOff.
"Modified: 10.1.1997 / 17:38:36 / cg"
!
doReturn
"return - the selected context will do a ^nil"
inspecting ifTrue:[
selectedContext isNil ifTrue:[
^ self showError:'** select a context first **'
].
self interruptProcessWith:[selectedContext unwind].
^ self
].
steppedContext := wrapperContext := nil.
haveControl := false.
exitAction := #return.
"exit private event-loop"
catchBlock notNil ifTrue:[catchBlock value].
"/ not reached
'DebugView [warning]: return failed' errorPrintCR.
returnButton turnOff.
"Modified: 10.1.1997 / 17:38:39 / cg"
!
doSend
"single send; reenter with next message send"
stepHow := #send.
self doStep:-1
"/ inspecting ifTrue:[^ self].
"/
"/ canContinue ifTrue:[
"/ steppedContext := wrapperContext := nil.
"/ haveControl := false.
"/ exitAction := #step.
"/
"/ "exit private event-loop"
"/ catchBlock notNil ifTrue:[catchBlock value].
"/
"/ "/ not reached
"/ 'DebugView [warning]: send failed' errorPrintCR.
"/ sendButton turnOff.
"/ ]
"Modified: 7.3.1997 / 18:41:26 / cg"
!
doStep
"skip for next send in selected method"
stepHow := #step.
self doStep:-1
"Modified: 7.3.1997 / 18:46:49 / cg"
!
doStep:lineNr
"common helper for step, skip & next.
Arrange for single-steppping until we pass lineNr (if nonNil)
or to next line (if nil) or to next send (if -1)"
|con method|
inspecting ifTrue:[^ self].
canContinue ifTrue:[
selectedContext notNil ifTrue:[
con := actualContext. "/ selectedContext.
steppedContextLineno := actualContext lineNumber.
] ifFalse:[
con := contextArray at:2.
steppedContextLineno := con lineNumber.
].
skipLineNr := lineNr.
lineNr == -1 ifTrue:[
steppedContextLineno := skipLineNr := nil.
].
stepHow == #send ifTrue:[
steppedContext := contextArray at:1.
stepHow := #nextIn.
] ifFalse:[
stepHow == #nextOut ifTrue:[
steppedContext := con home.
] ifFalse:[
steppedContext := con.
].
].
wrapperContext := nil.
"/ ' step con:' print. (ObjectMemory addressOf:steppedContext) printHex. ' ' print. steppedContext printCR.
"
if we step in a wrapped method,
prepare to skip the prolog ...
"
inWrap := false.
method := con method.
(method notNil
and:[method isWrapped
and:[method originalMethod ~~ method]]) ifTrue:[
inWrap := true
].
lineNr == #return ifTrue:[
Processor activeProcess forceInterruptOnReturnOf:con.
].
con := nil.
bigStep := true.
haveControl := false.
exitAction := #step.
"exit private event-loop"
catchBlock notNil ifTrue:[catchBlock value].
"/ not reached
'DebugView [warning]: step failed' errorPrintCR.
stepButton turnOff. nextButton turnOff. sendButton turnOff.
]
"Modified: / 13.1.1998 / 15:34:14 / cg"
!
doStop
"stop the process (if its running, otherwise this is a no-op)"
inspecting ifTrue:[
device hasColors ifTrue:[
continueButton foregroundColor:Color green darkened darkened.
].
continueButton label:(resources string:'continue').
continueButton action:[self doContinue].
self processPerform:#stop.
^ self
].
"Modified: 20.10.1996 / 18:30:48 / cg"
!
doTerminate
"terminate - the process has a chance for cleanup"
inspecting ifTrue:[
self processPerform:#terminate.
^ self
].
steppedContext := wrapperContext := nil.
haveControl := false.
exitAction := #terminate.
"exit private event-loop"
catchBlock notNil ifTrue:[catchBlock value].
"/ not reached (normally)
inspecting ifFalse:[
'DebugView [warning]: terminate failed' errorPrintCR.
self warn:'terminate failed'.
].
terminateButton turnOff.
"Modified: 10.1.1997 / 17:38:22 / cg"
!
doTrace
"tracing - not really implemented ..."
self warn:'this function is not yet implemented'.
"/ |v b|
"/
"/ traceView isNil ifTrue:[
"/ 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 := nil.
"/ 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.
"/
"/ tracing := true.
!
doTraceStep
"tracestep - not implemented yet"
canContinue ifTrue:[
tracing := true.
self doStep
]
!
exit
"exit from menu: immediate exit from smalltalk"
OperatingSystem exit
!
implementors
"open a browser on the implementors"
selectedContext isNil ifTrue:[
^ self showError:'** select a context first **'
].
SystemBrowser browseImplementorsOf:selectedContext selector.
!
inspectContext
"launch an inspector on the currently selected context"
contextView selection notNil ifTrue:[
(contextView selectionValue startsWith:'**') ifFalse:[
(contextArray at:(contextView selection)) inspect.
]
]
!
quickTerminate
"quick terminate - the process will get no chance for cleanup actions"
inspecting ifTrue:[
self processPerform:#terminateNoSignal.
^ self
].
steppedContext := wrapperContext := nil.
haveControl := false.
exitAction := #quickTerminate.
"exit private event-loop"
catchBlock notNil ifTrue:[catchBlock value].
"/ not reached (normally)
inspecting ifFalse:[
'DebugView [warning]: terminate failed' errorPrintCR.
self warn:'terminate failed'.
].
terminateButton turnOff.
"Modified: 10.1.1997 / 17:42:10 / cg"
!
removeAllBreakpoints
"remove all trace & breakpoints - if any"
(MessageTracer notNil and:[MessageTracer isLoaded]) ifTrue:[
MessageTracer unwrapAllMethods
]
"Modified: 21.9.1997 / 11:38:23 / cg"
!
removeBreakpoint
"remove breakpoint on the selected contexts method - if any"
|implementorClass method|
selectedContext isNil ifTrue:[
^ self showError:'** select a context first **'
].
(MessageTracer isNil or:[MessageTracer isLoaded not]) ifTrue:[
^ self
].
implementorClass := selectedContext methodClass.
implementorClass notNil ifTrue:[
method := implementorClass compiledMethodAt:selectedContext selector.
(method notNil and:[method isBreakpointed]) ifTrue:[
method clearBreakPoint
]
].
contextView middleButtonMenu disable:#removeBreakpoint.
"Modified: / 13.1.1998 / 00:24:47 / cg"
!
senders
"open a browser on the senders"
selectedContext isNil ifTrue:[
^ self showError:'** select a context first **'
].
SystemBrowser browseAllCallsOn:selectedContext selector.
!
showDenseBacktrace
verboseBacktrace := false.
contextView middleButtonMenu labelAt:#showDenseBacktrace put:(resources string:'show verbose backtrace').
contextView middleButtonMenu selectorAt:#showDenseBacktrace put:#showVerboseBacktrace.
self redisplayBacktrace.
"Created: 10.1.1997 / 21:33:55 / cg"
"Modified: 10.1.1997 / 21:37:21 / cg"
!
showMore
"double number of contexts shown"
contextArray notNil ifTrue:[
nChainShown := nChainShown * 2.
self redisplayBacktrace.
]
"Modified: 12.1.1997 / 01:24:26 / cg"
!
showVerboseBacktrace
verboseBacktrace := true.
contextView middleButtonMenu labelAt:#showVerboseBacktrace put:(resources string:'dense stack backtrace').
contextView middleButtonMenu selectorAt:#showVerboseBacktrace put:#showDenseBacktrace.
self redisplayBacktrace.
"Modified: 10.1.1997 / 21:37:13 / cg"
!
skip
"skip for cursor line in selected method"
stepHow := #skip.
self doStep:codeView cursorLine.
"Modified: 3.3.1997 / 20:56:23 / cg"
!
skipForReturn
"skip until context is left."
stepHow := #skipReturn.
self doStep:#return.
"Modified: 3.3.1997 / 20:56:32 / cg"
! !
!DebugView methodsFor:'private'!
busy
^ busy
!
exclusive:aBoolean
exclusive := aBoolean
!
inspectedProcess
^ inspectedProcess
!
interruptProcessWith:aBlock
"let inspected process do something, then update the context list"
inspectedProcess isDead ifTrue:[
self showTerminated.
^ self
].
inspectedProcess interruptWith:aBlock.
"
give the process a chance to run, then update
"
(Delay forSeconds:0.2) wait.
self setContext:(inspectedProcess suspendedContext).
!
processPerform:aMessage
"do something, then update the context list"
inspectedProcess isDead ifTrue:[
self showTerminated.
^ self
].
inspectedProcess perform:aMessage.
"
give the process a chance to run, then update
"
(Delay forSeconds:0.2) wait.
self setContext:(inspectedProcess suspendedContext).
!
redisplayBacktrace
"force redisplay of the walkBack list; invoked when the
verbose-flag setting is changed"
|oldSelection oldContext con idx|
contextArray notNil ifTrue:[
self withWaitCursorDo:[
oldSelection := contextView selection.
oldSelection notNil ifTrue:[
oldContext := contextArray at:oldSelection ifAbsent:nil.
].
con := firstContext.
"/ con := contextArray at:1.
"/ force redeisplay, even if same by changing the first entry
contextArray size > 0 ifTrue:[
contextArray at:1 put:nil.
].
self setContext:con.
oldContext isNil ifTrue:[
idx := oldSelection
] ifFalse:[
idx := contextArray identityIndexOf:oldContext ifAbsent:nil.
].
contextView setSelection:idx.
idx notNil ifTrue:[
self showSelection:idx
]
]
]
"Created: / 10.1.1997 / 21:36:46 / cg"
"Modified: / 15.1.1998 / 19:45:09 / cg"
!
setContext:aContext
"show calling chain from aContext in the walk-back listview"
^ self setContext:aContext releaseInspectors:true
"Modified: 27.6.1996 / 17:21:59 / cg"
!
setContext:aContext releaseInspectors:releaseInspectors
"show calling chain from aContext in the walk-back listview"
|con text method caller caller2 m count showIt c suspendContext nm h|
(contextArray size > 0 and:[aContext == (contextArray at:1)]) ifTrue:[
"no change"
^ false
].
firstContext := aContext.
m := contextView middleButtonMenu.
m notNil ifTrue:[
m disable:#showMore.
].
aContext isNil ifTrue:[
text := Array with:'** no context **'.
contextArray := nil.
] ifFalse:[
text := OrderedCollection new:nChainShown.
contextArray := OrderedCollection new:nChainShown.
con := aContext.
verboseBacktrace ~~ true ifTrue:[
"/ with dense backtrace, hide the ProcessorScheduler
"/ contexts at the top; look for a Process>>suspend*
"/ context within the first 10 contexts
suspendContext := nil.
c := con.
1 to:10 do:[:i |
|sel|
c notNil ifTrue:[
(sel := c selector) notNil ifTrue:[
((sel isSymbol and:[sel startsWith:'suspend'])
and:[c receiver isMemberOf:Process]) ifTrue:[
suspendContext := c
].
].
c := c sender.
]
].
suspendContext notNil ifTrue:[
con := suspendContext. suspendContext := nil
].
].
"
get them all
"
count := 0.
[con notNil and:[count <= nChainShown]] whileTrue:[
(self showingContext:con nesting:count) ifTrue:[
contextArray add:con.
(MoreDebuggingDetail == true) ifTrue:[
nm := (((ObjectMemory addressOf:con) printStringRadix:16) , ' ' , con printString).
] ifFalse:[
nm := con printString.
].
text add:nm.
count := count + 1.
].
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
].
"/ with dense backtrace, skip the doIt methods context
"/ (its dummy anyway) and fake that contexts name
verboseBacktrace ~~ true ifTrue:[
(con isBlockContext
and:[(h := con home) == con sender
and:[((h selector == #doIt)
or:[h selector == #doIt:])
and:[h method who isNil]]]) ifTrue:[
con := con sender.
text removeLast.
text add:(con methodHome printString)
].
h := nil. "/ never keep refs to contexts unless you really need them ...
].
"/ and also, all lazy loading intermediates
verboseBacktrace ~~ true ifTrue:[
(con selector == #noByteCode
and:[con receiver isMethod]) ifTrue:[
contextArray removeLast.
text removeLast.
con := con sender.
count := count - 1.
]
].
con := con sender
].
"
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
].
verboseBacktrace ~~ true ifTrue:[
"/ in dense mode, remove the process startup
"/ contexts (if any)
(con := contextArray last) methodClass == Process ifTrue:[
con selector == #start ifTrue:[
contextArray removeLast.
text removeLast.
[contextArray size > 0
and:[contextArray last methodHome == con]] whileTrue:[
contextArray removeLast.
text removeLast.
]
]
]
]
] ifFalse:[
m notNil ifTrue:[
m enable:#showMore.
].
text add:(resources string:'*** more walkback follows - click here to see them ***')
].
].
contextView setList:text.
releaseInspectors ifTrue:[
receiverInspector release.
contextInspector release.
].
m notNil ifTrue:[
m disable:#removeBreakpoint.
m disable:#implementors.
m disable:#senders.
m disable:#browseClass.
].
^ true
"Created: / 14.12.1995 / 19:10:31 / cg"
"Modified: / 17.1.1998 / 02:09:59 / cg"
!
setContextSkippingInterruptContexts:aContext
"show calling chain from aContext in the walk-back listview.
Ignore any non-interesting interrupt-context."
|con|
verboseBacktrace ifFalse:[
con := aContext.
(con notNil and:[con selector == #threadSwitch:]) ifTrue:[
con := con sender.
(con notNil and:[con selector == #timerInterrupt]) ifTrue:[
con := con sender.
].
].
].
^ self setContext:con releaseInspectors:true
"Created: / 20.10.1996 / 18:10:21 / cg"
"Modified: / 17.1.1998 / 12:43:19 / cg"
!
showError:message
codeView contents:(resources string:message).
shown ifTrue:[
exclusive ifTrue:[
"/ consider this a kludge:
"/ if exclusive, cannot use flash, since it suspends
"/ (but we cannot suspend here ...)
codeView redrawInverted. device flush.
OperatingSystem millisecondDelay:200.
codeView redraw
] ifFalse:[
codeView flash
]
]
"Modified: 24.11.1995 / 22:07:30 / cg"
!
showTerminated
self showError:'** the process has terminated **'
!
showingContext:aContext nesting:nesting
"return false, if this context is to be skipped.
Here, we hide some wellKnown methods, which are usually
not too interesting;
the set of methods which are suppressed is my (claus's) own choice."
|sel rec mClass
sender senderReceiver senderSelector senderReceiverClass|
verboseBacktrace ifTrue:[^ true].
rec := aContext receiver.
sel := aContext selector.
mClass := aContext methodClass.
sender := aContext sender.
sender notNil ifTrue:[
senderSelector := sender selector.
senderReceiver := sender receiver.
senderReceiverClass := senderReceiver class.
].
sel == #withCursor:do: ifTrue:[
(mClass == WindowGroup) ifTrue:[^ false].
(mClass == TopView) ifTrue:[^ false].
].
(sel == #withExecuteCursorDo:
or:[sel == #withWaitCursorDo:]) ifTrue:[
(mClass == DisplaySurface) ifTrue:[^ false].
].
(sel == #do:
or:[sel == #from:to:do:]) ifTrue:[
mClass == Array ifTrue:[^ false].
mClass == OrderedCollection ifTrue:[^ false].
].
(sel == #perform:
or:[sel == #perform:with:
or:[sel == #perform:with:with:
or:[sel == #perform:with:with:with:
or:[sel == #perform:with:with:with:with:]]]])
ifTrue:[
nesting == 0 ifTrue:[^ true].
mClass == Array ifTrue:[^ false].
mClass == OrderedCollection ifTrue:[^ false].
].
sel == #valueWithReceiver:arguments:selector:search:sender: ifTrue:[^ false].
(mClass == Object) ifTrue:[
(sel startsWith:'perform:') ifTrue:[^ false]
].
(mClass == Method) ifTrue:[
(sel startsWith:'valueWithReceiver:') ifTrue:[^ false]
].
(mClass == SmallInteger) ifTrue:[
(sel == #to:do:) ifTrue:[^ false].
(sel == #to:by:do:) ifTrue:[^ false].
].
(mClass == Block) ifTrue:[
sel == #valueNowOrOnUnwindDo: ifTrue:[^ false].
sel == #valueOnUnwindDo: ifTrue:[^ false].
sel == #value ifTrue:[^ false].
sel == #value: ifTrue:[^ false].
sel == #value:value: ifTrue:[^ false].
sel == #value:value:value: ifTrue:[^ false].
sel == #value:value:value:value: ifTrue:[^ false].
sel == #value:value:value:value:Value: ifTrue:[^ false].
sel == #value:value:value:value:value:value: ifTrue:[^ false].
].
aContext isBlockContext ifTrue:[
"/ sel == #value ifTrue:[^ false].
"/ sel == #value: ifTrue:[^ false].
"/ sel == #value:value: ifTrue:[^ false].
"/ sel == #value:value:value: ifTrue:[^ false].
"/ sel == #value:value:value:value: ifTrue:[^ false].
"/ sel == #value:value:value:value:Value: ifTrue:[^ false].
"/ sel == #value:value:value:value:value:value: ifTrue:[^ false].
"/ (senderSelector == #answer:do:) ifTrue:[
"/ senderReceiverClass == QuerySignal ifTrue:[
"/ ^ false
"/ ]
"/ ]
aContext home notNil ifTrue:[
(aContext home receiver isMemberOf:Semaphore) ifTrue:[
(aContext home selector == #wait) ifTrue:[^ false]
]
]
].
((mClass == Signal)
or:[(mClass == QuerySignal)
or:[mClass == SignalSet]]
) ifTrue:[
sel == #handle:do: ifTrue:[^ false].
sel == #raise ifTrue:[^ false].
].
(mClass == QuerySignal) ifTrue:[
sel == #answer:do: ifTrue:[^ false].
].
(mClass == Exception) ifTrue:[
sel == #doRaise ifTrue:[^ false].
sel == #doCallHandler: ifTrue:[^ false].
sel == #raise ifTrue:[
senderReceiverClass == Signal ifTrue:[^ false].
]
].
(mClass == Context) ifTrue:[
sel == #unwind ifTrue:[^ false].
sel == #unwind: ifTrue:[^ false].
].
(mClass == ProcessorScheduler) ifTrue:[
sel == #interruptActive ifTrue:[^ false].
sel == #threadSwitch: ifTrue:[^ false].
sel == #suspend: ifTrue:[^ false].
].
mClass == Process ifTrue:[
sel == #suspendWithState: ifTrue:[^ false].
].
^ true.
"Created: / 10.1.1997 / 21:01:39 / cg"
"Modified: / 15.1.1998 / 19:47:36 / cg"
!
stepping
^ stepping
!
unstep
stepping := false.
bigStep := false.
steppedContext := wrapperContext := nil.
exitAction := nil
"Modified: 22.10.1996 / 11:59:57 / cg"
!
updateContext
|oldContext idx|
inspectedProcess state == #dead ifTrue:[
self showTerminated.
^ self
].
oldContext := selectedContext.
[
(self setContextSkippingInterruptContexts:inspectedProcess suspendedContext) ifTrue:[
oldContext notNil ifTrue:[
contextArray notNil ifTrue:[
idx := contextArray identityIndexOf:oldContext.
idx ~~ 0 ifTrue:[
self showSelection:idx
] ifFalse:[
codeView contents:('** context returned **')
]
]
]
].
] valueUninterruptably.
"Modified: 20.10.1996 / 18:11:24 / cg"
! !
!DebugView methodsFor:'private cache handling'!
cacheMyself
"remember myself for next debug session"
"caching the last debugger will make the next debugger appear
faster, since no resources have to be allocated in the display.
We have to be careful to release all refs to the debuggee, though.
Otherwise, the GC will not be able to release it."
windowGroup notNil ifTrue:[
windowGroup setProcess:nil.
].
self releaseDebuggee.
cachable ~~ true ifTrue:[^ self].
"/
"/ only cache if I am on the Display
"/
device == Display ifTrue:[
exclusive ifTrue:[
CachedExclusive := self
] ifFalse:[
CachedDebugger := self
].
]
"Modified: 10.7.1997 / 15:50:46 / stefan"
"Modified: 31.7.1997 / 21:20:14 / cg"
!
isCached
"tell wether we are a cached debugger"
CachedExclusive == self ifTrue:[
^ true.
].
CachedDebugger == self ifTrue:[
^ true.
].
^ false.
"Created: 10.7.1997 / 15:22:43 / stefan"
!
releaseDebuggee
"We have to be careful to release all refs to the debuggee,
because we may be in the cache.
Otherwise, the GC will not be able to release it"
busy := false.
codeView acceptAction:nil.
codeView doItAction:nil.
codeView contents:nil.
receiverInspector release.
contextInspector release.
inspectedProcess := nil.
exitAction := nil.
contextArray := nil.
selectedContext := actualContext := firstContext := nil.
steppedContext := wrapperContext := nil.
catchBlock := nil.
grabber := nil.
self autoUpdateOff.
"Created: 10.7.1997 / 14:57:51 / stefan"
"Modified: 10.7.1997 / 15:50:38 / stefan"
!
uncacheMyself
"do not remember myself any longer for next debug session"
|idx|
cachable := false.
CachedExclusive == self ifTrue:[
CachedExclusive := nil.
].
CachedDebugger == self ifTrue:[
CachedDebugger := nil.
].
OpenDebuggers notNil ifTrue:[
idx := OpenDebuggers identityIndexOf:self.
idx ~~ 0 ifTrue:[
OpenDebuggers at:idx put:nil
].
].
"Modified: 31.7.1997 / 21:20:11 / cg"
! !
!DebugView methodsFor:'private control loop'!
controlLoop
"this is a kludge:
start a dispatchloop which exits when
either continue, return or step is pressed
"
haveControl := true.
[
[haveControl] whileTrue:[
self controlLoopCatchingErrors
].
] valueNowOrOnUnwindDo:[
catchBlock := nil.
haveControl := false
].
"Modified: 9.7.1996 / 18:29:09 / cg"
!
controlLoopCatchingErrors
"this is the debuggers own private event handling loop;
errors are caught, to prevent recursive debugger-invocations."
"setup a self removing catch-block"
catchBlock := [catchBlock := nil. ^ nil].
(exclusive or:[windowGroup isNil]) 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,
all processing for normal views stops here ...
"
WindowGroup setActiveGroup:windowGroup.
SignalSet anySignal handle:[:ex |
|signal|
signal := ex signal.
self showError:'*** Error in modal debugger:
>>>> Signal: ' , signal printString , '
>>>> In: ' , ex suspendedContext printString , '
>>>> From: ' , ex suspendedContext sender printString , '
>>>> : ' , ex suspendedContext sender sender printString , '
>>>> : ' , ex suspendedContext sender sender sender printString , '
>>>> : ' , ex suspendedContext sender sender sender sender printString , '
>>>> Message: ' , ex errorString , '
caught & ignored.'.
ex return.
] do:[
Object userNotificationSignal handle:[:ex |
(ex signal == ActivityNotificationSignal) ifTrue:[
ex proceed
].
self showError:ex errorString
] do:[
device dispatchModalWhile:[Processor activeProcess state:#debug.
haveControl].
]
].
WindowGroup setActiveGroup:nil.
] 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 |
|answer signal|
signal := ex signal.
DebuggingDebugger ~~ true ifTrue:[
"/
"/ ignore recursive breakpoints
"/
(MessageTracer notNil
and:[MessageTracer isLoaded
and:[signal == MessageTracer breakpointSignal]]) ifTrue:[
'DebugView [info]: breakpoint in debugger ignored' infoPrintCR.
ex proceed
].
(signal == ActivityNotificationSignal) ifTrue:[
ex proceed
].
(signal == Process terminateSignal) ifTrue:[
"/ mhm - someone wants to shoot me down while debugging ...
answer := Dialog
choose:('process termination signal arrived while debugging\\close debugger ?') withCRs
labels:#( 'ignore' 'close & terminate' )
values:#( #proceed #close )
default:#close.
answer == #close ifTrue:[
self destroy.
ex reject
].
ex return.
].
signal == Exception recursiveExceptionSignal ifTrue:[
(MessageTracer notNil
and:[MessageTracer isLoaded
and:[ex parameter signal == MessageTracer breakpointSignal]])
ifTrue:[
'DebugView [info]: recursive breakpoint in debugger ignored' infoPrintCR.
ex proceed.
].
self showError:'*** Recursive error in debugger:
>>>> Signal: ' , ex signal printString , '
>>>> ' , ex parameter signal printString , '
>>>> In: ' , ex suspendedContext printString , '
>>>> From: ' , ex suspendedContext sender printString , '
>>>> : ' , ex suspendedContext sender sender printString , '
>>>> : ' , ex suspendedContext sender sender sender printString , '
>>>> : ' , ex suspendedContext sender sender sender sender printString , '
>>>> Message: ' , ex errorString , '
caught & ignored.'.
ex return
].
].
self topView raiseDeiconified.
answer := Dialog
choose:('error in debugger: ' , ex errorString , '\\debug again ?') withCRs
labels:#( 'proceed' 'cancel' 'debug' )
values:#( #proceed #cancel #debug )
default:#cancel.
answer == #debug ifTrue:[
Debugger enterUnconditional:(ex suspendedContext) withMessage:'error in debugger: ' , ex errorString.
ex proceed.
].
answer == #proceed ifTrue:[
ex proceed.
].
ex return.
] do:[
windowGroup eventLoopWhile:[Processor activeProcess state:#debug.
true] onLeave:[]
].
].
catchBlock := nil.
"Created: / 24.11.1995 / 20:33:45 / cg"
"Modified: / 17.1.1998 / 12:58:35 / cg"
! !
!DebugView methodsFor:'user interaction'!
codeAccept:someCode
"user wants some code to be recompiled - must unwind stack since everything above
and including selected method cannot be continued."
"
actually, this is not true, since the active methods will still be
executed correctly - however, the code shown in the debugger is no
longer in sync (showing the new code) with the executed code.
Therefore, we hide those contexts to avoid confusion ....
If you dont like this behavior, remove the 'inspecting ifFalse:' check below"
"walk up context chain and find highest context which is either the selected context,
or - if its a block-context - whose home is the selected context"
|con top sel implementorClass method newMethod|
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
].
"
use class&selector to find the method for the compilation
and compile.
"
sel := selectedContext selector.
implementorClass := selectedContext methodClass.
method := implementorClass compiledMethodAt:sel.
"/
"/ provide the classes nameSpace on a query;
"/ in case we accept while in another nameSpace context,
"/ (but for a class which is somewhere else)
"/
Class nameSpaceQuerySignal
answer:(implementorClass nameSpace)
do:[
Class methodRedefinitionSignal handle:[:ex |
ex proceedWith:#keep
] do:[
newMethod := implementorClass compilerClass
compile:someCode
forClass:implementorClass
inCategory:(method category)
notifying:codeView.
]
].
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).
"
continue/step is no longer possible
"
canContinue := false.
self showSelection:1.
exitAction := #return
].
].
codeView cursor:Cursor normal
"Modified: / 7.3.1998 / 13:43:59 / cg"
!
destroy
"closing the debugger implies an abort or continue"
contextView middleButtonMenu hide.
inspecting ifFalse:[
"I am running on top of a process, abort or continue it"
windowGroup notNil ifTrue:[
windowGroup setProcess:nil.
].
self uncacheMyself.
"/
"/ catch invalid return;
"/ this happens, when my process has somehow died (quickterminate)
"/ and I am a leftOver view, which gets terminated via the launchers
"/ #destroy-window function.
"/
Context invalidReturnSignal handle:[:ex |
'DebugView [info]: OOPS - non regular debugView closing(1)' infoPrintCR.
self uncacheMyself.
Debugger newDebugger.
ex return.
] do:[
Object abortSignal isHandled ifTrue:[
self doAbort.
] ifFalse:[
self doContinue
]
].
"/ We don't reach this point normally
'DebugView [info]: OOPS - non regular debugView closing(2)' infoPrintCR.
Debugger newDebugger.
self uncacheMyself.
].
"/ since I am going to be destroyed, remove me from the cache
self uncacheMyself.
super destroy.
"Modified: 10.7.1997 / 17:15:41 / stefan"
"Modified: 12.8.1997 / 02:07:19 / cg"
!
doShowSelection:lineNr
"user clicked on a header line - show selected code in textView.
Also sent to autoselect an interesting context on entry."
|breakPointSignal|
(MessageTracer notNil and:[MessageTracer isLoaded]) ifTrue:[
breakPointSignal := MessageTracer breakpointSignal.
].
breakPointSignal notNil ifTrue:[
breakPointSignal handle:[:ex |
'DebugView [info]: breakpoint in debugger ignored' infoPrintCR.
ex proceed
] do:[
self updateForContext:lineNr
].
] ifFalse:[
self updateForContext:lineNr
]
!
showSelection:lineNr
"user clicked on a header line - show selected code in textView.
Also sent to autoselect an interesting context on entry."
Object errorSignal handle:[:ex |
|s con|
'DebugView [info]: error when showing selection in debugger ignored' infoPrintCR.
s := '' writeStream.
s nextPutLine:'**** error in debugger, while extracting source'.
s nextPutLine:'****'.
s nextPutAll: '**** '; nextPutLine:(ex errorString withCRs).
s nextPutLine:'****'.
con := ex suspendedContext.
s nextPutAll: '**** '; nextPutLine:(con printString , ' [' , con lineNumber printString , ']').
con := con sender.
[con notNil] whileTrue:[
s nextPutAll: '**** '; nextPutLine:(con printString , ' [' , con lineNumber printString , ']').
con receiver == self ifTrue:[
con := nil
] ifFalse:[
con := con sender.
]
].
codeView contents:(s contents).
ex return.
] do:[
self doShowSelection:lineNr
]
"Modified: / 8.11.1997 / 19:38:03 / cg"
!
updateForContext:lineNr
"show selected code for lineNr in contextList in textView.
Also used to autoselect an interesting context on entry."
|con homeContext sel method code canAccept
implementorClass lineNrInMethod rec m line
sender selSender tryVars possibleBlocks errMsg
mthd cls codeSet|
contextArray notNil ifTrue:[
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 showMore.
lineNr >= contextArray size ifTrue:[
contextView setSelection:lineNr.
con := contextArray at:lineNr
]
].
con isNil ifTrue:[
codeView contents:nil.
^ self
].
].
selectedContext := con.
m := contextView middleButtonMenu.
(m notNil and:[selectedContext notNil]) ifTrue:[
m enableAll:#(implementors senders inspectContext)
].
self withWaitCursorDo:[
codeSet := false.
"
give it to the (lower right) inspector
"
"/ Object errorSignal handle:[:ex |
"/ 'DebugView [warning]: error while accessing context' errorPrintCR.
"/ contextInspector inspect:nil.
"/ ] do:[
contextInspector inspect:con.
"/ ].
"/ show a stack inspector sometimes
con hasStackToShow ifTrue:[
stackInspector isNil ifTrue:[
receiverInspector origin:(0.0 @ 0.0) corner:0.3 @ 1.0.
contextInspector origin:(0.3 @ 0.0) corner:(0.6 @ 1.0).
stackInspector := InspectorView
origin:(0.6 @ 0.0) corner:(1.0 @ 1.0)
in:contextInspector superView.
stackInspector realize.
stackInspector label:'stack'.
stackInspector hideReceiver:true.
].
stackInspector inspect:(con stackFrame asArray).
stackInspector showLast.
] ifFalse:[
stackInspector notNil ifTrue:[
stackInspector destroy.
stackInspector := nil.
receiverInspector origin:(0.0 @ 0.0) corner:0.5 @ 1.0.
contextInspector origin:(0.5 @ 0.0) corner:(1.0 @ 1.0).
]
].
"
get the home context
"
con isBlockContext ifTrue:[
homeContext := con methodHome
] ifFalse:[
homeContext := con
].
con canReturn ifTrue:[
returnButton enable. restartButton enable.
] ifFalse:[
returnButton disable. restartButton disable.
].
lineNrInMethod := con lineNumber.
canAccept := false.
homeContext isNil ifTrue:[
"
mhmh - an optimized block
should get the block here, and get the method from
that one ...
But in 2.10.x, there is no easy way to get to the block
since that one is not in the context.
Starting with 2.11, the new block calling scheme will fix this.
"
"temporary kludge - peek into the sender context.
If its a do-like method and there is a single block variable
in the args or temporaries, that must be the one.
This helps in some cases.
"
(sender := con sender) notNil ifTrue:[
tryVars := false.
(selSender := sender selector) notNil ifTrue:[
(selSender endsWith:'do:') ifTrue:[
tryVars := true.
] ifFalse:[
(selSender endsWith:'Do:') ifTrue:[
tryVars := true.
]
]
].
tryVars ifTrue:[
possibleBlocks := sender argsAndVars select:[:v | v isBlock].
possibleBlocks := possibleBlocks select:[:b | b home isNil].
possibleBlocks size == 1 ifTrue:[
method := possibleBlocks first method.
].
]
].
] ifFalse:[
"fetch rec here - so we wont need context in doItAction"
rec := homeContext receiver.
sel := homeContext selector.
sel notNil ifTrue:[
canAccept := true.
implementorClass := homeContext methodClass.
implementorClass isNil ifTrue:[
Object errorSignal handle:[:ex |
code := 'error while asking method for its source'.
canAccept := false.
ex return.
] do:[
"
special: look if this context was created by
valueWithReceiver kind of method invocation;
if so, grab the method from the sender and show it
"
((sender := homeContext sender) notNil
and:[(sender selector startsWith:'valueWithReceiver:')
and:[sender receiver isMethod]]) ifTrue:[
method := sender receiver.
self sensor shiftDown ifTrue:[
code := method decompiledSource
] ifFalse:[
code := method source.
].
canAccept := false.
] ifFalse:[
(method := con method) notNil ifTrue:[
self sensor shiftDown ifTrue:[
code := method decompiledSource
] ifFalse:[
code := method source.
].
canAccept := false.
]
]
]
] ifFalse:[
method := implementorClass compiledMethodAt:sel.
].
]
].
code isNil ifTrue:[
errMsg := nil.
method notNil ifTrue:[
Object errorSignal handle:[:ex |
code := 'error while asking method for its source'.
canAccept := false.
ex return.
] do:[
self sensor shiftDown ifTrue:[
code := method decompiledSource
] ifFalse:[
code := method source.
].
].
code isNil ifTrue:[
method sourceFilename notNil ifTrue:[
codeView contents:(resources
string:'** no sourcefile: %1 **'
with:method sourceFilename).
codeView flash.
codeSet := true.
] ifFalse:[
errMsg := '** no source **'
]
]
] ifFalse:[
homeContext isNil ifTrue:[
errMsg := '** sorry; cannot show code of all optimized blocks (yet) **'.
] ifFalse:[
errMsg := '** no method - no source **'
]
].
errMsg notNil ifTrue:[
self showError:errMsg.
codeSet := true.
]
].
code isNil ifTrue:[
canAccept := false.
codeSet ifFalse:[
codeView contents:nil.
]
] ifFalse:[
UserPreferences current syntaxColoring ifTrue:[
code := SyntaxHighlighter formatMethod:code in:implementorClass.
].
code ~= (codeView contents) ifTrue:[codeView contents:code].
(lineNrInMethod notNil and:[lineNrInMethod ~~ 0]) ifTrue:[
"/ lineNrInMethod > codeView list size ifTrue:[
"/ lineNrInMethod := codeView list size + 1
"/ ].
"/ codeView selectLine:lineNrInMethod.
"/ codeView makeSelectionVisible
lineNrInMethod <= codeView list size ifTrue:[
(lineNrInMethod == 255
and:[method notNil
and:[method code isNil]]) ifTrue:[
"/ means: do not really know in interpreted methods
codeView selectFromLine:255 col:1 toLine:codeView list size + 1 col:0.
] ifFalse:[
codeView selectLine:lineNrInMethod.
].
codeView makeSelectionVisible
]
].
].
codeView acceptEnabled:canAccept.
canAccept ifTrue:[
codeView acceptAction:[:code | self codeAccept:code asString]
] ifFalse:[
codeView acceptAction:[:code | self device beep].
].
receiverInspector inspect:rec.
"
the one below is wrong: currently, the
evaluator cannot handle passed contexts.
Once it does, pass con as in:-arg
"
codeView doItAction:[:theCode |
rec class evaluatorClass
evaluate:theCode
in:actualContext
receiver:rec
notifying:codeView
logged:true
ifFail:nil
].
selectedContext := homeContext.
actualContext := con
].
] ifFalse:[
codeView contents:nil.
].
con isContext ifFalse:[
sendButton disable.
] ifTrue:[
sendButton enable.
].
"clear out locals to prevent keeping around unneeded contexts
(due to the block held in codeView).
(not really needed, since stuff gets collected away sooner or later ...
... but this makes it a bit sooner)
"
con := nil.
homeContext := nil.
"
enable/disable some menu items
"
m := contextView middleButtonMenu.
(m notNil and:[selectedContext notNil]) ifTrue:[
m enableAll:#(implementors senders inspectContext skip skipForReturn).
(method notNil and:[method isWrapped]) ifTrue:[
m enable:#removeBreakpoint.
] ifFalse:[
m disable:#removeBreakpoint.
].
mthd := selectedContext method.
mthd notNil ifTrue:[
cls := mthd containingClass.
].
m enable:#browseClass.
cls notNil ifTrue:[
m enableAll:#(browse browseClass browseClassHierarchy browseFullClassProtocol).
] ifFalse:[
m disableAll:#(browse browseClass browseClassHierarchy browseFullClassProtocol).
].
]
"Created: / 14.8.1997 / 20:15:00 / cg"
"Modified: / 17.4.1998 / 20:59:39 / cg"
! !
!DebugView class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.195 1998-04-17 19:00:31 cg Exp $'
! !
DebugView initialize!