"

 COPYRIGHT (c) 1989 by Claus Gittinger

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

StandardSystemView subclass:#DebugView

	instanceVariableNames:'busy haveControl exitAction canContinue contextView codeView

		receiverInspector contextInspector contextArray selectedContext

		catchBlock grabber traceView tracing bigStep skipLineNr

		steppedContextAddress abortButton terminateButton continueButton

		stepButton nextButton nextOverButton nextOutButton sendButton

		returnButton restartButton exclusive inspecting nChainShown

		inspectedProcess updateProcess stopButton updateButton

		monitorToggle stepping steppedContextLineno stepForReturn

		actualContext inWrap stackInspector steppedContext wrapperContext

		verboseBacktrace firstContext stepHow cachable'

	classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail

		DebuggingDebugger VerboseBacktraceDefault DefaultIcon

		InitialNCHAINShown'

	poolDictionaries:''

	category:'Interface-Debugger'

!

!DebugView class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1989 by Claus Gittinger

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    This class implements a graphical debugger interface.

    The debugger usually sits on top of the faulting process,

    taking over its event processing. Thus only the 'stopped' process is affected;

    other processes continue to respond to events.

    The one exception is when an error occurs within the dispatcher process

    or in one of the eventhandler processes - in this case, the debugger

    will sit on an exclusive display connection.

    The whole debugging will be changed, once the required process primitives

    are available, which allow control of another processes execution

    (i.e. single-step, restart & return). The setup will be changed then,

    to have the debugger control the debuggee (i.e. two processes)

    See additional information in 'doc/misc/debugger.doc'.

    Notice: the DebugView class caches the last used debugger in a class

    variable. It may happen, that a malfunctioning debugger (for example,

    a halfway destroyed one) is kept there. You will notice this, if a

    debugger comes up without showing any contents. In this case, close

    (or destroy) the broken debugView, and execute

        Debugger newDebugger

    which removes the cached debugger and forces creation of a new one the

    next time. This is a temporary workaround - the debugger will be fixed to

    avoid this problem.

    [author:]

        Claus Gittinger

    [see also:]

        Exception Signal

        Process

"

! !

!DebugView class methodsFor:'initialization'!

initialize

    InitialNCHAINShown := 20.

    "Created: 20.3.1997 / 16:53:37 / cg"

    "Modified: 20.3.1997 / 16:54:32 / cg"

!

reinitialize

    self newDebugger

! !

!DebugView class methodsFor:'instance creation'!

enter

    "another way of entering the debugger"

    ^ self enter:(thisContext sender) withMessage:'Debugger'

    "Debugger enter"

!

enter:aContext

    "enter the debugger on aContext"

    ^ self enter:aContext withMessage:'Debugger'

