"

 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'

       classVariableNames:'CachedDebugger CachedExclusive 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

     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 userInterruptPriority)

	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

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

    thisContext isRecursive ifTrue:[

	^ MiniDebugger enterWithMessage:'recursive error'.

    ].

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

    aDebugger := super new.

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

    aProcess notNil ifTrue:[

	nm := aProcess name.

	nm notNil ifTrue:[

	    nm := (aProcess nameOrId 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'

				'-'

"

				'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

"

					 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.

	].

    ]

!

reinitialize

    super reinitialize.

    "

     this is reached, when we come up after a restart.

     ST/X does not support this, since the contexts are

     all dead, and processes have been recreated.

    "

    super destroy

!

addToCurrentProject

    "ignored here"

    ^ self

!

createOnTop

    ^ false "true"

!

realize

    super realize.

    exclusive ifTrue:[

	windowGroup := nil

    ].

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

    ]

! !

!DebugView methodsFor:'interrupt handling'!

stepInterrupt

    |where here s isWrap method lastWrappedConAddr wrappedMethod|

    Processor activeProcess ~~ inspectedProcess ifTrue:[

	'stray step interrupt' errorPrintNL.

	^ self

    ].

    "

     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.

"/ 'change stepCon from: ' print.

"/  (steppedContextAddress printStringRadix:16)print.

"/ ' to: ' print.

"/  (lastWrappedConAddr printStringRadix:16)printNL.

		]

    ].

    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