"

 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 steppedContextAddress canAbort

       classVariableNames:'cachedDebugger theOneAndOnlyNotifier'

       poolDictionaries:''

       category:'Interface-Debugger'

!

DebugView comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

              All Rights Reserved

this class implements a graphical debugger interface.

written spring/summer 89 by claus

'!

!DebugView class methodsFor:'instance creation'!

new

    "return a DebugView - return the standard debugger if it already

     exists"

    |debugger|

    ProcessorScheduler isPureEventDriven ifTrue:[

        cachedDebugger isNil ifTrue:[

        ].

        ^ cachedDebugger

    ].

    (cachedDebugger isNil or:[cachedDebugger busy]) ifTrue:[

        debugger := super new.

        debugger label:'Debugger'.

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

    ] ifFalse:[

        debugger := cachedDebugger

    ].

    cachedDebugger isNil ifTrue:[

        cachedDebugger := debugger

    ].

    ^ debugger

!

newDebugger

    "force creation of a new debugger"

    cachedDebugger := nil

    "DebugView newDebugger"

!

enterWithMessage:aString

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

     error- and halt messages"

    |aDebugger name|

    StepInterruptPending := nil.

    aDebugger := self new.

    aDebugger label:aString , ' (process: ' , name , ')'.

    aDebugger enter.

    ^ nil

    "nil halt"

!

enter

    "another way of entering the debugger"

    |aDebugger name|

    StepInterruptPending := nil.

    aDebugger := self new.

    aDebugger label:'Debugger (process: ' , name , ')'.

    aDebugger enter.

    ^ nil

    "Debugger enter"

! !

!DebugView methodsFor:'initialization'!

initialize

    |v panel hpanel bpanel terminateButton continueButton stepButton sendButton|

    super initialize.

    font := font on:device.

    busy := false.

    exitAction := nil.

    bigStep := false.

    bpanel := HorizontalPanelView

                        origin:(0.0 @ 0.0)

                        extent:(1.0 @ (font height * 2))

                            in:self.

    bpanel layout:#left.

    terminateButton := Button

                        label:(resources at:'terminate')

                        action:[abortButton turnOffWithoutRedraw. self doTerminate]

                        in:bpanel.

    abortButton := Button

                        label:(resources at:'abort')

                        action:[abortButton turnOffWithoutRedraw. self doAbort]

                        in:bpanel.

    continueButton := Button

                        label:(resources at:'continue')

                        action:[continueButton turnOffWithoutRedraw. self doContinue]

                        in:bpanel.

    stepButton := Button

                        label:(resources at:'step')

                        action:[stepButton turnOff. self doStep]

                        in:bpanel.

    sendButton := Button

                        label:(resources at:'send')

                        action:[sendButton turnOff. self doSend]

                        in:bpanel.

    panel := VariableVerticalPanel

                        origin:(0.0 @ bpanel height)

                        corner:(1.0 @ 1.0)

                            in:self.

    v := ScrollableView for:SelectionInListView in:panel.

    v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25).

    contextView := v scrolledView.

    contextView action:[:lineNr | self showSelection:lineNr].

    v := ScrollableView for:CodeView in:panel.

    v origin:(0.0 @ 0.25) corner:(1.0 @ 0.75).

    codeView := v scrolledView.

    hpanel := VariableHorizontalPanel in:panel.

    hpanel origin:(0.0 @ 0.75) corner:(1.0 @ 1.0).

    receiverInspector := InspectorView

                                origin:(0.0 @ 0.0) corner:(0.5 @ 1.0)

                                    in:hpanel.

    contextInspector := ContextInspectorView

                                origin:(0.5 @ 0.0) corner:(1.0 @ 1.0)

                                    in:hpanel

!

initializeMiddleButtonMenu

    |labels|

    labels := resources array:#('continue'

                                'terminate'

                                'abort'

                                '-'

                                'step'

                                'trace step'

                                'send'

"

                                'trace'

                                'untrace'

"

                                '-'

                                'resume'

                                'restart'

                                '-'

"

                                'breakpoints'

                                '-'

"

                                'exit smalltalk'

                              ).

    contextView

        middleButtonMenu:(PopUpMenu 

                                labels:labels

                             selectors:#(doContinue

                                         doTerminate

                                         doAbort

                                         nil

                                         doStep

                                         doTraceStep

                                         doSend

"

                                         doTrace

                                         doNoTrace

"

                                         nil

                                         doResume

                                         doRestart

                                         nil

"

                                         doBreakpoints

                                         nil

"

                                         doExit)

                                  receiver:self

                                       for:contextView)

!

addToCurrentProject

    "ignored here"

    ^ self

!

createOnTop

    ^ false "true"

! !

!DebugView methodsFor:'error handling'!

catch:aSymbol with:someArgument for:anObject

    "this one is sent when an error occurs while in the debugger -

     we dont want another debugger to come up - do we ?"

    anObject class name print.

    ' ' print.

    aSymbol print. '(' print. someArgument print.

    ') within debugger cought' printNewline.

    (aSymbol == #halt:) ifFalse:[

        catchBlock value

    ].

    ^ nil

! !

!DebugView methodsFor:'interrupt handling'!