!

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."

    |active found c|

    StepInterruptPending := nil.

    thisContext isRecursive ifTrue:[

        "/ care for the special case, were the Debugger was autoloaded.

        "/ in this case, thisContext IS recursive, but thats no error

        "/ condition.

        found := false.

        c := thisContext sender.

        [found not

         and:[c notNil 

         and:[c selector ~~ #enter:withMessage:]]] whileTrue:[

            c selector == #noByteCode ifTrue:[

                found := true

            ].

            c := c sender

        ].

        found ifFalse:[

            ('DebugView [warning]: reentered with: ', aString) errorPrintCR.

            ^ MiniDebugger 

                enterWithMessage:'DebugView [error]: recursive error (in debugger)'.

        ]

    ].

    "

     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:[

        active := Processor activeProcess.

        OpenDebuggers do:[:aDebugger |

            (aDebugger notNil and:[aDebugger ~~ 0]) ifTrue:[

                (aDebugger inspectedProcess == active) ifTrue:[

"/ 'entering stepping debugger again' printNL.

                    aDebugger unstep.

                    aDebugger setLabelFor:aString in:active.

                    ^ aDebugger enter:aContext select:nil.

                ]

            ]

        ]

    ].

    ^ self enterUnconditional:aContext withMessage:aString

    "Modified: / 30.10.1997 / 21:09:12 / cg"

!

enterUnconditional:aContext withMessage:aString

    "enter a debugger - do not check for recursive invocation"

    |aDebugger breakpointSignal proc|

    StepInterruptPending := nil.

    proc := Processor activeProcess.

    (MessageTracer notNil and:[MessageTracer isLoaded]) ifTrue:[

        breakpointSignal := MessageTracer breakpointSignal.

    ].

    breakpointSignal notNil ifTrue:[

        breakpointSignal handle:[:ex |

            'DebugView [info]: breakpoint in debugger ignored' infoPrintCR.

            ex proceed

        ] do:[

            aDebugger := self new.

            aDebugger setLabelFor:aString in:proc.

            aDebugger enter:aContext select:nil.

        ]

    ] ifFalse:[

        aDebugger := self new.

        aDebugger setLabelFor:aString in:proc.

        aDebugger enter:aContext select:nil.

    ].

    ^ nil

    "nil halt"

    "Modified: / 30.10.1997 / 21:10:55 / cg"

!

enterWithMessage:aString

    "the standard way of entering the debugger - sent from Objects

     error- and halt messages"

    ^ self enter:(thisContext sender) withMessage:aString

    "Debugger enterWithMessage:'hi there'"

!

new

    "return a new DebugView - return a cached debugger if it already

     exists"

    |debugger|

    "

     need a blocking debugger if no processes or 

     or if its a timing/interrupt process 

     (because otherwise we would not get any events here ...

    "

    Processor activeProcessIsSystemProcess ifTrue:[

        (CachedExclusive isNil 

        or:[CachedExclusive device ~~ Screen current]) ifTrue:[

            debugger := self newExclusive

        ] ifFalse:[

            debugger := CachedExclusive.

            CachedExclusive := nil.

        ].

    ] ifFalse:[

        CachedDebugger notNil ifTrue:[

            (CachedDebugger device ~~ Screen current 

            or:[CachedDebugger device isOpen not]) ifTrue:[

                CachedDebugger := nil

            ]

        ].

        CachedDebugger isNil ifTrue:[

            Screen current isOpen ifFalse:[

                DeviceWorkstation currentScreenQuerySignal handle:[:ex |

                    ex proceedWith:Display

                ] do:[

                    debugger := super new.

                ]

            ] ifTrue:[

                debugger := super new.

            ].

            debugger label:'Debugger'.

            debugger icon:self defaultIcon.

        ] ifFalse:[

            debugger := CachedDebugger.

            CachedDebugger := nil.

        ]

    ].

    ^ debugger

    "Modified: 31.7.1997 / 21:20:27 / cg"

!

newExclusive

    "return a debugger for exclusive display access"

    |debugger|

    debugger := super new.

    debugger label:'Debugger'.

    debugger icon:self defaultIcon.

    debugger exclusive:true.

    ^ debugger

    "Modified: 1.1.1970 / 23:27:06 / cg"

!

openOn:aProcess

    "start a  debugger on aProcess

     (actually not more than a good-looking inspector)"

    |aDebugger label nm|

    aDebugger := super new.

    aDebugger icon:self defaultIcon.

    aProcess notNil ifTrue:[

        nm := aProcess name.

        nm notNil ifTrue:[

            nm := (nm contractTo:17) , '-' , aProcess id printString

        ] ifFalse:[

            nm := aProcess id printString

        ].

        label := 'Debugger [' , nm , ']'.

    ] ifFalse:[

        label := 'no process'

    ].

    aDebugger label:label iconLabel:'Debugger'.

    aDebugger openOn:aProcess.

    ^ nil

    "Modified: 4.4.1997 / 16:22:36 / cg"

! !

!DebugView class methodsFor:'cleanup'!

lowSpaceCleanup 

    "in low memory situations, give up cached debuggers"

    CachedDebugger := nil.

    CachedExclusive := nil.

    OpenDebuggers := nil.

    "

     DebugView lowSpaceCleanup

    "

    "Modified: 18.4.1996 / 16:48:03 / cg"

!

newDebugger

    "force creation of a new debugger"

    CachedDebugger := nil.

    CachedExclusive := nil.

    OpenDebuggers := nil.

    "

     DebugView newDebugger

    "

! !

!DebugView class methodsFor:'defaults'!

defaultIcon

    "return the debuggers default window icon"

    <resource: #style (#ICON #ICON_FILE)>

    |nm i|

    (i := DefaultIcon) isNil ifTrue:[

        i := self classResources at:'ICON' default:nil.

        i isNil ifTrue:[

            nm := ClassResources at:'ICON_FILE' default:'Debugger.xbm'.

            i := Image fromFile:nm resolution:100.

            i isNil ifTrue:[

                i := Image fromFile:('bitmaps/' , nm) resolution:100.

                i isNil ifTrue:[

                    i := StandardSystemView defaultIcon

                ]

            ]

        ].

        i notNil ifTrue:[

            DefaultIcon := i := i on:Display

        ]

    ].

    ^ i

    "Modified: 19.3.1997 / 20:48:34 / ca"

    "Modified: 18.4.1997 / 15:16:27 / cg"

!

defaultVerboseBacktrace

    ^ VerboseBacktraceDefault

    "Created: 11.1.1997 / 12:14:35 / cg"

!

defaultVerboseBacktrace:aBoolean

    VerboseBacktraceDefault := aBoolean

    "Created: 11.1.1997 / 12:14:44 / cg"

! !

!DebugView class methodsFor:'misc'!

interestingContextFrom:aContext

    "return an interesting 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 :-)"

    |delta con|

    delta := self interestingContextIndexFrom:aContext.

    con := aContext.

    [con notNil and:[delta > 1]] whileTrue:[

        con := con sender.

        delta := delta - 1.

    ].

    con isNil ifTrue:[

        ^ aContext

    ].

    ^ con

    "Modified: 11.1.1997 / 17:58:44 / cg"

!

interestingContextIndexFrom:aContext

    "return an interesting 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 ex|

    aContext isNil ifTrue:[^ 1].

    aContext isBlockContext ifTrue:[^ 1].

    VerboseBacktraceDefault == true ifTrue:[^ 1].

    "/ somewhere, at the bottom, there must be a raise ...

    "/ find the exception

    c := aContext.

    1 to:5 do:[:i |

        c isNil ifTrue:[^ 1].

        sel := c selector.

        ((sel == #raise) 

        or:[sel == #raiseRequest]) ifTrue:[

            (c receiver isKindOf:Exception) ifTrue:[

                ex := c receiver.

                offset := i.

                found := c

            ] ifFalse:[

                (c receiver isSignal) ifTrue:[

                    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:[

        "/ this is a kludge, but convenient.

        "/ show the place where the divisionByZero happend,

        "/ not where the signal was raised.

        sel := aContext selector.

        (sel == #//      

        or:[sel == #/

        or:[sel == #\\]]) ifTrue:[

            ^ 2

        ].

        ^ 1

    ].

    "

     got it; move up, skipping all intermediate Signal and

     Exception contexts

    "

    prev := nil.

    [   

        ((c receiver isSignal)

        or:[(c receiver isKindOf:Exception)])

    ] whileTrue:[

        prev := c.

        (c := c sender) isNil ifTrue:[^ offset].

        offset := offset + 1.

    ].

    "

     now, we are one above the raising context

    "

    "

     if the sender-method of the raise is one of objects error methods ...

    "

    ( #( halt halt: 

         error error: 

         doesNotUnderstand: 

         subclassResponsibility 

         primitiveFailed) includes:c selector) 

    ifTrue:[

        c selector == #doesNotUnderstand: ifTrue:[

            "