hg/stx-libtool: comparison DebugView.st

equal deleted inserted replaced

-:da3f109853ba
+:f8371812c789
 !
 stepOrNext
 |where here s isWrap method lastWrappedConAddr wrappedMethod
 inBlock left ignore contextBelow lastWrappedContext
-leftWrap enteredWrap|
+leftWrap enteredWrap anyStepBlocks belowSteppedContext|
 "/ DebuggingDebugger := true
 skipLineNr == #return ifTrue:[
 name := Processor activeProcess nameOrId.
 InStepInterrupt := nil.
 ^ nil
 ].
 inBlock := false.
+anyStepBlocks := false.
 "/
 "/ is this for a send or a step/next ?
 "/
 (bigStep
 "/where print. ' ' print. ((ObjectMemory addressOf:where)printStringRadix:16) printCR.
 "/steppedContext print. ' ' print. ((ObjectMemory addressOf:steppedContext)printStringRadix:16) printCR.
 where == steppedContext ifFalse:[
-"
-check if we are in a context below steppedContext
+"/ check if we are in a context below steppedContext
-(i.e. if steppedContext can be reached from
+"/ (i.e. if steppedContext can be reached from
-interrupted context. Not using context-ref but its
+"/  interrupted context. Not using context-ref but its
-address to avoid creation of many useless contexts.)
+"/  address to avoid creation of many useless contexts.)
-"
 inBlock ifFalse:[
 [where notNil] whileTrue:[
+"/ 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.
+(where receiver isBlock
+and:[where receiver home == steppedContext])
+ifTrue:[
+anyStepBlocks := true.
+] ifFalse:[
+where args do:[:arg |
+(arg isBlock
+and:[arg home == steppedContext])
+ifTrue:[
+anyStepBlocks := true.
+]
+]
+].
 DebuggingDebugger == true ifTrue:[
 ((ObjectMemory addressOf:where) printStringRadix:16)print. ' ' print.
 where selector printNL.
 ].
 yes, a context below
 - continue and schedule another stepInterrupt.
 Must flush caches since optimized methods not always
 look for pending interrupts
 "
-ObjectMemory flushInlineCaches.
+'---' printCR.
-(contextBelow notNil
+contextBelow printCR.
-and:[inBlock not]) ifTrue:[
+inBlock printCR.
+contextBelow notNil ifTrue:[
 "/ 'prepare for unwind-catch' printNL.
 "/ 'con= ' print. contextBelow printCR.
 contextBelow selector notNil ifTrue:[
 self label:'single stepping - please wait ...(' , contextBelow selector , ')'.
 ].
 contextBelow printCR.
 ].
 Processor activeProcess forceInterruptOnReturnOf:contextBelow.
 StepInterruptPending := nil.
 ] ifFalse:[
+ObjectMemory flushInlineCaches.
 here selector notNil ifTrue:[
 self label:'single stepping - please wait ...(' , here selector , ')'.
 ].
 DebuggingDebugger == true ifTrue:[
 InStepInterrupt := nil.
 ^ nil
 ].
-where home == steppedContext ifTrue:[
+where methodHome == steppedContext methodHome ifTrue:[
 inBlock := true.
 ].
-contextBelow := where.
+anyStepBlocks ifFalse:[
+inBlock ifFalse:[
+contextBelow := where
+]
+].
 where := where sender
 ].
 s := 'context returned'.
 left := true.
 ].
 left ifTrue:[
 steppedContext home notNil ifTrue:[
 steppedContext := steppedContext home.
 s := 'after step'.
 left := false.
+"/ DebugView enterUnconditional:thisContext withMessage:'debug'.
 ]
 ].
 "
 kludge to hide breakpoint wrappers in the context list:
 "/'enter' printCR.
 self enter:thisContext sender sender
 "Created: 14.10.1996 / 12:53:39 / cg"
-"Modified: 23.10.1996 / 01:20:16 / cg"
+"Modified: 23.10.1996 / 19:11:27 / cg"
 ! !
 !DebugView methodsFor:'menu / button actions'!
 autoUpdateOff
 ! !
 !DebugView class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.113 1996-10-23 15:35:33 cg Exp $'
+^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.114 1996-10-23 18:13:15 cg Exp $'
 ! !

changeset 803	f8371812c789
parent 801	9aac5620fff5
child 804	7861d5447298