stepInterrupt

    |where here s|

    "is this for a send or a step ?"

    bigStep ifTrue:[

        where := thisContext.

        where := where sender.

        where := where sender.     

        here := where.

        (ObjectMemory addressOf:where) == steppedContextAddress  ifFalse:[

            "

             check if we are in a context below steppedContext

             (i.e. if steppedContext can be reached from

              interrupted context. Not using context-ref but its

              address to avoid creation of many useless contexts..)

            "

            [where notNil] whileTrue:[

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

                    tracing ifTrue:[

                        here printString printNewline

                    ].

                    where := nil. here := nil.

                    "yes - continue"

                    "scedule another stepInterrupt

                     - must flush caches since optimized methods not always

                     look for pending interrupts"

                    ObjectMemory flushInlineCaches.

                    StepInterruptPending := true.

                    InterruptPending := true.

                    InStepInterrupt := nil.

                    ^ nil

                ].

                where := where sender

            ]

        ].

        bigStep := false.

        tracing := false.

        s := 'after step'

    ] ifFalse:[

        steppedContextAddress := nil.

        s := 'after send'

    ].

    name isNil ifTrue:[

    ].

    self label:(s , ' (process: ' , name , ')').

    "release refs to context"

    where := nil. here := nil.

    self enter

! !

!DebugView methodsFor:'basic'!

busy

    ^ busy

!

enter

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

     exclusive event loop on top of eveything else"

    |where con oldRecursionLimit selection|

    oldRecursionLimit := RecursionLimit.

    RecursionLimit := nil.

    bigStep := false.

    "if debugger is entered while a box has grabbed the

     pointer, we must ungrab - otherwise X wont talk to

     us here"

    ActiveGrab notNil ifTrue:[

        grabber := ActiveGrab.

        ActiveGrab device ungrabPointer.

        ActiveGrab device synchronizeOutput.

        ActiveGrab := nil

    ] ifFalse:[

        grabber := nil

    ].

    drawableId notNil ifTrue:[

        "not the first time - realize at old position"

        self rerealize

    ] ifFalse:[

    ].

    self raise.

    Display synchronizeOutput.

    where := thisContext.

    where := where sender.

    where notNil ifTrue:[

        (where receiver == DebugView) ifTrue:[

            where := where sender

        ]

        "where is now interrupted methods context"

    ].

    self setContext:where.

    "select context, where halt was ..."

    ( #(halt error raise) includes:where sender selector) ifTrue:[

        selection := 3

    ] ifFalse:[

        ( #(halt: error:) includes:where selector) ifTrue:[

            selection := 2

        ]

    ].

    where := nil.

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

    steppedContextAddress notNil ifTrue:[

        selection := 3

    ].

    selection notNil ifTrue:[

        self showSelection:selection.

        contextView selection:selection

    ].

    canAbort := false.

    1 to:contextArray size do:[:index |

        (#(doIt printIt inspectIt)

        includes:(contextArray at:index) selector) ifTrue:[

            canAbort := true

        ]

    ].

    canAbort ifTrue:[

        abortButton enable

    ] ifFalse:[

        abortButton disable

    ].

    canContinue := true.

    self controlLoop.

    "kludge: look for a doIt, printIt or inspectIt frame for abort"

    (canAbort and:[exitAction == #abort]) ifTrue:[

        selectedContext := nil.

        1 to:contextArray size do:[:index |

            (#(doIt printIt inspectIt)

                includes:(contextArray at:index) selector) ifTrue:[

                selectedContext := contextArray at:index

            ]

        ].

        exitAction := #resume

    ].

    contextArray := nil.

    (exitAction == #step) ifFalse:[

        self unrealize.

        device synchronizeOutput.

        (exitAction == #resume) ifTrue:[

            selectedContext notNil ifTrue:[

                con := selectedContext.

                selectedContext := nil.

                ErrorActive := false.

                InInterrupt := nil.

                RecursionLimit := oldRecursionLimit.

                con unwind.

                'cannot resume selected context' printNewline

            ]

        ] ifFalse:[

            (exitAction == #restart) ifTrue:[

                selectedContext notNil ifTrue:[

                    con := selectedContext.

                    selectedContext := nil.

                    ErrorActive := false.

                    InInterrupt := nil.

                    RecursionLimit := oldRecursionLimit.

                    con restart.

                    'cannot restart selected context' printNewline

                ]

            ] ifFalse:[

                (exitAction == #terminate) ifTrue:[

                    selectedContext := nil.

                    ErrorActive := false.

                    InInterrupt := nil.

                    RecursionLimit := oldRecursionLimit.

                    'cannot terminate process' printNewline

                ]

            ]

        ]

    ].

    selectedContext := nil.

    grabber notNil ifTrue:[

        grabber device grabPointerIn:(grabber id).

        ActiveGrab := grabber

    ].

    RecursionLimit := oldRecursionLimit.

    (exitAction == #step) ifTrue:[

        "scedule another stepInterrupt

         - must flush caches since optimized methods not always

         look for pending interrupts"

        ObjectMemory flushInlineCaches.

        ObjectMemory stepInterruptHandler:self.

        StepInterruptPending := true.

        InterruptPending := true.

        InStepInterrupt := nil

    ]

!

controlLoop

    "this is a kludge:

        start a dispatchloop which exits when