--- a/MiniDebugger.st Thu Feb 07 09:53:25 2013 +0100
+++ b/MiniDebugger.st Tue Mar 05 18:10:13 2013 +0000
@@ -14,7 +14,7 @@
Object subclass:#MiniDebugger
instanceVariableNames:'tracing stepping traceBlock command commandArg commandCount
enteringContext dot nesting'
- classVariableNames:'TheOneAndOnlyDebugger'
+ classVariableNames:'TheOneAndOnlyDebugger NotFirstTimeEntered'
poolDictionaries:''
category:'System-Debugging-Support'
!
@@ -69,59 +69,64 @@
StepInterruptPending := nil.
Error handle:[:ex |
- ex return
+ 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.
+ 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.
- 'context: ' print. aContext printString printCR.
- (con := aContext) notNil ifTrue:[
- con := con sender.
- ' ......: ' print. con printString printCR.
- [con notNil] whileTrue:[
- sender := con sender.
- (sender notNil and:[sender selector == con selector]) ifTrue:[
- ' ......: ' print. sender printString printCR.
- ' ......: [** intermediate recursive contexts skipped **]' printCR.
- [sender notNil
- and:[sender selector == con selector
- and:[sender method == con method]]] whileTrue:[
- con := sender.
- sender := con sender.
- ].
- ].
- con := sender.
- ' ......: ' print. con printString printCR.
- ]
- ]
- ].
+ 'context: ' print. aContext printString printCR.
+ (con := aContext) notNil ifTrue:[
+ con := con sender.
+ ' ......: ' print. con printString printCR.
+ [con notNil] whileTrue:[
+ sender := con sender.
+ (sender notNil and:[sender selector == con selector]) ifTrue:[
+ ' ......: ' print. sender printString printCR.
+ ' ......: [** intermediate recursive contexts skipped **]' printCR.
+ [sender notNil
+ and:[sender selector == con selector
+ and:[sender method == con method]]] whileTrue:[
+ con := sender.
+ sender := con sender.
+ ].
+ ].
+ con := sender.
+ ' ......: ' print. con printString printCR.
+ ]
+ ]
+ ].
+ NotFirstTimeEntered ~~ true ifTrue:[
+ NotFirstTimeEntered := true.
+ 'Type "c" to proceed, "?" for help' printCR.
+ ].
].
OperatingSystem hasConsole ifFalse:[
- Error handle:[:ex |
- ex return
- ] do:[
- self warn:('Unexpected error:\' , aString , '\\No MiniDebugger functionality available') withCRs .
- ].
+ Error handle:[:ex |
+ ex return
+ ] do:[
+ self warn:('Unexpected error:\' , aString , '\\No MiniDebugger functionality available') withCRs .
+ ].
- Error handle:[:ex |
- 'cannot raise Abort - exiting ...' errorPrintCR.
- Smalltalk exit.
- ] do:[
- AbortOperationRequest raise.
- ]
+ Error handle:[:ex |
+ 'cannot raise Abort - exiting ...' errorPrintCR.
+ Smalltalk exit.
+ ] do:[
+ AbortOperationRequest raise.
+ ]
] ifTrue:[
- self new enter:aContext mayProceed:mayProceed.
+ self new enter:aContext mayProceed:mayProceed.
].
mayProceed ifFalse:[
- AbortOperationRequest raise
+ AbortOperationRequest raise
].
^ nil
@@ -551,18 +556,26 @@
!
doCommand:cmd
- "a single command; return true, if command loop should be finished"
+ "a single command;
+ return true, if command loop should be finished"
- |id proc|
+ |id proc bool|
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
]
+ ] ifFalse:[
+ commandArg = '-' ifTrue:[
+ bool := false
+ ] ifFalse:[
+ commandArg = '+' ifTrue:[
+ bool := true
+ ]
+ ]
]
].
@@ -609,7 +622,11 @@
].
(cmd == $P) ifTrue:[
- self showProcesses.
+ self showProcesses:#all.
+ ^ false
+ ].
+ (cmd == $p) ifTrue:[
+ self showProcesses:#live.
^ false
].
@@ -644,6 +661,14 @@
^ false
].
+ (cmd == $h) ifTrue:[
+ (bool notNil) ifTrue:[
+ Smalltalk ignoreHalt:bool not.
+ ].
+ 'halts are ' print. (Smalltalk ignoreHalt ifTrue:['disabled'] ifFalse:['enabled']) printCR.
+ ^ false
+ ].
+
(cmd == $R) ifTrue:[
proc notNil ifTrue:[
proc resume.
@@ -790,7 +815,7 @@
arg := arg copyWith:c.
c := Character fromUser.
].
- commandArg := arg copyFrom:2.
+ commandArg := (arg copyFrom:2) withoutSeparators.
command := cmd.
commandCount := cnt.
].
@@ -851,18 +876,29 @@
!
showProcesses
+ self showProcesses:#all
+!
+
+showProcesses:how
|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.
+ |doShow|
+
+ doShow := (how == #all).
+ doShow := doShow or:[ (how == #dead) and:[ p isDead ]].
+ doShow := doShow or:[ (how ~~ #dead) and:[ p isDead not ]].
+ doShow ifTrue:[
+ '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"
@@ -870,58 +906,59 @@
showValidCommandHelp
'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
- W [id]. stop (current) process
- R [id]. resume (current) process
- Q [id]. quick terminate (current) process - no unwinds or cleanup
+ 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
+ W [id] stop (current) process
+ R [id] resume (current) process
+ Q [id] quick terminate (current) process - no unwinds or cleanup
- P ..... list processes
- w [id]. walkback (of process with id)
- b [id]. full (VM) backtrace (more detail)
- B ..... backtrace of all other processes
-
- U ..... unwrap all traced/breakpointed methods
- g ..... collect all garbage
- g 2.... collect all garbage & reclaim symbols
- g 3.... collect all garbage, reclaim symbols and compress
+ p ...... list processes ("P" for full list)
+ w [id] walkback (of process with id)
+ b [id] full (VM) backtrace (more detail)
+ B ...... backtrace of all other processes
- S ..... save snapshot into crash.img
- x ..... exit Smalltalk
- X ..... exit Smalltalk (+core dump)
+ U ...... unwrap all traced/breakpointed methods
+ h [-/+] disable/enable halts
+ g ...... collect all garbage
+ g 2 .... collect all garbage & reclaim symbols
+ g 3 .... collect all garbage, reclaim symbols and compress
+
+ S ...... save snapshot into crash.img
+ x ...... exit Smalltalk ("X" to exit with core dump)
- . ..... print dot (the current context)
- - ..... move dot up (sender)
- + ..... move dot down (called context)
- l ..... list method source around dot''s
- L ..... list dot''s method source code
+ . ...... print dot (the current context)
+ - ...... move dot up (sender)
+ + ...... move dot down (called context)
+ l ...... list dot''s method source around PC ("L" for full list)
- r ..... receiver (in dot) printString
- i ..... inspect receiver (in dot)
- I ..... interpreter (expression evaluator)
- e expr evaluate expression
+ r ...... receiver (in dot) printString
+ i ...... inspect receiver (in dot)
+ I ...... interpreter (expression evaluator)
+ e expr evaluate expression
+' errorPrintCR.
- To repair a broken X-Connection, enter an interpreter and evaluate:
+ (XWorkstation notNil and:[ Screen default isKindOf:XWorkstation ]) ifTrue:[
+' To repair a broken X-Connection, enter an interpreter (enter "I") and evaluate:
Display := XWorkstation new.
- Display initializeFor:''hostName:0''.
+ Display initializeFor:''localhost:0''.
Display startDispatch.
NewLauncher openOnDevice:Display.
<empty line>
- then enter ''c'' to continue; a NewLauncher should pop up soon.
-
+ then enter "c" to continue; a NewLauncher should pop up soon.
' errorPrintCR
+ ]
! !
!MiniDebugger class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.80 2013-02-01 14:47:44 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.82 2013-02-23 11:14:32 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.80 2013-02-01 14:47:44 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.82 2013-02-23 11:14:32 cg Exp $'
! !