"

 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 canAbort abortButton terminateButton

		continueButton stepButton nextButton sendButton returnButton

		restartButton exclusive inspecting nChainShown inspectedProcess

		updateProcess stopButton updateButton monitorToggle stepping

		steppedContextLineno stepForReturn actualContext inWrap'

	classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail'

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

"

! !

!DebugView class methodsFor:'initialization'!

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|

    StepInterruptPending := nil.

    thisContext isRecursive ifTrue:[

	^ MiniDebugger enterWithMessage:'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 ifTrue:[

		(aDebugger inspectedProcess == active) ifTrue:[

"/ 'entering stepping debugger again' printNL.

		    aDebugger unstep.

		    aDebugger setLabelFor:aString in:active.

		    ^ aDebugger enter:aContext.

		]

	    ]

	]

    ].

    ^ self enterUnconditional:aContext withMessage:aString

!

enterUnconditional:aContext withMessage:aString

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

    |aDebugger|

    StepInterruptPending := nil.

    aDebugger := self new.

    aDebugger setLabelFor:aString in:Processor activeProcess.

    aDebugger enter:aContext.

    ^ nil

    "nil halt"

!

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

!

lowSpaceCleanup 

    "in low memory situations, give up cached debuggers"

    self newDebugger

    "

     DebugView lowSpaceCleanup

    "

    "Modified: 22.2.1996 / 17:58:16 / cg"

!

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

	    debugger := self newExclusive

	] ifFalse:[

	    debugger := CachedExclusive.

	    CachedExclusive := nil.

	].

    ] ifFalse:[

	CachedDebugger isNil ifTrue:[

	    debugger := super new.

	    debugger label:'Debugger'.

	    debugger icon:(Form fromFile:'Debugger.xbm' resolution:100).

	] ifFalse:[

	    debugger := CachedDebugger.

	    CachedDebugger := nil.

	]

    ].

    ^ debugger

!

newDebugger

    "force creation of a new debugger"

    CachedDebugger := nil.

    CachedExclusive := nil.

    OpenDebuggers := nil.

    "

     DebugView newDebugger

    "

!

newExclusive

    "return a debugger for exclusive display access"

    |debugger|

    debugger := super new.

    debugger label:'Debugger'.

    debugger icon:(Form fromFile:'Debugger.xbm' resolution:100).

    debugger exclusive:true.

    ^ debugger

!

openOn:aProcess

    "start a  debugger on aProcess

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

    |aDebugger label nm|

    aDebugger := super new.

    aDebugger icon:(Form fromFile:'Debugger.xbm' resolution:100).

    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.

    aDebugger iconLabel:'Debugger'.

    aDebugger openOn:aProcess.

    ^ nil

! !

!DebugView methodsFor:'basic'!

enter

    "enter the debugger - on the sending context"

    |where|

    busy := true.

    where := thisContext.      "enter"

    where := where sender.     "the calling context"

    where notNil ifTrue:[

	(where receiver == DebugView) ifTrue:[

	    where := where sender

	]

	"where is now interrupted methods context"

    ].

    ^ self enter:where

!

