hg/stx-libtool: comparison DebugView.st

equal deleted inserted replaced

-:57c1ccc3d7e0
+:7b48409ae088
 			      abortButton terminateButton continueButton
 			      stepButton sendButton returnButton restartButton
 			      exclusive inspecting nChainShown
 			      inspectedProcess updateProcess
 			      monitorToggle'
-classVariableNames:'CachedDebugger CachedExclusive'
+classVariableNames:'CachedDebugger CachedExclusive MoreDebuggingDetail'
 poolDictionaries:''
 category:'Interface-Debugger'
 !
 DebugView comment:'
 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'!
 copyright
 "
 !
 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 $
 "
 !
 documentation
 "
 openOn:aProcess
 "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'
 ].
 aDebugger label:label.
 aDebugger iconLabel:'Debugger'.
 terminateButton := Button
 			label:(resources at:'terminate')
 			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')
 			action:[abortButton turnOffWithoutRedraw. self doAbort]
 			in:bpanel.
 			label:(resources at:'restart')
 			action:[restartButton turnOff. self doRestart]
 			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')
 			action:[stepButton turnOff. self doStep]
 			in:bpanel.
 exclusive ifTrue:[
 	windowGroup := nil
 ].
 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).
 ]
 ! !
 !DebugView methodsFor:'interrupt handling'!
 stepInterrupt
 |where here s isWrap method lastWrappedConAddr wrappedMethod|
-"
+Processor activeProcess ~~ inspectedProcess ifTrue:[
-kludge, check if we are in a wrapper methods hidden setup-sequence
+	'stray step interrupt' errorPrintNL.
+	^ self
+].
+"
+kludge: check if we are in a wrapper methods hidden setup-sequence
 "
 here := thisContext.        "stepInterrupt"
 here := here sender.        "the interrupted context"
 "/ 'here in ' print.
 |con selection m|
 busy := true.
 inspecting := false.
-inspectedProcess := nil.
+inspectedProcess := Processor activeProcess.
 bigStep := false.
 nChainShown := 50.
 "if debugger is entered while a box has grabbed the
 pointer, we must ungrab - otherwise X wont talk to
 us here
 "
