"

 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

                              abortButton terminateButton continueButton

                              stepButton sendButton returnButton restartButton

                              exclusive inspecting nChainShown

                              processList'

       classVariableNames:'CachedDebugger CachedExclusive'

       poolDictionaries:''

       category:'Interface-Debugger'

!

DebugView comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

              All Rights Reserved

'!

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

"

!

version

"

"

!

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

"

! !

!DebugView class methodsFor:'instance creation'!

new

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

     exists"

    |debugger active|

    "need a blocking debugger if no processes or 

     or if its a timing/interrupt process 

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

    active := Processor activeProcess.

    (ProcessorScheduler isPureEventDriven 

    or:[(active priority > Processor userSchedulingPriority)

    or:[active nameOrId endsWith:'dispatcher']]) 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

!

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.

    CachedExclusive := nil

    "DebugView newDebugger"

!

enterWithMessage:aString

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

     error- and halt messages"

    thisContext isRecursive ifTrue:[

        ^ MiniDebugger enterWithMessage:aString

    ].

    ^ self enter:(thisContext sender) withMessage:aString

    "Debugger enterWithMessage:'hi there'"

!

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

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

     error- and halt messages"

    |aDebugger|

    thisContext isRecursive ifTrue:[

        ^ MiniDebugger enterWithMessage:'recursive error'.

    ].

    StepInterruptPending := nil.

    aDebugger := self new.

    aDebugger label:aString , ' (' , Processor activeProcess nameOrId , ')'.

    aDebugger enter:aContext.

    ^ nil

    "nil halt"

!

openOn:aProcess

    "start a  debugger on aProcess

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

    |aDebugger label|

    aDebugger := super new.

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

    aProcess notNil ifTrue:[

        label := 'inspecting Debugger (' , aProcess nameOrId , ')'.

    ] ifFalse:[

        label := 'no process'

    ].

    aDebugger label:label.

    aDebugger iconLabel:'Debugger'.

    aDebugger openOn:aProcess.

    ^ nil

! !

!DebugView methodsFor:'initialization'!

initialize

    |v panel hpanel bpanel|

    super initialize.

    font := font on:device.

    busy := false.

    exclusive := false.

    inspecting := false.

    exitAction := nil.

    bigStep := false.

    canContinue := false.

    canAbort := 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:[terminateButton turnOffWithoutRedraw. self doTerminate]

                        in:bpanel.

    abortButton := Button

                        label:(resources at:'abort')

                        action:[abortButton turnOffWithoutRedraw. self doAbort]

                        in:bpanel.

    returnButton := Button

                        label:(resources at:'return')

                        action:[returnButton turnOff. self doReturn]

                        in:bpanel.

    restartButton := Button

                        label:(resources at:'restart')

                        action:[restartButton turnOff. self doRestart]

                        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:#(

                                'show more'

                                '-'

"

                                'continue'

                                'terminate'

                                'abort'

                                '-'

                                'step'

                                'send'

                                '-'

                                'return'

                                'restart'

                                '-'

"

                                'remove breakpoint'

                                '-'

                                'implementors ...'

                                'senders ...'

                                '-'

                                'inspect context'

                                '-'

                                'exit smalltalk'

                              ).

    contextView

        middleButtonMenu:(PopUpMenu 

                                labels:labels

                             selectors:#(

                                         doShowMore

                                         nil

"

                                         doContinue

                                         doTerminate

                                         doAbort

                                         nil

                                         doStep

                                         doSend

                                         nil

                                         doReturn

                                         doRestart

                                         nil

"

                                         doRemoveBreakpoint

                                         nil

                                         doImplementors

                                         doSenders

                                         nil

                                         doInspectContext

                                         nil

                                         doExit

                                        )

                                  receiver:self

                                       for:contextView).

!

addToCurrentProject

    "ignored here"

    ^ self

!

createOnTop

    ^ false "true"

!

realize

    super realize.

    exclusive ifTrue:[

        windowGroup := nil

    ].

! !

!DebugView methodsFor:'interrupt handling'!

stepInterrupt

    |where here s isWrap method lastWrappedConAddr wrappedMethod|

    "

     kludge, check if we are in a wrapper methods hidden setup-sequence

    "

    here := thisContext.        "stepInterrupt"

    here := here sender.        "the interrupted context"  

"/ 'here in ' print.

"/  ((ObjectMemory addressOf:here) printStringRadix:16)print. '' printNL.

    where := here.

    isWrap := false.

    wrappedMethod := nil.

    5 timesRepeat:[

"/ where selector printNL.

        method := where method.

        (method notNil and:[method isWrapped]) ifTrue:[

            "

             in a wrapper method

            "

            wrappedMethod ~~ method ifTrue:[

                wrappedMethod := method.

                lastWrappedConAddr := ObjectMemory addressOf:where.

                where sender receiver == method originalMethod ifFalse:[

                    isWrap := true.

                ]

            ] ifFalse:[

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

"/ 'change stepCon from: ' print.

"/  (steppedContextAddress printStringRadix:16)print.

"/ ' to: ' print.

"/  (lastWrappedConAddr printStringRadix:16)printNL.

                    steppedContextAddress := lastWrappedConAddr

                ]

            ]

        ].

        where := where sender

    ].

    isWrap ifTrue:[

"/ 'ignore wrap' printNL.

        "

          ignore, while in wrappers hidden setup

        "

        where := nil. here := nil.

        ObjectMemory flushInlineCaches.

        StepInterruptPending := true.

        InterruptPending := true.

        InStepInterrupt := nil.

        ^ nil

    ].

    "

     is this for a send or a step ?

    "

    bigStep ifTrue:[

        "

         a step - ignore all contexts below the interresting one

        "

        where := here.      "the interrupted context"

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

            where := where sender.

"/ 'look for ' print.

"/  (steppedContextAddress printStringRadix:16)print. '' printNL.

            (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) printStringRadix:16)print. ' ' print.

"/  where selector printNL.

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

"/ 'found it - below' printNL.

                        "

                         found the interresting context somwehere up in the

                         chain. We seem to be still below the interresting one ...

                        "

                        tracing == true ifTrue:[

                            here printString printNewline

                        ].

                        where := nil. here := nil.

                        "

                          yes, a context below

                          - continue and schedule 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

                ].

                s := 'left stepped method'

            ] ifTrue:[

"/ 'found it right in sender' printNL.

                s := 'after step'

            ].

        ] ifTrue:[

"/ 'found it right away' printNL.

            s := 'after step'

        ].

        tracing := false.

        bigStep := false.

    ] ifFalse:[

        "

         a send

        "

        steppedContextAddress := nil.

        s := 'after send'

    ].

    name := Processor activeProcess nameOrId.

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

    "release refs to context"

    where := nil. here := nil.

    self enter:thisContext sender 

! !

!DebugView methodsFor:'basic'!

enter

    "enter the debugger - on the sending context"

    |where|

    busy := true.

    where := thisContext.      "enter"