"

 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 sendButton returnButton restartButton

			      exclusive inspecting nChainShown

			      inspectedProcess updateProcess

			      monitorToggle stepping steppedContextLineno actualContext inWrap'

       classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail'

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

    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:'instance creation'!

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

!

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

!

newDebugger

    "force creation of a new debugger"

    CachedDebugger := nil.

    CachedExclusive := nil.

    OpenDebuggers := nil.

    "

     DebugView newDebugger

    "

!

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

!

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

    StepInterruptPending := nil.

    thisContext isRecursive ifTrue:[

	^ MiniDebugger enterWithMessage:'recursive error'.

    ].

    "

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

	OpenDebuggers do:[:aDebugger |

	    aDebugger notNil ifTrue:[

		(aDebugger inspectedProcess == Processor activeProcess) ifTrue:[

"/ 'entering stepping debugger again' printNL.

		    aDebugger unstep.

		    aDebugger setLabelFor:aString in:Processor activeProcess.

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

!

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:'initialization'!

initialize

    |v panel hpanel bpanel dummy|

    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.

    dummy := View extent:(20 @ 5) in:bpanel.

    dummy borderWidth:0; level:0.

    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.

    dummy := View extent:(20 @ 5) in:bpanel.

    dummy borderWidth:0; level:0.

    continueButton := Button

			label:(resources at:'continue')

			action:[continueButton turnOffWithoutRedraw. self doContinue]

			in:bpanel.

    dummy := View extent:(20 @ 5) in:bpanel.

    dummy borderWidth:0; level:0.

    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 m|

    labels := resources array:#(

				'show more'

				'-'

				'skip'

				'-'

"

				'continue'

				'terminate'

				'abort'

				'-'

				'step'

				'send'

				'-'

				'return'

				'restart'

				'-'

"

				'remove breakpoint'

				'remove all trace & breakpoints'

				'-'

				'implementors ...'

				'senders ...'

				'-'

				'inspect context'

				'-'

				'quickTerminate'

				'-'

				'exit smalltalk'

			      ).

    m := (PopUpMenu 

				labels:labels

			     selectors:#(

					 doShowMore

					 nil

					 doSkip

					 nil

"

					 doContinue

					 doTerminate

					 doAbort

					 nil

					 doStep

					 doSend

					 nil

					 doReturn

					 doRestart

					 nil

"

					 doRemoveBreakpoint

					 doRemoveAllBreakpoints

					 nil

					 doImplementors

					 doSenders

					 nil

					 doInspectContext

					 nil

					 doQuickTerminate

					 nil

					 doExit

					)

				  receiver:self

				       for:contextView).

    contextView middleButtonMenu:m. 

    inspecting ifTrue:[

	m notNil ifTrue:[

	    m disable:#doTraceStep.

	    m disable:#doRemoveBreakpoint.

	].

    ]

!

addToCurrentProject

    "ignored here"

    ^ self

!

createOnTop

    ^ false "true"

!

realize

    super realize.

    exclusive ifTrue:[

	windowGroup := nil

    ].

    inspecting ifTrue:[

	inspectedProcess notNil ifTrue:[

	    "

	     set prio somewhat higher (by 2, to allow walkBack-update process

	     to run between mine and the debugged processes prio)

	    "

	    Processor activeProcess 

		priority:(inspectedProcess priority + 2 min:16).

	]

    ]

!

setLabelFor:aMessage in:aProcess

    |l nm|

    l := aMessage , ' ('.

    nm := aProcess name.

    nm notNil ifTrue:[

	l := l , (nm contractTo:17) , '-'.

    ].

    l := l , aProcess id printString , ')'.

    self label:l.

! !

!DebugView methodsFor:'interrupt handling'!

stepInterrupt

    |where here s isWrap method lastWrappedConAddr wrappedMethod inBlock left ignore|

    Processor activeProcess ~~ inspectedProcess ifTrue:[

	'stray step interrupt' errorPrintNL.

	^ self

    ].

    "

     kludge to hide breakpoint wrappers in the context list: 

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

	 if so, ignore the interrupt and continue single sending

    "

    here := thisContext.        "stepInterrupt"

    here := here sender.        "the interrupted context"  

"/ '*******' printNL.

"/ 'here in ' print.

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

    where := here.

    isWrap := false.

    left := false.

    inWrap ifTrue:[

	wrappedMethod := nil.

	5 timesRepeat:[

"/ where selector printNL.

	    (where notNil and:[where isBlockContext not]) ifTrue:[

		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.

			]