-ActiveGrab notNil ifTrue:[
+(grabber := device activePointerGrab) notNil ifTrue:[
-	grabber := ActiveGrab.
+	device ungrabPointer
-	ActiveGrab device ungrabPointer.
-	ActiveGrab device synchronizeOutput.
-	ActiveGrab := nil
-] ifFalse:[
-	grabber := nil
 ].
 terminateButton enable.
 drawableId notNil ifTrue:[
 	terminateButton turnOffWithoutRedraw.
 	continueButton turnOffWithoutRedraw.
 	abortButton turnOffWithoutRedraw.
 	stepButton turnOffWithoutRedraw.
 	sendButton turnOffWithoutRedraw.
-	self rerealize
+"/        self rerealize
 ] ifFalse:[
 	exclusive ifFalse:[
 	    windowGroup isNil ifTrue:[
 		windowGroup := WindowGroup new.
 		windowGroup addTopView:self.
 	    ].
 	].
-	self realize.
+"/        self realize.
 	self iconLabel:'Debugger'.
 ].
-"
+"/    "
-bring us to the top
+"/   bring us to the top
-"
+"/  "
-self raise.
+"/  self raise.
-Display synchronizeOutput.
+"/  Display synchronizeOutput.
 "
 get the walkback list
 "
 self setContext:aContext.
 "
 and find one to show
 "
-steppedContextAddress isNil ifTrue:[
+exitAction == #step ifTrue:[
-	"
+	selection := 1.
-	 preselect a more interresting context, (where halt/raise was ...)
+	steppedContextAddress notNil ifTrue:[
-	"
+	    "
-	selection := self interrestingContextFrom:aContext.
+	     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:[
-	"
+	steppedContextAddress isNil ifTrue:[
-	 if we came here by a big-step, show the method where we are
+	    "
-	"
+	     preselect a more interresting context, (where halt/raise was ...)
-	steppedContextAddress notNil ifTrue:[
+	    "
-	    (ObjectMemory addressOf:aContext) == steppedContextAddress ifTrue:[
+	    selection := self interrestingContextFrom:aContext.
-		selection := 1
+	] ifFalse:[
-	    ] ifFalse:[
+	    "
-		(ObjectMemory addressOf:aContext sender) == steppedContextAddress ifTrue:[
+	     if we came here by a big-step, show the method where we are
-		    selection := 2
+	    "
+	    steppedContextAddress notNil ifTrue:[
+		(ObjectMemory addressOf:aContext) == steppedContextAddress ifTrue:[
+		    selection := 1
+		] ifFalse:[
+		    (ObjectMemory addressOf:aContext sender) == steppedContextAddress ifTrue:[
+			selection := 2
+		    ]
 		]
 	    ]
 	]
 ].
 	    terminateButton enable.
 	    m enable:#doTerminate.
 	]
 ].
+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.
 receiverInspector release.
 contextInspector release.
 ].
 selectedContext := nil.
 grabber notNil ifTrue:[
-	grabber device grabPointerIn:(grabber id).
+	device grabPointerInView:grabber.
-	ActiveGrab := grabber
+	grabber := nil.
 ].
 (exitAction == #step) ifTrue:[
 	"scedule another stepInterrupt
 	 - must flush caches since optimized methods not always
 !
 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.
+not running on top of the debugged process, but as a separate
-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, and offering
-one. (think of it as an inspector showing more detail)"
+some more control operations)"
 |bpanel updateButton stopButton dummy|
 busy := true.
 bigStep := false.
 stopButton label:(resources at:'stop');
 	       action:[self doStop].
 bpanel addSubView:stopButton after:continueButton.
 dummy := View extent:(20 @ 5) in:bpanel.
+dummy borderWidth:0; level:0.
 "/    stepButton destroy.
 "/    sendButton destroy.
 updateButton := Button
 	].
 	self setContext:aProcess suspendedContext.
 	catchBlock := [
+	    catchBlock := nil.
 	    contextArray := nil.
 	    selectedContext := nil.
 	    (exitAction == #terminate) ifTrue:[
 		aProcess terminate.
 	    ].
 receiverInspector release.
 contextInspector release
 !
 controlLoopCatchingErrors
-"setup a catch-block"
+"setup a self removing catch-block"
-catchBlock := [^ nil].
+catchBlock := [catchBlock := nil. ^ nil].
 exclusive ifTrue:[
 	"if we do not have multiple processes or its a system process
 	 we start another dispatch loop, which exits when
 	 either continue, return or step is pressed
 	 simply enter the DebugViews-Windowgroup event loop.
 	 effectively suspending event processing for the currently
 	 active group.
 	"
 	SignalSet anySignal handle:[:ex |
-	    'ignored error in debugger: ' errorPrint.
+"/            (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'!
 busy
 ^ busy
 !
+showError:message
+codeView contents:(resources string:message).
+codeView flash
+!
 showTerminated
-codeView contents:(resources string:'** process has terminated **').
+self showError:'** the process has terminated **'
-codeView flash
 !
 processAction:aBlock
 "do something, then update the context list"
 exclusive := aBoolean
 !
 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
-|c found offset sel|
+and Exception contexts, to present the context in which the error
+actually occured.
+Just for your convenience :-)"
+|c found offset sel prev|
 "somewhere, at the bottom, there must be a raise ..."
 c := aContext.
 1 to:5 do:[:i |
 	c isNil ifTrue:[^ 1 "^ nil"].
 	sel := c selector.
-	((sel == #raise)
+	(sel == #raise) ifTrue:[
-	or:[(sel == #raiseRequestWith:)
-	or:[(sel == #raiseRequestWith:errorString:)]])
-	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)
-now, we are one above the raise
+	or:[(c receiver isKindOf:Exception)])
-"
-"
-if raise implementation reuses raise code ...
-"
-[
-	#( raise raiseRequestWith: #raiseRequestWith:errorString: )
-	includes:c selector
 ] whileTrue:[
+	prev := c.
 	(c := c sender) isNil ifTrue:[^ offset].
 	offset := offset + 1.
 ].
+"
+now, we are one above the raise
+"
 "
 if the sender of the raise is one of objects error methods ...
 "
 ( #( halt halt:
 	    (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
+	"
+	prev receiver == MessageTracer breakpointSignal ifTrue:[
+	    offset := offset + 1
+	].
 ].
 ^ offset
 !
 	"
 	 get them all
 	"
 	[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.
 	    ].
 	homeContext notNil ifTrue:[
 	    sel := homeContext selector.
 	    sel notNil ifTrue:[
 		implementorClass := homeContext searchClass whichClassImplements:sel.
 		implementorClass isNil ifTrue:[
-		    codeView contents:(resources string:'** no method - no source **')
+		    self showError:'** no method - no source **'
 		] ifFalse:[
 		    method := implementorClass compiledMethodAt:sel.
 		    code := method source.
 		    code isNil ifTrue:[
 			method sourceFilename notNil ifTrue:[
 			    codeView contents:(resources
 						   string:'** no sourcefile: %1 **'
-						   with:method sourceFilename)
+						   with:method sourceFilename).
+			    codeView flash
 			] ifFalse:[
-			    codeView contents:(resources string:'** no source **')
+			    self showError:'** no source **'
 			]
 		    ]
 		].
 		code isNil ifTrue:[
 		    codeView acceptAction:nil.
 destroy
 "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.
 	    'oops, abort failed' errorPrintNewline.
 	] ifFalse:[
 	    self doContinue
 	]
 ].
-self autoUpdateOff.
-inspectedProcess := nil.
-super destroy
 !
 doExit
 "exit from menu: immediate exit from smalltalk"
 doRemoveBreakpoint
 "remove breakpoint on the selected contexts method - if any"
 |implementorClass method|
+selectedContext isNil ifTrue:[
+	^ self showError:'** select a context first **'
+].
 implementorClass := selectedContext searchClass
 			    whichClassImplements:selectedContext selector.
 implementorClass notNil ifTrue:[
 	method := implementorClass compiledMethodAt:selectedContext selector.
 !
 doSenders
 "open a browser on the senders"
-selectedContext notNil ifTrue:[
+selectedContext isNil ifTrue:[
-	SystemBrowser browseAllCallsOn:selectedContext selector.
+	^ self showError:'** select a context first **'
-]
+].
+SystemBrowser browseAllCallsOn:selectedContext selector.
 !
 doImplementors
 "open a browser on the implementors"
-selectedContext notNil ifTrue:[
+selectedContext isNil ifTrue:[
-	SystemBrowser browseImplementorsOf:selectedContext selector.
+	^ 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.
 ]
 !
 doSend
 	inspectedProcess isDead ifTrue:[
 	    self showTerminated.
 	    ^ 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].
 	].
 	^ self
 ].
 	]
 ].
 ^ self.
 "obsolete ..."
-Processor activeProcess id == 0 ifTrue:[
+"/    Processor activeProcess id == 0 ifTrue:[
-	"dont allow termination of main-thread"
+"/        "dont allow termination of main-thread"
-	exitAction := #abort
+"/        exitAction := #abort
-] ifFalse:[
+"/    ] ifFalse:[
-	exitAction := #terminate
+"/        exitAction := #terminate
-]
+"/    ]
 !
 doTerminate
 "terminate - the process has a chance for cleanup"
 doReturn
 "return - the selected context will do a ^nil"
 inspecting ifTrue:[
+	selectedContext isNil ifTrue:[
+	    ^ self showError:'** select a context first **'
+	].
 	self interruptProcessWith:[selectedContext return].
 	^ self
 ].
 steppedContextAddress := nil.
 doRestart
 "restart - the selected context will be restarted"
 inspecting ifTrue:[
+	selectedContext isNil ifTrue:[
+	    ^ self showError:'** select a context first **'
+	].
 	self interruptProcessWith:[selectedContext restart].
 	^ self
 ].
 steppedContextAddress := nil.

changeset 52	7b48409ae088
parent 48	f007285a17ba
child 53	2fc78a0165e7