hg/stx-libtool: comparison DebugView.st

equal deleted inserted replaced

-:72a555a0c626
+:1848d4e89bc4
 		continueButton stepButton nextButton sendButton returnButton
 		restartButton exclusive inspecting nChainShown inspectedProcess
 		updateProcess stopButton updateButton monitorToggle stepping
 		steppedContextLineno stepForReturn actualContext inWrap
 		stackInspector'
-	classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail'
+	classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail
+		DebuggingDebugger'
 	poolDictionaries:''
 	category:'Interface-Debugger'
 !
 !DebugView  class methodsFor:'documentation'!
 ].
 self label:'single stepping - please wait ...'.
 stepping := true.
 ObjectMemory stepInterruptHandler:self.
-stepForReturn == true ifFalse:[
+Context singleStepInterruptRequest isHandled ifTrue:[
-Context singleStepInterruptRequest isHandled ifTrue:[
+"bigStep" steppedContextLineno notNil ifTrue:[
-"bigStep" steppedContextLineno notNil ifTrue:[
+Context singleStepInterruptRequest raiseWith:#next
-Context singleStepInterruptRequest raiseWith:#next
-] ifFalse:[
-Context singleStepInterruptRequest raiseWith:#step
-]
 ] ifFalse:[
-ObjectMemory flushInlineCaches.
+Context singleStepInterruptRequest raiseWith:#step
+]
+] ifFalse:[
+ObjectMemory flushInlineCaches.
+skipLineNr ~~ #return ifTrue:[
 StepInterruptPending := 1.
 InterruptPending := 1.
-InStepInterrupt := nil
+] ifFalse:[
-]
+'step for return' printCR.
+].
+InStepInterrupt := nil
 ]
 ] ifFalse:[
 OpenDebuggers notNil ifTrue:[
 idx := OpenDebuggers identityIndexOf:self.
 idx ~~ 0 ifTrue:[
 self cacheMyself.
 ]
 "Created: 24.11.1995 / 19:52:54 / cg"
 "Modified: 3.5.1996 / 23:58:16 / stefan"
-"Modified: 26.7.1996 / 16:19:45 / cg"
+"Modified: 14.10.1996 / 13:41:19 / cg"
 !
 openOn:aProcess
 "enter the debugger on a process -
 in this case, we are just inspecting the context chain of the process,
 ] ifFalse:[
 labels := resources array:#(
 'show more'
 '-'
 'skip'
+'step out'
 '-'
 "
 'continue'
 'terminate'
 'abort'
 selectors := #(
 showMore
 nil
 skip
+skipForReturn
 nil
 "
 doContinue
 doTerminate
 doAbort
 inspecting ifTrue:[
 m notNil ifTrue:[
 m disableAll:#(doTraceStep removeBreakpoint browse browseClass
 browseClassHierarchy browseFullClassProtocol
-implementors senders inspectContext skip).
+implementors senders inspectContext skip doStepOut).
 ].
 ]
-"Modified: 27.2.1996 / 14:41:53 / cg"
+"Modified: 14.10.1996 / 13:21:26 / cg"
 !
 realize
 super realize.
 "/    exclusive ifTrue:[
 self label:l.
 ! !
 !DebugView methodsFor:'interrupt handling'!
+contextInterrupt
+DebuggingDebugger == true ifTrue:[
+'contextIRQ' printCR.
+].
+^ self stepOrNext
+"Modified: 14.10.1996 / 13:30:47 / cg"
+!
 stepInterrupt
-|where here s isWrap method lastWrappedConAddr wrappedMethod inBlock left ignore|
+DebuggingDebugger == true ifTrue:[
+'stepIRQ' printCR.
-"/
+].
-"/ should no longer happen
+^ self stepOrNext
-"/
-stepForReturn == true ifTrue:[
+"Modified: 14.10.1996 / 13:30:56 / cg"
-'stepForreturn' printCR.
+!
-self enter:thisContext sender.
+stepOrNext
+|where here s isWrap method lastWrappedConAddr wrappedMethod
+inBlock left ignore contextBelow|
+skipLineNr == #return ifTrue:[
+name := Processor activeProcess nameOrId.
+self label:('context returned ' , ' (process: ' , name , ')').
+here := thisContext sender sender.
+here lineNumber printCR.
+here := nil.
+self enter:thisContext sender sender.
 ^ self
 ].
+"/    "/
+"/    "/ should no longer happen
+"/    "/
+"/    stepForReturn == true ifTrue:[
+"/"/'stepForreturn' printCR.
+"/        self enter:thisContext sender.
+"/        ^ self
+"/    ].
 Processor activeProcess ~~ inspectedProcess ifTrue:[
 'stray step interrupt' errorPrintNL.
 ^ self
 ].
 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 caller; step- or contextIRQ"
 here := here sender.        "the interrupted context"
-"/ '*******' printNL.
+DebuggingDebugger == true ifTrue:[
-"/ 'here in ' print.
+'*******' printNL.
-"/  ((ObjectMemory addressOf:here) printStringRadix:16)print. '' printNL.
+'here in ' print.
+((ObjectMemory addressOf:here) printStringRadix:16) print. ' ' print.
+here selector printNL.
+].
 where := here.
 isWrap := false.
 left := false.
 ]
 ].
 ].
 isWrap ifTrue:[
-"/ 'ignore wrap' printNL.
+DebuggingDebugger == true ifTrue:[
-"/ ' ' printNL.
+'ignore wrap' printNL.
-"
+].
-ignore, while in wrappers hidden setup
-"
+"/
+"/ ignore, while in wrappers hidden setup
+"/
 where := nil. here := nil.
 ObjectMemory flushInlineCaches.
+skipLineNr == #return ifTrue:[
+'skipRet in wrap' printCR.
+].
 StepInterruptPending := 1.
 InterruptPending := 1.
 InStepInterrupt := nil.
 ^ nil
 ].
 inBlock := false.
