hg/stx-libtool: comparison DebugView.st

equal deleted inserted replaced

-:03021754d821
+:74bdfa87c71d
 ((ObjectMemory addressOf:steppedContext) printStringRadix:16) print. ' ' print.
 ].
 steppedContext printCR.
 ].
-"/ kludge an bug-workaround;
+"/ when single stepping, ignore breakpoints
-"/ I should not see those ...
+here selector == #break ifTrue:[
+(here receiver isKindOf:Breakpoint) ifTrue:[
+false "here receiver isEnabled" ifFalse:[
+con := nil.
+where := nil. here := nil.
+StepInterruptPending := 1.
+InterruptPending := 1.
+InStepInterrupt := nil.
+^ self
+]
+].
+].
+"/ kludge: a bug-workaround;
+"/ I should not see those...
 here selector == #ioInterrupt ifTrue:[
 DebuggingDebugger2 == true ifTrue:[
 'oops - should not get that one' printCR.
 ].
 where home notNil ifTrue:[
 "/
 "/ in a block called by 'our' context ?
 "/
 where home == steppedContext ifTrue:[
 "/ '*block*' printCR.
 inBlock := true
 ]
 ].
 where == steppedContext ifFalse:[
 where := where sender.
 where notNil ifTrue:[
 where home == steppedContext ifTrue:[
 "/ '*block*' printCR.
 inBlock := true.
 ]
 ].
 "/ 'looking for ' print.
 "/ 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.
 receiver := where receiver.
+where selector == #critical: ifTrue:[
+anyStepBlocks := true.
+] ifFalse:[
 (receiver isBlock
 and:[(receiver isKindOf:Block)
-and:[receiver home == steppedContext]])
+and:[receiver homeMethod == steppedContext method
+"receiver home == steppedContext"]])
 ifTrue:[
 anyStepBlocks := true.
 ] ifFalse:[
 where args do:[:arg |
 (arg isBlock
 and:[(arg isKindOf:Block)
-and:[arg home == steppedContext]])
+and:[arg homeMethod == steppedContext method
+"arg home == steppedContext"]])
 ifTrue:[
 anyStepBlocks := true.
-]
+] ifFalse:[
+(where methodHome receiver isBlock
+and:[(where methodHome receiver isKindOf:Block)
+and:[where methodHome receiver homeMethod == steppedContext method
+"where methodHome receiver home == steppedContext"]])
+ifTrue:[
+anyStepBlocks := true.
+]
+].
 ]
 ].
+].
 DebuggingDebugger2 == true ifTrue:[
 ((ObjectMemory addressOf:where) printStringRadix:16)print. ' ' print.
 where selector printCR.
 ].
 ].
 oneMore := true
 ].
 inBlock ifTrue:[
-"/ 'inBlock' printCR.
+DebuggingDebugger2 == true ifTrue:[
+'inBlock' printCR.
+].
 s := 'in block'.
 ].
 inBlockBelow ifTrue:[
+DebuggingDebugger2 == true ifTrue:[
+'inBlockBelow' printCR.
+].
 ignore := true
 ].
 DebuggingDebugger2 == true ifTrue:[
 where notNil ifTrue:[
 self doStep:-1
 "Modified: 7.3.1997 / 18:46:49 / cg"
 !
-doStep:lineNr
+doStep:lineNrOrNilOrMinus1
 "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|
 ] ifFalse:[
 con := contextArray at:2.
 steppedContextLineno := con lineNumber.
 ].
-skipLineNr := lineNr.
+skipLineNr := lineNrOrNilOrMinus1.
-lineNr == -1 ifTrue:[
+lineNrOrNilOrMinus1 == -1 ifTrue:[
 steppedContextLineno := skipLineNr := nil.
 ].
 (stepUntilEntering isNil and:[stepHow == #send]) ifTrue:[
 steppedContext := contextArray at:1.
 steppedContext := con home.
 ] ifFalse:[
 steppedContext := con.
 ].
 ].
 wrapperContext := nil.
 "/ ' step con:' print. (ObjectMemory addressOf:steppedContext) printHex. ' ' print. steppedContext printCR.
 "
 and:[method isWrapped
 and:[method originalMethod ~~ method]]) ifTrue:[
 inWrap := true
 ].
-lineNr == #return ifTrue:[
+lineNrOrNilOrMinus1 == #return ifTrue:[
 Processor activeProcess forceInterruptOnReturnOf:con.
 ].
 con := nil.
 bigStep := true.
 ! !
 !DebugView class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.600 2013-07-13 20:39:12 cg Exp $'
+^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.601 2013-07-22 09:38:33 cg Exp $'
 !
 version_CVS
-^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.600 2013-07-13 20:39:12 cg Exp $'
+^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.601 2013-07-22 09:38:33 cg Exp $'
 !
 version_SVN
-^ '$Id: DebugView.st,v 1.600 2013-07-13 20:39:12 cg Exp $'
+^ '$Id: DebugView.st,v 1.601 2013-07-22 09:38:33 cg Exp $'
 ! !
 DebugView initialize!

changeset 13197	74bdfa87c71d
parent 13162	e19746a3bf73
child 13210	214639c7834e