--- a/MiniDebugger.st Wed Sep 28 16:37:41 2011 +0200
+++ b/MiniDebugger.st Thu Sep 29 09:06:51 2011 +0200
@@ -43,8 +43,10 @@
Also, if an interrupt occurs within the debuger, this one is called
for.
+ MiniDebugger enter
+
[author:]
- Claus Gittinger
+ Claus Gittinger
"
! !
@@ -216,17 +218,11 @@
^ nil
! !
-!MiniDebugger methodsFor:'initialization'!
-
-initialize
- traceBlock := nil.
- tracing := false.
- stepping := false
-! !
-
-!MiniDebugger methodsFor:'interrupt handling'!
+!MiniDebugger methodsFor:'entering'!
enter:aContext mayProceed:mayProceed
+ "regular entry, via unhandled exception"
+
|c leaveCmd stillHere yesNo|
enteringContext := dot := aContext.
@@ -245,7 +241,7 @@
'** Abort cought - back in previous debugLevel' printCR.
] do:[
Error handle:[:ex |
- 'Error while executing command: ' print.
+ 'Error while executing MiniDebugger command: ' print.
ex description printCR.
yesNo := self getCommand:'- (i)gnore / (p)roceed / (d)ebug / b(acktrace) ? '.
yesNo == $d ifTrue:[
@@ -304,37 +300,48 @@
enteringContext := dot := nil.
^ nil
- "Modified: / 18.8.1998 / 18:10:29 / cg"
+ "Modified (comment): / 29-09-2011 / 09:05:57 / cg"
!
stepInterrupt
+ "entry via single stepinterrupt"
+
|where|
where := thisContext. "where is stepInterrupt context"
where notNil ifTrue:[
- where := where sender "where is now interrupted methods context"
+ where := where sender "where is now interrupted methods context"
].
stepping ifTrue:[
- where notNil ifTrue:[
- where fullPrint
- ] ifFalse:[
- 'stepInterrupt: no context' errorPrintCR
- ].
- self enter:where mayProceed:true
+ where notNil ifTrue:[
+ where fullPrint
+ ] ifFalse:[
+ 'stepInterrupt: no context' errorPrintCR
+ ].
+ self enter:where mayProceed:true
] ifFalse:[
- where notNil ifTrue:[
- traceBlock notNil ifTrue:[
- traceBlock value:where
- ]
- ] ifFalse:[
- 'traceInterrupt: no context' errorPrintCR
- ].
- ObjectMemory flushInlineCaches.
- StepInterruptPending := 1.
- InterruptPending := 1
+ 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"
+ "Modified: / 20-05-1996 / 10:23:11 / cg"
+ "Modified (comment): / 29-09-2011 / 09:06:29 / cg"
+! !
+
+!MiniDebugger methodsFor:'initialization'!
+
+initialize
+ traceBlock := nil.
+ tracing := false.
+ stepping := false
! !
!MiniDebugger methodsFor:'private'!
@@ -368,18 +375,20 @@
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 selector ~~ #commandLoop] whileTrue:[
+ backtrace := backtrace sender.
+ ].
+ "remove Debugger commandLoop frame"
+ backtrace := backtrace sender.
+ "remove Debugger enter frame"
+ backtrace := backtrace sender
].
^ backtrace
+
+ "Modified: / 29-09-2011 / 09:00:14 / cg"
!
moveDotDown
@@ -483,188 +492,22 @@
!MiniDebugger methodsFor:'user commands'!
commandLoop
- |cmd done valid context id proc|
+ "read-eval commands, until one of the continue, abort or single step commands is entered;
+ return the last command character"
+
+ |cmd done|
done := false.
[done] whileFalse:[
- valid := false.
cmd := self getCommand:nil.
- cmd isNil ifTrue:[ "/ EOF -> continue
+ cmd isNil ifTrue:[ "/ EOF is treated like continue command
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 == $S) ifTrue:[
- valid := true.
- 'saving "crash.img"...' print.
- ObjectMemory writeCrashImage.
- 'done.' printCR.
- ].
-
- (cmd == $B) ifTrue:[
- valid := true.
- self printAllBacktraces
- ].
-
- (cmd == $P) ifTrue:[
- valid := true.
- self showProcesses.
- ].
-
- (cmd == $r) ifTrue:[
- valid := true.
- dot receiver printCR
- ].
-
- (cmd == $i) ifTrue:[
- valid := true.
- MiniInspector openOn:(dot receiver)
- ].
-
- (cmd == $I) ifTrue:[
- valid := true.
- self interpreterLoopWith:nil
- ].
- (cmd == $e) ifTrue:[
- valid := true.
- Parser evaluate:commandArg.
- ].
-
- 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 == $R) ifTrue:[
- valid := true.
- proc notNil ifTrue:[
- proc resume.
- ]
- ].
-
- (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 == $W) 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:[
- 'aborting process id: ' print. id printCR.
- valid := true.
- proc interruptWith:[AbortOperationRequest raise]
- ] ifFalse:[
- 'aborting' printCR.
- ]
- ].
-
- (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.
- self garbageCollectCommand:id
- ].
-
- (cmd == $U) ifTrue:[valid := true. MessageTracer unwrapAllMethods].
- (cmd == $X) ifTrue:[valid := true. Smalltalk fatalAbort].
- (cmd == $x) ifTrue:[valid := true. OperatingSystem exit].
-
- (cmd == $.) ifTrue:[valid := true. self printDot ].
- (cmd == $m) ifTrue:[valid := true. self printDotsMethodSource ].
- (cmd == $-) ifTrue:[valid := true. self moveDotUp ].
- (cmd == $+) ifTrue:[valid := true. self moveDotDown ].
-
- "/ avoid usage print if return was typed ...
- ((cmd == Character return)
- or:[cmd == Character linefeed]) ifTrue:[valid := true.].
-
- valid ifFalse: [
- self showValidCommandHelp.
- ]
+ done := self doCommand:cmd.
].
- context := nil.
^ cmd
- "Modified: / 29-09-2006 / 12:23:18 / cg"
+ "Modified (comment): / 29-09-2011 / 09:02:24 / cg"
!
doAbort
@@ -693,6 +536,190 @@
"Modified: / 16.11.2001 / 17:39:14 / cg"
!
+doCommand:cmd
+ "a single command; return true, if command loop should be finished"
+
+ |id proc|
+
+ 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:[
+ 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:[
+ '-------- walkback of current process -------' printCR.
+ self printBacktraceFrom:(self getContext)
+ ]
+ ].
+ ^ false
+ ].
+
+ (cmd == $b) ifTrue:[
+ 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
+ ]
+ ].
+ ^ false
+ ].
+
+ (cmd == $S) ifTrue:[
+ 'saving "crash.img"...' print.
+ ObjectMemory writeCrashImage.
+ 'done.' printCR.
+ ^ false
+ ].
+
+ (cmd == $B) ifTrue:[
+ self printAllBacktraces.
+ ^ false
+ ].
+
+ (cmd == $P) ifTrue:[
+ self showProcesses.
+ ^ false
+ ].
+
+ (cmd == $r) ifTrue:[
+ dot receiver printCR.
+ ^ false
+ ].
+
+ (cmd == $i) ifTrue:[
+ MiniInspector openOn:(dot receiver).
+ ^ false
+ ].
+
+ (cmd == $I) ifTrue:[
+ self interpreterLoopWith:nil.
+ ^ false
+ ].
+ (cmd == $e) ifTrue:[
+ Parser evaluate:commandArg.
+ ^ false
+ ].
+
+ (cmd == $c) ifTrue:[^ true].
+ (cmd == $s) ifTrue:[^ true].
+ (cmd == $t) ifTrue:[^ true].
+ (cmd == $a) ifTrue:[^ true].
+
+ (cmd == $u) ifTrue:[
+ stepping := false.
+ tracing := false.
+ Processor activeProcess vmTrace:false.
+ ^ false
+ ].
+
+ (cmd == $R) ifTrue:[
+ proc notNil ifTrue:[
+ proc resume.
+ ].
+ ^ false
+ ].
+
+ (cmd == $T) ifTrue:[
+ proc notNil ifTrue:[
+ proc terminate.
+ ] ifFalse:[
+ id notNil ifTrue:[
+ 'no process with id: ' print. id printCR.
+ ] ifFalse:[
+ Processor terminateActive
+ ]
+ ].
+ ^ false
+ ].
+
+ (cmd == $W) ifTrue:[
+ proc notNil ifTrue:[
+ 'stopping process id: ' print. id printCR.
+ proc stop.
+ ] ifFalse:[
+ 'invalid process id: ' print. id printCR.
+ ].
+ ^ false
+ ].
+
+ (cmd == $a) ifTrue:[
+ "without id-arg, this is handled by caller"
+ proc notNil ifTrue:[
+ 'aborting process id: ' print. id printCR.
+ proc interruptWith:[AbortOperationRequest raise]
+ ] ifFalse:[
+ 'aborting' printCR.
+ ].
+ ^ false
+ ].
+
+ (cmd == $Q) ifTrue:[
+ proc notNil ifTrue:[
+ proc terminateNoSignal.
+ ] ifFalse:[
+ id notNil ifTrue:[
+ 'no process with id: ' print. id printCR.
+ ] ifFalse:[
+ Processor terminateActiveNoSignal
+ ]
+ ].
+ ^ false
+ ].
+
+ (cmd == $g) ifTrue:[
+ self garbageCollectCommand:id.
+ ^ false
+ ].
+
+ (cmd == $U) ifTrue:[
+ MessageTracer unwrapAllMethods.
+ ^ false
+ ].
+ (cmd == $X) ifTrue:[
+ Smalltalk fatalAbort.
+ "/ not reached
+ ^ false
+ ].
+ (cmd == $x) ifTrue:[
+ OperatingSystem exit.
+ "/ not reached
+ ^ false
+ ].
+
+ (cmd == $.) ifTrue:[self printDot. ^ false ].
+ (cmd == $m) ifTrue:[self printDotsMethodSource. ^ false ].
+ (cmd == $-) ifTrue:[self moveDotUp. ^ false ].
+ (cmd == $+) ifTrue:[self moveDotDown. ^ false ].
+
+ "/ avoid usage print if return was typed ...
+ ((cmd == Character return)
+ or:[cmd == Character linefeed]) ifTrue:[^ false].
+
+ self showValidCommandHelp.
+ ^ false.
+
+ "Modified: / 29-09-2006 / 12:23:18 / cg"
+ "Created: / 29-09-2011 / 08:58:47 / cg"
+!
+
getCommand:prompt
"/ Screen notNil ifTrue:[
"/ Screen allScreens do:[:aScreen |
@@ -875,9 +902,9 @@
!MiniDebugger class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.78 2010-10-29 16:52:00 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.79 2011-09-29 07:06:51 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.78 2010-10-29 16:52:00 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.79 2011-09-29 07:06:51 cg Exp $'
! !