-"
+"/
-is this for a send or a step/next ?
+"/ is this for a send or a step/next ?
-"
+"/
 bigStep 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 ?
 "/
 interrupted context. Not using context-ref but its
 address to avoid creation of many useless contexts.)
 "
 inBlock ifFalse:[
 [where notNil] whileTrue:[
-"/  ((ObjectMemory addressOf:where) printStringRadix:16)print. ' ' print.
-"/  where selector printNL.
+DebuggingDebugger == true ifTrue:[
+((ObjectMemory addressOf:where) printStringRadix:16)print. ' ' print.
+where selector printNL.
+].
 (ObjectMemory addressOf:where) == steppedContextAddress ifTrue:[
 "/ 'found it - below; ignore' printNL.
 "
 found the interesting context somwehere up in the
 chain. We seem to be still below the interesting one ...
 - continue and schedule another stepInterrupt.
 Must flush caches since optimized methods not always
 look for pending interrupts
 "
 ObjectMemory flushInlineCaches.
-StepInterruptPending := 1.
+contextBelow notNil ifTrue:[
-InterruptPending := 1.
+"/ 'prepare for unwind-catch' printNL.
+"/ 'con= ' print. contextBelow printCR.
+Processor activeProcess forceInterruptOnReturnOf:contextBelow.
+StepInterruptPending := nil.
+] ifFalse:[
+StepInterruptPending := 1.
+InterruptPending := 1.
+].
 InStepInterrupt := nil.
 ^ nil
 ].
+contextBelow := where.
 where := where sender
 ].
 s := 'left stepped method'.
 left := true.
 ].
 inBlock ifTrue:[
 "/ 'inBlock' printNL.
 s := 'in block'.
 ].
-where notNil ifTrue:[
+DebuggingDebugger == true ifTrue:[
-'(' print. steppedContextLineno print. ') ' print.
+where notNil ifTrue:[
-where print.
+'(' print. steppedContextLineno print. ') ' print.
-'[' print. where lineNumber print. ']' printNL.
+where print.
+'[' print. where lineNumber print. ']' printNL.
+].
 ].
 ignore := false.
 (bigStep
 (left not
 and:[skipLineNr notNil
 and:[where lineNumber < skipLineNr]]) ifTrue:[
 "/ 'skip (' print. skipLineNr print. ' unreached - ignored' printNL.
+ignore := true
+].
+(steppedContextLineno isNil
+and:[skipLineNr isNil
+and:[thisContext sender selector == #contextInterrupt]]) ifTrue:[
+"/ 'same line2 (after conIRQ) - ignored' printNL.
 ignore := true
 ].
 ignore ifTrue:[
 "/' ' printNL.
 tracing := false.
 bigStep := false.
 "release refs to context"
 where := nil. here := nil.
-'enter' printCR.
+"/'enter' printCR.
-self enter:thisContext sender
+self enter:thisContext sender sender
-"Modified: 1.7.1996 / 11:35:44 / cg"
+"Created: 14.10.1996 / 12:53:39 / cg"
+"Modified: 14.10.1996 / 13:50:53 / cg"
 ! !
 !DebugView methodsFor:'menu / button actions'!
 autoUpdateOff
 self doStep:-1
 !
 doStep:lineNr
-"step until we pass lineNr (if nonNil) or to next line (if nil)
+"common helper for step, skip & next.
-or to next send (if -1)"
+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].
 steppedContextLineno := actualContext lineNumber.
 ] ifFalse:[
 con := contextArray at:2.
 steppedContextLineno := con lineNumber.
 ].
 skipLineNr := lineNr.
 lineNr == -1 ifTrue:[
 steppedContextLineno := skipLineNr := nil.
 ].
 steppedContextAddress := ObjectMemory addressOf:con.
 "
 if we step in a wrapped method,
 prepare to skip the prolog ...
 "
 "/ ' step con:' print. steppedContextAddress printHex. ' ' printNL.
 method := con method.
 (method notNil and:[method isWrapped]) ifTrue:[
 inWrap := true
 ].
+lineNr == #return ifTrue:[
+Processor activeProcess forceInterruptOnReturnOf:con.
+].
 con := nil.
 bigStep := true.
 haveControl := false.
 exitAction := #step.
 stepButton turnOff.
 nextButton turnOff.
 sendButton turnOff.
 ]
-"Modified: 29.5.1996 / 13:19:38 / cg"
+"Modified: 14.10.1996 / 13:23:33 / cg"
 !
 doStop
 "stop the process (if its running, otherwise this is a no-op)"
 skip
 "skip for cursor line in selected method"
 self doStep:codeView cursorLine.
+!
+skipForReturn
+"skip until context is left."
+self doStep:#return.
+"Modified: 14.10.1996 / 13:22:46 / cg"
 ! !
 !DebugView methodsFor:'private'!
 busy
 ! !
 !DebugView  class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.100 1996-10-04 09:21:57 cg Exp $'
+^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.101 1996-10-14 13:41:21 cg Exp $'
 ! !

changeset 754	1848d4e89bc4
parent 745	89a242c66cda
child 755	94705dbabfe0