accept in the debugger always assignes the classes'
package or the NoPackage.
Never take the current packageQuery value.
"
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.
"
"{ Package: 'stx:libtool' }"
StandardSystemView subclass:#DebugView
instanceVariableNames:'busy haveControl exitAction canContinue contextView codeView
receiverInspector contextInspector contextArray selectedContext
catchBlock grabber mayProceed traceView tracing bigStep
skipLineNr steppedContextAddress abortButton terminateButton
continueButton stepButton nextButton nextOverButton nextOutButton
sendButton returnButton restartButton exclusive inspecting
nChainShown inspectedProcess updateProcess stopButton
updateButton defineButton monitorToggle stepping
steppedContextLineno stepForReturn actualContext inWrap
stackInspector steppedContext wrapperContext verboseBacktrace
firstContext stepHow cachable currentMethod ignoreBreakpoints
stepUntilEntering lastStepUntilEntering
lastSelectionInReceiverInspector lastSelectionInContextInspector
canShowMore exitAbort reportButton setOfHiddenCallingSelectors'
classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail
DebuggingDebugger VerboseBacktraceDefault DefaultIcon
DefaultDebuggerBackgroundColor InitialNCHAINShown'
poolDictionaries:''
category:'Interface-Debugger'
!
!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.
"
!
documentation
"
This class implements a graphical debugger interface.
The debugger usually sits on top of the faulting process,
taking over its event processing.
(this is different from other Smalltalk debuggers, which control
the debuggee as a separate process. Consider this an historic
leftover - the debugger was one of the first applications written for
ST/X; however, why should we change it without a particular need ...).
Only the 'stopped' debugged 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 destroyed 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.
[author:]
Claus Gittinger
[see also:]
Exception Signal
Process
"
! !
!DebugView class methodsFor:'initialization'!
initialize
InitialNCHAINShown := 20.
"/ DefaultDebuggerBackgroundColor := Color red lightened.
"/ DefaultDebuggerBackgroundColor := Color blue lightened lightened.
"Created: 20.3.1997 / 16:53:37 / cg"
"Modified: 20.3.1997 / 16:54:32 / cg"
!
reinitialize
self newDebugger
! !
!DebugView class methodsFor:'instance creation'!
enter
"enter a debugger"
<context: #return>
self enter:thisContext sender withMessage:'debugger entered' mayProceed:true.
!
enter:aContext withMessage:aString
"enter a debugger"
<context: #return>
^ self
enter:aContext
withMessage:aString
mayProceed:true
!
enter:aContext withMessage:aString mayProceed:mayProceed
"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."
<context: #return>
|active|
StepInterruptPending := nil.
ControlInterrupt handle:[:ex |
'DebugView [info]: breakpoint in debugger setup ignored [enter.]' infoPrintCR.
('DebugView [info]: breakpoint on:' , ex suspendedContext printString) infoPrintCR.
ex proceed
] do:[
"
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:[
active := Processor activeProcess.
OpenDebuggers do:[:aDebugger |
(aDebugger inspectedProcess == active) ifTrue:[
aDebugger device isOpen ifTrue:[
"/ 'entering stepping debugger again' printNL.
aDebugger unstep.
aDebugger setLabelFor:aString in:active.
aDebugger mayProceed:mayProceed.
^ aDebugger enter:aContext select:nil.
]
]
]
].
].
^ self enterUnconditional:aContext withMessage:aString mayProceed:mayProceed
"Modified: / 18.11.2001 / 00:48:03 / cg"
!
enterUnconditional:aContext withMessage:aString mayProceed:mayProceed
"enter a debugger - do not check for recursive invocation"
<context: #return>
|aDebugger|
StepInterruptPending := nil.
"/ ignore halts & breakpoints while setting up the debugger
"/ to avoid recursive debugging ...
ControlInterrupt handle:[:ex |
'DebugView [info]: breakpoint in debugger setup ignored [enterUncond.]' infoPrintCR.
('DebugView [info]: breakpoint on:' , ex suspendedContext printString) infoPrintCR.
ex proceed
] do:[
aDebugger := self new.
].
aDebugger isNil ifTrue:[
'DebugView [error]: cannot open debugger' errorPrintCR.
'DebugView [error]: Exception: ' errorPrint. aString errorPrintCR.
mayProceed ifTrue:[
(Dialog confirm:'Error/Breakpoint cought.\\Press Continue or Abort.' withCRs
yesLabel:'Continue' noLabel:'Abort')
ifTrue:[
^ nil
].
] ifFalse:[
self information:'Error cought.\\Press OK to abort the operation.' withCRs.
].
AbortOperationRequest raise.
"not reached"
].
aDebugger mayProceed:mayProceed.
aDebugger setLabelFor:aString in:Processor activeProcess.
aDebugger enter:aContext select:nil.
^ nil.
"
nil halt
"
"Modified: / 18.11.2001 / 00:29:23 / cg"
!
enterWithMessage:message
"enter a debugger"
<context: #return>
self enter:(thisContext sender) withMessage:message mayProceed:true.
!
new
"return a new DebugView.
- return a cached debugger if it already exists.
Also, care for remote displays on which no debugger is wanted
(ask with mayOpenDebugger) - if so, open on the default screen."
|debugger currentScreen debuggerDevice|
currentScreen := Screen current.
currentScreen notNil ifTrue:[
(currentScreen suppressDebugger) ifTrue:[
"/ no debuggers with that device - show an alertBox which aborts...
^ nil.
].
(currentScreen mayOpenDebugger) ifFalse:[
"/ no debugger on that device - but on the main screen
currentScreen := Screen default.
].
].
"
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:[
((debugger := CachedExclusive) isNil
or:[debugger device ~~ currentScreen
or:[currentScreen isNil
or:[currentScreen isOpen not]]]) ifTrue:[
debugger := self newExclusive
].
CachedExclusive := nil.
] ifFalse:[
CachedDebugger notNil ifTrue:[
(CachedDebugger device ~~ currentScreen
or:[currentScreen isNil
or:[currentScreen isOpen not]]) ifTrue:[
CachedDebugger := nil
]
].
(debugger := CachedDebugger) notNil ifTrue:[
CachedDebugger := nil.
] ifFalse:[
debuggerDevice := currentScreen.
debuggerDevice isNil ifTrue:[
"/ use the default display
debuggerDevice := Screen default.
].
(debuggerDevice isNil
or:[debuggerDevice isOpen not
"/ or:[debuggerDevice mayOpenDebugger not]
]) ifTrue:[
"/ no debugger
^ nil.
].
Screen currentScreenQuerySignal answer:debuggerDevice
do:[
debugger := super new.
].
debugger label:'Debugger'.
debugger icon:self defaultIcon.
]
].
^ debugger
"Modified: 31.7.1997 / 21:20:27 / cg"
!
newExclusive
"return a debugger for exclusive display access"
|debugger|
debugger := super new.
debugger label:'Debugger'.
debugger icon:self defaultIcon.
debugger exclusive:true.
^ debugger
"Modified: 1.1.1970 / 23:27:06 / cg"
!
openOn:aProcess
"start a debugger on aProcess
(actually not more than a good-looking inspector)"
|aDebugger label nm|
aDebugger := super new.
aDebugger icon:self defaultIcon.
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 iconLabel:'Debugger'.
aDebugger openOn:aProcess.
^ nil
"Modified: 4.4.1997 / 16:22:36 / cg"
! !
!DebugView class methodsFor:'cleanup'!
lowSpaceCleanup
"in low memory situations, give up cached debuggers"
CachedDebugger := nil.
CachedExclusive := nil.
OpenDebuggers := nil.
"
DebugView lowSpaceCleanup
"
"Modified: 18.4.1996 / 16:48:03 / cg"
!
newDebugger
"force creation of a new debugger (give up cached debuggers)"
CachedDebugger := nil.
CachedExclusive := nil.
OpenDebuggers := nil.
(Debugger isBehavior and:[Debugger name = #DebugView]) ifTrue:[
Debugger := self
].
"
DebugView newDebugger
"
! !
!DebugView class methodsFor:'defaults'!
defaultIcon
"return the debuggers default window icon"
<resource: #style (#ICON #ICON_FILE)>
|nm i resources|
(i := DefaultIcon) isNil ifTrue:[
resources := self classResources.
i := resources at:'ICON' default:nil.
i isNil ifTrue:[
nm := resources at:'ICON_FILE' default:'Debugger.xbm'.
i := Smalltalk imageFromFileNamed:nm forClass:self.
i isNil ifTrue:[
i := StandardSystemView defaultIcon
]
].
i notNil ifTrue:[
DefaultIcon := i := i onDevice:Display
]
].
^ i
"Modified: / 19.3.1997 / 20:48:34 / ca"
"Modified: / 17.11.2001 / 23:09:45 / cg"
!
defaultVerboseBacktrace
^ VerboseBacktraceDefault
"Created: 11.1.1997 / 12:14:35 / cg"
!
defaultVerboseBacktrace:aBoolean
VerboseBacktraceDefault := aBoolean
"Created: 11.1.1997 / 12:14:44 / cg"
!
updateStyleCache
"extract values from the styleSheet and cache them in class variables"
<resource: #style (#'debugView.viewBackgroundColor')>
DefaultDebuggerBackgroundColor := StyleSheet at:#'debugView.viewBackgroundColor'
"Modified: / 17.11.2001 / 17:31:42 / cg"
! !
!DebugView class methodsFor:'menu specs'!
menuSpec
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:DebugView andSelector:#menuSpec
(Menu new fromLiteralArrayEncoding:(DebugView menuSpec)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'View'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: canShowMore
label: 'Show more WalkBack'
itemValue: showMore
translateLabel: true
)
(MenuItem
label: 'Show verbose WalkBack'
itemValue: toggleVerboseWalkback
translateLabel: true
isVisible: showingDenseWalkback
)
(MenuItem
label: 'Show dense WalkBack'
itemValue: toggleVerboseWalkback
translateLabel: true
isVisible: showingVerboseWalkback
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Exit'
itemValue: closeRequest
translateLabel: true
isVisible: isInspecting
)
(MenuItem
label: 'Close Debugger and Abort'
itemValue: closeRequest
translateLabel: true
isVisible: isNotInspecting
)
)
nil
nil
)
)
(MenuItem
label: 'Process'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Continue'
itemValue: doContinue
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Abort'
itemValue: doAbort
translateLabel: true
)
(MenuItem
enabled: abortAllIsHandled
label: 'Abort All'
itemValue: doAbortAll
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Terminate'
itemValue: doTerminate
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'Context'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: canReturn
label: 'Return'
itemValue: doReturn
translateLabel: true
)
(MenuItem
enabled: canRestart
label: 'Restart'
itemValue: doRestart
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasContextSelected
label: 'Inspect'
itemValue: inspectContext
translateLabel: true
)
(MenuItem
label: 'Copy WalkBack Text'
itemValue: copyWalkbackText
translateLabel: true
)
(MenuItem
label: 'Bookmark Method in SystemBrowser'
itemValue: addBrowserBookmark
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'Class'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: canBrowseImplementingClass
label: 'Browse Implementing Class'
itemValue: browseImplementingClass
translateLabel: true
)
(MenuItem
enabled: canBrowseReceiversClass
label: 'Browse Receivers Class'
itemValue: browseReceiversClass
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: canBrowseClassHierarchy
label: 'Browse Receivers Class Hierarchy'
itemValue: browseClassHierarchy
translateLabel: true
)
(MenuItem
enabled: canBrowseFullClassProtocol
label: 'Browse Receivers Full Protocol'
itemValue: browseFullClassProtocol
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'Selector'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Browse Implementors...'
itemValue: browseImplementorsOf
translateLabel: true
)
(MenuItem
label: 'Browse Senders...'
itemValue: browseSendersOf
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: canDefineMethod
label: 'Define'
itemValue: doDefineMethod
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'Breakpoint'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: canRemoveBreakpoint
label: 'Remove'
itemValue: removeBreakpoint
translateLabel: true
)
(MenuItem
label: 'Remove all Breakpoints'
itemValue: removeAllBreakpoints
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: canAddBreakpoint
label: 'Add'
itemValue: addBreakpoint
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Allow Breakpoints in Debugger'
itemValue: allowBreakPointsInDebugger:
translateLabel: true
indication: allowBreakPointsInDebugger
)
)
nil
nil
)
)
(MenuItem
label: 'Help'
translateLabel: true
startGroup: right
submenu:
(Menu
(
(MenuItem
label: 'Debuggers Documentation'
itemValue: openHTMLDocument:
translateLabel: true
argument: 'tools/debugView/TOP.html'
)
(MenuItem
label: '-'
)
(MenuItem
label: 'About DebugView...'
itemValue: openAboutThisApplication
translateLabel: true
)
)
nil
nil
)
)
)
nil
nil
)
! !
!DebugView class methodsFor:'misc'!
interestingContextFrom:aContext
"return an interesting context to be shown in an error notifier.
We move up the calling chain, skipping intermediate Signal
and Exception contexts, to present the context in which the error
actually occured.
Just for your convenience :-)"
|someContexts con idx|
someContexts := Array new:25.
con := aContext.
idx := 1.
[(idx <= someContexts size) and:[con notNil]] whileTrue:[
someContexts at:idx put:con.
con := con sender.
idx := idx + 1.
].
idx := self interestingContextIndexIn:someContexts.
^ someContexts at:idx.
!
interestingContextIndexIn:aContextArray
"return an interesting contexts offset, or nil.
This is the context initially shown in the walkback.
We move up the calling chain, skipping all intermediate Signal
and Exception contexts, to present the context in which the error
actually occured.
Just for your convenience :-)"
|con found offset sel prev ex rcvr nMax idx|
nMax := aContextArray size.
nMax <= 1 ifTrue:[^ 1].
con := aContextArray at:1.
con isBlockContext ifTrue:[^ 1].
"/ somewhere, at the bottom, there must be a raise ...
"/ find the exception
1 to:5 do:[:i |
con := aContextArray at:i ifAbsent:nil.
con notNil ifTrue:[
sel := con selector.
((sel == #halt) or:[sel == #halt:]) ifTrue:[
^ i + 1
].
((sel == #raise) or:[sel == #raiseRequest]) ifTrue:[
rcvr := con receiver.
(rcvr isLazyValue not and:[rcvr isException]) ifTrue:[
ex := rcvr.
offset := i.
found := con
] ifFalse:[
(rcvr isLazyValue not and:[rcvr isExceptionCreator]) ifTrue:[
offset := i.
found := con
]
]
].
].
].
"
if this is a noHandler exception, skip forward
to the erronous context
"
ex notNil ifTrue:[
ex signal == Signal noHandlerSignal ifTrue:[
found := ex suspendedContext
]
].
found isNil ifTrue:[
"/ this is a kludge, but convenient.
"/ show the place where the error (divisionByZero...) happend,
"/ not where the signal was raised.
sel := (aContextArray at:1) methodHome selector.
"/ typically a DivisionByZero - show caller of division
(sel == #//
or:[sel == #/
or:[sel == #\\]]) ifTrue:[
^ 2
].
"/ show the place of the bad message; not where the Signal was raised...
(sel == #doesNotUnderstand:) ifTrue:[
^ 3 min:nMax
].
"/ show the bad method; not where the Signal was raised...
(sel == #noByteCode) ifTrue:[
^ 2
].
"/ show the place of the halt; not where the HaltSignal was raised...
((sel == #halt) or:[sel == #halt:]) ifTrue:[
^ 2
].
"/ show the place of error-call; not where the ErrorSignal was raised...
(sel == #error:mayProceed:) ifTrue:[
nMax > 2 ifTrue:[
sel := (aContextArray at:2) selector.
sel == #mustBeBoolean ifTrue:[
^ 3
].
sel == #assert:message: ifTrue:[
nMax > 3 ifTrue:[
sel := (aContextArray at:3) selector.
sel == #assert: ifTrue:[
nMax > 4 ifTrue:[
sel := (aContextArray at:4) selector.
sel == #deny: ifTrue:[
^ 5
]
].
^ 4
].
^ 3
].
].
].
^ 2
].
"/ show the place of signalInterrupt-call; not where the Signal was raised...
(sel == #signalInterrupt:) ifTrue:[
^ 2
].
"/ show the place of error-call; not where the ErrorSignal was raised...
(sel == #error:) ifTrue:[
^ 2
].
"/ show the place of the assert; not where the Signal was raised...
(sel == #assert:) ifTrue:[
nMax > 2 ifTrue:[
sel := (aContextArray at:2) selector.
sel == #deny: ifTrue:[
^ 3
].
].
^ 2
].
"/ show the place of the send; not where the Signal was raised...
(sel == #subclassResponsibility) ifTrue:[
^ 2
].
"/ show the place of the bad index; not where the Signal was raised...
( #(#notIndexed
#indexNotIntegerOrOutOfBounds:
#subscriptBoundsError:
#elementBoundsError:
"/ #subclassResponsibility
) includes:sel) ifTrue:[
idx := 2.
[ idx <= 3
and:[
sel := (aContextArray at:idx) selector.
#(#notIndexed
#indexNotIntegerOrOutOfBounds:
#subscriptBoundsError:
#elementBoundsError: ) includes:sel
]
] whileTrue:[ idx := idx + 1 ].
sel := (aContextArray at:idx) selector.
(nMax > idx and:[ #(#basicAt: #basicAt:put: #at: #at:put: ) includes:sel])
ifTrue:[
sel := (aContextArray at:idx+1) selector.
(nMax > (idx+1) and:[ #(#basicAt: #basicAt:put: #at: #at:put: ) includes:sel])
ifTrue:[
sel := (aContextArray at:idx+2) selector.
(nMax > (idx+2) and:[ #(#basicAt: #basicAt:put: #at: #at:put: ) includes:sel])
ifTrue:[
^ idx+3
].
^ idx+2
].
^ idx+1
].
^ idx
].
^ 1
].
con := found.
"
got it; move up, skipping all intermediate Signal and
Exception contexts
"
prev := nil.
rcvr := con receiver.
[
rcvr isLazyValue not and:[(rcvr isExceptionHandler) or:[(rcvr isException)]]
] whileTrue:[
prev := con.
nMax > offset ifFalse:[^ offset].
offset := offset + 1.
con := aContextArray at:offset.
rcvr := con receiver.
].
"
now, we are one above the raising context
"
"
if the sender-method of the raise is one of objects error methods ...
"
( #( halt halt:
error error:
doesNotUnderstand:
subclassResponsibility
primitiveFailed) includes:con selector)
ifTrue:[
con selector == #doesNotUnderstand: ifTrue:[
"
one more up, to get to the originating context
"
con := aContextArray at:(offset + 1).
con isNil ifTrue:[^ offset].
offset := offset + 1.
].
con := aContextArray at:(offset + 1).
con isNil ifTrue:[^ offset].
offset := offset + 1.
] ifFalse:[
"
ok, got the raise - if its a BreakPoint, look for the sender
"
(prev receiver == BreakPointInterrupt) ifTrue:[
offset := offset + 1
].
].
^ offset
"Created: / 17.11.2001 / 20:37:49 / cg"
"Modified: / 17.11.2001 / 21:44:06 / cg"
! !
!DebugView methodsFor:'basic'!
enableDisableActions
|m|
m := contextView middleButtonMenu.
m notNil ifTrue:[
self updateMenuItems.
(inspecting or:[AbortOperationRequest isHandled]) ifTrue:[
abortButton enable.
m enable:#doAbort.
] ifFalse:[
abortButton disable.
m disable:#doAbort.
].
exclusive ifTrue:[
terminateButton disable.
m disable:#doTerminate.
] ifFalse:[
terminateButton enable.
m enable:#doTerminate.
]
].
mayProceed == false ifTrue:[
continueButton disable.
m notNil ifTrue:[m disable:#doContinue].
] ifFalse:[
continueButton enable.
m notNil ifTrue:[m enable:#doContinue]
].
"Created: / 16.11.2001 / 17:40:51 / cg"
!
enter:aContext select:initialSelectionOrNil
"enter the debugger - get and display the context, then start an
exclusive event loop on top of eveything else"
<context: #return>
|con m enteredByInterrupt sel iAmNew foundNoByteCodeContext foundExitContext c|
DebuggingDebugger == true ifTrue:[
'==> enter: (' print. aContext print.
') select: ' print. initialSelectionOrNil printCR.
].
thisContext isRecursive ifTrue:[
"/ care for the special case, were the Debugger was autoloaded.
"/ in this case, thisContext IS recursive, but thats no error
"/ condition.
foundNoByteCodeContext := false.
foundExitContext := false.
c := thisContext findNextContextWithSelector:#enter:withMessage:mayProceed: or:#noByteCode or:#exit_unwindThenDo:.
[
foundNoByteCodeContext not
and:[ foundExitContext not
and:[c notNil
and:[c selector ~~ #enter:withMessage:mayProceed:
]]]]
whileTrue:[
c selector == #exit_unwindThenDo: ifTrue:[
foundExitContext := true
].
c selector == #noByteCode ifTrue:[
foundNoByteCodeContext := true
].
c := c findNextContextWithSelector:#enter:withMessage:mayProceed: or:#noByteCode or:#exit_unwindThenDo:.
].
(foundNoByteCodeContext not
and:[ foundExitContext not]) ifFalse:[
('DebugView [warning]: reentered') errorPrintCR.
^ MiniDebugger
enter:aContext
withMessage:'DebugView [error]: recursive error (in debugger)'
mayProceed:mayProceed.
].
foundExitContext ifTrue:[
'DebugView [error]: recursive error (in debugger) ignored' printCR.
^ self.
].
].
"/'entering: ' print. aContext printCR.
"/'initial: ' print. initialSelectionOrNil printCR.
iAmNew := drawableId isNil.
verboseBacktrace := VerboseBacktraceDefault ? false.
thisContext sender fixAllLineNumbers. "/ _CONTEXTLINENOS(s)
busy := cachable := true.
inspecting := false.
inspectedProcess := Processor activeProcess.
stepping := false.
bigStep := false.
stepHow := nil.
nChainShown := InitialNCHAINShown.
"/ if debugger is entered while a box has grabbed the
"/ pointer, we must ungrab - otherwise X wont talk to us here.
"/ On a multiUser system, ungrab all of them ...
"/ Q: this is good for multi-screen apps (where an error should not happen),
"/ but not for multi-user development, where the debugger is entered often.
"/ What is a good solution to this dilemma ?
Screen allScreens do:[:aScreen |
aScreen ungrabPointer.
aScreen ungrabKeyboard.
].
("inspectedProcess suspendedContext isNil
or:["inspectedProcess isSystemProcess"]") ifTrue:[
terminateButton disable.
] ifFalse:[
terminateButton enable.
abortButton enable.
].
iAmNew ifFalse:[
"/ not the first time - disable buttons & menus
"/ from the previous life
self turnOffAllButtons.
m := contextView middleButtonMenu.
m notNil ifTrue:[
m disableAll:#(showMore "skip skipForReturn" inspectContext).
].
verboseBacktrace
ifTrue:[self showVerboseWalkback]
ifFalse:[self showDenseWalkback].
].
self iconLabel:'Debugger'.
windowGroup isNil ifTrue:[
self windowGroup: WindowGroup new.
windowGroup addTopView:self.
].
exclusive ifFalse:[
"/ create a (modal) windowGroup for myself
windowGroup setModal:true.
] ifTrue:[
"/ create a windowGroup with a synchronous sensor for me
windowGroup beSynchronous.
].
windowGroup setProcess:Processor activeProcess.
"
get the walkback list; clear inspectors if we did not come here by single stepping)
"
self setContext:aContext releaseInspectors:(exitAction ~~ #step).
"/'after setContext; first is ' print.
"/(contextArray at:1 ifAbsent:nil) printCR.
self setInitialSelectionOnEntry:initialSelectionOrNil context:aContext.
m := contextView middleButtonMenu.
m notNil ifTrue:[
self updateMenuItems.
(inspecting or:[AbortOperationRequest isHandledIn:aContext]) ifTrue:[
abortButton enable.
m enable:#doAbort.
] ifFalse:[
abortButton disable.
m disable:#doAbort.
].
exclusive ifTrue:[
terminateButton disable.
m disable:#doTerminate.
] ifFalse:[
terminateButton enable.
m enable:#doTerminate.
].
iAmNew ifFalse:[
m disableAll:#(showMore "skip skipForReturn" inspectContext).
].
].
mayProceed == false ifTrue:[
continueButton disable.
m notNil ifTrue:[m disable:#doContinue].
] ifFalse:[
continueButton enable.
m notNil ifTrue:[m enable:#doContinue]
].
"
If this is a new debugger, do a realize.
Otherwise, its probably better to do a map, which shows the
view at the previous position, without a need for the user to set the
position again
"
iAmNew ifFalse:[
self remap.
] ifTrue:[
self realize.
].
exclusive ifTrue:[
self showError:'
Debugging system process `' , (inspectedProcess nameOrId) printString , '''.
This is a modal debugger - all event processing is stopped..
Therefore, you cannot interact with other views or
open any other tools while this debugger is active.
Also, there is no event processing (redraw) for other views.'
].
self raise.
canContinue := true.
exitAction := nil.
"/ enter private event handling loop. This is left (and we come back here again)
"/ when any button was pressed which requires continuation of the debuggee or
"/ closedown of the debugger.
[self controlLoop] ifCurtailed:[
windowGroup notNil ifTrue:[
windowGroup setProcess:nil.
].
self destroy
].
"/ release all context stuff.
"/ This is required to avoid keeping references to the debuggees objects
"/ forever. (since the debugger is reused for faster startup next time)
contextView contents:nil.
codeView acceptAction:nil.
codeView doItAction:nil.
ObjectMemory stepInterruptHandler == self ifTrue:[
ObjectMemory stepInterruptHandler:nil.
].
"/ not stepping - close window
(exitAction ~~ #step) ifTrue:[
lastSelectionInReceiverInspector := receiverInspector selectedKeyName.
lastSelectionInContextInspector := contextInspector selectedKeyName.
receiverInspector release.
contextInspector release.
self unmap.
device flush.
(exitAction == #abort) ifTrue:[
self exit_abort.
].
(exitAction == #abortAll) ifTrue:[
self exit_abortAll.
].
(exitAction == #return) ifTrue:[
self exit_return.
].
(exitAction == #restart) ifTrue:[
self exit_restart.
].
(exitAction == #quickTerminate) ifTrue:[
self exit_quickTerminate.
].
(exitAction == #terminate) ifTrue:[
self exit_terminate.
]
].
"/ stepping - window stays open
selectedContext := actualContext := firstContext := nil.
"/ restore the previous pointer grab
grabber notNil ifTrue:[
device grabPointerInView:grabber.
grabber := nil.
].
(exitAction == #step) ifTrue:[
"
schedule another stepInterrupt
- must enter myself into the collection of open debuggers,
in case the stepping process comes back again via a halt or signal
before the step is finished. In this case, the stepping debugger should
come up (instead of a new one)
- must flush caches since optimized methods not always
look for pending interrupts
"
"/
"/ also must care for stepping into a return
"/
steppedContext notNil ifTrue:[
Processor activeProcess forceInterruptOnReturnOf:steppedContext.
].
OpenDebuggers isNil ifTrue:[
OpenDebuggers := WeakIdentitySet new.
].
OpenDebuggers add:self.
self label:'single stepping - please wait ...'.
stepping := true.
ObjectMemory stepInterruptHandler:self.
Processor activeProcess stepInterruptHandler:self.
ObjectMemory flushCaches.
Context singleStepInterruptRequest isHandled ifTrue:[
"bigStep" steppedContextLineno notNil ifTrue:[
Context singleStepInterruptRequest raiseWith:#next
] ifFalse:[
Context singleStepInterruptRequest raiseWith:#step
]
] ifFalse:[
"/ see if we came here through an interrupt-action
"/ (i.e. aProcess interruptWith:...)
enteredByInterrupt := false.
con := thisContext findNextContextWithSelector:#timerInterrupt or:#ioInterrupt or:nil.
[enteredByInterrupt not
and:[con notNil
and:[con ~~ aContext]]] whileTrue:[
((sel := con selector) == #timerInterrupt
or:[sel == #ioInterrupt]) ifTrue:[
enteredByInterrupt := true.
] ifFalse:[
con := con findNextContextWithSelector:#timerInterrupt or:#ioInterrupt or:nil.
].
].
ObjectMemory flushInlineCaches.
DebuggingDebugger == true ifTrue:[
enteredByInterrupt printCR.
].
enteredByInterrupt ifTrue:[
"/ dont want to step through all intermediate
"/ (scheduler-) contexts; place a return-trap on the
"/ one right below the interesting one
"/ 'special unwind return' printCR.
con unwindThenDo:[
Processor activeProcess stepInterruptHandler:self.
ObjectMemory stepInterruptHandler:self.
InStepInterrupt := nil.
StepInterruptPending := 1.
InterruptPending := 1].
] ifFalse:[
"/ 'normal step return' printCR.
skipLineNr ~~ #return ifTrue:[
StepInterruptPending := 1.
InterruptPending := 1.
] ifFalse:[
"/ 'step for return' printCR.
]
].
InStepInterrupt := nil
]
] ifFalse:[
OpenDebuggers notNil ifTrue:[
OpenDebuggers remove:self ifAbsent:[].
].
self cacheMyself.
]
"Modified: / 17.4.1997 / 13:01:32 / stefan"
"Created: / 30.10.1997 / 21:08:18 / cg"
"Modified: / 13.10.1998 / 19:56:59 / ps"
"Modified: / 18.11.2001 / 00:48:47 / cg"
!
exit_abort
"/ cannot simply raise an abort here, because if there is an abortHandler somewhere,
"/ that one would run on top of this context.
"/ Therefore, any controlInterrupt(i.e. halt) or reentering of the debugger from that handler
"/ would be interpreted as a recursive invocation (in #enter:select).
"/ To avoid this, we unwind all contexts and simulate the raise as if it was
"/ done in the #enter:select method.
"/ You are not expected to understand this.
self exit_unwindThenDo:[ AbortOperationRequest raise ]
!
exit_abortAll
"/ cannot simply raise an abort here, because if there is an abortHandler somewhere,
"/ that one would run on top of this context.
"/ Therefore, any controlInterrupt(i.e. halt) or reentering of the debugger from that handler
"/ would be interpreted as a recursive invocation (in #enter:select).
"/ To avoid this, we unwind all contexts and simulate the raise as if it was
"/ done in the #enter:select method.
"/ You are not expected to understand this.
self exit_unwindThenDo:[ AbortAllOperationRequest raise ]
!
exit_quickTerminate
self cacheMyself.
Processor activeProcess terminateNoSignal
"Created: / 16.11.2001 / 17:23:51 / cg"
"Modified: / 17.11.2001 / 23:20:07 / cg"
!
exit_restart
|con|
selectedContext notNil ifTrue:[
con := selectedContext.
self cacheMyself.
"
have to catch errors occuring in unwind-blocks
"
Error handle:[:ex |
'DebugView [info]: ignored error while unwinding: ' infoPrint.
ex description infoPrintCR.
ex proceed
] do:[
con unwindAndRestart.
].
'DebugView [warning]: cannot restart selected context' errorPrintCR
]
"Created: / 16.11.2001 / 17:23:17 / cg"
"Modified: / 17.11.2001 / 23:37:09 / cg"
!
exit_return
|con retVal|
selectedContext notNil ifTrue:[
"
if there is a selection in the codeView,
evaluate it and use the result as return value
"
"/ disabled for now, there is almost always a selection (the current line)
"/ and that is syntactically incorrect ...
"/ ... leading to a popup warning from the codeView
"/
"/ codeView hasSelection ifTrue:[
"/ Error handle:[:ex |
"/ 'DebugView [warning]: error - returning nil' errorPrintCR.
"/ retVal := nil.
"/ ex return
"/ ] do:[
"/ |s|
"/
"/ s := codeView selection asString.
"/ retVal := codeView doItAction value:s.
"/ ].
"/ ].
con := selectedContext.
self cacheMyself.
"
have to catch errors occuring in unwind-blocks
"
Error handle:[:ex |
'DebugView [info]: ignored error while unwinding: ' infoPrint.
ex description infoPrintCR.
ex proceed
] do:[
con unwind:retVal.
].
'DebugView [warning]: cannot return from selected context' errorPrintCR
]
"Created: / 16.11.2001 / 17:22:24 / cg"
"Modified: / 17.11.2001 / 23:20:21 / cg"
!
exit_terminate
"
have to catch errors occuring in unwind-blocks
"
Error handle:[:ex |
'DebugView [info]: ignored error while unwinding: ' infoPrint.
ex description infoPrintCR.
ex proceed
] do:[
self cacheMyself.
Processor activeProcess terminate.
].
'DebugView [warning]: cannot terminate process' errorPrintCR
"Created: / 16.11.2001 / 17:24:20 / cg"
"Modified: / 17.11.2001 / 23:20:27 / cg"
!
exit_unwindThenDo:aBlock
|con|
"/ cannot simply raise an abort here, because if there is an abortHandler somewhere,
"/ that one would run on top of this context.
"/ Therefore, any controlInterrupt(i.e. halt) or reentering of the debugger from that handler
"/ would be interpreted as a recursive invocation (in #enter:select).
"/ To avoid this, we unwind all contexts and simulate the raise as if it was
"/ done in the #enter:select method.
"/ You are not expected to understand this.
"
have to catch errors occuring in unwind-blocks
"
self cacheMyself.
Error handle:[:ex |
'DebugView [info]: ignored error while unwinding: ' infoPrint.
ex description infoPrintCR.
ex proceed
] do:[
"/ find the enter:select context.
con := thisContext sender.
[
(con selector == #enter:select:)
and:[con receiver == self]
]
whileFalse:[ con := con sender ].
"/ must skip over its caller (because this one has a ControlInterrupt handler too)
con sender receiver == self class ifTrue:[
con := con sender.
con sender receiver == self class ifTrue:[
con := con sender.
con isBlockContext ifTrue:[
con := con methodHome.
]
].
].
con unwindThenDo:aBlock.
].
'DebugView [warning]: abort failed' errorPrintCR
"Created: / 16.11.2001 / 17:20:45 / cg"
"Modified: / 18.11.2001 / 00:58:14 / cg"
!
initialSelectionOnEntry:initialSelectionOrNil context:aContext
|selection con1 con2 h|
initialSelectionOrNil notNil ifTrue:[
^ initialSelectionOrNil
].
"
and find the one context to show initially
- if we came here by a send (single step), its the top context;
- if we came here by a step (i.e. bigStep), its the top context
(for ifs and whiles) or the sender (for regular sends).
- otherwise, we came here by some signal raise, and we are interested
in the context where the raise actually occured.
"
con1 := (contextArray at:1 ifAbsent:nil).
con2 := (contextArray at:2 ifAbsent:nil).
exitAction == #step ifTrue:[
selection := 1.
steppedContext notNil ifTrue:[
"
if we came here by a big-step, show the method where we are
"
con1 == steppedContext ifTrue:[
selection := 1
] ifFalse:[
con2 == steppedContext ifTrue:[
selection := 2
]
].
"
for bigStep, we could also be in a block below the actual method ...
"
((h := con1 home) notNil
and:[h == steppedContext]) ifTrue:[
selection := 1
] ifFalse:[
(con2 notNil
and:[(h := con2 home) notNil
and:[h == steppedContext]]) ifTrue:[
selection := 2
]
].
h := nil.
]
] ifFalse:[
steppedContext isNil ifTrue:[
"
preselect a more interesting context, (where halt/raise was ...)
"
"/ selection := self class interestingContextIndexFrom:aContext.
selection := self class interestingContextIndexIn:contextArray.
selection := selection min:(contextArray size).
] ifFalse:[
"
if we came here by a big-step, show the method where we are
"
con1 == steppedContext ifTrue:[
selection := 1
] ifFalse:[
con2 == steppedContext ifTrue:[
selection := 2.
]
]
]
].
^ selection
"Created: / 17.11.2001 / 20:26:26 / cg"
"Modified: / 17.11.2001 / 22:51:46 / cg"
!
isInspecting
^ inspecting
!
isNotInspecting
^ inspecting not
!
openOn:aProcess
"enter the debugger on a process -
in this case, we are just inspecting the context chain of the process,
not running on top of the debugged process, but as a separate
one. (think of it as an inspector showing more detail, and offering
some more control operations)"
|bpanel dummy w|
verboseBacktrace := VerboseBacktraceDefault ? false.
busy := true.
bigStep := false.
stepHow := nil.
inspecting := true.
inspectedProcess := aProcess.
nChainShown := InitialNCHAINShown.
bpanel := abortButton superView.
bpanel ignoreInvisibleComponents:true.
"/ get the max size & freeze button
continueButton label:(resources string:'Continue').
w := continueButton preferredExtent x.
continueButton label:(resources string:'Stop').
w := w max:(continueButton preferredExtent x).
continueButton preferredExtent:(w @ continueButton preferredExtent y).
aProcess state == #run ifTrue:[
device hasColors ifTrue:[
continueButton foregroundColor:Color red darkened.
].
continueButton label:(resources string:'Stop').
continueButton action:[self doStop].
] ifFalse:[
device hasColors ifTrue:[
continueButton foregroundColor:Color green darkened darkened.
].
continueButton label:(resources string:'Continue').
continueButton action:[self doContinue].
].
continueButton preferredExtent:(w @ continueButton preferredExtent y).
returnButton disable.
restartButton disable.
dummy := View extent:(10 @ 5) in:bpanel.
dummy borderWidth:0; level:0.
"/ stepButton destroy.
"/ sendButton destroy.
updateButton := Button
label:(resources string:'Update')
action:[self updateContext]
in:bpanel.
monitorToggle := Toggle in:bpanel.
monitorToggle label:(resources string:'Monitor').
monitorToggle pressAction:[self autoUpdateOn].
monitorToggle releaseAction:[self autoUpdateOff].
"can only look into process - context chain is not active"
canContinue := true.
terminateButton enable.
abortButton enable.
sendButton disable; beInvisible.
stepButton disable; beInvisible.
nextButton disable; beInvisible.
nextOverButton notNil ifTrue:[nextOverButton disable; beInvisible].
nextOutButton notNil ifTrue:[nextOutButton disable; beInvisible].
aProcess isNil ifTrue:[
terminateButton disable.
abortButton disable.
continueButton disable.
returnButton disable.
restartButton disable.
] ifFalse:[
(aProcess suspendedContext isNil
or:[aProcess isSystemProcess]) ifTrue:[
terminateButton disable.
].
self setContextSkippingInterruptContexts:aProcess suspendedContext.
catchBlock := [
catchBlock := nil.
contextArray := nil.
selectedContext := actualContext := firstContext := nil.
steppedContext := wrapperContext := nil.
(exitAction == #terminate) ifTrue:[
aProcess terminate.
].
(exitAction == #quickTerminate) ifTrue:[
aProcess terminateNoSignal.
].
super destroy
].
].
self open
"Modified: 20.3.1997 / 16:53:56 / cg"
"Modified: 17.4.1997 / 13:01:57 / stefan"
!
setInitialSelectionOnEntry:initialSelectionOrNil context:aContext
|selection|
selection := self initialSelectionOnEntry:initialSelectionOrNil context:aContext.
selection notNil ifTrue:[
self showSelection:selection.
contextView setSelection:selection.
selection > 1 ifTrue:[
contextView scrollToLine:(selection - 1)
]
].
"Created: / 16.11.2001 / 17:28:07 / cg"
"Modified: / 17.11.2001 / 20:27:21 / cg"
!
turnOffAllButtons
terminateButton turnOffWithoutRedraw.
continueButton turnOffWithoutRedraw.
returnButton turnOffWithoutRedraw.
restartButton turnOffWithoutRedraw.
abortButton turnOffWithoutRedraw.
nextButton turnOffWithoutRedraw.
stepButton turnOffWithoutRedraw.
sendButton turnOffWithoutRedraw.
"Created: / 16.11.2001 / 17:36:18 / cg"
! !
!DebugView methodsFor:'help'!
flyByHelpTextFor:aComponent
|s|
aComponent == abortButton ifTrue:[
s := 'Abort (Unwind to EventLoop)'
].
aComponent == terminateButton ifTrue:[
s := 'Terminate Process (Close View)'
].
aComponent == continueButton ifTrue:[
continueButton label = (resources string:'Stop') ifTrue:[
s := 'Stop'
] ifFalse:[
s := 'Continue Execution'
]
].
aComponent == stepButton ifTrue:[
s := 'Step to Next Send'
].
aComponent == nextButton ifTrue:[
s := 'Step to Next Line'
].
aComponent == nextOverButton ifTrue:[
s := 'Step Over'
].
aComponent == nextOutButton ifTrue:[
s := 'Step Out'
].
aComponent == sendButton ifTrue:[
s := 'Send Next Message'
].
aComponent == returnButton ifTrue:[
s := 'Return from selected Method'
].
aComponent == restartButton ifTrue:[
s := 'Restart selected Method'
].
aComponent == monitorToggle ifTrue:[
s := 'Toggle Monitoring'
].
aComponent == updateButton ifTrue:[
s := 'Update'
].
s notNil ifTrue:[
^ resources string:s
].
^ nil
"Modified: 29.8.1995 / 23:38:54 / claus"
"Modified: 4.3.1997 / 01:54:03 / cg"
!
helpTextFor:aComponent
|s|
aComponent == abortButton ifTrue:[
s := 'HELP_ABORT'
].
aComponent == terminateButton ifTrue:[
s := 'HELP_TERMINATE'
].
aComponent == continueButton ifTrue:[
continueButton label = (resources string:'Stop') ifTrue:[
s := 'HELP_STOP'
] ifFalse:[
s := 'HELP_CONTINUE'
]
].
aComponent == stepButton ifTrue:[
s := 'HELP_STEP'
].
aComponent == nextButton ifTrue:[
s := 'HELP_NEXT'
].
aComponent == nextOverButton ifTrue:[
s := 'HELP_NEXTOVER'
].
aComponent == nextOutButton ifTrue:[
s := 'HELP_NEXTOUT'
].
aComponent == stepButton ifTrue:[
s := 'HELP_STEP'
].
aComponent == sendButton ifTrue:[
s := 'HELP_SEND'
].
aComponent == returnButton ifTrue:[
s := 'HELP_RETURN'
].
aComponent == restartButton ifTrue:[
s := 'HELP_RESTART'
].
aComponent == contextView ifTrue:[
s := 'HELP_WALKBACK'
].
aComponent == codeView ifTrue:[
s := 'HELP_CODEVIEW'
].
aComponent == monitorToggle ifTrue:[
s := 'HELP_MONITOR'
].
aComponent == updateButton ifTrue:[
s := 'HELP_UPDATE'
].
"/ aComponent == stopButton ifTrue:[
"/ s := 'HELP_STOP'
"/ ].
(aComponent isComponentOf:receiverInspector) ifTrue:[
s := 'HELP_REC_INSP'
].
(aComponent isComponentOf:contextInspector) ifTrue:[
s := 'HELP_CON_INSP'
].
s notNil ifTrue:[
^ resources string:s
].
^ nil
"Modified: 29.8.1995 / 23:38:54 / claus"
"Modified: 4.3.1997 / 01:54:03 / cg"
! !
!DebugView methodsFor:'initialization & release'!
addToCurrentProject
"ignored here"
^ self
!
destroy
"closing the debugger implies an abort or continue"
|m|
self checkIfCodeIsReallyModified ifTrue:[
(self confirm:('Code modified - exit anyway ?'))
ifFalse:[
^ self
]
].
self autoUpdateOff.
(m := contextView middleButtonMenu) notNil ifTrue:[m hide].
inspecting ifFalse:[
"I am running on top of a process, abort or continue it"
windowGroup notNil ifTrue:[
windowGroup setProcess:nil.
].
self uncacheMyself.
"/
"/ catch invalid return;
"/ this happens, when my process has somehow died (quickterminate)
"/ and I am a leftOver view, which gets terminated via the launchers
"/ #destroy-window function.
"/
Context cannotReturnSignal handle:[:ex |
'DebugView [info]: OOPS - non regular debugView closing(1)' infoPrintCR.
self uncacheMyself.
Debugger newDebugger.
ex return.
] do:[
AbortOperationRequest isHandled ifTrue:[
self doAbort.
] ifFalse:[
self doContinue
]
].
"/ We don't reach this point normally
'DebugView [info]: OOPS - non regular debugView closing(2)' infoPrintCR.
Debugger newDebugger.
self uncacheMyself.
].
Debugger newDebugger.
"/ since I am going to be destroyed, remove me from the cache
self uncacheMyself.
super destroy.
"Modified: / 10.7.1997 / 17:15:41 / stefan"
"Modified: / 16.11.2001 / 17:38:15 / cg"
!
initialize
|menuPanel mH panel bpanel bH bpanel1 bH1 bpanel2 bH2 codePanel oldLayout v|
super initialize.
font := font onDevice:device.
verboseBacktrace := VerboseBacktraceDefault ? false.
ignoreBreakpoints := true. "/ ignore halts/breakpoints in doIts of
"/ the debugger
busy := false.
exclusive := false.
inspecting := false.
exitAction := nil.
bigStep := false.
stepHow := nil.
canContinue := false.
mH := 0.
menuPanel := MenuPanel in:self.
menuPanel verticalLayout:false.
menuPanel menu:(self class menuSpec).
menuPanel receiver:self.
mH := menuPanel preferredExtent y.
menuPanel origin:(0.0 @ 0.0) corner:(1.0 @ (mH)).
oldLayout := true.
"/ oldLayout := false.
oldLayout ifTrue:[
bpanel := HorizontalPanelView in:self.
self initializeButtonsIn:bpanel.
bH := bpanel preferredExtent y.
bpanel origin:(0.0 @ mH)
extent:(1.0 @ bH).
panel := VariableVerticalPanel
origin:(0.0 @ (mH + bH))
corner:(1.0 @ 1.0)
in:self.
v := self initializeContextListViewIn:panel.
v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25).
codePanel := View in:panel.
v := self initializeCodeViewIn:codePanel.
v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
codePanel origin:(0.0 @ 0.25) corner:(1.0 @ 0.75).
v := self initializeInspectorViewsIn:panel.
v origin:(0.0 @ 0.75) corner:(1.0 @ 1.0).
] ifFalse:[
bpanel1 := HorizontalPanelView in:self.
self initializeButtons1In:bpanel1.
bH1 := bpanel1 preferredExtent y.
bpanel1 origin:(0.0 @ mH)
extent:(1.0 @ bH1).
panel := VariableVerticalPanel
origin:(0.0 @ (mH + bH1))
corner:(1.0 @ 1.0)
in:self.
v := self initializeContextListViewIn:panel.
v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25).
codePanel := View in:panel.
bpanel2 := HorizontalPanelView in:codePanel.
self initializeButtons2In:bpanel2.
bH2 := bpanel2 preferredExtent y.
bpanel2 origin:(0.0 @ 0.0)
extent:(1.0 @ bH2).
v := self initializeCodeViewIn:codePanel.
v origin:(0.0 @ bH2) corner:(1.0 @ 1.0).
codePanel origin:(0.0 @ 0.25) corner:(1.0 @ 0.75).
v := self initializeInspectorViewsIn:panel.
v origin:(0.0 @ 0.75) corner:(1.0 @ 1.0).
].
DefaultDebuggerBackgroundColor notNil ifTrue:[
self allViewBackground:DefaultDebuggerBackgroundColor.
].
"
Debugger newDebugger
"
"Modified: / 17.11.2001 / 20:50:24 / cg"
!
initializeAbortButtonIn:bpanel
abortButton := Button
label:(resources string:'Abort')
action:[
abortButton turnOffWithoutRedraw.
self doAbort
]
in:bpanel.
"Created: / 17.11.2001 / 20:56:47 / cg"
"Modified: / 17.11.2001 / 20:57:17 / cg"
!
initializeButtons1In:bpanel
|separator|
bpanel horizontalLayout:#leftMax. "was: #left. "
bpanel verticalLayout:#centerMax.
bpanel verticalSpace:ViewSpacing // 2.
self initializeAbortButtonIn:bpanel.
"/ separator := View extent:(10 @ 5) in:bpanel.
"/ separator borderWidth:0; level:0.
self initializeContinueButtonIn:bpanel.
separator := View extent:(10 @ 5) in:bpanel.
separator borderWidth:0; level:0.
self initializeTerminateButtonIn:bpanel.
separator := View extent:(10 @ 5) in:bpanel.
separator borderWidth:0; level:0.
self initializeDefineButtonIn:bpanel.
(UserPreferences current allowSendMailFromDebugger and:[SendMailTool notNil]) ifTrue:[
self initializeReportButtonIn:bpanel.
].
"Modified: / 17.11.2001 / 21:02:59 / cg"
!
initializeButtons2In:bpanel
|separator|
bpanel horizontalLayout:#leftMax. "was: #left. "
bpanel verticalLayout:#centerMax.
bpanel verticalSpace:ViewSpacing // 2.
self initializeNextButtonIn:bpanel.
self initializeStepButtonIn:bpanel.
"/ cg:
"/ I disabled the stepIn / stepOut buttons - for now.
"/ they do not work relyable with inlined blocks yet.
"/
"/ img := Image fromFile:'bitmaps/stepIn.xpm'.
"/ img isNil ifTrue:[
"/ img := (resources at:'next')
"/ ].
"/ nextButton := Button
"/ label:img
"/ action:[stepButton turnOff. self doNext]
"/ in:bpanel.
"/
"/ img := Image fromFile:'bitmaps/stepOver.xpm'.
"/ img isNil ifTrue:[
"/ img := (resources at:'over')
"/ ].
"/ nextOverButton := Button
"/ label:img
"/ action:[stepButton turnOff. self doNextOver]
"/ in:bpanel.
"/
"/ img := Image fromFile:'bitmaps/stepOut.xpm'.
"/ img isNil ifTrue:[
"/ img := (resources at:'out')
"/ ].
"/ nextOutButton := Button
"/ label:img
"/ action:[stepButton turnOff. self doNextOut]
"/ in:bpanel.
self initializeSendButtonIn:bpanel.
separator := View extent:(30 @ 5) in:bpanel.
separator borderWidth:0; level:0.
self initializeReturnButtonIn:bpanel.
self initializeRestartButtonIn:bpanel.
"Modified: / 17.11.2001 / 21:01:38 / cg"
!
initializeButtonsIn:bpanel
|separator|
bpanel horizontalLayout:#left.
bpanel verticalLayout:#centerMax.
bpanel verticalSpace:ViewSpacing // 2.
self initializeAbortButtonIn:bpanel.
separator := View extent:(10 @ 5) in:bpanel.
separator borderWidth:0; level:0.
self initializeContinueButtonIn:bpanel.
separator := View extent:(10 @ 5) in:bpanel.
separator borderWidth:0; level:0.
self initializeReturnButtonIn:bpanel.
self initializeRestartButtonIn:bpanel.
separator := View extent:(10 @ 5) in:bpanel.
separator borderWidth:0; level:0.
self initializeNextButtonIn:bpanel.
self initializeStepButtonIn:bpanel.
"/ cg:
"/ I disabled the stepIn / stepOut buttons - for now.
"/ they do not work relyable with inlined blocks yet.
"/
"/ img := Image fromFile:'bitmaps/stepIn.xpm'.
"/ img isNil ifTrue:[
"/ img := (resources at:'next')
"/ ].
"/ nextButton := Button
"/ label:img
"/ action:[stepButton turnOff. self doNext]
"/ in:bpanel.
"/
"/ img := Image fromFile:'bitmaps/stepOver.xpm'.
"/ img isNil ifTrue:[
"/ img := (resources at:'over')
"/ ].
"/ nextOverButton := Button
"/ label:img
"/ action:[stepButton turnOff. self doNextOver]
"/ in:bpanel.
"/
"/ img := Image fromFile:'bitmaps/stepOut.xpm'.
"/ img isNil ifTrue:[
"/ img := (resources at:'out')
"/ ].
"/ nextOutButton := Button
"/ label:img
"/ action:[stepButton turnOff. self doNextOut]
"/ in:bpanel.
self initializeSendButtonIn:bpanel.
separator := View extent:(30 @ 5) in:bpanel.
separator borderWidth:0; level:0.
self initializeTerminateButtonIn:bpanel.
separator := View extent:(30 @ 5) in:bpanel.
separator borderWidth:0; level:0.
self initializeDefineButtonIn:bpanel.
(UserPreferences current allowSendMailFromDebugger and:[SendMailTool notNil]) ifTrue:[
self initializeReportButtonIn:bpanel.
].
"Created: / 17.11.2001 / 20:56:20 / cg"
"Modified: / 17.11.2001 / 21:03:18 / cg"
!
initializeCodeViewIn:panel
|v|
v := HVScrollableView
for:CodeView
miniScrollerH:true
miniScrollerV:false
in:panel.
"/ v autoHideScrollBars:true.
codeView := v scrolledView.
^ v
!
initializeContextListViewIn:panel
|v|
v := HVScrollableView
for:SelectionInListView
miniScrollerH:true
miniScrollerV:false
in:panel.
v autoHideHorizontalScrollBar:true.
contextView := v scrolledView.
contextView action:[:lineNr | self showSelection:lineNr].
contextView doubleClickAction:[:line | self browseImplementingClass].
contextView selectConditionBlock:[:line | self checkSelectionChangeAllowed:line].
contextView middleButtonMenu:(self middleButtonMenu).
^ v
!
initializeContextViewsMiddleButtonMenu
<resource: #programMenu >
contextView middleButtonMenu:(self middleButtonMenu).
!
initializeContinueButtonIn:bpanel
continueButton := Button
label:(resources string:'Continue')
action:[
continueButton turnOffWithoutRedraw.
self doContinue
]
in:bpanel.
"Created: / 17.11.2001 / 20:57:34 / cg"
!
initializeDefineButtonIn:bpanel
defineButton := Button
label:(resources string:'Define')
action:[
defineButton turnOffWithoutRedraw.
self doDefine
]
in:bpanel.
defineButton beInvisible
"Created: / 17.11.2001 / 21:02:48 / cg"
!
initializeInspectorViewsIn:panel
|hpanel|
hpanel := VariableHorizontalPanel in:panel.
receiverInspector := InspectorView
origin:(0.0 @ 0.0) corner:(0.5 @ 1.0)
in:hpanel.
receiverInspector fieldListLabel:'Receiver'.
contextInspector := ContextInspectorView
origin:(0.5 @ 0.0) corner:(1.0 @ 1.0)
in:hpanel.
contextInspector fieldListLabel:'Context'.
^ hpanel
!
initializeNextButtonIn:bpanel
nextButton := Button
label:(resources string:'Next')
action:[
stepButton turnOff.
self doNext
]
in:bpanel.
"Created: / 17.11.2001 / 20:59:38 / cg"
!
initializeReportButtonIn:bpanel
reportButton := Button
label:(resources string:'Report by Mail')
action:[
reportButton turnOffWithoutRedraw.
self doOpenReportMailApp.
]
in:bpanel.
"Created: / 17.11.2001 / 21:02:20 / cg"
!
initializeRestartButtonIn:bpanel
restartButton := Button
label:(resources string:'Restart')
action:[
restartButton turnOff.
self doRestart
]
in:bpanel.
"Created: / 17.11.2001 / 20:58:52 / cg"
!
initializeReturnButtonIn:bpanel
returnButton := Button
label:(resources string:'Return')
action:[
returnButton turnOff.
self doReturn
]
in:bpanel.
"Created: / 17.11.2001 / 20:58:22 / cg"
!
initializeSendButtonIn:bpanel
sendButton := Button
label:(resources string:'Send')
action:[
sendButton turnOff.
self doSend
]
in:bpanel.
"Created: / 17.11.2001 / 21:01:20 / cg"
!
initializeStepButtonIn:bpanel
stepButton := Button
label:(resources string:'Step')
action:[
stepButton turnOff.
self doStep
]
in:bpanel.
"Created: / 17.11.2001 / 21:00:13 / cg"
!
initializeTerminateButtonIn:bpanel
terminateButton := Button
label:(resources string:'Terminate')
action:[
terminateButton turnOffWithoutRedraw.
self doTerminate
]
in:bpanel.
"Created: / 17.11.2001 / 21:02:20 / cg"
!
middleButtonMenu
<resource: #programMenu >
|items m|
exclusive ifTrue:[
items := #(
('Show Longer WalkBack' showMore )
('Show Verbose WalkBack' showVerboseWalkback )
('-' )
('Add Breakpoint' addBreakpoint )
('Remove Breakpoint' removeBreakpoint )
('Remove all Trace & Breakpoints' removeAllBreakpoints )
('-' )
('Copy WalkBack Text' copyWalkbackText )
('-' )
('QuickTerminate' quickTerminate )
('=' )
('Exit Smalltalk (no Confirmation)' exit )
).
] ifFalse:[
items := #(
('Show Longer Walkback' showMore )
('Show Verbose Walkback' showVerboseWalkback )
('-' )
('Skip' skip )
('Step Out' skipForReturn )
('Skip until Entering...' skipUntilEntering )
('-' )
"
('Continue' doContinue )
('Terminate' doTerminate )
('Abort' doAbort )
('-' )
('Step' doStep )
('Send' doSend )
('-' )
('Return' doReturn )
('Restart' doRestart )
('-' )
"
('Add Breakpoint' addBreakpoint )
('Remove Breakpoint' removeBreakpoint )
('Remove all Trace & Breakpoints' removeAllBreakpoints )
).
self allowBreakPointsInDebugger ifFalse:[
items := items , #(
('Allow Halt & Breakpoint in Debugger' doNotIgnoreBreakpoints )
).
] ifTrue:[
items := items , #(
('Ignore Halt & Breakpoints in Debugger' doIgnoreBreakpoints )
).
].
items := items , #(
('-' )
('Browse (Implementing Class)' browseImplementingClass )
('Browse (Receivers Class)' browseReceiversClass )
('Browse Class Hierarchy' browseClassHierarchy )
('Browse Full Class Protocol' browseFullClassProtocol )
('Implementors' browseImplementors )
('Implementors Of...' browseImplementorsOf )
('Senders' browseSenders )
('Senders Of...' browseSendersOf )
('-' )
('Inspect Context' inspectContext )
('Copy WalkBack Text' copyWalkbackText )
('-' )
('QuickTerminate' quickTerminate )
('=' )
('Exit Smalltalk (no Confirmation)' exit )
).
].
m := PopUpMenu
itemList:items
resources:resources
receiver:self
for:contextView.
verboseBacktrace ifTrue:[
m labelAt:#showVerboseWalkback put:(resources string:'Show Dense WalkBack').
m selectorAt:#showVerboseWalkback put:#showDenseWalkback
].
inspecting ifTrue:[
m notNil ifTrue:[
m disableAll:#(doTraceStep removeBreakpoint browseImplementingClass browseReceiversClass
browseClassHierarchy browseFullClassProtocol
browseImplementors browseSenders inspectContext skip doStepOut).
].
].
self updateMenuItems.
^ m.
!
postRealize
super postRealize.
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:(Processor highIOPriority)) max:(Processor userSchedulingPriority+1)).
]
].
self sensor addEventListener:self.
"Created: 24.7.1997 / 18:17:44 / cg"
!
reinitialize
"/ redefined - since the debugView runs on top of
"/ the debuggee, there would be no event loop for me.
drawableId notNil ifTrue:[
^ self
].
"physically create the view & subviews"
self recreate.
!
setLabelFor:aMessage in:aProcess
|l lines nm|
lines := aMessage asStringCollection.
lines size > 1 ifTrue:[
l := lines first
] ifFalse:[
l := aMessage.
].
l := l , ' ('.
Error handle:[:ex |
l := l , '???'
] do:[
nm := aProcess name.
nm notNil ifTrue:[
l := l , (nm contractTo:17) , ''.
].
l := l , '[' , aProcess id printString , ']'.
].
l := l , ')'.
self label:l.
"Modified: / 06-07-2006 / 12:43:19 / cg"
! !
!DebugView methodsFor:'interrupt handling'!
contextInterrupt
DebuggingDebugger == true ifTrue:[
'contextIRQ' printCR.
thisContext sender fullPrint.
].
self stepOrNext
"Modified: / 30.10.1997 / 21:22:25 / cg"
!
stepInterrupt
DebuggingDebugger == true ifTrue:[
'stepIRQ' printCR.
thisContext sender fullPrint.
].
Processor yield.
self stepOrNext
"Modified: / 13.1.1998 / 21:14:11 / cg"
!
stepOrNext
|where here con s isWrap method wrappedMethod
inBlock left ignore contextBelow lastWrappedContext
leftWrap enteredWrap anyStepBlocks
oneMore initiallyShown inBlockBelow receiver|
"/ DebuggingDebugger := true
"/ DebuggingDebugger := false
skipLineNr == #return ifTrue:[
name := Processor activeProcess nameOrId.
self label:('stepping context returned ' , ' (process: ' , name , ')').
here := thisContext sender sender.
here setLineNumber:nil.
here := nil.
con := thisContext sender sender sender.
BreakPointInterrupt handle:[:ex |
'DebugView [info]: breakpoint in debugger ignored [stepOrNext]' infoPrintCR.
ex proceed
] do:[
self enter:con select:nil.
].
con := nil.
^ self
].
"/ "/
"/ "/ should no longer happen
"/ "/
"/ stepForReturn == true ifTrue:[
"/"/'stepForreturn' printCR.
"/ self enter:thisContext sender.
"/ ^ self
"/ ].
Processor activeProcess ~~ inspectedProcess ifTrue:[
'DebugView [info]: stray step interrupt' infoPrintCR.
^ self
].
here := thisContext. "stepInterrupt"
here := here sender. "the caller; step- or contextIRQ"
here := here sender. "the interrupted context"
DebuggingDebugger == true ifTrue:[
'*******' printCR.
'here in ' print.
inWrap ifTrue:['(wrap) ' print.].
((ObjectMemory addressOf:here) printStringRadix:16) print. ' ' print.
here selector printCR.
].
"/ kludge an bug-workaround;
"/ I should not see those ...
here selector == #ioInterrupt ifTrue:[
DebuggingDebugger == true ifTrue:[
'oops - should not get that one' printCR.
].
Processor ioInterrupt.
StepInterruptPending := 1.
InterruptPending := 1.
where := nil. here := nil.
InStepInterrupt := nil.
^ self
].
stepUntilEntering notNil ifTrue:[
DebuggingDebugger == true ifTrue:[
'check if entering ' print. stepUntilEntering printCR.
].
(stepUntilEntering match:here selector) ifTrue:[
DebuggingDebugger == true ifTrue:[
'entering...' printCR.
].
name := Processor activeProcess nameOrId.
self label:('arrived at ' , stepUntilEntering , ' (process: ' , name , ')').
lastStepUntilEntering := stepUntilEntering.
stepUntilEntering := nil.
self enter:here select:nil.
con := nil.
^ self
].
"/ see if stepping context is still active ...
con := here.
DebuggingDebugger == true ifTrue:[
'start searching at: ' print.
con fullPrint.
].
[con notNil and:[con ~~ steppedContext]] whileTrue:[
con := con sender
].
con notNil ifTrue:[
DebuggingDebugger == true ifTrue:[
'steppingContext still active - continue stepping' printCR.
].
con := nil.
where := nil. here := nil.
StepInterruptPending := 1.
InterruptPending := 1.
InStepInterrupt := nil.
^ self
].
stepUntilEntering := nil.
].
"
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
"
isWrap := false.
left := false.
leftWrap := enteredWrap := false.
where := here.
inWrap ifTrue:[
wrappedMethod := nil.
5 timesRepeat:[
(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.
lastWrappedContext := where.
where sender receiver == method originalMethod ifFalse:[
isWrap := true.
]
] ifFalse:[
where == steppedContext ifTrue:[
DebuggingDebugger == true ifTrue:[
'change stepCon from: ' print.
steppedContext print.
' to lastWrapped: ' print.
lastWrappedContext printCR.
].
inWrap := false.
leftWrap := true.
wrapperContext := steppedContext.
steppedContext := lastWrappedContext
]
]
].
where := where sender
]
].
].
isWrap ifTrue:[
DebuggingDebugger == true ifTrue:[
'ignore wrap' printCR.
].
"/
"/ ignore, while in wrappers hidden setup
"/
where := nil. here := nil.
ObjectMemory flushInlineCaches.
skipLineNr == #return ifTrue:[
DebuggingDebugger == true ifTrue:[
'skipRet in wrap' printCR.
]
].
StepInterruptPending := 1.
InterruptPending := 1.
InStepInterrupt := nil.
^ self
].
inBlock := inBlockBelow := anyStepBlocks := false.
DebuggingDebugger == true ifTrue:[
'bigStep is: ' print. bigStep printCR.
'steppedContext is: ' print. steppedContext printCR.
].
"/
"/ is this for a send or a step/next ?
"/
(bigStep
and:[steppedContext notNil]) ifTrue:[
"
a step or next - ignore all contexts below the interesting one
"
where := here. "the interrupted context"
contextBelow := nil.
where home notNil ifTrue:[
"/
"/ in a block called by 'our' context ?
"/
where home == steppedContext ifTrue:[
"/ '*block*' printCR.
inBlock := true
]
].
where == steppedContext ifFalse:[
where := where sender.
where notNil ifTrue:[
where home == steppedContext ifTrue:[
"/ '*block*' printCR.
inBlock := true.
]
].
"/ 'looking for ' print.
"/ (steppedContextAddress printStringRadix:16)print. '' printCR.
"/where print. ' ' print. ((ObjectMemory addressOf:where)printStringRadix:16) printCR.
"/steppedContext print. ' ' print. ((ObjectMemory addressOf:steppedContext)printStringRadix:16) printCR.
where == steppedContext 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.)
inBlock ifFalse:[
[where notNil] whileTrue:[
"/ if either the receiver or any arg of this context
"/ is a block of the steppedContext, we must really
"/ do a single step. Otherwise, stepping through a
"/ do:-loop would be very difficult.
receiver := where receiver.
(receiver isBlock
and:[(receiver isKindOf:Block)
and:[receiver home == steppedContext]])
ifTrue:[
anyStepBlocks := true.
] ifFalse:[
where args do:[:arg |
(arg isBlock
and:[(arg isKindOf:Block)
and:[arg home == steppedContext]])
ifTrue:[
anyStepBlocks := true.
]
]
].
DebuggingDebugger == true ifTrue:[
((ObjectMemory addressOf:where) printStringRadix:16)print. ' ' print.
where selector printCR.
].
where == steppedContext ifTrue:[
"/ 'found it - below; ignore' printCR.
"
found the interesting context somwehere up in the
chain. We seem to be still below the interesting one ...
"
tracing == true ifTrue:[
here printString printCR
].
"
yes, a context below
- continue and schedule another stepInterrupt.
Must flush caches since optimized methods not always
look for pending interrupts
"
contextBelow notNil ifTrue:[
"/ 'prepare for unwind-catch' printCR.
"/ 'con= ' print. contextBelow printCR.
"/ contextBelow selector notNil ifTrue:[
"/ self label:'single stepping - please wait ...(' , contextBelow selector , ')'.
"/ ].
DebuggingDebugger == true ifTrue:[
'below stepCon; continue until unwind of: ' print.
contextBelow printCR.
].
Processor activeProcess forceInterruptOnReturnOf:contextBelow.
StepInterruptPending := nil.
] ifFalse:[
ObjectMemory flushInlineCaches.
"/ here selector notNil ifTrue:[
"/ self label:'single stepping - please wait ...(' , here selector , ')'.
"/ ].
DebuggingDebugger == true ifTrue:[
'in stepCon; continue single stepping' printCR.
].
StepInterruptPending := 1.
InterruptPending := 1.
].
where := nil. here := nil.
InStepInterrupt := nil.
^ self
].
(steppedContext notNil and:[
where methodHome == steppedContext methodHome]) ifTrue:[
inBlockBelow := true.
].
anyStepBlocks ifFalse:[
inBlock ifFalse:[
"/ workaround a VM bug,
"/ which does not honor interrupt-on-return of block contexts
"/ sigh
where isBlockContext ifFalse:[
contextBelow := where
].
]
].
where := where sender
].
s := 'context returned'.
left := true.
].
] ifTrue:[
"/ 'found it right in sender' printCR.
s := 'after step'
].
] ifTrue:[
"/ 'found it right away' printCR.
s := 'after step'
].
] ifFalse:[
"/ ' send' printCR.
"
a send
"
DebuggingDebugger == true ifTrue:[
'clear steppedContext' printCR.
].
steppedContext := nil.
s := 'after send'
].
ignore := false.
(inBlock and:[stepHow == #nextOver or:[stepHow == #nextOut]]) ifTrue:[
ignore := true.
].
"/ handle the case, when a subBlock leaves;
"/ continue stepping in the home context.
left ifTrue:[
steppedContext home notNil ifTrue:[
steppedContext := steppedContext home.
s := 'after step'.
left := false.
"/ DebugView enterUnconditional:thisContext withMessage:'debug'.
]
].
"
kludge to hide breakpoint wrappers in the context list:
check if we are in a wrapper methods hidden exit-sequence
if so, ignore the interrupt and continue single sending
"
(where isNil
and:[wrapperContext notNil])
ifTrue:[
"/ did not find our steppedContext along the chain;
"/ could be in a wrappedMethods exitBlock ...
leftWrap ifFalse:[
where := here.
wrappedMethod := nil.
5 timesRepeat:[
where notNil ifTrue:[
where isBlockContext ifFalse:[
method := where method.
(method notNil and:[method isWrapped]) ifTrue:[
where == wrapperContext ifTrue:[
DebuggingDebugger == true ifTrue:[
'change stepCon fromWrapped: ' print.
steppedContext print.
' to: ' print.
wrapperContext printCR.
].
inWrap := true.
enteredWrap := true.
steppedContext := wrapperContext.
wrapperContext := nil.
]
].
].
where := where sender
]
].
].
enteredWrap ifTrue:[
ignore := true
]
].
"/
left ifTrue:[
"/ special care for stepInterrupt in send,
"/ when created a dummy context (lineNr == 1)
steppedContext lineNumber isNil ifTrue:[
steppedContext selector == here sender selector ifTrue:[
left := false.
s := 'after step'.
steppedContext := here sender.
].
].
oneMore := true
].
inBlock ifTrue:[
"/ 'inBlock' printCR.
s := 'in block'.
].
inBlockBelow ifTrue:[
ignore := true
].
DebuggingDebugger == true ifTrue:[
where notNil ifTrue:[
'(' print. steppedContextLineno print. ') ' print.
where printCR.
].
].
ignore ifFalse:[
(bigStep
and:[steppedContextLineno notNil
and:[where notNil
and:[where lineNumber == steppedContextLineno]]]) ifTrue:[
(here isBlockContext
and:[(here methodHome == steppedContext)
or:[here home == steppedContext]]) ifTrue:[
DebuggingDebugger == true ifTrue:[
'same line but in block' printCR.
].
steppedContext := actualContext := here.
steppedContextLineno := here lineNumber.
] ifFalse:[
"/ kludge - I only have the info for up to 255 lines
steppedContextLineno ~~ 255 ifTrue:[
DebuggingDebugger == true ifTrue:[
'same line - ignored' printCR.
].
ignore := true
].
].
].
(left not
and:[skipLineNr notNil
and:[where notNil
and:[where lineNumber notNil
and:[where lineNumber < skipLineNr]]]]) ifTrue:[
DebuggingDebugger == true ifTrue:[
'skip (' print. skipLineNr print. ' unreached - ignored' printCR.
].
ignore := true
].
(steppedContextLineno isNil
and:[skipLineNr isNil
and:[thisContext sender selector == #contextInterrupt]]) ifTrue:[
DebuggingDebugger == true ifTrue:[
'same line2 (after conIRQ) - ignored' printCR.
].
ignore := true
].
].
ignore ifTrue:[
"/' ' printCR.
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 := 1.
InterruptPending := 1.
InStepInterrupt := nil.
^ self
].
"/ ' ' printCR.
name := Processor activeProcess nameOrId.
self label:(s , ' (process: ' , name , ')').
tracing := false.
bigStep := false.
"release refs to context"
where := nil. here := nil.
"/'enter' printCR.
DebuggingDebugger == true ifTrue:[
'==> enter on: ' print. thisContext sender sender printCR.
].
initiallyShown := nil.
(oneMore == true) ifTrue:[
(thisContext sender sender lineNumber ? 0) <= 1 ifTrue:[
initiallyShown := 2
] ifFalse:[
initiallyShown := 1
]
].
con := thisContext sender sender.
BreakPointInterrupt handle:[:ex |
'DebugView [info]: breakpoint in debugger ignored [stepOpNext 2]' infoPrintCR.
ex proceed
] do:[
self enter:con select:initiallyShown
].
con := nil
"Created: / 14.10.1996 / 12:53:39 / cg"
"Modified: / 18.11.2001 / 01:00:55 / cg"
! !
!DebugView methodsFor:'menu & button actions'!
addBreakpoint
"add a breakpoint on the selected contexts method - if any"
|implementorClass method|
selectedContext isNil ifTrue:[
^ self showError:'** select a context first **'
].
(MessageTracer isNil or:[MessageTracer isLoaded not]) ifTrue:[
^ self
].
implementorClass := selectedContext methodClass.
implementorClass notNil ifTrue:[
method := implementorClass compiledMethodAt:selectedContext selector.
(method notNil and:[method isBreakpointed not]) ifTrue:[
method setBreakPoint
]
].
contextView middleButtonMenu disable:#addBreakpoint.
contextView middleButtonMenu enable:#removeBreakpoint.
"Modified: / 13.1.1998 / 00:24:47 / cg"
!
addBrowserBookmark
"add a browser-bookmark for the selected contexts method"
|cls sel|
selectedContext isNil ifTrue:[^ self].
cls := selectedContext receiver class.
sel := selectedContext selector.
(cls includesSelector:sel) ifFalse:[
sel := nil
].
Tools::NewSystemBrowser addToBookMarks:cls selector:sel
!
allowBreakPointsInDebugger
^ ignoreBreakpoints not
!
allowBreakPointsInDebugger:aBoolean
ignoreBreakpoints := aBoolean not.
self initializeMiddleButtonMenu.
self initializeContextViewsMiddleButtonMenu.
!
autoUpdateOff
"stop the update process"
updateProcess notNil ifTrue:[
monitorToggle lampColor:(Color yellow).
updateProcess terminate.
updateProcess := nil
]
!
autoUpdateOn
"fork a subprocess which updates the contextList in regular intervals"
updateProcess isNil ifTrue:[
updateProcess :=
[
[true] whileTrue:[
monitorToggle showLamp ifTrue:[
monitorToggle lampColor:(Color yellow).
] ifFalse:[
monitorToggle activeForegroundColor:Color black.
].
(Delay forSeconds:0.25) wait.
self updateContext.
monitorToggle showLamp ifTrue:[
monitorToggle lampColor:(Color red).
] ifFalse:[
monitorToggle activeForegroundColor:Color red.
].
(Delay forSeconds:0.25) wait.
self updateContext.
]
] forkAt:(Processor activePriority - 1)
]
!
browseClass
"browse the reveivers class (of the selected contexts message)"
|cls sel|
selectedContext isNil ifTrue:[^ self].
cls := selectedContext receiver class.
sel := selectedContext selector.
(cls includesSelector:sel) ifFalse:[
sel := nil
].
cls browserClass openInClass:cls selector:sel.
"Modified: / 3.2.1998 / 20:23:36 / cg"
!
browseClassHierarchy
"browse the reveivers classHierarchy (of the selected contexts message)"
|cls mthd|
selectedContext isNil ifTrue:[^ self].
mthd := selectedContext method.
mthd notNil ifTrue:[
cls := mthd containingClass.
"/ still nil if unbound - then use receivers class
].
cls isNil ifTrue:[
cls := selectedContext receiver class
].
cls browserClass browseClassHierarchy:cls.
"Modified: / 17.11.2001 / 19:43:06 / cg"
!
browseFullClassProtocol
"browse the reveivers full protocol (of the selected contexts message)"
|cls mthd|
selectedContext isNil ifTrue:[^ self].
mthd := selectedContext method.
mthd notNil ifTrue:[
cls := mthd containingClass.
"/ still nil if unbound - then use receivers class
].
cls isNil ifTrue:[
cls := selectedContext receiver class
].
cls browserClass browseFullClassProtocol:cls.
"Modified: / 17.11.2001 / 19:43:43 / cg"
!
browseImplementingClass
"browse the implementing class (of the selected contexts message)"
|mthd who sel cls|
selectedContext isNil ifTrue:[^ self].
mthd := selectedContext method.
mthd notNil ifTrue:[
who := selectedContext method who.
who notNil ifTrue:[
cls := who methodClass.
sel := who methodSelector.
]
].
cls isNil ifTrue:[
"/ class not found - try receiver
cls := selectedContext receiver class
].
cls browserClass openInClass:cls selector:sel.
"Created: / 22.11.1995 / 21:27:01 / cg"
"Modified: / 3.2.1998 / 19:46:40 / cg"
!
browseImplementors
"open a browser on the implementors of the selected methods selector"
selectedContext isNil ifTrue:[
^ self showError:'** select a context first **'
].
"/ selectedContext receiver class browserClass
UserPreferences systemBrowserClass
browseImplementorsOf:selectedContext selector.
!
browseImplementorsOf
"open a browser on the implementors of some selector"
|initial selector sel|
(sel := codeView selection) notNil ifTrue:[
initial := SystemBrowser extractSelectorFrom:sel
].
initial isNil ifTrue:[
initial := selectedContext isNil
ifTrue:[nil]
ifFalse:[selectedContext selector].
].
selector := Dialog
requestSelector:'Selector to browse implementors of:'
initialAnswer:initial.
selector size == 0 ifFalse:[
UserPreferences systemBrowserClass
browseImplementorsMatching:selector.
]
"Modified: / 6.2.2000 / 01:05:14 / cg"
!
browseReceiversClass
"browse the reveivers class (of the selected contexts message)"
|cls sel|
selectedContext isNil ifTrue:[^ self].
cls := selectedContext receiver class.
sel := selectedContext selector.
(cls includesSelector:sel) ifFalse:[
sel := nil
].
cls browserClass openInClass:cls selector:sel.
"Modified: / 3.2.1998 / 20:23:36 / cg"
!
browseSenders
"open a browser on the senders of the selected methods selector"
selectedContext isNil ifTrue:[
^ self showError:'** select a context first **'
].
UserPreferences systemBrowserClass
browseAllCallsOn:selectedContext selector.
!
browseSendersOf
"open a browser on the senders of some selector"
|initial selector sel|
(sel := codeView selection) notNil ifTrue:[
initial := SystemBrowser extractSelectorFrom:sel
].
initial isNil ifTrue:[
initial := selectedContext isNil
ifTrue:[nil]
ifFalse:[selectedContext selector].
].
selector := Dialog
requestSelector:'Selector to browse senders of:'
initialAnswer:initial.
selector size == 0 ifFalse:[
UserPreferences systemBrowserClass
browseAllCallsOn:selector asSymbol.
]
"Modified: / 6.2.2000 / 01:05:29 / cg"
!
copyWalkbackText
"place the contents of the walkback view into the copy-paste buffer.
This allows pasting it into some other view for printing ..."
self setClipboardText:(contextArray collect:[:con | con fullPrintString]) asStringCollection
"Modified: 28.8.1995 / 15:31:59 / claus"
!
doAbort
"abort - send Object>>abortSignal, which is usually caught
at save places (for example: in the event loop) and returns back
from whatever the process is doing, but does not terminate it."
self checkIfCodeIsReallyModified ifTrue:[
(self confirm:('Code modified - abort anyway ?'))
ifFalse:[
^ self
]
].
inspecting ifTrue:[
inspectedProcess isDead ifTrue:[
self showTerminated.
^ self
].
(AbortOperationRequest isHandledIn:inspectedProcess suspendedContext) ifFalse:[
self showError:'** the process does not handle the abort signal **'
] ifTrue:[
self interruptProcessWith:[AbortOperationRequest raise].
].
^ self
].
steppedContext := wrapperContext := nil.
haveControl := false.
exitAction := #abort.
"exit private event-loop"
catchBlock notNil ifTrue:[
abortButton turnOff.
catchBlock value.
"/ not reached
'DebugView [warning]: abort failed' errorPrintCR.
].
^ self.
"Modified: / 17.11.2001 / 22:53:22 / cg"
!
doAbortAll
"abortAll - send Object>>abortAllSignal, which is usually caught
at save places (for example: in the event loop) and returns back
from whatever the process is doing, but does not terminate it."
self checkIfCodeIsReallyModified ifTrue:[
(self confirm:('Code modified - abort anyway ?'))
ifFalse:[
^ self
]
].
inspecting ifTrue:[
inspectedProcess isDead ifTrue:[
self showTerminated.
^ self
].
(AbortOperationRequest isHandledIn:inspectedProcess suspendedContext) ifFalse:[
self showError:'** the process does not handle the abort signal **'
] ifTrue:[
self interruptProcessWith:[AbortAllOperationRequest raise].
].
^ self
].
steppedContext := wrapperContext := nil.
haveControl := false.
exitAction := #abortAll.
"exit private event-loop"
catchBlock notNil ifTrue:[
abortButton turnOff.
catchBlock value.
"/ not reached
'DebugView [warning]: abort failed' errorPrintCR.
].
^ self.
"Modified: / 17.11.2001 / 22:53:22 / cg"
!
doContinue
"continue from menu"
|proc exContext ex answer|
self checkIfCodeIsReallyModified ifTrue:[
(self confirm:('Code modified - continue anyway ?')) ifFalse:[
^ self
]
].
inspecting ifTrue:[
device hasColors ifTrue:[
continueButton foregroundColor:Color red darkened.
].
continueButton label:(resources string:'Stop').
continueButton action:[self doStop].
self processPerform:#resume.
^ self
].
canContinue ifTrue:[
exContext := thisContext findSpecialHandle:false raise:true.
(exContext notNil
and:[ (ex := exContext receiver) isLazyValue not
and:[ ex isException
and:[ ex signal == NoHandlerError
and:[ ex parameter signal == RecursionError]]]])
ifTrue:[
"/ debug due to unhandled recursionInterrupt.
"/ ask if we should proceed with more stack.
answer := self confirm:'Debugger entered due to a stack overflow.\\Continue with more stack ?' withCRs.
answer == true ifTrue:[
proc := Processor activeProcess.
proc setMaximumStackSize:(proc maximumStackSize * 2).
].
].
steppedContext := wrapperContext := nil.
tracing := false.
haveControl := false.
exitAction := #continue.
"exit private event-loop"
catchBlock value.
"/ not reached.
'DebugView [warning]: continue failed' errorPrintCR.
continueButton turnOff.
] ifFalse:[
inspecting ifFalse:[
'DebugView [info]: resuming top context' infoPrintCR.
self showSelection:1.
self doReturn
]
]
"Modified: / 5.10.1998 / 13:03:47 / cg"
"Modified: / 26.7.1999 / 15:38:45 / stefan"
!
doDefine
|selectionIndex selector argNames receiversClass proto haltStmtDef haltStmtFix code cat
bagOfClassNames bagOfUsedClassNames|
selectionIndex := contextView selection.
selector := actualContext selector.
"generate nice argument names"
bagOfClassNames := (actualContext args collect:[:eachArg | eachArg class name]) asBag.
bagOfUsedClassNames := Bag new.
argNames := actualContext args
collect:
[:eachArg |
|nm|
nm := eachArg class name.
(bagOfClassNames occurrencesOf:nm) == 1 ifTrue:[
nm article , nm
] ifFalse:[
bagOfUsedClassNames add:nm.
nm asLowercaseFirst , (bagOfUsedClassNames occurrencesOf:nm) printString
].
].
proto := Method methodDefinitionTemplateForSelector:selector andArgumentNames:argNames.
haltStmtDef := ' self halt:''please define %2 here''.'.
haltStmtFix := ' self halt:''please change %2 as required''.'.
actualContext receiver isNil ifTrue:[
(self confirm:'Are you sure you want to add this method (to UndefinedObject) ?')
ifFalse:[
^ self
]
].
receiversClass := actualContext receiver class.
(receiversClass instVarNames includes:selector) ifTrue:[
code := '%1\' , haltStmtFix , '\ ^ %2'.
cat := 'accessing'.
].
(selector numArgs == 1
and:[(selector endsWith:':')
and:[receiversClass instVarNames includes:(selector copyWithoutLast:1)]])
ifTrue:[
code := '%1\' , haltStmtFix , '\ %2 := arg.'.
cat := 'accessing'.
].
"/ actualContext receiver isClass ifTrue:[
"/ selector == #new ifTrue:[
"/ code := '%1\' , haltStmt , '\ ^ self basicNew initialize'
"/ ].
"/ selector == #'new:' ifTrue:[
"/ code := '%1\' , haltStmt , '\ ^ (self basicNew:arg) initialize'
"/ ].
"/ ].
code isNil ifTrue:[
code := '%1\' , haltStmtDef
].
self
codeAccept:(code bindWith:proto with:selector) withCRs
unwind:false
category:cat
onCancel:[^ self].
self doShowSelection:selectionIndex.
self doRestart
"Modified: / 17.11.2001 / 23:43:54 / cg"
!
doIgnoreBreakpoints
self allowBreakPointsInDebugger:false
!
doMicroSend
"single send; reenter with next message send"
inspecting ifTrue:[^ self].
self checkIfCodeIsReallyModified ifTrue:[
(self confirm:('Code modified - step anyway ?'))
ifFalse:[
^ self
]
].
canContinue ifTrue:[
steppedContext := wrapperContext := nil.
haveControl := false.
exitAction := #step.
"exit private event-loop"
catchBlock value.
"/ not reached
'DebugView [warning]: send failed' errorPrintCR.
sendButton turnOff.
]
"Created: / 6.3.1997 / 21:09:36 / cg"
"Modified: / 29.7.1998 / 21:49:29 / cg"
!
doNext
"skip for next source-code line; entering blocks"
stepHow := #nextIn.
self doStep:nil
"Modified: 7.3.1997 / 18:38:41 / cg"
!
doNextOut
"skip for next source-code line; leaving blocks"
stepHow := #nextOut.
self doStep:nil
"Created: 3.3.1997 / 21:31:22 / cg"
"Modified: 7.3.1997 / 18:38:49 / cg"
!
doNextOver
"skip for next source-code line; skip over blocks"
stepHow := #nextOver.
self doStep:nil
"Created: 3.3.1997 / 20:50:38 / cg"
"Modified: 7.3.1997 / 18:39:00 / cg"
!
doNoTrace
traceView notNil ifTrue:[
traceView topView destroy.
traceView := nil.
].
tracing := false
!
doNotIgnoreBreakpoints
self allowBreakPointsInDebugger:true
!
doOpenReportMailApp
"open a mail report tool"
| str |
str := '' writeStream.
str nextPutLine:('Error notification from '
, OperatingSystem getLoginName
, '@'
, OperatingSystem getHostName).
str cr.
str nextPutLine:('Time: ' , Timestamp now printString).
str nextPutLine:('STX Version: ' , Smalltalk versionString).
str nextPutLine:('Description: ' , self label).
"/ str nextPutLine:('Error: ', printedException description).
"/ str nextPutLine:('Signal: ', printedException signal printString).
"/ str nextPutLine:('Parameter: ', printedException parameter printString).
str nextPutLine:'Backtrace:'.
str cr.
firstContext notNil ifTrue:[
firstContext fullPrintAllOn:str.
].
str cr;cr.
SendMailTool openForMessage:(str contents) withSubject:('STX Error:[', self label, ']') preOpenBlock:[:inst|
inst recipientEntryField value:'error@exept.de'
].
str close.
!
doRestart
"restart - the selected context will be restarted"
self checkIfCodeIsReallyModified ifTrue:[
(self confirm:('Code modified - restart anyway ?')) ifFalse:[
^ self
]
].
inspecting ifTrue:[
selectedContext isNil ifTrue:[
^ self showError:'** select a context first **'
].
self interruptProcessWith:[ selectedContext unwindAndRestart ].
^ self
].
steppedContext := wrapperContext := nil.
haveControl := false.
exitAction := #restart. "exit private event-loop"
catchBlock value.
"/ normally not reached
'DebugView [warning]: restart failed' errorPrintCR.
restartButton turnOff.
"Modified: / 29.7.1998 / 21:49:53 / cg"
!
doReturn
"return - the selected context will do a ^nil"
self checkIfCodeIsReallyModified ifTrue:[
(self confirm:('Code modified - return anyway ?'))
ifFalse:[
^ self
]
].
inspecting ifTrue:[
selectedContext isNil ifTrue:[
^ self showError:'** select a context first **'
].
self interruptProcessWith:[selectedContext unwind:nil].
^ self
].
steppedContext := wrapperContext := nil.
haveControl := false.
exitAction := #return.
"exit private event-loop"
catchBlock value.
"/ not reached
'DebugView [warning]: return failed' errorPrintCR.
returnButton turnOff.
"Modified: / 29.7.1998 / 21:50:03 / cg"
!
doSend
"single send; reenter with next message send"
stepHow := #send.
self doStep:-1
"/ inspecting ifTrue:[^ self].
"/
"/ canContinue ifTrue:[
"/ steppedContext := wrapperContext := nil.
"/ haveControl := false.
"/ exitAction := #step.
"/
"/ "exit private event-loop"
"/ catchBlock notNil ifTrue:[catchBlock value].
"/
"/ "/ not reached
"/ 'DebugView [warning]: send failed' errorPrintCR.
"/ sendButton turnOff.
"/ ]
"Modified: 7.3.1997 / 18:41:26 / cg"
!
doStep
"skip for next send in selected method"
stepHow := #step.
self doStep:-1
"Modified: 7.3.1997 / 18:46:49 / cg"
!
doStep:lineNr
"common helper for step, skip & next.
Arrange for single-steppping until we pass lineNr (if nonNil)
or to next line (if nil) or to next send (if -1)"
|con method|
inspecting ifTrue:[^ self].
self checkIfCodeIsReallyModified ifTrue:[
(self confirm:('Code modified - step anyway ?'))
ifFalse:[
^ self
]
].
canContinue ifTrue:[
selectedContext notNil ifTrue:[
con := actualContext. "/ selectedContext.
steppedContextLineno := actualContext lineNumber.
] ifFalse:[
con := contextArray at:2.
steppedContextLineno := con lineNumber.
].
skipLineNr := lineNr.
lineNr == -1 ifTrue:[
steppedContextLineno := skipLineNr := nil.
].
(stepUntilEntering isNil and:[stepHow == #send]) ifTrue:[
steppedContext := contextArray at:1.
stepHow := #nextIn.
] ifFalse:[
stepHow == #nextOut ifTrue:[
steppedContext := con home.
] ifFalse:[
steppedContext := con.
].
].
wrapperContext := nil.
"/ ' step con:' print. (ObjectMemory addressOf:steppedContext) printHex. ' ' print. steppedContext printCR.
"
if we step in a wrapped method,
prepare to skip the prolog ...
"
inWrap := false.
method := con method.
(method notNil
and:[method isWrapped
and:[method originalMethod ~~ method]]) ifTrue:[
inWrap := true
].
lineNr == #return ifTrue:[
Processor activeProcess forceInterruptOnReturnOf:con.
].
con := nil.
bigStep := true.
haveControl := false.
exitAction := #step.
"exit private event-loop"
catchBlock value.
"/ not reached
'DebugView [warning]: step failed' errorPrintCR.
stepButton turnOff. nextButton turnOff. sendButton turnOff.
]
"Modified: / 29.7.1998 / 21:50:16 / cg"
!
doStop
"stop the process (if its running, otherwise this is a no-op)"
inspecting ifTrue:[
device hasColors ifTrue:[
continueButton foregroundColor:Color green darkened darkened.
].
continueButton label:(resources string:'Continue').
continueButton action:[self doContinue].
self processPerform:#stop.
^ self
].
"Modified: 20.10.1996 / 18:30:48 / cg"
!
doTerminate
"terminate - the process has a chance for cleanup"
self checkIfCodeIsReallyModified ifTrue:[
(self confirm:('Code modified - terminate anyway ?'))
ifFalse:[
^ self
]
].
inspecting ifTrue:[
self processPerform:#terminate.
^ self
].
steppedContext := wrapperContext := nil.
haveControl := false.
exitAction := #terminate.
"exit private event-loop"
catchBlock value.
"/ not reached (normally)
inspecting ifFalse:[
'DebugView [warning]: terminate failed' errorPrintCR.
(self confirm:'Regular terminate failed - do it the hard way ?') ifTrue:[
Debugger newDebugger.
Processor activeProcess terminate.
]
].
terminateButton turnOff.
"Modified: / 29.7.1998 / 21:50:35 / cg"
!
doTrace
"tracing - not really implemented ..."
self warn:'this function is not yet implemented'.
"/ |v b|
"/
"/ traceView isNil ifTrue:[
"/ v := StandardSystemView on:Display.
"/ v label:'Debugger-Trace'.
"/ v icon:icon.
"/
"/ b := Button label:'untrace' in:v.
"/ b origin:(0 @ 0) extent:(1.0 @ (b height)).
"/ b action:[
"/ StepInterruptPending := nil.
"/ tracing := false.
"/ v unrealize.
"/ traceView := nil
"/ ].
"/ traceView := ScrollableView for:TextCollector in:v.
"/ traceView origin:(0 @ (b height))
"/ extent:[v width @ (v height - b height)]
"/ ].
"/ v realize.
"/
"/ tracing := true.
!
doTraceStep
"tracestep - not implemented yet"
canContinue ifTrue:[
tracing := true.
self doStep
]
!
exit
"exit from menu: immediate exit from smalltalk"
OperatingSystem exit
!
inspectContext
"launch an inspector on the currently selected context"
contextView selection notNil ifTrue:[
(contextView selectionValue startsWith:'**') ifFalse:[
(contextArray at:(contextView selection)) inspect.
]
]
!
openAboutThisApplication
"opens an about box for this application."
DialogBox aboutClass:self class.
!
quickTerminate
"quick terminate - the process will get no chance for cleanup actions"
inspecting ifTrue:[
self processPerform:#terminateNoSignal.
^ self
].
steppedContext := wrapperContext := nil.
haveControl := false.
exitAction := #quickTerminate.
"exit private event-loop"
catchBlock value.
"/ not reached (normally)
inspecting ifFalse:[
'DebugView [warning]: quick terminate failed' errorPrintCR.
(self confirm:'Regular quick terminate failed - do it the hard way ?') ifTrue:[
Debugger newDebugger.
Processor activeProcess terminateNoSignal.
]
].
terminateButton turnOff.
"Modified: 10.1.1997 / 17:42:10 / cg"
!
removeAllBreakpoints
"remove all trace & breakpoints - if any"
(MessageTracer notNil and:[MessageTracer isLoaded]) ifTrue:[
self withExecuteCursorDo:[
MessageTracer unwrapAllMethods
]
]
"Modified: / 21.5.1998 / 01:44:43 / cg"
!
removeBreakpoint
"remove breakpoint on the selected contexts method - if any"
|implementorClass method|
selectedContext isNil ifTrue:[
^ self showError:'** select a context first **'
].
(MessageTracer isNil or:[MessageTracer isLoaded not]) ifTrue:[
^ self
].
implementorClass := selectedContext methodClass.
implementorClass notNil ifTrue:[
method := implementorClass compiledMethodAt:selectedContext selector.
(method notNil and:[method isBreakpointed]) ifTrue:[
method clearBreakPoint
]
].
contextView middleButtonMenu disable:#removeBreakpoint.
contextView middleButtonMenu enable:#addBreakpoint.
"Modified: / 13.1.1998 / 00:24:47 / cg"
!
showDenseWalkback
|m|
m := contextView middleButtonMenu.
verboseBacktrace := false.
m labelAt:#showDenseWalkback put:(resources string:'Show Verbose WalkBack').
m selectorAt:#showDenseWalkback put:#showVerboseWalkback.
self redisplayBacktrace.
"Created: / 17.11.2001 / 20:08:08 / cg"
"Modified: / 17.11.2001 / 22:39:48 / cg"
!
showMore
"double the number of contexts shown"
contextArray notNil ifTrue:[
nChainShown := nChainShown * 2.
self redisplayBacktrace.
]
"Modified: / 17.11.2001 / 20:14:31 / cg"
!
showVerboseWalkback
|m|
verboseBacktrace := true.
m := contextView middleButtonMenu.
m labelAt:#showVerboseWalkback put:(resources string:'Show Dense WalkBack').
m selectorAt:#showVerboseWalkback put:#showDenseWalkback.
self redisplayBacktrace.
"Created: / 17.11.2001 / 20:07:57 / cg"
"Modified: / 17.11.2001 / 22:39:41 / cg"
!
showingDenseWalkback
^ verboseBacktrace == false.
"Created: / 17.11.2001 / 20:13:53 / cg"
!
showingVerboseWalkback
^ verboseBacktrace == true.
"Created: / 17.11.2001 / 20:13:46 / cg"
!
skip
"skip for cursor line in selected method"
stepHow := #skip.
self doStep:codeView cursorLine.
"Modified: 3.3.1997 / 20:56:23 / cg"
!
skipForReturn
"skip until the selected context is left."
stepHow := #skipReturn.
self doStep:#return.
"Modified: 3.3.1997 / 20:56:32 / cg"
!
skipUntilEntering
"skip until some particular method is invoked."
|selector|
selector := Dialog
request:'Skip until entering what (matchpattern):'
initialAnswer:self goodSkipUntilSelector.
selector size == 0 ifTrue:[^ self].
stepUntilEntering := selector asSymbol.
stepHow := #send.
self doStep:-1.
"Modified: 3.3.1997 / 20:56:32 / cg"
!
toggleVerboseWalkback
verboseBacktrace ifFalse:[
self showVerboseWalkback
] ifTrue:[
self showDenseWalkback
].
"Modified: / 17.11.2001 / 20:07:45 / cg"
! !
!DebugView methodsFor:'private'!
abortAllIsHandled
^ AbortAllOperationRequest isHandled
!
busy
^ busy
!
canAddBreakpoint
|m|
m := contextView middleButtonMenu.
^ m notNil and:[m isEnabled:#addBreakpoint]
!
canBrowseClassHierarchy
|m|
m := contextView middleButtonMenu.
^ m notNil and:[m isEnabled:#browseClassHierarchy]
!
canBrowseFullClassProtocol
|m|
m := contextView middleButtonMenu.
^ m notNil and:[m isEnabled:#browseFullClassProtocol]
!
canBrowseImplementingClass
|m|
m := contextView middleButtonMenu.
^ m notNil and:[m isEnabled:#browseImplementingClass]
!
canBrowseReceiversClass
|m|
m := contextView middleButtonMenu.
^ m notNil and:[m isEnabled:#browseReceiversClass]
!
canDefineMethod
^ defineButton isVisible
!
canRemoveBreakpoint
|m|
m := contextView middleButtonMenu.
^ m notNil and:[m isEnabled:#removeBreakpoint]
!
canRestart
^ restartButton isEnabled
"Modified: / 17.11.2001 / 19:59:49 / cg"
!
canReturn
^ returnButton isEnabled
"Modified: / 17.11.2001 / 19:59:18 / cg"
!
canShowMore
^ canShowMore
!
exclusive:aBoolean
exclusive := aBoolean
!
explainSelection
|interval node definingNode crsrPos nm varIdx|
interval := self selectedInterval.
interval isEmpty ifTrue:[
crsrPos := codeView characterPositionOfCursor.
codeView characterUnderCursor isSeparator ifTrue:[
crsrPos := (crsrPos - 1) max:1
].
interval := crsrPos to:crsrPos.
].
node := self findNodeForInterval:interval.
node notNil ifTrue: [
node isVariable ifTrue:[
nm := node name.
(nm = 'self') ifTrue:[
self showValue:(actualContext methodHome receiver).
^ self
].
(#( 'super' 'thisContext') includes:nm) ifTrue:[
^ self
].
definingNode := node whoDefines:nm.
definingNode notNil ifTrue:[
definingNode isMethod ifTrue:[
varIdx := definingNode arguments findFirst:[:arg | arg name = nm].
varIdx ~~ 0 ifTrue:[
self showValue:(actualContext methodHome argAt:varIdx)
]
].
definingNode isBlock ifTrue:[
varIdx := definingNode arguments findFirst:[:arg | arg name = nm].
(definingNode arguments contains:[:arg | arg name = nm]) ifTrue:[
varIdx ~~ 0 ifTrue:[
]
].
].
definingNode parent notNil ifTrue:[
definingNode parent isMethod ifTrue:[
varIdx := definingNode temporaries findFirst:[:arg | arg name = nm].
varIdx ~~ 0 ifTrue:[
actualContext methodHome numVars >= varIdx ifTrue:[
self showValue:(actualContext methodHome varAt:varIdx)
]
].
].
definingNode parent isBlock ifTrue:[
varIdx := definingNode temporaries findFirst:[:arg | arg name = nm].
varIdx ~~ 0 ifTrue:[
].
]
].
].
]
].
!
findNodeForInterval:interval
|tree node source|
interval isEmpty ifTrue: [^ nil].
RBParser isNil ifTrue:[^ nil].
source := codeView contents asString string.
source := currentMethod source.
Error handle:[:ex |
Transcript showCR:ex description.
] do:[
Compiler parseErrorSignal catch:[
tree := RBParser
parseMethod:source
onError: [:str :err ":nodesSoFar" | ].
].
tree isNil ifTrue:[
Compiler parseErrorSignal handle:[:ex |
] do:[
tree := RBParser
parseDoItMethodBody:source
onError: [:str :err ":nodesSoFar" | ].
].
].
].
tree isNil ifTrue:[^ nil].
node := tree whichNodeIsContainedBy:interval.
node isNil ifTrue: [
node := self findNodeIn:tree forInterval:interval
].
^ node
!
findNodeIn:tree forInterval:interval
|node|
node := nil.
tree nodesDo:[:each |
(each intersectsInterval:interval) ifTrue:[
(node isNil or:[node == each parent]) ifTrue:[
node := each
] ifFalse:[
(node parent notNil
and:[node parent isCascade and:[each parent isCascade]]) ifFalse:[^ nil]
]
]
].
^ node
!
goodSkipUntilSelector
|current|
lastStepUntilEntering notNil ifTrue:[^ lastStepUntilEntering].
selectedContext isNil ifTrue:[^ nil].
current := selectedContext selector.
current isNil ifTrue:[^ nil].
('change:*' match:current) ifTrue:[
^ 'update:*'
].
^ nil
!
hasContextSelected
^ contextView hasSelection
"Created: / 17.11.2001 / 19:57:03 / cg"
!
ignoreBreakpoints
^ ignoreBreakpoints
"Created: / 17.11.2001 / 18:20:16 / cg"
!
inspectedProcess
^ inspectedProcess
!
interruptProcessWith:aBlock
"let inspected process do something, then update the context list"
inspectedProcess isDead ifTrue:[
self showTerminated.
^ self
].
inspectedProcess interruptWith:aBlock.
"
give the process a chance to run, then update
"
(Delay forSeconds:0.2) wait.
self setContext:(inspectedProcess suspendedContext).
!
mayProceed:aBoolean
mayProceed := aBoolean
!
processPerform:aMessage
"do something, then update the context list"
inspectedProcess isDead ifTrue:[
self showTerminated.
^ self
].
inspectedProcess perform:aMessage.
"
give the process a chance to run, then update
"
(Delay forSeconds:0.2) wait.
self setContext:(inspectedProcess suspendedContext).
!
redisplayBacktrace
"force redisplay of the walkBack list; invoked when the
verbose-flag setting is changed"
|oldSelection oldContext con idx|
contextArray notNil ifTrue:[
self withExecuteCursorDo:[
oldSelection := contextView selection.
oldSelection notNil ifTrue:[
oldContext := contextArray at:oldSelection ifAbsent:nil.
].
con := firstContext.
"/ con := contextArray at:1.
"/ force redeisplay, even if same by changing the first entry
contextArray size > 0 ifTrue:[
contextArray at:1 put:nil.
].
self setContext:con.
oldContext isNil ifTrue:[
idx := oldSelection
] ifFalse:[
idx := contextArray identityIndexOf:oldContext ifAbsent:nil.
].
contextView setSelection:idx.
idx notNil ifTrue:[
self showSelection:idx
]
]
]
"Created: / 10.1.1997 / 21:36:46 / cg"
"Modified: / 21.5.1998 / 01:47:07 / cg"
!
selectedInterval
^ codeView selectionStartIndex to:(codeView selectionStopIndex - 1)
!
setContext:aContext
"show calling chain from aContext in the walk-back listview"
^ self setContext:aContext releaseInspectors:true
"Modified: 27.6.1996 / 17:21:59 / cg"
!
setContext:aContext releaseInspectors:releaseInspectors
"show calling chain from aContext in the walk-back listview.
Most complications here arise from filtering less-interesting contexts
if not in verbose-context mode."
|con text method caller caller2 called called2 m count c cc
suspendContext calledBySuspendContext nm h calledContext|
(contextArray size > 0 and:[aContext == (contextArray at:1)]) ifTrue:[
"no change"
^ false
].
firstContext := aContext.
m := contextView middleButtonMenu.
m notNil ifTrue:[
m disable:#showMore.
].
canShowMore := false.
aContext isNil ifTrue:[
text := Array with:'** no context **'.
contextArray := nil.
] ifFalse:[
text := OrderedCollection new:nChainShown.
contextArray := OrderedCollection new:nChainShown.
con := aContext.
calledContext := nil.
verboseBacktrace ~~ true ifTrue:[
"/ with dense backtrace, hide the ProcessorScheduler
"/ contexts at the top; look for a Process>>suspend*
"/ context within the first 10 contexts
suspendContext := nil.
c := con.
1 to:10 do:[:i |
|sel|
c notNil ifTrue:[
(sel := c selector) notNil ifTrue:[
((sel isSymbol and:[sel startsWith:'suspend'])
and:[c receiver isMemberOf:Process]) ifTrue:[
suspendContext := c.
calledBySuspendContext := cc.
].
].
cc := c.
c := c sender.
]
].
suspendContext notNil ifTrue:[
con := suspendContext.
calledContext := calledBySuspendContext.
suspendContext := nil
].
].
verboseBacktrace ~~ true ifTrue:[
con notNil ifTrue:[
"/ hide the halt implementation
(con selector == #halt
or:[con selector == #halt:]) ifTrue:[
con method mclass == Object ifTrue:[
calledContext := con.
con := con sender.
]
]
]
].
"
get them all
"
count := 0.
[con notNil and:[count <= nChainShown]] whileTrue:[
[
DebuggingDebugger == true ifTrue:[
'showingContext1: (' print. con print.
') --> ' print. (self showingContext1:con calling:calledContext) printCR.
].
self showingContext1:con calling:calledContext
] whileFalse:[
calledContext := con.
con := con sender.
].
DebuggingDebugger == true ifTrue:[
'showingContext2: (' print. con print.
') --> ' print. (self showingContext2:con nesting:count) printCR.
].
(self showingContext2:con nesting:count) ifTrue:[
"/ ignore it, if its in the same
"/ method as the previous context
"/ (verboseBacktrace ~~ true
"/ and:[count > 0
"/ and:[contextArray last method == con method
"/ and:[(contextArray last isBlockContext not
"/ & con isBlockContext not) not ]]]) ifTrue:[
"/ "/ skip it, if its in the same method
"/ "/ as the called context.
"/ ] ifFalse:[
contextArray add:con.
(MoreDebuggingDetail == true) ifTrue:[
nm := (((ObjectMemory addressOf:con) printStringRadix:16) , ' ' , con printString).
] ifFalse:[
Error handle:[:ex | nm := '???' ] do:[nm := con printString].
].
text add:nm.
count := count + 1.
"/ ].
].
"/
"/ kludge: if its a wrapped method, then hide the wrap-call
"/
method := con method.
(method notNil and:[method isWrapped]) ifTrue:[
called := con.
caller := con sender.
(caller notNil and:[caller receiver == method originalMethod]) ifTrue:[
called2 := caller.
caller2 := caller sender.
(caller2 notNil and:[caller2 method == method]) ifTrue:[
calledContext := called2.
con := caller2
]
].
caller := caller2 := nil
].
"/ with dense backtrace, skip the doIt methods context
"/ (its dummy anyway) and fake that contexts name
verboseBacktrace ~~ true ifTrue:[
(con isBlockContext
and:[(h := con home) == con sender
and:[(self setOfHiddenCallingSelectors includes:h selector)
and:[h method who isNil]]]) ifTrue:[
calledContext := con.
con := con sender.
text removeLast.
text add:(con methodHome printString).
].
h := nil. "/ never keep refs to contexts unless you really need them ...
].
"/ with dense backtrace, dont show below the doIt
( verboseBacktrace ~~ true
and:[ (self setOfHiddenCallingSelectors includes:con selector) ]) ifTrue:[
con := nil.
] ifFalse:[
calledContext := con.
con := con sender
]
].
"
did we reach the end ?
"
(con isNil or:[con sender isNil]) ifTrue:[
"/ the very last one is the startup context
"/ (in main) - it has nil as receiver and nil as selector
(contextArray notEmpty
and:[contextArray last selector isNil]) ifTrue:[
contextArray removeLast.
text removeLast
].
verboseBacktrace ~~ true ifTrue:[
"/ in dense mode, remove the process startup
"/ contexts (if any)
(contextArray size > 0
and:[(con := contextArray last) methodClass == Process]) ifTrue:[
con selector == #start ifTrue:[
contextArray removeLast.
text removeLast.
[contextArray size > 0
and:[contextArray last methodHome == con]] whileTrue:[
contextArray removeLast.
text removeLast.
]
]
]
]
] ifFalse:[
m notNil ifTrue:[
m enable:#showMore.
].
canShowMore := true.
text add:(resources string:'*** more walkback follows - click here to see them ***')
].
].
contextView setList:text.
releaseInspectors ifTrue:[
receiverInspector release.
contextInspector release.
].
m notNil ifTrue:[
m disableAll:#(addBreakpoint removeBreakpoint browseImplementors browseSenders browseReceiversClass).
].
self updateMenuItems.
^ true
"Created: / 14.12.1995 / 19:10:31 / cg"
"Modified: / 17.11.2001 / 22:29:19 / cg"
!
setContextSkippingInterruptContexts:aContext
"show calling chain from aContext in the walk-back listview.
Ignore any non-interesting interrupt-context."
|con|
verboseBacktrace ifFalse:[
con := aContext.
(con notNil and:[con selector == #threadSwitch:]) ifTrue:[
con := con sender.
(con notNil and:[con selector == #timerInterrupt]) ifTrue:[
con := con sender.
].
].
].
^ self setContext:con releaseInspectors:true
"Created: / 20.10.1996 / 18:10:21 / cg"
"Modified: / 17.1.1998 / 12:43:19 / cg"
!
showError:message
codeView contents:(resources string:message).
shown ifTrue:[
exclusive ifTrue:[
"/ consider this a kludge:
"/ if exclusive, cannot use flash, since it suspends
"/ (but we cannot suspend here ...)
codeView redrawInverted. device flush.
OperatingSystem millisecondDelay:200.
codeView redraw
] ifFalse:[
codeView flash
]
]
"Modified: / 18.11.2001 / 00:01:13 / cg"
!
showTerminated
self showError:'** the process has terminated **'
!
showValue:aValue
"/ TODO: show value in info field
"/ Transcript showCR:aValue printString
!
showingContext1:aContext calling:calledContext
|recIsException sel rec senderRec mthd mthdClass calledSel calledRec|
verboseBacktrace == true ifTrue:[ ^true ].
aContext isNil ifTrue:[ ^true ].
sel := aContext selector.
rec := aContext receiver.
mthd := aContext method.
mthd notNil ifTrue:[ mthdClass := mthd mclass ].
"/ to avoid firing/waiting the lazy or future
recIsException := (rec isLazyValue not) and:[rec isException].
aContext sender notNil ifTrue:[
senderRec := aContext sender receiver
].
DebuggingDebugger == true ifTrue:[
'showingContext1: (' print. aContext print.
') calling: (' print. calledContext print.
')' printCR.
].
(#(doCallHandler: doRaise
) includes:sel)
ifTrue:[
recIsException ifTrue:[ ^ false].
].
(#(raise raiseRequest
) includes:sel)
ifTrue:[
recIsException ifTrue:[
(senderRec isLazyValue not
and:[ senderRec isExceptionCreator]) ifTrue:[^ false].
].
].
(#(doWhile:
) includes:sel)
ifTrue:[
rec isBlock ifTrue:[
aContext sender isBlockContext ifTrue:[^ false].
].
].
"/ calledContext notNil ifTrue:[
"/ calledSel := calledContext selector.
"/ calledRec := calledContext receiver.
"/ calledRec isLazyValue ifFalse:[
"/ ((calledSel == #doWhile:)
"/ and:[calledRec isBlock])
"/ ifTrue:[^ false].
"/
"/ ((#(ensure: ifCurtailed: valueNowOrOnUnwindDo: valueOnUnwindDo:
"/ ) includes:calledSel)
"/ and:[calledRec isBlock])
"/ ifTrue:[^ false].
"/
"/ ((calledSel == #handle:do:)
"/ and:[calledRec isExceptionHandler])
"/ ifTrue:[^ false].
"/ ].
"/ ].
(#(handleDo:) includes:sel)
ifTrue:[
(calledRec isLazyValue not and:[calledRec isExceptionHandler]) ifTrue:[^ false].
].
(#(
withCursor:do:
withWaitCursorDo:
) includes:sel)
ifTrue:[
(mthdClass == TopView) ifTrue:[^ false].
(mthdClass == ApplicationModel) ifTrue:[^ false].
(mthdClass == WindowGroup) ifTrue:[^ false].
].
(#(
wait
) includes:sel)
ifTrue:[
(mthdClass == Semaphore) ifTrue:[^ false].
(mthdClass == SemaphoreSet) ifTrue:[^ false].
].
^ true
"Created: / 17.11.2001 / 22:24:06 / cg"
"Modified: / 17.11.2001 / 22:41:42 / cg"
!
showingContext2:aContext nesting:nesting
"return false, if this context is to be skipped.
Here, we hide some well known methods, which are usually
not too interesting;
the set of methods which are suppressed is my (claus's) own choice."
|sel rec mClass
sender senderReceiver senderSelector senderReceiverClass|
verboseBacktrace ifTrue:[^ true].
aContext isNil ifTrue:[^ true].
rec := aContext receiver.
sel := aContext selector.
mClass := aContext methodClass.
sender := aContext sender.
sender notNil ifTrue:[
senderSelector := sender selector.
senderReceiver := sender receiver.
senderReceiverClass := senderReceiver class.
].
sel == #withCursor:do: ifTrue:[
(mClass == WindowGroup) ifTrue:[^ false].
(mClass == TopView) ifTrue:[^ false].
].
(sel == #withExecuteCursorDo:
or:[sel == #withWaitCursorDo:]) ifTrue:[
(mClass == DisplaySurface) ifTrue:[^ false].
].
(sel == #do:
or:[sel == #from:to:do:
or:[sel == #keysAndValuesDo:
or:[sel == #doWithIndex:]]]) ifTrue:[
mClass == Array ifTrue:[^ false].
mClass == OrderedCollection ifTrue:[^ false].
mClass == Set ifTrue:[^ false].
mClass == Dictionary ifTrue:[^ false].
mClass == Interval ifTrue:[^ false].
].
(sel == #perform:
or:[sel == #perform:with:
or:[sel == #perform:with:with:
or:[sel == #perform:with:with:with:
or:[sel == #perform:with:with:with:with:]]]])
ifTrue:[
nesting == 0 ifTrue:[^ true].
mClass == Array ifTrue:[^ false].
mClass == OrderedCollection ifTrue:[^ false].
].
sel == #valueWithReceiver:arguments:selector:search:sender: ifTrue:[^ false].
(mClass == Object) ifTrue:[
(sel startsWith:'perform:') ifTrue:[^ false]
].
(mClass == Method) ifTrue:[
(sel startsWith:'valueWithReceiver:') ifTrue:[^ false]
].
(mClass == SmallInteger) ifTrue:[
(sel == #to:do:) ifTrue:[^ false].
(sel == #to:by:do:) ifTrue:[^ false].
].
(mClass == Block) ifTrue:[
sel == #ensure: ifTrue:[^ false].
sel == #ifCurtailed: ifTrue:[^ false].
sel == #valueNowOrOnUnwindDo: ifTrue:[^ false].
sel == #valueOnUnwindDo: ifTrue:[^ false].
sel == #on:do: ifTrue:[^ false].
sel == #value ifTrue:[^ false].
sel == #value: ifTrue:[^ false].
sel == #value:value: ifTrue:[^ false].
sel == #value:value:value: ifTrue:[^ false].
sel == #value:value:value:value: ifTrue:[^ false].
sel == #value:value:value:value:Value: ifTrue:[^ false].
sel == #value:value:value:value:value:value: ifTrue:[^ false].
].
aContext isBlockContext ifTrue:[
"/ sel == #value ifTrue:[^ false].
"/ sel == #value: ifTrue:[^ false].
"/ sel == #value:value: ifTrue:[^ false].
"/ sel == #value:value:value: ifTrue:[^ false].
"/ sel == #value:value:value:value: ifTrue:[^ false].
"/ sel == #value:value:value:value:Value: ifTrue:[^ false].
"/ sel == #value:value:value:value:value:value: ifTrue:[^ false].
"/ (senderSelector == #answer:do:) ifTrue:[
"/ senderReceiverClass == QuerySignal ifTrue:[
"/ ^ false
"/ ]
"/ ]
aContext home notNil ifTrue:[
aContext home receiver isLazyValue ifFalse:[
(aContext home receiver isMemberOf:Semaphore) ifTrue:[
(aContext home selector == #wait) ifTrue:[^ false]
]
]
]
].
(rec isExceptionHandler) ifTrue:[
sel == #handle:do: ifTrue:[^ false].
sel == #handleDo: ifTrue:[^ false].
(sel startsWith:#raise) ifTrue:[^ false].
sel == #answer:do: ifTrue:[^ false].
].
(rec isLazyValue not and:[ rec isException] ) ifTrue:[
sel == #doRaise ifTrue:[^ false].
sel == #doCallHandler: ifTrue:[^ false].
(sel == #raise or:[sel == #raiseRequest]) ifTrue:[
senderReceiverClass == Signal ifTrue:[^ false].
]
].
(mClass == Context) ifTrue:[
sel == #unwind ifTrue:[^ false].
sel == #unwind: ifTrue:[^ false].
].
(mClass == ProcessorScheduler) ifTrue:[
sel == #interruptActive ifTrue:[^ false].
sel == #threadSwitch: ifTrue:[^ false].
sel == #suspend: ifTrue:[^ false].
].
mClass == Process ifTrue:[
sel == #suspendWithState: ifTrue:[^ false].
].
^ true.
"Modified: / 15.1.1998 / 19:47:36 / cg"
"Created: / 17.11.2001 / 19:34:20 / cg"
!
stepping
^ stepping
!
unstep
stepping := false.
bigStep := false.
steppedContext := wrapperContext := nil.
exitAction := nil
"Modified: 22.10.1996 / 11:59:57 / cg"
!
updateContext
|oldContext idx|
inspectedProcess state == #dead ifTrue:[
self showTerminated.
^ self
].
oldContext := selectedContext.
[
(self setContextSkippingInterruptContexts:inspectedProcess suspendedContext) ifTrue:[
oldContext notNil ifTrue:[
contextArray notNil ifTrue:[
idx := contextArray identityIndexOf:oldContext.
idx ~~ 0 ifTrue:[
self showSelection:idx
] ifFalse:[
codeView contents:('** context returned **')
]
]
]
].
] valueUninterruptably.
"Modified: 20.10.1996 / 18:11:24 / cg"
! !
!DebugView methodsFor:'private queries'!
isAborting
^ exitAction == #abort
!
setOfHiddenCallingSelectors
^ setOfHiddenCallingSelectors ? #( #'doIt' #'doIt:' )
!
setOfHiddenCallingSelectors:aCollectionOfSymbols
setOfHiddenCallingSelectors := aCollectionOfSymbols
! !
!DebugView methodsFor:'private-cache handling'!
cacheMyself
"remember myself for next debug session"
"caching the last debugger will make the next debugger appear
faster, since no resources have to be allocated in the display.
We have to be careful to release all refs to the debuggee, though.
Otherwise, the GC will not be able to release it."
windowGroup notNil ifTrue:[
windowGroup setProcess:nil.
].
self releaseDebuggee.
cachable ~~ true ifTrue:[^ self].
"/
"/ only cache if I am on the Display
"/
device == Display ifTrue:[
exclusive ifTrue:[
CachedExclusive := self
] ifFalse:[
CachedDebugger := self
].
].
ObjectMemory stepInterruptHandler == self ifTrue:[
ObjectMemory stepInterruptHandler:nil
].
"Modified: 10.7.1997 / 15:50:46 / stefan"
"Modified: 31.7.1997 / 21:20:14 / cg"
!
isCached
"tell wether we are a cached debugger"
CachedExclusive == self ifTrue:[
^ true.
].
CachedDebugger == self ifTrue:[
^ true.
].
^ false.
"Created: 10.7.1997 / 15:22:43 / stefan"
!
releaseDebuggee
"We have to be careful to release all refs to the debuggee,
because we may be in the cache.
Otherwise, the GC will not be able to release it"
busy := false.
codeView acceptAction:nil.
codeView doItAction:nil.
codeView contents:nil.
receiverInspector release.
contextInspector release.
inspectedProcess := nil.
contextArray := nil.
selectedContext := actualContext := firstContext := nil.
steppedContext := wrapperContext := nil.
catchBlock := nil.
grabber := nil.
self autoUpdateOff.
"Created: / 10.7.1997 / 14:57:51 / stefan"
"Modified: / 10.7.1997 / 15:50:38 / stefan"
"Modified: / 17.11.2001 / 22:58:17 / cg"
!
uncacheMyself
"do not remember myself any longer for next debug session"
cachable := false.
CachedExclusive == self ifTrue:[
CachedExclusive := nil.
].
CachedDebugger == self ifTrue:[
CachedDebugger := nil.
].
OpenDebuggers notNil ifTrue:[
OpenDebuggers remove:self ifAbsent:[].
].
"Modified: 31.7.1997 / 21:20:11 / cg"
! !
!DebugView methodsFor:'private-control loop'!
controlLoop
"this is a kludge:
start a dispatchloop which exits when
either continue, return or step is pressed
"
haveControl := true.
[
[haveControl] whileTrue:[
self controlLoopCatchingErrors
].
] ensure:[
catchBlock := nil.
haveControl := false
].
"Modified: 9.7.1996 / 18:29:09 / cg"
!
controlLoopCatchingErrors
"this is the debuggers own private event handling loop;
errors are caught, to prevent recursive debugger-invocations."
"setup a self removing catch-block"
catchBlock := [catchBlock := nil. ^ nil].
(exclusive or:[windowGroup isNil]) ifTrue:[
"if we do not have multiple processes or its a system process
we start another dispatch loop, which exits when
either continue, return or step is pressed
or (via the catchBlock) if an error occurs.
Since our display is an extra exclusive one,
all processing for normal views stops here ...
"
WindowGroup setActiveGroup:windowGroup.
SignalSet anySignal handle:[:ex |
|signal|
signal := ex signal.
self showError:'*** Error in modal debugger:
>>>> Signal: ' , signal printString , '
>>>> In: ' , ex suspendedContext printString , '
>>>> From: ' , ex suspendedContext sender printString , '
>>>> : ' , ex suspendedContext sender sender printString , '
>>>> : ' , ex suspendedContext sender sender sender printString , '
>>>> : ' , ex suspendedContext sender sender sender sender printString , '
>>>> : ' , ex suspendedContext sender sender sender sender sender printString , '
>>>> : ' , ex suspendedContext sender sender sender sender sender sender printString , '
>>>> : ' , ex suspendedContext sender sender sender sender sender sender sender printString , '
>>>> : ' , ex suspendedContext sender sender sender sender sender sender sender sender printString , '
>>>> : ' , ex suspendedContext sender sender sender sender sender sender sender sender sender printString , '
>>>> : ' , ex suspendedContext sender sender sender sender sender sender sender sender sender sender printString , '
>>>> : ' , ex suspendedContext sender sender sender sender sender sender sender sender sender sender sender printString , '
>>>> : ' , ex suspendedContext sender sender sender sender sender sender sender sender sender sender sender sender printString , '
>>>> : ' , ex suspendedContext sender sender sender sender sender sender sender sender sender sender sender sender sender printString , '
>>>> : ' , ex suspendedContext sender sender sender sender sender sender sender sender sender sender sender sender sender sender printString , '
>>>> Message: ' , ex description , '
caught & ignored.'.
ex return.
] do:[
UserNotification handle:[:ex |
(ex signal == ActivityNotificationSignal) ifTrue:[
ex proceed
].
self showError:ex description.
ex proceed.
] do:[
device dispatchModalWhile:[Processor activeProcess state:#debug.
haveControl].
]
].
WindowGroup setActiveGroup:nil.
] ifFalse:[
"we do have multiple processes -
simply enter the DebugViews-Windowgroup event loop.
effectively suspending event processing for the currently
active group.
"
SignalSet anySignal handle:[:ex |
|answer signal eMsg|
signal := ex signal.
DebuggingDebugger ~~ true ifTrue:[
(signal == ActivityNotification) ifTrue:[
ex proceed
].
"/
"/ ignore recursive breakpoints
"/
(signal isControlInterrupt) ifTrue:[
ignoreBreakpoints == true ifTrue:[
'DebugView [info]: halt/break in debugger ignored 1' infoPrintCR.
ex proceed
].
].
(signal == TerminateProcessRequest) ifTrue:[
"/ mhm - someone wants to shoot me down while debugging ...
answer := Dialog
choose:('Process termination signal arrived while debugging\\close debugger ?') withCRs
labels:#( 'Ignore' 'Close & terminate' )
values:#( #proceed #close )
default:#close.
answer == #close ifTrue:[
self destroy.
ex reject
].
ex return.
].
signal == RecursiveExceptionError ifTrue:[
(ex parameter signal == BreakPointInterrupt)
ifTrue:[
'DebugView [info]: recursive breakpoint in debugger ignored' infoPrintCR.
ex proceed.
].
self showError:'*** Recursive error in debugger:
>>>> Signal: ' , ex signal printString , '
>>>> ' , ex parameter signal printString , '
>>>> In: ' , ex suspendedContext printString , '
>>>> From: ' , ex suspendedContext sender printString , '
>>>> : ' , ex suspendedContext sender sender printString , '
>>>> : ' , ex suspendedContext sender sender sender printString , '
>>>> : ' , ex suspendedContext sender sender sender sender printString , '
>>>> Message: ' , ex description , '
caught & ignored.'.
ex return
].
].
self topView raiseDeiconified.
eMsg := ex description.
(ex signal isControlInterrupt) ifTrue:[
eMsg := eMsg , Character cr asString , 'in ' , ex suspendedContext printString
].
answer := Dialog
choose:('Error in debugger:\' withCRs , eMsg , '\\debug again ?' withCRs)
labels:#( 'Proceed' 'Cancel' 'Debug' )
values:#( #proceed #cancel #debug )
default:#cancel.
answer == #debug ifTrue:[
'DebugView [info]: cought exception - debugging' infoPrintCR.
Debugger
enterUnconditional:(ex suspendedContext)
withMessage:'Error in debugger: ' , eMsg
mayProceed:true.
ex proceed.
].
answer == #proceed ifTrue:[
'DebugView [info]: ignored exception - proceeding' infoPrintCR.
ex proceed.
].
'DebugView [info]: cought exception - returning' infoPrintCR.
ex return.
] do:[
"/ make certain that sub-debuggers, inspectors etc.
"/ come up on my device.
Screen currentScreenQuerySignal answer:device
do:[
windowGroup
eventLoopWhile:[Processor activeProcess state:#debug.
true]
onLeave:[]
]
].
].
catchBlock := nil.
"Created: / 24.11.1995 / 20:33:45 / cg"
"Modified: / 18.11.2001 / 01:04:17 / cg"
! !
!DebugView methodsFor:'user interaction'!
checkIfCodeIsReallyModified
|source|
codeView modified ifFalse:[^ false].
currentMethod isNil ifTrue:[
^ false
].
source := currentMethod source.
source notNil ifTrue:[
source string = codeView contents string ifTrue:[
^ false
].
(source string withTabsExpanded:8) = (codeView contents string withTabsExpanded:8) ifTrue:[
^ false
].
].
^ true
!
checkSelectionChangeAllowed
^ self checkSelectionChangeAllowed:nil
!
checkSelectionChangeAllowed:newSelection
self checkIfCodeIsReallyModified ifFalse:[^ true].
(newSelection notNil
and:[newSelection = contextView selection]) ifTrue:[
^ true
].
(self confirm:('Code modified - change selection anyway ?')) ifFalse:[
^ false
].
codeView modified:false.
^ true
!
codeAccept:someCode
"user wants some code to be recompiled - must unwind stack since everything above
and including selected method cannot be continued."
^ self codeAccept:someCode unwind:true category:nil onCancel:nil
"Modified: / 17.11.2001 / 21:53:38 / cg"
!
codeAccept:someCode unwind:doUnwind category:givenCategoryOrNil onCancel:cancelAction
"user wants some code to be recompiled - must unwind stack since everything above
and including selected method cannot be continued."
"
actually, this is not true, since the active methods will still be
executed correctly - however, the code shown in the debugger is no
longer in sync (showing the new code) with the executed code.
Therefore, we hide those contexts to avoid confusion ....
If you dont like this behavior, remove the 'inspecting ifFalse:' check below"
"walk up context chain and find highest context which is either the selected context,
or - if its a block-context - whose home is the selected context"
|con top sel implementorClass method newMethod category|
codeView withWaitCursorDo:[
"
find the method-home context for this one
"
con := selectedContext.
top := con.
[con notNil] whileTrue:[
(con methodHome == selectedContext) ifTrue:[
top := con
].
con := con sender
].
"
use class&selector to find the method for the compilation
and compile.
"
category := givenCategoryOrNil.
sel := selectedContext selector.
implementorClass := selectedContext methodClass.
implementorClass notNil ifTrue:[
category isNil ifTrue:[
method := implementorClass compiledMethodAt:sel.
category := method category
]
] ifFalse:[
implementorClass := selectedContext receiver class.
implementorClass ~~ Object ifTrue:[
implementorClass := Dialog
request:('Define ''%1'' in class:' bindWith:sel allBold)
initialAnswer:implementorClass name
list:(implementorClass withAllSuperclasses collect:[:each| each name]).
implementorClass size == 0 ifTrue:[
^ cancelAction value "/ cancelled
].
implementorClass := Smalltalk classNamed:implementorClass.
implementorClass isNil ifTrue:[
Dialog warn:'No such class'.
^ cancelAction value "/ cancelled
].
].
].
"/
"/ provide the classes nameSpace on a query;
"/ in case we accept while in another nameSpace context,
"/ (but for a class which is somewhere else)
"/
(Class updateChangeFileQuerySignal,
Class updateChangeListQuerySignal,
Class updateHistoryLineQuerySignal) answer:true
do:[
Class nameSpaceQuerySignal
answer:(implementorClass nameSpace)
do:[
Class packageQuerySignal
answer:(implementorClass package ? Project noProjectID)
do:[
codeView contents:someCode.
newMethod := implementorClass compilerClass
compile:someCode
forClass:implementorClass
inCategory:category
notifying:codeView.
].
].
].
inspecting ifFalse:[
"
if it worked, remove everything up to and including top
from context chain
"
(newMethod notNil and:[newMethod ~~ #Error]) ifTrue:[
codeView modified:false.
doUnwind ifTrue:[
selectedContext canReturn ifTrue:[
self setContext:(top "sender").
exitAction := #restart.
selectedContext setLineNumber:1.
self doRestart.
] ifFalse:[
self setContext:(top sender).
exitAction := #return.
].
"
continue/step is no longer possible
"
"/ continueButton disable.
"/ canContinue := false.
].
contextView selection:1.
"/ self showSelection:1.
"/ contextView makeSelectionVisible. "/ scrollToLine:(selection - 1)
] ifFalse:[
^ cancelAction value
]
].
].
"Created: / 17-11-2001 / 21:50:55 / cg"
"Modified: / 29-08-2006 / 14:22:22 / cg"
!
confirm:aString
"open a modal yes-no dialog.
Redefined here, to answer true, if exclusice Debugger, which cannot handle popup boxes"
(exclusive or:[windowGroup isNil]) ifTrue:[
^ true
].
^ super confirm:aString.
!
doShowSelection:lineNr
"user clicked on a header line - show selected code in textView.
Also sent to autoselect an interesting context on entry."
BreakPointInterrupt handle:[:ex |
ignoreBreakpoints ifFalse:[ex reject].
'DebugView [info]: breakpoint in debugger ignored [doShowSelection.]' infoPrintCR.
ex proceed
] do:[
self updateForContext:lineNr
].
self updateMenuItems
"Modified: / 17.11.2001 / 22:12:16 / cg"
!
hideStackInspector
stackInspector notNil ifTrue:[
stackInspector destroy.
stackInspector := nil.
receiverInspector origin:(0.0 @ 0.0) corner:0.5 @ 1.0.
contextInspector origin:(0.5 @ 0.0) corner:(1.0 @ 1.0)
]
!
processEvent:anEvent
"filter keyboard events for popUp variable value display.
Return true, if I have eaten the event"
|evView focusView key rawKey inCodeView|
evView := anEvent view.
evView notNil ifTrue:[
focusView := evView windowGroup focusView.
focusView isNil ifTrue:[
focusView := evView.
].
anEvent isKeyPressEvent ifTrue:[
key := anEvent key.
rawKey := anEvent rawKey.
inCodeView := (focusView == codeView
or:[focusView isComponentOf:codeView]).
inCodeView ifTrue:[
key == #CodeCompletion ifTrue:[
"/ complete the word before/under the cursor.
"/ self
"/ enqueueMessage:#codeCompletion
"/ for:self
"/ arguments:#().
^ true
].
].
].
false ifTrue:[
anEvent isButtonReleaseEvent ifTrue:[
anEvent view == codeView ifTrue:[
(RBParser notNil and:[RBParser isLoaded])
ifTrue:[
self sensor
pushEvent:anEvent. "/ must be first in queue
self sensor
pushUserEvent:#explainSelection
for:self
withArguments:nil.
^ true "/ eaten
]
]
].
].
].
^ false
!
showSelection:lineNr
"user clicked on a header line - show selected code in textView.
Also sent to autoselect an interesting context on entry."
Notification
handle:
[:ex |
"/ ex suspendedContext fullPrintAll.
Transcript showCR:ex description.
"/ Transcript showCR:ex parameter.
ex proceed
]
do:
[
Error
handle:
[:ex |
|s con|
ex signal isControlInterrupt
ifTrue:
[
'DebugView [info]: halt/break ignored - while showing selection in debugger' infoPrintCR.
ex proceed
].
'DebugView [info]: error when showing selection in debugger ignored' infoPrintCR.
s := '' writeStream.
s nextPutLine:'**** error in debugger, while extracting source'.
s nextPutLine:'****'.
s nextPutAll: '**** '; nextPutLine:(ex description "withCRs").
s nextPutLine:'****'.
con := ex suspendedContext.
s nextPutAll: '**** '; nextPutLine:(con printString).
con := con sender.
con fullPrintAllOn:s.
"/ [con notNil] whileTrue:[
"/ Error catch:[:ex |
"/ s nextPutAll: '**** '; nextPutLine:(con printString).
"/ ].
"/
"/ (con receiver == self and:[con selector == #'enter:select:']) ifTrue:[
"/ con := nil
"/ ] ifFalse:[
"/ con := con sender.
"/ ]
"/ ].
codeView contents:(s contents).
ex return.
]
do:
[
self doShowSelection:lineNr
]
]
"Modified: / 04-07-2006 / 14:50:06 / cg"
!
showStackInspectorFor:con
stackInspector isNil ifTrue:[
receiverInspector origin:(0.0 @ 0.0) corner:0.3 @ 1.0.
contextInspector origin:(0.3 @ 0.0) corner:(0.6 @ 1.0).
stackInspector := InspectorView
origin:(0.6 @ 0.0)
corner:(1.0 @ 1.0)
in:contextInspector superView.
stackInspector realize.
stackInspector fieldListLabel:'Stack'.
stackInspector hideReceiver:true
].
stackInspector inspect:(con stackFrame asArray).
stackInspector showLast
!
updateForContext:lineNr
"show selected code for lineNr in contextList in textView.
Also used to autoselect an interesting context on entry."
|con homeContext sel method code canAccept
implementorClass lineNrInMethod rec m line
sender selSender tryVars possibleBlocks errMsg
codeSet highlighter evaluatorClass
canDefine|
canDefine := false.
currentMethod := nil.
contextArray notNil ifTrue:[
lineNr <= contextArray size ifTrue:[
con := contextArray at:lineNr.
].
"
clicking on the '** ...'-line shows more ...
"
con isNil ifTrue:[
line := contextView list at:lineNr.
(line startsWith:'**') ifTrue:[
self showMore.
lineNr >= contextArray size ifTrue:[
contextView setSelection:lineNr.
con := contextArray at:lineNr ifAbsent:nil
]
].
con isNil ifTrue:[
codeView contents:nil.
^ self
].
].
selectedContext := con.
m := contextView middleButtonMenu.
(m notNil and:[selectedContext notNil]) ifTrue:[
m enableAll:#(browseImplementors browseSenders inspectContext)
].
self withExecuteCursorDo:[
codeSet := false.
"
give it to the (lower right) inspector
"
Error handle:[:ex |
'DebugView [warning]: error while accessing context' errorPrintCR.
contextInspector inspect:nil.
ex reject.
] do:[
contextInspector inspect:con.
contextInspector tryToSelectKeyNamed:lastSelectionInContextInspector.
].
"/ show a stack inspector sometimes
con hasStackToShow ifTrue:[
self showStackInspectorFor:con
] ifFalse:[
self hideStackInspector
].
"
get the home context
"
con isBlockContext ifTrue:[
homeContext := con methodHome.
] ifFalse:[
homeContext := con
].
con canReturn ifTrue:[
returnButton enable. restartButton enable.
] ifFalse:[
returnButton disable. restartButton disable.
].
lineNrInMethod := con lineNumber.
canAccept := false.
homeContext isNil ifTrue:[
"
mhmh - an optimized block
should get the block here, and get the method from
that one ...
But in the current version, there is no easy way to get to the block
since that one is not in the context.
A future new block calling scheme will fix this
(passing the block instead of the home as block argument).
"
"temporary kludge - peek into the sender context.
If its a do-like method and there is a single block variable
in the args or temporaries, that must be the one.
This helps in some cases.
"
(sender := con sender) notNil ifTrue:[
tryVars := false.
(selSender := sender selector) notNil ifTrue:[
((selSender endsWith:'do:') or:[selSender endsWith:'Do:']) ifTrue:[
tryVars := true.
]
].
tryVars ifTrue:[
possibleBlocks := sender argsAndVars select:[:v | v isBlock].
possibleBlocks := possibleBlocks select:[:b | b home isNil].
possibleBlocks size == 1 ifTrue:[
method := possibleBlocks first method.
].
]
].
] ifFalse:[
"fetch rec here - so we wont need context in doItAction"
rec := homeContext receiver.
sel := homeContext selector.
sel notNil ifTrue:[
canAccept := true.
implementorClass := homeContext methodClass.
implementorClass isNil ifTrue:[
Error handle:[:ex |
ex signal == BreakPointInterrupt ifTrue:[
ex proceed.
].
code := 'error while asking method for its source'.
code := code , Character cr , ex signal printString.
code := code , Character cr , 'in: ' , ex suspendedContext printString.
canAccept := false.
ex return.
] do:[
"
special: look if this context was created by
valueWithReceiver kind of method invocation;
if so, grab the method from the sender and show it
"
((sender := homeContext sender) notNil
and:[((sender selector ? '') startsWith:'valueWithReceiver:')
and:[sender receiver isMethod]]) ifTrue:[
method := sender receiver.
canAccept := false.
] ifFalse:[
(method := con method) notNil ifTrue:[
canAccept := false.
]
].
]
] ifFalse:[
method := implementorClass compiledMethodAt:sel.
].
]
].
code isNil ifTrue:[
errMsg := nil.
method isNil ifTrue:[
"/ fall back heuristics
con isBlockContext ifTrue:[
((sender := con sender) notNil
and:[((sender selector ? '') startsWith:'value')
and:[sender receiver isBlock]]) ifTrue:[
code := sender receiver source.
]
] ifFalse:[
((sender := con sender) notNil
and:[((sender selector ? '') startsWith:'valueWith')
and:[sender receiver isMethod]]) ifTrue:[
method := sender receiver.
]
]
].
method notNil ifTrue:[
Error handle:[:ex |
ex signal isControlInterrupt ifTrue:[
ex proceed.
].
code := 'error while asking method for its source'.
code := code , Character cr , ex signal printString.
code := code , Character cr , 'in: ' , ex suspendedContext printString.
canAccept := false.
ex return.
] do:[
self sensor shiftDown ifTrue:[
code := method decompiledSource
] ifFalse:[
code := method source.
].
].
code isNil ifTrue:[
method sourceFilename notNil ifTrue:[
codeView contents:(resources
string:'** no sourcefile: %1 **'
with:method sourceFilename).
codeView flash.
codeSet := true.
] ifFalse:[
[
|src|
src := String streamContents:[:s | Decompiler decompile:method to:s].
codeView contents:src.
codeSet := true.
] on: Error do:[
errMsg := '** no source **'
].
]
]
] ifFalse:[
homeContext isNil ifTrue:[
errMsg := '** sorry; cannot show code of all optimized blocks (yet) **'.
] ifFalse:[
errMsg := '** no method - no source **'.
canDefine := true.
]
].
errMsg notNil ifTrue:[
self showError:errMsg.
codeSet := true.
]
].
code isNil ifTrue:[
"/ canAccept := false.
codeSet ifFalse:[
codeView contents:nil.
]
] ifFalse:[
lineNrInMethod == 0 ifTrue:[
(method notNil and:[method isJavaMethod]) ifTrue:[
lineNrInMethod := method lineNumber
].
"/ guess lineNumber from sent-messages selector
"/ kludge to fix lineNr-display of shared subclassResponsibility methods.
lineNrInMethod == 0 ifTrue:[
|conIdx sentContext messages|
conIdx := contextArray identityIndexOf:con.
conIdx > 1 ifTrue:[
sentContext := contextArray at:conIdx-1.
sentContext isBlockContext ifFalse:[
(method notNil and:[code notNil]) ifTrue:[
messages := method messagesSent.
messages size == 1 ifTrue:[
sentContext selector == messages first ifTrue:[
lineNrInMethod := code asStringCollection findFirst:[:l | l includesString:sentContext selector].
]
]
].
].
].
].
].
UserPreferences current syntaxColoring ifTrue:[
implementorClass isNil ifTrue:[
(con isBlockContext
and:[con home isNil
and:[con guessedHome notNil]])
ifTrue:[
implementorClass := con guessedHome mclass
]
].
implementorClass notNil ifTrue:[
(highlighter := implementorClass syntaxHighlighterClass) notNil ifTrue:[
code size < 100000 ifTrue:[
code := highlighter formatMethod:code in:implementorClass.
]
]
]
].
"/ code ~= (codeView contents) ifTrue:[
codeView setContents:code.
"/ ].
(lineNrInMethod notNil
and:[lineNrInMethod ~~ 0
and:[lineNrInMethod <= codeView list size]]) ifTrue:[
lineNrInMethod == 255 ifFalse:[
(lineNrInMethod == 255
and:[method notNil
and:[method hasCode not]]) ifTrue:[
"/ means: do not really know in interpreted methods
codeView selectFromLine:255 col:1 toLine:codeView list size + 1 col:0.
] ifFalse:[
codeView selectLine:lineNrInMethod.
].
codeView makeSelectionVisible
].
] ifFalse:[
codeView unselect.
codeView scrollToTop
]
].
codeView acceptEnabled:canAccept.
canAccept ifTrue:[
codeView acceptAction:[:code | self codeAccept:code asString]
] ifFalse:[
codeView acceptAction:[:code | self beep]
].
receiverInspector inspect:rec.
receiverInspector tryToSelectKeyNamed:lastSelectionInReceiverInspector.
"
the one below is wrong: currently, the
evaluator cannot handle passed contexts.
Once it does, pass con as in:-arg
"
(rec isJavaObject
and:[method isNil or:[method isJavaMethod not]]) ifTrue:[
"/ although a java object, use the smalltalk parser here for doIts.
evaluatorClass := Parser
] ifFalse:[
evaluatorClass := rec class evaluatorClass
].
codeView doItAction:[:theCode |
evaluatorClass
evaluate:theCode
in:actualContext
receiver:rec
notifying:codeView
logged:true
ifFail:nil
].
currentMethod := method.
selectedContext := homeContext.
actualContext := con
].
] ifFalse:[
codeView contents:nil.
].
codeView modified:false.
con isContext ifFalse:[
sendButton disable.
] ifTrue:[
sendButton enable.
].
"clear out locals to prevent keeping around unneeded contexts
(due to the block held in codeView).
(not really needed, since stuff gets collected away sooner or later ...
... but this makes it a bit sooner)
"
con := nil.
homeContext := nil.
canDefine ifTrue:[
defineButton beVisible.
] ifFalse:[
defineButton beInvisible.
].
"
enable/disable some menu items
"
self updateMenuItems
"Created: / 14-08-1997 / 20:15:00 / cg"
"Modified: / 06-08-2006 / 15:33:35 / cg"
!
updateMenuItems
|m mthd cls mCls rCls|
"
enable/disable some menu items
"
m := contextView middleButtonMenu.
m notNil ifTrue:[
m disable:#removeBreakpoint.
m disable:#addBreakpoint.
canShowMore ifFalse:[
m disable:#showMore
].
selectedContext notNil ifTrue:[
m enableAll:#(browseImplementors browseSenders inspectContext skip skipForReturn).
mthd := selectedContext method.
mthd notNil ifTrue:[
cls := mCls := mthd containingClass.
mthd isBreakpointed ifTrue:[
m enable:#removeBreakpoint.
] ifFalse:[
m enable:#addBreakpoint.
]
].
rCls := selectedContext receiver class.
cls isNil ifTrue:[
cls := rCls
].
cls notNil ifTrue:[
m enableAll:#(browseImplementingClass browseReceiversClass browseClassHierarchy browseFullClassProtocol).
rCls == mCls ifTrue:[
m disable:#browseReceiversClass
].
mCls isNil ifTrue:[
m disable:#browseImplementingClass
]
] ifFalse:[
m disableAll:#(browseImplementingClass browseReceiversClass browseClassHierarchy browseFullClassProtocol).
].
] ifFalse:[
m disableAll:#(browseImplementingClass browseReceiversClass browseClassHierarchy browseFullClassProtocol).
]
]
! !
!DebugView class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.403 2006-08-29 12:27:22 cg Exp $'
! !
DebugView initialize!