--- a/DebugView.st Thu Nov 17 15:44:34 1994 +0100
+++ b/DebugView.st Thu Nov 17 15:47:59 1994 +0100
@@ -22,7 +22,7 @@
exclusive inspecting nChainShown
inspectedProcess updateProcess
monitorToggle'
- classVariableNames:'CachedDebugger CachedExclusive'
+ classVariableNames:'CachedDebugger CachedExclusive MoreDebuggingDetail'
poolDictionaries:''
category:'Interface-Debugger'
!
@@ -31,7 +31,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.16 1994-10-28 03:30:49 claus Exp $
+$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.17 1994-11-17 14:46:40 claus Exp $
'!
!DebugView class methodsFor:'documentation'!
@@ -52,7 +52,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.16 1994-10-28 03:30:49 claus Exp $
+$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.17 1994-11-17 14:46:40 claus Exp $
"
!
@@ -182,12 +182,18 @@
"start a debugger on aProcess
(actually not more than a good-looking inspector)"
- |aDebugger label|
+ |aDebugger label nm|
aDebugger := super new.
aDebugger icon:(Form fromFile:'Debugger.xbm' resolution:100).
aProcess notNil ifTrue:[
- label := 'process Debugger (' , aProcess nameOrId , ')'.
+ nm := aProcess name.
+ nm notNil ifTrue:[
+ nm := (aProcess nameOrId contractTo:17) , '-' , aProcess id printString
+ ] ifFalse:[
+ nm := aProcess id printString
+ ].
+ label := 'Debugger [' , nm , ']'.
] ifFalse:[
label := 'no process'
].
@@ -225,6 +231,7 @@
action:[terminateButton turnOffWithoutRedraw. self doTerminate]
in:bpanel.
dummy := View extent:(20 @ 5) in:bpanel.
+ dummy borderWidth:0; level:0.
abortButton := Button
label:(resources at:'abort')
@@ -241,12 +248,14 @@
in:bpanel.
dummy := View extent:(20 @ 5) in:bpanel.
+ dummy borderWidth:0; level:0.
continueButton := Button
label:(resources at:'continue')
action:[continueButton turnOffWithoutRedraw. self doContinue]
in:bpanel.
dummy := View extent:(20 @ 5) in:bpanel.
+ dummy borderWidth:0; level:0.
stepButton := Button
label:(resources at:'step')
@@ -385,6 +394,10 @@
].
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).
]
@@ -395,8 +408,13 @@
stepInterrupt
|where here s isWrap method lastWrappedConAddr wrappedMethod|
+ Processor activeProcess ~~ inspectedProcess ifTrue:[
+ 'stray step interrupt' errorPrintNL.
+ ^ self
+ ].
+
"
- kludge, check if we are in a wrapper methods hidden setup-sequence
+ kludge: check if we are in a wrapper methods hidden setup-sequence
"
here := thisContext. "stepInterrupt"
here := here sender. "the interrupted context"
@@ -549,7 +567,7 @@
busy := true.
inspecting := false.
- inspectedProcess := nil.
+ inspectedProcess := Processor activeProcess.
bigStep := false.
nChainShown := 50.
@@ -557,13 +575,8 @@
pointer, we must ungrab - otherwise X wont talk to
us here
"
- ActiveGrab notNil ifTrue:[
- grabber := ActiveGrab.
- ActiveGrab device ungrabPointer.
- ActiveGrab device synchronizeOutput.
- ActiveGrab := nil
- ] ifFalse:[
- grabber := nil
+ (grabber := device activePointerGrab) notNil ifTrue:[
+ device ungrabPointer
].
terminateButton enable.
@@ -575,7 +588,7 @@
abortButton turnOffWithoutRedraw.
stepButton turnOffWithoutRedraw.
sendButton turnOffWithoutRedraw.
- self rerealize
+"/ self rerealize
] ifFalse:[
exclusive ifFalse:[
windowGroup isNil ifTrue:[
@@ -583,15 +596,15 @@
windowGroup addTopView:self.
].
].
- self realize.
+"/ self realize.
self iconLabel:'Debugger'.
].
- "
- bring us to the top
- "
- self raise.
- Display synchronizeOutput.
+"/ "
+"/ bring us to the top
+"/ "
+"/ self raise.
+"/ Display synchronizeOutput.
"
get the walkback list
@@ -601,21 +614,39 @@
"
and find one to show
"
- steppedContextAddress isNil ifTrue:[
- "
- preselect a more interresting context, (where halt/raise was ...)
- "
- selection := self interrestingContextFrom:aContext.
+ exitAction == #step ifTrue:[
+ selection := 1.
+ steppedContextAddress notNil ifTrue:[
+ "
+ 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
+ ]
+ ]
+ ]
+ ]
] 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
+ steppedContextAddress isNil ifTrue:[
+ "
+ 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
+ ]
]
]
]
@@ -645,10 +676,24 @@
]
].
+ drawableId notNil ifTrue:[
+ self rerealize
+ ] ifFalse:[
+ self realize.
+ ].
+
+ "
+ bring us to the top
+ "
+ self raise.
+ Display synchronizeOutput.
+
"
enter private event handling loop
"
canContinue := true.
+ exitAction := nil.
+
self controlLoop.
contextArray := nil.
@@ -743,8 +788,8 @@
selectedContext := nil.
grabber notNil ifTrue:[
- grabber device grabPointerIn:(grabber id).
- ActiveGrab := grabber
+ device grabPointerInView:grabber.
+ grabber := nil.
].
(exitAction == #step) ifTrue:[
@@ -766,9 +811,9 @@
openOn:aProcess
"enter the debugger on a process -
in this case, we are just inspecting the context chain of the process,
- not offering continue/abort/step and send functions.
- 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)"
+ 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 updateButton stopButton dummy|
@@ -786,6 +831,7 @@
bpanel addSubView:stopButton after:continueButton.
dummy := View extent:(20 @ 5) in:bpanel.
+ dummy borderWidth:0; level:0.
"/ stepButton destroy.
"/ sendButton destroy.
@@ -825,6 +871,7 @@
self setContext:aProcess suspendedContext.
catchBlock := [
+ catchBlock := nil.
contextArray := nil.
selectedContext := nil.
(exitAction == #terminate) ifTrue:[
@@ -861,8 +908,8 @@
!
controlLoopCatchingErrors
- "setup a catch-block"
- catchBlock := [^ nil].
+ "setup a self removing catch-block"
+ catchBlock := [catchBlock := nil. ^ nil].
exclusive ifTrue:[
"if we do not have multiple processes or its a system process
@@ -880,13 +927,19 @@
active group.
"
SignalSet anySignal handle:[:ex |
- 'ignored error in debugger: ' errorPrint.
+"/ (self confirm:('error in debugger: ' , ex errorString , '\\debug again ?') withCRs)
+"/ ifTrue:[
+"/ Debugger enter:(ex suspendedContext).
+"/ ex return.
+"/ ].
+"/ 'ignored error in debugger: ' errorPrint.
ex errorString errorPrintNL.
ex return.
] do:[
windowGroup eventLoopWhile:[true]
- ]
- ]
+ ].
+ ].
+ catchBlock := nil.
! !
!DebugView methodsFor:'private'!
@@ -895,9 +948,13 @@
^ busy
!
+showError:message
+ codeView contents:(resources string:message).
+ codeView flash
+!
+
showTerminated
- codeView contents:(resources string:'** process has terminated **').
- codeView flash
+ self showError:'** the process has terminated **'
!
processAction:aBlock
@@ -927,9 +984,13 @@
interrestingContextFrom:aContext
"return an interresting contexts offset, or nil.
- Just to add a bit of comfort :-)"
+ 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|
+ |c found offset sel prev|
"somewhere, at the bottom, there must be a raise ..."
@@ -937,40 +998,34 @@
1 to:5 do:[:i |
c isNil ifTrue:[^ 1 "^ nil"].
sel := c selector.
- ((sel == #raise)
- or:[(sel == #raiseRequestWith:)
- or:[(sel == #raiseRequestWith:errorString:)]])
- ifTrue:[
+ (sel == #raise) ifTrue:[
offset := i.
found := c
].
c := c sender.
].
- (c := found) isNil ifTrue:[^ 1 "nil"].
+ (c := found) isNil ifTrue:[^ 1].
"
- got it; move up, for the one that called the raise
+ got it; move up, skipping all intermediate Signal and
+ Exception contexts
"
- (c := c sender) isNil ifTrue:[^ offset].
- offset := offset + 1.
+ prev := nil.
+ [
+ ((c receiver isKindOf:Signal)
+ or:[(c receiver isKindOf:Exception)])
+ ] whileTrue:[
+ prev := c.
+ (c := c sender) isNil ifTrue:[^ offset].
+ offset := offset + 1.
+ ].
"
now, we are one above the raise
"
"
- if raise implementation reuses raise code ...
- "
- [
- #( raise raiseRequestWith: #raiseRequestWith:errorString: )
- includes:c selector
- ] whileTrue:[
- (c := c sender) isNil ifTrue:[^ offset].
- offset := offset + 1.
- ].
-
- "
if the sender of the raise is one of objects error methods ...
"
( #( halt halt:
@@ -988,6 +1043,13 @@
].
(c := c sender) isNil ifTrue:[^ offset].
offset := offset + 1.
+ ] ifFalse:[
+ "
+ ok, got the raise - if its a BreakPoint, look for the sender
+ "
+ prev receiver == MessageTracer breakpointSignal ifTrue:[
+ offset := offset + 1
+ ].
].
^ offset
@@ -1021,7 +1083,7 @@
"
[con notNil and:[contextArray size <= nChainShown]] whileTrue:[
contextArray add:con.
- (Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[
+ (MoreDebuggingDetail == true) ifTrue:[
text add:(((ObjectMemory addressOf:con) printStringRadix:16) , ' ' , con printString).
] ifFalse:[
text add:con printString.
@@ -1135,7 +1197,7 @@
sel notNil ifTrue:[
implementorClass := homeContext searchClass whichClassImplements:sel.
implementorClass isNil ifTrue:[
- codeView contents:(resources string:'** no method - no source **')
+ self showError:'** no method - no source **'
] ifFalse:[
method := implementorClass compiledMethodAt:sel.
code := method source.
@@ -1143,9 +1205,10 @@
method sourceFilename notNil ifTrue:[
codeView contents:(resources
string:'** no sourcefile: %1 **'
- with:method sourceFilename)
+ with:method sourceFilename).
+ codeView flash
] ifFalse:[
- codeView contents:(resources string:'** no source **')
+ self showError:'** no source **'
]
]
].
@@ -1265,8 +1328,24 @@
"closing the debugger implies an abort or continue"
contextView middleButtonMenu hide.
+
+ "
+ we manually release all private data, since the Debugger
+ is cached for reuse - thus the memory would not be collectable
+ otherwise.
+ "
receiverInspector release.
contextInspector release.
+ inspectedProcess := nil.
+ exitAction := nil.
+ contextArray := nil.
+ selectedContext := nil.
+ catchBlock := nil.
+ grabber := nil.
+ self autoUpdateOff.
+
+ super destroy.
+
inspecting ifFalse:[
canAbort ifTrue:[
self doAbort.
@@ -1275,9 +1354,6 @@
self doContinue
]
].
- self autoUpdateOff.
- inspectedProcess := nil.
- super destroy
!
doExit
@@ -1291,6 +1367,10 @@
|implementorClass method|
+ selectedContext isNil ifTrue:[
+ ^ self showError:'** select a context first **'
+ ].
+
implementorClass := selectedContext searchClass
whichClassImplements:selectedContext selector.
implementorClass notNil ifTrue:[
@@ -1311,28 +1391,32 @@
doSenders
"open a browser on the senders"
- selectedContext notNil ifTrue:[
- SystemBrowser browseAllCallsOn:selectedContext selector.
- ]
+ selectedContext isNil ifTrue:[
+ ^ self showError:'** select a context first **'
+ ].
+ SystemBrowser browseAllCallsOn:selectedContext selector.
!
doImplementors
"open a browser on the implementors"
- selectedContext notNil ifTrue:[
- SystemBrowser browseImplementorsOf:selectedContext selector.
- ]
+ selectedContext isNil ifTrue:[
+ ^ self showError:'** select a context first **'
+ ].
+ SystemBrowser browseImplementorsOf:selectedContext selector.
!
doShowMore
"double number of contexts shown"
- |oldSelection|
+ |oldSelection con|
contextArray notNil ifTrue:[
oldSelection := contextView selection.
nChainShown := nChainShown * 2.
- self setContext:contextArray first.
+ con := contextArray at:1.
+ contextArray at:1 put:nil.
+ self setContext:con.
contextView selection:oldSelection.
]
!
@@ -1400,7 +1484,7 @@
^ self
].
(Object abortSignal isHandledIn:inspectedProcess suspendedContext) ifFalse:[
- codeView contents:(resources string:'** process no longer handles abort **')
+ self showError:'** the process does not handle the abort signal **'
] ifTrue:[
self interruptProcessWith:[Object abortSignal raise].
].
@@ -1423,12 +1507,12 @@
^ self.
"obsolete ..."
- Processor activeProcess id == 0 ifTrue:[
- "dont allow termination of main-thread"
- exitAction := #abort
- ] ifFalse:[
- exitAction := #terminate
- ]
+"/ Processor activeProcess id == 0 ifTrue:[
+"/ "dont allow termination of main-thread"
+"/ exitAction := #abort
+"/ ] ifFalse:[
+"/ exitAction := #terminate
+"/ ]
!
doTerminate
@@ -1479,6 +1563,9 @@
"return - the selected context will do a ^nil"
inspecting ifTrue:[
+ selectedContext isNil ifTrue:[
+ ^ self showError:'** select a context first **'
+ ].
self interruptProcessWith:[selectedContext return].
^ self
].
@@ -1499,6 +1586,9 @@
"restart - the selected context will be restarted"
inspecting ifTrue:[
+ selectedContext isNil ifTrue:[
+ ^ self showError:'** select a context first **'
+ ].
self interruptProcessWith:[selectedContext restart].
^ self
].