"

 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

                              exclusive'

       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.

The debugger usually sits on top of the faulting process,

stopping it from further event processing.

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

written spring/summer 89 by claus

'!

!DebugView class methodsFor:'instance creation'!

new

    "return a DebugView - return the standard 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 ..."

    ProcessorScheduler isPureEventDriven ifTrue:[

        cachedDebugger isNil ifTrue:[

            cachedDebugger := self newExclusive

        ].

        ^ cachedDebugger

    ].

        ^ self newExclusive

    ].

    (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

!

newExclusive

    "return a debugger for exclusive display access"

    |debugger|

    debugger := super on:ModalDisplay.

    debugger label:'Debugger'.

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

    debugger exclusive:true.

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

    name := Processor activeProcess nameOrId.

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

    aDebugger enter.

    ^ nil

    "nil halt"

!

enter

    "another way of entering the debugger"

    |aDebugger name|

    StepInterruptPending := nil.

    aDebugger := self new.

    name := Processor activeProcess nameOrId.

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

    aDebugger enter.

    ^ nil

    "Debugger enter"

! !

!DebugView methodsFor:'initialization'!

initialize

    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"

!

realize

    super realize.

    exclusive ifTrue:[

        windowGroup := nil

    ].

! !

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

    ] ifFalse:[

        steppedContextAddress := nil.

        s := 'after send'

    ].

    name := Processor activeProcess name.

    name isNil ifTrue:[

        name := Processor activeProcess id printString.

    ].

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

    "release refs to context"

    where := nil. here := nil.

    self enter

! !

!DebugView methodsFor:'basic'!

busy

    ^ busy

!

exclusive:aBoolean

    exclusive := aBoolean

!

enter

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

     exclusive event loop on top of eveything else"

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

        exclusive ifFalse:[

            windowGroup isNil ifTrue:[

                windowGroup := WindowGroup new.

                windowGroup addTopView:self.

            ].

        ].

        self realize

    ].

    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.

                InInterrupt := nil.

                con unwind.

                'cannot resume selected context' printNewline

            ]

        ] ifFalse:[

            (exitAction == #restart) ifTrue:[

                selectedContext notNil ifTrue:[

                    con := selectedContext.

                    selectedContext := nil.

                    InInterrupt := nil.

                    con restart.

                    'cannot restart selected context' printNewline

                ]

            ] ifFalse:[

                (exitAction == #terminate) ifTrue:[

                    selectedContext := nil.

                    InInterrupt := nil.

                    Processor activeProcess terminate.

                    'cannot terminate process' printNewline

                ]

            ]

        ]

    ].

    selectedContext := nil.

    grabber notNil ifTrue:[

        grabber device grabPointerIn:(grabber id).

        ActiveGrab := grabber

    ].

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