enter:aContext

    "enter the debugger - get and display the context, then start an

     exclusive event loop on top of eveything else"

    |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

     us here

    "

    (grabber := device activePointerGrab) notNil ifTrue:[

        device ungrabPointer.

        device ungrabKeyboard.

    ].

    (inspectedProcess suspendedContext isNil 

    or:[Processor isSystemProcess:inspectedProcess]) ifTrue:[

        terminateButton disable.

    ] ifFalse:[

        terminateButton enable.

        abortButton enable.

    ].

    drawableId notNil ifTrue:[

        "

         not the first time - disable buttons & menus

         from previous life

        "

        terminateButton turnOffWithoutRedraw.

        continueButton turnOffWithoutRedraw.

        returnButton turnOffWithoutRedraw.

        restartButton turnOffWithoutRedraw.

        abortButton turnOffWithoutRedraw.

        nextButton turnOffWithoutRedraw.

        stepButton turnOffWithoutRedraw.

        sendButton turnOffWithoutRedraw.

        m := contextView middleButtonMenu.

        m notNil ifTrue:[

            m disableAll:#(showMore skip skipForoReturn inspectContext).

        ]

    ] ifFalse:[

        self iconLabel:'Debugger'.

    ].

    windowGroup isNil ifTrue:[

        windowGroup := WindowGroup new.

        windowGroup addTopView:self.

    ].

    exclusive ifFalse:[

        "/ create a (modal) windowGroup for myself

        windowGroup setModal:true.

    ] ifTrue:[

        "/ create a windowGroup with a synchronous sensor for me

        windowGroup sensor:(SynchronousWindowSensor new device:device).

    ].

    windowGroup setProcess:Processor activeProcess.

    "

     get the walkback list; clear inspectors if we did not come here by single stepping)

    "

    self setContext:aContext releaseInspectors:(exitAction ~~ #step).

    "

     and find the one context to show initially

     - if we came here by a send (single step), its the top context;

     - if we came here by a step (i.e. bigStep), its the top context

       (for ifs and whiles) or the sender (for regular sends).

     - otherwise, we came here by some signal raise, and we are interested

       in the context where the raise actually occured.

    "

    exitAction == #step ifTrue:[

        selection := 1.

        steppedContextAddress notNil ifTrue:[

            "

             if we came here by a big-step, show the method where we are

            "

            (ObjectMemory addressOf:aContext) == steppedContextAddress ifTrue:[

                selection := 1

            ] ifFalse:[

                (ObjectMemory addressOf:aContext sender) == steppedContextAddress ifTrue:[

                    selection := 2

                ]

            ].

            "

             for bigStep, we could also be in a block below the actual method ...

            "

            (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 interesting context, (where halt/raise was ...)

            "

            selection := self interestingContextFrom:aContext.

        ] ifFalse:[

            "

             if we came here by a big-step, show the method where we are

            "

            (ObjectMemory addressOf:aContext) == steppedContextAddress ifTrue:[

                selection := 1

            ] ifFalse:[

                (ObjectMemory addressOf:aContext sender) == steppedContextAddress ifTrue:[

                    selection := 2

                ]

            ]

        ]

    ].

    selection notNil ifTrue:[

        self showSelection:selection.

        contextView selection:selection.

        selection > 1 ifTrue:[

            contextView scrollToLine:(selection - 1)

        ]

    ].

    m := contextView middleButtonMenu.

    m notNil ifTrue:[

        canAbort := inspecting or:[Object abortSignal isHandled].

        canAbort ifTrue:[

            abortButton enable.

            m enable:#doAbort.

        ] ifFalse:[

            abortButton disable.

            m disable:#doAbort.

        ].

        exclusive ifTrue:[

            terminateButton disable.

            m disable:#doTerminate.

        ] ifFalse:[

            terminateButton enable.

            m enable:#doTerminate.

        ]

    ].

    "

     drawableId is nil, if this is a new debugger. Then do a realize.

     Otherwise, its probably better to do a rerealize, which shows the

     view at the previous position, without a need for the user to set the

     position again

    "

    drawableId notNil ifTrue:[

        self rerealize

    ] ifFalse:[

        self realize.

    ].

    exclusive ifTrue:[

        self showError:'

Debugging system process `' , (inspectedProcess nameOrId) printString , '''.

This is a modal debugger - all event processing is stopped..

Therefore, you cannot interact with other views or 

open any other tools while this debugger is active.

Also, there is no event processing (redraw) for other views.'

    ].

    "

     bring us to the top

    "

    self raise.

    device flush.

    canContinue := true.

    exitAction := nil.

    "

     enter private event handling loop. This is left (and we come back here again)

     when any button was pressed which requires continuation of the debuggee or

     closedown of the debugger.

    "

    [self controlLoop] valueOnUnwindDo:[

        windowGroup notNil ifTrue:[

            windowGroup setProcess:nil.

        ].

        self destroy

    ].

    "

     release all context stuff.

     This is required to avoid keeping references to the debuggees objects

     forever. (since the debugger is reused for faster startup next time)

    "

    contextArray := nil.

    codeView acceptAction:nil.

    contextView contents:nil.

    (exitAction ~~ #step) ifTrue:[

        receiverInspector release.

        contextInspector release.

        self unrealize.

        device flush.

        (exitAction == #abort) ifTrue:[

            self cacheMyself.

            "

             have to catch errors occuring in unwind-blocks

            "

            ErrorSignal handle:[:ex |

                'ignored error while unwinding: ' errorPrint.

                ex errorString errorPrintNL.