added 'S' -> stopp a process
added optional count-prefix for 'l'-command
(only output n contexts)
"
COPYRIGHT (c) 1988 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.
"
Object subclass:#MiniDebugger
instanceVariableNames:'tracing stepping traceBlock command commandArg commandCount'
classVariableNames:'TheOneAndOnlyDebugger'
poolDictionaries:''
category:'System-Debugging-Support'
!
!MiniDebugger class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1988 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
"
a primitive (non graphical) debugger for use on systems without
graphics or when the real debugger dies (i.e. an error occurs in
the graphical debugger).
Also, if an interrupt occurs within the debuger, this one is called
for.
[author:]
Claus Gittinger
"
! !
!MiniDebugger class methodsFor:'instance creation'!
enter
"enter a miniDebugger"
^ self enterWithMessage:'MiniDebugger'
!
enter:aContext
"enter a miniDebugger - for protocol compatibility with the GUI-debugger"
^ self enterWithMessage:'MiniDebugger'
!
enter:aContext withMessage:aString
"enter a miniDebugger - for protocol compatibility with the GUI-debugger"
^ self enterWithMessage:aString
!
enterWithMessage:aString
"enter a miniDebugger"
|active|
StepInterruptPending := nil.
Object errorSignal handle:[:ex |
ex return
] do:[
thisContext isRecursive ifTrue:[
"/ 'recursive error in debugger ignored' errorPrintCR.
^ self
].
aString printCR.
Processor notNil ifTrue:[
active := Processor activeProcess.
'process: id=' print. active id print.
' name=' print. active name printCR.
].
].
self new enter.
^ nil
"Modified: 20.5.1996 / 10:28:31 / cg"
!
new
"redefined to make certain that there is only one miniDebugger
in the system"
TheOneAndOnlyDebugger isNil ifTrue:[
TheOneAndOnlyDebugger := self basicNew initialize
].
^ TheOneAndOnlyDebugger
"
TheOneAndOnlyDebugger := nil
"
"Modified: / 31.7.1998 / 17:08:07 / cg"
!
singleStep:aBlock
|aDebugger|
aDebugger := self new stepping.
ObjectMemory stepInterruptHandler:aDebugger.
ObjectMemory flushInlineCaches.
StepInterruptPending := 1.
InterruptPending := 1.
aBlock value.
StepInterruptPending := nil.
ObjectMemory stepInterruptHandler:nil
!
trace:aBlock
self trace:aBlock with:[:where | where printCR]
"Modified: 20.5.1996 / 10:27:37 / cg"
!
trace:aBlock on:aStream
self trace:aBlock with:[:where | where printString printOn:aStream.
aStream cr]
!
trace:aBlock with:aTraceBlock
|aDebugger|
aDebugger := self new tracingWith:aTraceBlock.
ObjectMemory stepInterruptHandler:aDebugger.
ObjectMemory flushInlineCaches.
StepInterruptPending := 1.
InterruptPending := 1.
aBlock value.
ObjectMemory stepInterruptHandler:nil.
StepInterruptPending := nil.
^ nil
! !
!MiniDebugger methodsFor:'initialization'!
initialize
traceBlock := nil.
tracing := false.
stepping := false
! !
!MiniDebugger methodsFor:'interrupt handling'!
enter
|leaveCmd stillHere|
stillHere := true.
[stillHere] whileTrue:[
leaveCmd := self commandLoop.
(leaveCmd == $s) ifTrue: [
self stepping.
ObjectMemory flushInlineCaches.
ObjectMemory stepInterruptHandler:self.
stillHere := false.
StepInterruptPending := 1.
InterruptPending := 1
].
(leaveCmd == $t) ifTrue: [
traceBlock := [:where | where fullPrint].
ObjectMemory flushInlineCaches.
ObjectMemory stepInterruptHandler:self.
stillHere := false.
StepInterruptPending := 1.
InterruptPending := 1
].
(leaveCmd == $c) ifTrue: [
traceBlock := nil.
stillHere := false.
stepping := false.
tracing := false.
StepInterruptPending := nil.
InterruptPending := nil
].
(leaveCmd == $a) ifTrue: [
"abort"
stepping := false.
tracing := false.
StepInterruptPending := nil.
InterruptPending := nil.
self doAbort.
stillHere := true.
"failed abort"
].
].
^ nil
"Modified: / 18.8.1998 / 18:10:29 / cg"
!
stepInterrupt
|where|
where := thisContext. "where is stepInterrupt context"
where notNil ifTrue:[
where := where sender "where is now interrupted methods context"
].
stepping ifTrue:[
where notNil ifTrue:[
where fullPrint
] ifFalse:[
'stepInterrupt: no context' errorPrintCR
].
self enter
] ifFalse:[
where notNil ifTrue:[
traceBlock notNil ifTrue:[
traceBlock value:where
]
] ifFalse:[
'traceInterrupt: no context' errorPrintCR
].
ObjectMemory flushInlineCaches.
StepInterruptPending := 1.
InterruptPending := 1
]
"Modified: 20.5.1996 / 10:23:11 / cg"
! !
!MiniDebugger methodsFor:'private'!
findContext:aSelector
|con|
con := thisContext sender.
[con notNil] whileTrue:[
(con isBlockContext not and:[con selector == aSelector]) ifTrue:[
"got it"
^ con
].
con := con sender
].
^ nil
!
getContext
|backtrace|
backtrace := thisContext.
(backtrace notNil) ifTrue: [
"remove Context getContext frame"
backtrace := backtrace sender.
"remove Debugger showContext frame"
backtrace := backtrace sender.
"remove Debugger commandLoop frame"
backtrace := backtrace sender.
"remove Debugger enter frame"
backtrace := backtrace sender
].
^ backtrace
!
printBacktraceFrom:aContext
|context n|
aContext isNil ifTrue:[
'no context' errorPrintCR.
^ self
].
context := aContext.
n := commandCount.
[context notNil] whileTrue: [
context fullPrint.
context := context sender.
n notNil ifTrue:[
n := n - 1.
n <= 0 ifTrue:[
^ self
]
]
]
!
stepping
traceBlock := nil.
tracing := false.
stepping := true
!
tracingWith:aBlockOrNil
traceBlock := aBlockOrNil.
stepping := false.
tracing := true
! !
!MiniDebugger methodsFor:'user commands'!
commandLoop
|cmd done valid context id proc|
done := false.
[done] whileFalse:[
valid := false.
cmd := self getCommand.
cmd isNil ifTrue:[ "/ EOF -> continue
cmd := $c
].
commandArg notEmpty ifTrue:[
id := Number readFrom:commandArg onError:nil.
id notNil ifTrue:[
proc := Process allSubInstances detect:[:p | p id == id] ifNone:nil.
proc == Processor activeProcess ifTrue:[
id := proc := nil
]
]
].
(cmd == $l) ifTrue:[
valid := true.
proc notNil ifTrue:[
'-------- walkback of process ' print. id print. ' -------' printCR.
self printBacktraceFrom:(proc suspendedContext)
] ifFalse:[
id notNil ifTrue:[
'no process with id: ' print. id printCR.
] ifFalse:[
context isNil ifTrue: [
context := self getContext
].
'-------- walkback of current process -------' printCR.
self printBacktraceFrom:context
]
].
].
(cmd == $b) ifTrue:[
valid := true.
proc notNil ifTrue:[
'-------- VM walkback of process ' print. id print. ' -------' printCR.
ObjectMemory printStackBacktraceFrom:(proc suspendedContext)
] ifFalse:[
id notNil ifTrue:[
'no process with id: ' print. id printCR.
] ifFalse:[
'-------- VM walkback of current process -------' printCR.
ObjectMemory printStackBacktrace
]
]
].
(cmd == $B) ifTrue:[
valid := true.
self printAllBacktraces
].
(cmd == $P) ifTrue:[
valid := true.
self showProcesses.
].
(cmd == $r) ifTrue:[
valid := true.
context isNil ifTrue: [
context := self getContext
].
context notNil ifTrue:[
"remove Debugger stepinterrupt/halt frame"
context sender receiver printCR
] ifFalse:[
'no context - dont know receiver' errorPrintCR
]
].
(cmd == $R) ifTrue:[
valid := true.
context isNil ifTrue: [
context := self getContext
].
context notNil ifTrue:[
"remove Debugger stepinterrupt/halt frame"
context sender receiver storeOn:Stdout
] ifFalse:[
'no context - dont know receiver' errorPrintCR
]
].
(cmd == $i) ifTrue:[
valid := true.
context isNil ifTrue: [
context := self getContext
].
context notNil ifTrue:[
"remove Debugger stepinterrupt/halt frame"
MiniInspector openOn:(context sender receiver)
] ifFalse:[
'no context - dont know receiver' errorPrintCR
]
].
(cmd == $I) ifTrue:[
valid := true.
context isNil ifTrue: [
context := self getContext
].
"/ context notNil ifTrue:[
"/ "remove Debugger stepinterrupt/halt frame"
"/ self interpreterLoopWith:(context sender receiver)
"/ ] ifFalse:[
"/ 'no context - dont know receiver' errorPrintCR.
self interpreterLoopWith:nil
"/ ]
].
context := nil.
(cmd == $c) ifTrue:[valid := true. done := true].
(cmd == $s) ifTrue:[valid := true. done := true].
(cmd == $t) ifTrue:[valid := true. done := true].
(cmd == $a) ifTrue:[valid := true. done := true].
(cmd == $u) ifTrue:[
stepping := false.
tracing := false.
Processor activeProcess vmTrace:false.
].
(cmd == $T) ifTrue:[
valid := true.
proc notNil ifTrue:[
proc terminate.
] ifFalse:[
id notNil ifTrue:[
'no process with id: ' print. id printCR.
] ifFalse:[
Processor terminateActive
]
]
].
(cmd == $S) ifTrue:[
valid := true.
proc notNil ifTrue:[
'stopping process id: ' print. id printCR.
proc stop.
] ifFalse:[
'invalid process id: ' print. id printCR.
]
].
(cmd == $a) ifTrue:[
"without id-arg, this is handled by caller"
proc notNil ifTrue:[
valid := true.
proc interruptWith:[AbortSignal raise]
]
].
(cmd == $Q) ifTrue:[
valid := true.
proc notNil ifTrue:[
proc terminateNoSignal.
] ifFalse:[
id notNil ifTrue:[
'no process with id: ' print. id printCR.
] ifFalse:[
Processor terminateActiveNoSignal
]
]
].
(cmd == $g) ifTrue:[
valid := true.
id == 3 ifTrue:[
ObjectMemory reclaimSymbols.
ObjectMemory compressOldSpace.
] ifFalse:[
id == 2 ifTrue:[
ObjectMemory reclaimSymbols.
] ifFalse:[
ObjectMemory garbageCollect.
]
]
].
(cmd == $U) ifTrue:[valid := true. MessageTracer unwrapAllMethods].
(cmd == $X) ifTrue:[valid := true. Smalltalk fatalAbort].
(cmd == $x) ifTrue:[valid := true. OperatingSystem exit].
valid ifFalse: [
'valid commands:
c ..... continue
s ..... step
t ..... trace (continue with trace)
a [id]. abort (i.e. raise abort signal) in (current) process
T [id]. terminate (current) process
Q [id]. quick terminate (current) process - no unwinds or cleanup
P ..... list processes
l [id]. print context chain (of process with id)
b [id]. full (VM) backtrace
B ..... backtrace of all other processes
r ..... receiver printString
R ..... Receiver storeString
i ..... inspect (enter MiniInspector on current receiver)
I ..... interpreter (expression evaluator)
U ..... unwrap all traced/breakpointed methods
g ..... collect all garbage
g 2.... collect all garbage & reclaim sumbols
g 3.... collect all garbage, reclaim sumbols and compress
X ..... exit (+core)
x ..... exit Smalltalk
' errorPrintCR
]
].
context := nil.
^ cmd
"Modified: / 31.7.1998 / 17:10:23 / cg"
!
doAbort
|con sig|
(sig := Object abortSignal) isHandled ifTrue:[
sig raise.
'abort raise failed' errorPrintCR.
].
"TEMPORARY kludge - find event handler context
this will be removed, once real debugging is possible
"
con := self findContext:#processEvent.
con isNil ifTrue:[
con := self findContext:#dispatch.
].
con notNil ifTrue:[
"got it"
con return.
'return failed' errorPrintCR.
].
'found no context to resume' errorPrintCR.
"Modified: 20.5.1996 / 10:23:00 / cg"
!
getCommand
"/ Display notNil ifTrue:[
"/ Display ungrabPointer.
"/ Display ungrabKeyboard.
"/ ].
"/ Screen notNil ifTrue:[
"/ Screen allScreens do:[:aScreen |
"/ aScreen ungrabPointer.
"/ aScreen ungrabKeyboard.
"/ ].
"/ ].
Display notNil ifTrue:[
Display ungrabPointer.
Display ungrabKeyboard.
].
'MiniDebugger> ' print.
UserInterruptSignal handle:[:ex |
ex restart
] do:[
|c cmd arg cnt|
cmd := Character fromUser.
cmd isNil ifTrue:[
"
mhmh end-of-file;
return a 'c' (for continue); hope thats ok.
"
cmd := $c
].
cnt := nil.
(cmd isDigit) ifTrue:[
cnt := 0.
[cmd isDigit] whileTrue:[
cnt := cnt * 10 + cmd digitValue.
cmd := Character fromUser
].
[cmd == Character space] whileTrue:[
cmd := Character fromUser
].
].
"
collect to end-of-line in arg
"
c := cmd.
arg := ''.
[c isNil or:[c isEndOfLineCharacter]] whileFalse: [
arg := arg copyWith:c.
c := Character fromUser.
].
commandArg := arg copyFrom:2.
command := cmd.
commandCount := cnt.
].
^ command
"Modified: / 31.7.1998 / 16:11:01 / cg"
!
interpreterLoopWith:anObject
|line done|
'read-eval-print loop; exit with empty line' printCR.
'' printCR.
done := false.
[done] whileFalse:[
'> ' print.
line := Stdin nextLine.
(line size == 0) ifTrue:[
done := true
] ifFalse:[
(Compiler evaluate:line
receiver:anObject
notifying:nil) printCR
]
]
"Modified: / 31.7.1998 / 16:01:47 / cg"
!
printAllBacktraces
Process allInstancesDo:[:p |
(p ~~ Processor activeProcess
and:[p isDead not]) ifTrue:[
'---------------------------------------------------------' printCR.
' proc id=' print. p id print.
' name=''' print. p name print.
''' createdBy: ' print. p creatorId print.
' state=' print. p state print.
' prio=' print. p priority printCR.
'' printCR. '' printCR.
self printBacktraceFrom:(p suspendedContext)
]
]
!
showProcesses
|active|
active := Processor activeProcess.
'current id=' print. active id print. ' name=''' print. active name print. '''' printCR.
Process allSubInstancesDo:[:p |
'proc id=' print. (p id printStringPaddedTo:5) print.
(p state printStringPaddedTo:10) print.
' pri=' print. (p priority printStringPaddedTo:2) print.
' creator:' print. (p creatorId printStringPaddedTo:5) print.
' name=''' print. p name print.
'''' printCR.
]
"Modified: / 31.7.1998 / 16:30:19 / cg"
! !
!MiniDebugger class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/Attic/MiniDebug.st,v 1.40 1999-02-25 20:17:04 cg Exp $'
! !