hg/stx-libtool: comparison DebugView.st

equal deleted inserted replaced

-:d0cb937cbcaa
+:36e13831b62d
 			      bigStep skipLineNr steppedContextAddress canAbort
 			      abortButton terminateButton continueButton
 			      stepButton sendButton returnButton restartButton
 			      exclusive inspecting nChainShown
 			      inspectedProcess updateProcess
-			      monitorToggle'
+			      monitorToggle stepping steppedContextLineno actualContext inWrap'
-classVariableNames:'CachedDebugger CachedExclusive MoreDebuggingDetail'
+classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers 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.20 1994-11-28 21:11:09 claus Exp $
+$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.21 1995-02-06 00:59:38 claus Exp $
 '!
 !DebugView class methodsFor:'documentation'!
 copyright
 "
 !
 version
 "
-$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.20 1994-11-28 21:11:09 claus Exp $
+$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.21 1995-02-06 00:59:38 claus Exp $
 "
 !
 documentation
 "
 new
 "return a new DebugView - return a cached debugger if it already
 exists"
-|debugger active|
+|debugger|
-"need a blocking debugger if no processes or
+"
+need a blocking debugger if no processes or
 or if its a timing/interrupt process
-(because otherwise we would not get any events here ..."
+(because otherwise we would not get any events here ...
+"
-active := Processor activeProcess.
+Processor activeProcessIsSystemProcess ifTrue:[
-(ProcessorScheduler isPureEventDriven
-or:[(active priority >= Processor userInterruptPriority)
-or:[active id == 0
-or:[active nameOrId endsWith:'dispatcher']]]) ifTrue:[
 	CachedExclusive isNil ifTrue:[
 	    debugger := self newExclusive
 	] ifFalse:[
 	    debugger := CachedExclusive.
 	    CachedExclusive := nil.
 newExclusive
 "return a debugger for exclusive display access"
 |debugger|
-debugger := super on:ModalDisplay.
+debugger := super new.
 debugger label:'Debugger'.
 debugger icon:(Form fromFile:'Debugger.xbm' resolution:100).
 debugger exclusive:true.
 ^ debugger
 !
 newDebugger
 "force creation of a new debugger"
 CachedDebugger := nil.
-CachedExclusive := nil
+CachedExclusive := nil.
+OpenDebuggers := nil.
-"DebugView newDebugger"
+"
+DebugView newDebugger
+"
 !
 enterWithMessage:aString
 "the standard way of entering the debugger - sent from Objects
 error- and halt messages"
 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."
+StepInterruptPending := nil.
+"
+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:[
+	OpenDebuggers do:[:aDebugger |
+	    aDebugger notNil ifTrue:[
+		(aDebugger inspectedProcess == Processor activeProcess) ifTrue:[
+"/ 'entering stepping debugger again' printNL.
+		    aDebugger unstep.
+		    aDebugger label:aString , ' (' , Processor activeProcess nameOrId , ')'.
+		    ^ aDebugger enter:aContext.
+		]
+	    ]
+	]
+].
 thisContext isRecursive ifTrue:[
 	^ MiniDebugger enterWithMessage:'recursive error'.
 ].
 ^ self enterUnconditional:aContext withMessage:aString
 initializeMiddleButtonMenu
 |labels m|
 labels := resources array:#(
 				'show more'
+				'-'
+				'skip'
 				'-'
 "
 				'continue'
 				'terminate'
 				'abort'
 m := (PopUpMenu
 				labels:labels
 			     selectors:#(
 					 doShowMore
+					 nil
+					 doSkip
 					 nil
 "
 					 doContinue
 					 doTerminate
 					 doAbort
 	    m disable:#doRemoveBreakpoint.
 	].
 ]
 !
-reinitialize
-super reinitialize.
-"
-this is reached, when we come up after a restart.
-ST/X does not support this, since the contexts are
-all dead, and processes have been recreated.
-"
-super destroy
-!
 addToCurrentProject
 "ignored here"
 ^ self
 !
 super realize.
 exclusive ifTrue:[
 	windowGroup := nil
 ].
-inspectedProcess notNil ifTrue:[
+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)
+	     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).
+	    Processor activeProcess
+		priority:(inspectedProcess priority + 2 min:16).
+	]
 ]
 ! !
 !DebugView methodsFor:'interrupt handling'!
 stepInterrupt
-|where here s isWrap method lastWrappedConAddr wrappedMethod|
+|where here s isWrap method lastWrappedConAddr wrappedMethod inBlock left ignore|
 Processor activeProcess ~~ inspectedProcess ifTrue:[
 	'stray step interrupt' errorPrintNL.
 	^ self
 ].
 "
-kludge: check if we are in a wrapper methods hidden setup-sequence
+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
 "
 here := thisContext.        "stepInterrupt"
 here := here sender.        "the interrupted context"
+"/ '*******' printNL.
 "/ 'here in ' print.
 "/  ((ObjectMemory addressOf:here) printStringRadix:16)print. '' printNL.
 where := here.
 isWrap := false.
-wrappedMethod := nil.
+left := false.
-5 timesRepeat:[
+inWrap ifTrue:[
+	wrappedMethod := nil.
+	3 timesRepeat:[
 "/ where selector printNL.
-	where notNil ifTrue:[
+	    (where notNil and:[where isBlockContext not]) ifTrue:[
-	    method := where method.
+		method := where method.
-	    (method notNil and:[method isWrapped]) ifTrue:[
+		(method notNil and:[method isWrapped]) ifTrue:[
-		"
+		    "
-		 in a wrapper method
+		     in a wrapper method
-		"
+		    "
-		wrappedMethod ~~ method ifTrue:[
+		    wrappedMethod ~~ method ifTrue:[
-		    wrappedMethod := method.
+			wrappedMethod := method.
-		    lastWrappedConAddr := ObjectMemory addressOf:where.
+			lastWrappedConAddr := ObjectMemory addressOf:where.
-		    where sender receiver == method originalMethod ifFalse:[
+			where sender receiver == method originalMethod ifFalse:[
-			isWrap := true.
+			    isWrap := true.
+			]
+		    ] ifFalse:[
+			(ObjectMemory addressOf:where) == steppedContextAddress ifTrue:[
+"/ 'change stepCon from: ' print.
+"/ (steppedContextAddress printStringRadix:16)print.
+"/ ' to: ' print.
+"/ (lastWrappedConAddr printStringRadix:16)printNL.
+			    inWrap := false.
+			    steppedContextAddress := lastWrappedConAddr
+			]
 		    ]
-		] ifFalse:[
+		].
-		    (ObjectMemory addressOf:where) == steppedContextAddress ifTrue:[
+		where := where sender
-"/ 'change stepCon from: ' print.
+	    ]
-"/  (steppedContextAddress printStringRadix:16)print.
+	].
-"/ ' to: ' print.
-"/  (lastWrappedConAddr printStringRadix:16)printNL.
-			steppedContextAddress := lastWrappedConAddr
-		    ]
-		]
-	    ].
-	    where := where sender
-	]
 ].
 isWrap ifTrue:[
 "/ 'ignore wrap' printNL.
+"/ ' ' printNL.
 	"
 	  ignore, while in wrappers hidden setup
 	"
 	where := nil. here := nil.
 	ObjectMemory flushInlineCaches.
 	InterruptPending := true.
 	InStepInterrupt := nil.
 	^ nil
 ].
+inBlock := false.
 "
 is this for a send or a step ?
 "
 bigStep ifTrue:[
 	"
 	 a step - ignore all contexts below the interresting one
 	"
 	where := here.      "the interrupted context"
+	where home notNil ifTrue:[
+	    (ObjectMemory addressOf:where home) == steppedContextAddress ifTrue:[
+"/ '*block*' printNL.
+		inBlock := true
+	    ]
+	].
 	(ObjectMemory addressOf:where) == steppedContextAddress ifFalse:[
 	    where := where sender.
-"/ 'look for ' print.
+	    where home notNil ifTrue:[
+		(ObjectMemory addressOf:where home) == steppedContextAddress ifTrue:[
+"/ '*block*' printNL.
+		    inBlock := true.
+		]
+	    ].
+"/ 'looking for ' print.
 "/  (steppedContextAddress printStringRadix:16)print. '' printNL.
 	    (ObjectMemory addressOf:where) == steppedContextAddress ifFalse:[
 		"
 		 check if we are in a context below steppedContext
 		 (i.e. if steppedContext can be reached from
 		  interrupted context. Not using context-ref but its
 		  address to avoid creation of many useless contexts.)
 		"
-		[where notNil] whileTrue:[
+		inBlock ifFalse:[
+		    [where notNil] whileTrue:[
 "/  ((ObjectMemory addressOf:where) printStringRadix:16)print. ' ' print.
 "/  where selector printNL.
-		    (ObjectMemory addressOf:where) == steppedContextAddress ifTrue:[
+			(ObjectMemory addressOf:where) == steppedContextAddress ifTrue:[
-"/ 'found it - below' printNL.
+"/ 'found it - below; ignore' printNL.
-			"
+			    "
-			 found the interresting context somwehere up in the
+			     found the interresting context somwehere up in the
-			 chain. We seem to be still below the interresting one ...
+			     chain. We seem to be still below the interresting one ...
-			"
+			    "
-			tracing == true ifTrue:[
+			    tracing == true ifTrue:[
-			    here printString printNewline
+				here printString printNewline
+			    ].
+			    where := nil. here := nil.
+			    "
+			      yes, a context below
+			      - continue and schedule another stepInterrupt.
+			      Must flush caches since optimized methods not always
+			      look for pending interrupts
+			    "
+			    ObjectMemory flushInlineCaches.
+			    StepInterruptPending := true.
+			    InterruptPending := true.
+			    InStepInterrupt := nil.
+			    ^ nil
 			].
-			where := nil. here := nil.
+			where := where sender
-			"
-			  yes, a context below
-			  - continue and schedule another stepInterrupt.
-			  Must flush caches since optimized methods not always
-			  look for pending interrupts
-			"
-			ObjectMemory flushInlineCaches.
-			StepInterruptPending := true.
-			InterruptPending := true.
-			InStepInterrupt := nil.
-			^ nil
 		    ].
-		    where := where sender
+		    s := 'left stepped method'.
+		    left := true.
 		].
-		s := 'left stepped method'
 	    ] ifTrue:[
 "/ 'found it right in sender' printNL.
 		s := 'after step'
 	    ].
 	] ifTrue:[
 "/ 'found it right away' printNL.
 	    s := 'after step'
 	].
-	tracing := false.
-	bigStep := false.
 ] ifFalse:[
+"/ ' send' printNL.
 	"
 	 a send
 	"
 	steppedContextAddress := nil.
 	s := 'after send'
 ].
+inBlock ifTrue:[
+"/ 'inBlock' printNL.
+	s := 'in block'.
+].
+"/    where notNil ifTrue:[
+"/        '(' print. steppedContextLineno print. ') ' print.
+"/        where print.
+"/        '[' print. where lineNumber print. ']' printNL.
+"/    ].
+ignore := false.
+(bigStep
+and:[where notNil
+and:[where lineNumber == steppedContextLineno]]) ifTrue:[
+"/ 'same line - ignored' printNL.
+	ignore := true
+].
+(left not
+and:[skipLineNr notNil
+and:[where lineNumber ~~ skipLineNr]]) ifTrue:[
+"/ 'skip (' print. skipLineNr print. ' unreached - 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 := true.
+	InterruptPending := true.
+	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.
 self enter:thisContext sender
 ! !
 enter:aContext
 "enter the debugger - get and display the context, then start an
 exclusive event loop on top of eveything else"
-|con selection m|
+|con selection m idx retval s|
 busy := true.
 inspecting := false.
 inspectedProcess := Processor activeProcess.
+stepping := false.
 bigStep := false.
 nChainShown := 50.
 "if debugger is entered while a box has grabbed the
 pointer, we must ungrab - otherwise X wont talk to
 drawableId notNil ifTrue:[
 	"not the first time - realize at old position"
 	terminateButton turnOffWithoutRedraw.
 	continueButton turnOffWithoutRedraw.
+	returnButton turnOffWithoutRedraw.
+	restartButton turnOffWithoutRedraw.
 	abortButton turnOffWithoutRedraw.
 	stepButton turnOffWithoutRedraw.
 	sendButton turnOffWithoutRedraw.
 "/        self rerealize
 ] ifFalse:[
 	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:[
-		(ObjectMemory addressOf:aContext) == steppedContextAddress ifTrue:[
+		selection := 1
-		    selection := 1
+	    ] ifFalse:[
-		] ifFalse:[
+		(ObjectMemory addressOf:aContext sender) == steppedContextAddress ifTrue:[
-		    (ObjectMemory addressOf:aContext sender) == steppedContextAddress ifTrue:[
+		    selection := 2
-			selection := 2
-		    ]
 		]
-	    ]
+	    ].
+	    (aContext home notNil and:[
+	    (ObjectMemory addressOf:aContext home) == steppedContextAddress]) ifTrue:[
+		selection := 1
+	    ] ifFalse:[
+		(aContext sender home notNil and:[
+		(ObjectMemory addressOf:aContext sender home) == steppedContextAddress]) ifTrue:[
+		    selection := 2
+		]
+	    ].
 	]
 ] ifFalse:[
 	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:[
-		(ObjectMemory addressOf:aContext) == steppedContextAddress ifTrue:[
+		selection := 1
-		    selection := 1
+	    ] ifFalse:[
-		] ifFalse:[
+		(ObjectMemory addressOf:aContext sender) == steppedContextAddress ifTrue:[
-		    (ObjectMemory addressOf:aContext sender) == steppedContextAddress ifTrue:[
+		    selection := 2
-			selection := 2
-		    ]
 		]
 	    ]
 	]
 ].
 selection notNil ifTrue:[
 	self showSelection:selection.
-	contextView selection:selection
+	contextView selection:selection.
+	selection > 1 ifTrue:[
+	    contextView scrollToLine:(selection - 1)
+	]
 ].
 m := contextView middleButtonMenu.
 m notNil ifTrue:[
 	canAbort := inspecting or:[Object abortSignal isHandled].
 This is required, since the debugger is reused,
 to avoid keeping references to the debuggees objects
 forever.
 "
 contextArray := nil.
-codeView contents:nil.
 codeView acceptAction:nil.
 contextView contents:nil.
 receiverInspector release.
 contextInspector release.
 (exitAction == #step) ifFalse:[
 	self unrealize.
 	device synchronizeOutput.
 	(exitAction == #abort) ifTrue:[
-	    selectedContext := nil.
+	    selectedContext := actualContext := nil.
-	    busy := false.
+	    self cacheMyself.
-	    exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
 	    "
 	     have to catch errors occuring in unwind-blocks
 	    "
 	    Object errorSignal handle:[:ex |
 		'ignored error while unwinding: ' errorPrint.
 	    ].
 	    'abort failed' errorPrintNL
 	].
 	(exitAction == #return) ifTrue:[
 	    selectedContext notNil ifTrue:[
+		"
+		 if there is a selection in the codeView,
+		 evaluate it and use the result as return value
+		"
+		codeView hasSelection ifTrue:[
+		    s := codeView selection asString.
+		    Object errorSignal handle:[:ex |
+			'DEBUGGER: error - returning nil' printNL.
+			retval := nil.
+			ex return
+		    ] do:[
+			retval := codeView doItAction value:s.
+		    ].
+		].
 		con := selectedContext.
-		selectedContext := nil.
+		selectedContext := actualContext := nil.
-		busy := false.
+		self cacheMyself.
-		exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
 		"
 		 have to catch errors occuring in unwind-blocks
 		"
 		Object errorSignal handle:[:ex |
 		    'ignored error while unwinding: ' errorPrint.
 		    ex errorString errorPrintNL.
 		    ex proceed
 		] do:[
-		    con unwind.
+		    con unwind:retval.
 		].
-		'cannot return selected context' errorPrintNL
+		'cannot return from selected context' errorPrintNL
 	    ]
 	] ifFalse:[
 	    (exitAction == #restart) ifTrue:[
 		selectedContext notNil ifTrue:[
 		    con := selectedContext.
-		    selectedContext := nil.
+		    selectedContext := actualContext := nil.
-		    busy := false.
+		    self cacheMyself.
-		    exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
 		    "
 		     have to catch errors occuring in unwind-blocks
 		    "
 		    Object errorSignal handle:[:ex |
 			'ignored error while unwinding: ' errorPrint.
 		    ].
 		    'cannot restart selected context' errorPrintNL
 		]
 	    ] ifFalse:[
 		((exitAction == #terminate) or:[exitAction == #quickTerminate]) ifTrue:[
-		    selectedContext := nil.
+		    selectedContext := actualContext := nil.
-		    busy := false.
+		    self cacheMyself.
-		    exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
 		    exitAction == #quickTerminate ifTrue:[
 			Processor activeProcess terminateNoSignal
 		    ] ifFalse:[
 			"
 			 have to catch errors occuring in unwind-blocks
 		]
 	    ]
 	]
 ].
-selectedContext := nil.
+selectedContext := actualContext := nil.
 grabber notNil ifTrue:[
 	device grabPointerInView:grabber.
 	grabber := nil.
 ].
 (exitAction == #step) ifTrue:[
 	"scedule another stepInterrupt
 	 - must flush caches since optimized methods not always
 	 look for pending interrupts"
+	OpenDebuggers isNil ifTrue:[
+	    OpenDebuggers := WeakArray with:self
+	] ifFalse:[
+	    (OpenDebuggers includes:self) ifFalse:[
+		idx := OpenDebuggers identityIndexOf:nil.
+		idx ~~ 0 ifTrue:[
+		    OpenDebuggers at:idx put:self
+		] ifFalse:[
+		    OpenDebuggers := OpenDebuggers copyWith:self
+		]
+	    ]
+	].
+	self label:'single stepping - please wait ...'.
+	stepping := true.
 	ObjectMemory flushInlineCaches.
 	ObjectMemory stepInterruptHandler:self.
 	StepInterruptPending := true.
 	InterruptPending := true.
 	InStepInterrupt := nil
 ] ifFalse:[
-	busy := false.
+	OpenDebuggers notNil ifTrue:[
-	exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self]
+	    idx := OpenDebuggers identityIndexOf:self.
+	    idx ~~ 0 ifTrue:[
+		OpenDebuggers at:idx put:nil
+	    ]
+	].
+	self cacheMyself.
 ]
 !
 openOn:aProcess
 "enter the debugger on a process -
 	self setContext:aProcess suspendedContext.
 	catchBlock := [
 	    catchBlock := nil.
 	    contextArray := nil.
-	    selectedContext := nil.
+	    selectedContext := actualContext := nil.
 	    (exitAction == #terminate) ifTrue:[
 		aProcess terminate.
 	    ].
 	    (exitAction == #quickTerminate) ifTrue:[
 		aProcess terminateNoSignal.
 exclusive ifTrue:[
 	"if we do not have multiple processes or its a system process
 	 we start another dispatch loop, which exits when
 	 either continue, return or step is pressed
 	 or (via the catchBlock) if an error occurs.
-	 Since our display is an extra exclusive one (ModalDisplay)
+	 Since our display is an extra exclusive one
 	 all processing for normal views stops here ...
 	"
 	device dispatchModalWhile:[haveControl]
 ] ifFalse:[
 	"we do have multiple processes -
 catchBlock := nil.
 ! !
 !DebugView methodsFor:'private'!
+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"
+busy := false.
+codeView acceptAction:nil.
+codeView doItAction:nil.
+codeView contents:nil.
+receiverInspector release.
+contextInspector release.
+inspectedProcess := nil.
+exitAction := nil.
+contextArray := nil.
+selectedContext := actualContext := nil.
+catchBlock := nil.
+grabber := nil.
+self autoUpdateOff.
+exclusive ifTrue:[CachedExclusive := self] ifFalse:[CachedDebugger := self].
+!
+inspectedProcess
+^ inspectedProcess
+!
 busy
 ^ busy
+!
+stepping
+^ stepping
 !
 showError:message
 codeView contents:(resources string:message).
 codeView flash
 self processAction:[inspectedProcess interruptWith:aBlock.]
 !
 exclusive:aBoolean
 exclusive := aBoolean
+!
+unstep
+stepping := false.
+bigStep := false.
+steppedContextAddress := nil.
+exitAction := nil
 !
 interrestingContextFrom:aContext
 "return an interresting 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|
+|c found offset sel prev ex|
 "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) ifTrue:[
+	    (c receiver isKindOf:Exception) ifTrue:[
+		ex := c receiver
+	    ].
 	    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:[^ 1].
 "
 	offset := offset + 1.
 ] ifFalse:[
 	"
 	 ok, got the raise - if its a BreakPoint, look for the sender
 	"
-	prev receiver == MessageTracer breakpointSignal ifTrue:[
+	(MessageTracer notNil and:[prev receiver == MessageTracer breakpointSignal]) ifTrue:[
 	    offset := offset + 1
 	].
 ].
 ^ offset
 		text add:(resources string:'*** more walkback follows - click here to see them ***')
 	    ].
 	].
 ].
-contextView setList: "list:" text.
+contextView setList:text.
 receiverInspector release.
 contextInspector release.
 m notNil ifTrue:[
 	m disable:#doRemoveBreakpoint.
 	] ifFalse:[
 	    sel := homeContext selector.
 	    sel notNil ifTrue:[
 		canAccept := true.
-"/                implementorClass := homeContext searchClass whichClassImplements:sel.
 		implementorClass := homeContext methodClass.
 		implementorClass isNil ifTrue:[
 		    "
-		     special: look if this context was create by
+		     special: look if this context was created by
 		     valueWithReceiver kind of method invocation;
 		     if so, grab the method from the sender and show it
 		    "
-"/                    con sender selector printNL.
 		    (con sender notNil
-		    and:[(con sender selector == #valueWithReceiver:arguments:selector:search:)
+		    and:[(con sender selector startsWith:'valueWithReceiver:')
 		    and:[con sender receiver isKindOf:Method]]) ifTrue:[
 			method := con sender receiver.
 			code := method source.
 			canAccept := false.
 		    ] ifFalse:[
-			self showError:'** no method - no source **'
+			con method notNil ifTrue:[
+			    method := con method.
+			    code := method source.
+			    canAccept := false.
+			] ifFalse:[
+			    self showError:'** no method - no source **'
+			]
 		    ]
 		] ifFalse:[
 		    method := implementorClass compiledMethodAt:sel.
 		    code := method source.
 		    code isNil ifTrue:[
 			     notifying:codeView
 			     logged:true
 			     ifFail:nil
 	].
-	selectedContext := homeContext
+	selectedContext := homeContext.
+	actualContext := con
 ].
 "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 ..."
 "
 use class&selector to find the method for the compilation
 and compile.
 "
 sel := selectedContext selector.
-"/    implementorClass := selectedContext searchClass whichClassImplements:sel.
 implementorClass := selectedContext methodClass.
 method := implementorClass compiledMethodAt:sel.
 newMethod := implementorClass compiler compile:someCode
 					  forClass:implementorClass
 					inCategory:(method category)
 receiverInspector release.
 contextInspector release.
 inspectedProcess := nil.
 exitAction := nil.
 contextArray := nil.
-selectedContext := nil.
+selectedContext := actualContext := nil.
-"/    catchBlock := nil.
 grabber := nil.
 self autoUpdateOff.
-inspecting ifTrue:[
+inspecting ifFalse:[
-	super destroy.
-] ifFalse:[
 	exclusive ifTrue:[
-	    CachedExclusive := nil.
+	    CachedExclusive == self ifTrue:[
+		CachedExclusive := nil.
+	    ]
 	] ifFalse:[
-	    CachedDebugger := nil
+	    CachedDebugger == self ifTrue:[
-	]
+		CachedDebugger := nil
-].
+	    ]
+	].
-inspecting ifFalse:[
-	canAbort ifTrue:[
+	inspecting ifFalse:[
-	    self doAbort.
+	    canAbort ifTrue:[
-	] ifFalse:[
+		self doAbort.
-	    self doContinue
+	    ] ifFalse:[
-	]
+		self doContinue
-].
+	    ]
+	].
+].
+super destroy    "/ 1.12.94
 !
 doExit
 "exit from menu: immediate exit from smalltalk"
 selectedContext isNil ifTrue:[
 	^ self showError:'** select a context first **'
 ].
-"/    implementorClass := selectedContext searchClass
-"/                            whichClassImplements:selectedContext selector.
 implementorClass := selectedContext methodClass.
 implementorClass notNil ifTrue:[
 	method := implementorClass compiledMethodAt:selectedContext selector.
 	(method notNil and:[method isWrapped]) ifTrue:[
 	    MessageTracer unwrapMethod:method
 	exitAction := #step.
 	ProcessorScheduler isPureEventDriven ifFalse:[
 	    "exit private event-loop"
 	    catchBlock notNil ifTrue:[catchBlock value].
 	    'DEBUGGER: oops, send failed' errorPrintNL.
-"/            self warn:'send failed'.
 	    sendButton turnOff.
-"/          sendButton disable.
 	].
 ]
 !
 doStep:lineNr
-"step from menu"
+"step until we pass lineNr (if nonNil) or to next line (if nil)"
+|con method|
 inspecting ifTrue:[^ self].
 canContinue ifTrue:[
 	selectedContext notNil ifTrue:[
-	    steppedContextAddress := ObjectMemory addressOf:selectedContext
+	    con := selectedContext.
+	    steppedContextLineno := actualContext lineNumber.
 	] ifFalse:[
-	    steppedContextAddress := ObjectMemory addressOf:(contextArray at:2)
+	    con := contextArray at:2.
-	].
+	    steppedContextLineno := con lineNumber.
+	].
+	steppedContextAddress := ObjectMemory addressOf:con.
+	"
+	 if we step in a wrapped method,
+	 prepare to skip the prolog ...
+	"
+"/ ' step con:' print. steppedContextAddress printHex. ' ' printNL.
+	inWrap := false.
+	method := con method.
+	(method notNil and:[method isWrapped]) ifTrue:[
+	    inWrap := true
+	].
+	con := nil.
 	bigStep := true.
 	skipLineNr := lineNr.
 	haveControl := false.
 	exitAction := #step.
 	ProcessorScheduler isPureEventDriven ifFalse:[
 	    "exit private event-loop"
 	    catchBlock notNil ifTrue:[catchBlock value].
 	    'DEBUGGER: oops, step failed' errorPrintNL.
-"/            self warn:'step failed'.
 	    stepButton turnOff.
-"/          stepButton disable.
 	].
 ]
 !
 doStep
 !
 doSkip
 "step from menu"
-self doStep:codeView cursorLine.
+codeView cursorLine notNil ifTrue:[
+	self doStep:codeView cursorLine.
+]
 !
 doTraceStep
 "tracestep - not implemented yet"
 	"exit private event-loop"
 	catchBlock notNil ifTrue:[
 	    abortButton turnOff.
 	    catchBlock value.
 	    'DEBUGGER: oops, abort failed' errorPrintNL.
-"/            self warn:'unwind failed'.
-"/            abortButton disable.
 	]
 ].
 ^ self.
 "obsolete ..."
 	inspecting ifFalse:[
 	    'DEBUGGER: oops, terminate failed' errorPrintNL.
 	    self warn:'terminate failed'.
 	].
 	terminateButton turnOff.
-"/        terminateButton disable.
 ].
 !
 doQuickTerminate
 "quick terminate - the process will get no chance for cleanup actions"
 	inspecting ifFalse:[
 	    'DEBUGGER: oops, terminate failed' errorPrintNL.
 	    self warn:'terminate failed'.
 	].
 	terminateButton turnOff.
-"/        terminateButton disable.
 ].
 !
 doReturn
 "return - the selected context will do a ^nil"
 exitAction := #return.
 ProcessorScheduler isPureEventDriven ifFalse:[
 	"exit private event-loop"
 	catchBlock notNil ifTrue:[catchBlock value].
 	'DEBUGGER: oops, return failed' errorPrintNL.
-"/        self warn:'return failed'.
 	returnButton turnOff.
-"/        returnButton disable.
 ].
 !
 doRestart
 "restart - the selected context will be restarted"
 exitAction := #restart.
 ProcessorScheduler isPureEventDriven ifFalse:[
 	"exit private event-loop"
 	catchBlock notNil ifTrue:[catchBlock value].
 	'DEBUGGER: oops, restart failed' errorPrintNL.
-"/        self warn:'restart failed'.
 	restartButton turnOff.
-"/        restartButton disable
 ].
 !
 doTrace
 "tracing - not really implemented ..."
 |v b|
 self warn:'this function is not yet implemented'.
-false ifTrue:[
+"/    traceView isNil ifTrue:[
-traceView isNil ifTrue:[
+"/        v := StandardSystemView on:Display.
-	v := StandardSystemView on:Display.
+"/        v label:'Debugger-Trace'.
-	v label:'Debugger-Trace'.
+"/        v icon:icon.
-	v icon:icon.
+"/
+"/        b := Button label:'untrace' in:v.
-	b := Button label:'untrace' in:v.
+"/        b origin:(0 @ 0) extent:(1.0 @ (b height)).
-	b origin:(0 @ 0) extent:(1.0 @ (b height)).
+"/        b action:[
-	b action:[
+"/            StepInterruptPending := false.
-	    StepInterruptPending := false.
+"/            tracing := false.
-	    tracing := false.
+"/            v unrealize.
-	    v unrealize.
+"/            traceView := nil
-	    traceView := nil
+"/        ].
-	].
+"/        traceView := ScrollableView for:TextCollector in:v.
-	traceView := ScrollableView for:TextCollector in:v.
+"/        traceView origin:(0 @ (b height))
-	traceView origin:(0 @ (b height))
+"/                  extent:[v width @ (v height - b height)]
-		  extent:[v width @ (v height - b height)]
+"/    ].
-].
+"/    v realize.
-v realize.
+"/
-].
+"/    tracing := true.
-tracing := true.
 !
 doNoTrace
 traceView notNil ifTrue:[
 	traceView topView destroy.
 	exitAction := #continue.
 	ProcessorScheduler isPureEventDriven ifFalse:[
 	    "exit private event-loop"
 	    catchBlock notNil ifTrue:[catchBlock value].
 	    'DEBUGGER: oops, continue failed' errorPrintNL.
-"/            self warn:'continue failed'.
 	    continueButton turnOff.
-"/            continueButton disable
 	].
 ] ifFalse:[
 	inspecting ifFalse:[
 	    'resuming top context' errorPrintNL.
 	    self showSelection:1.

changeset 57	36e13831b62d
parent 56	d0cb937cbcaa
child 58	43b7d463a7e5