hg/stx-libbasic: comparison MiniDebugger.st

equal deleted inserted replaced

-:826c0e1220af
+:c0422fc32176
+"{ Encoding: utf8 }"
 "
 COPYRIGHT (c) 1988 by Claus Gittinger
 	      All Rights Reserved
 This software is furnished under a license and may be used
 "{ NameSpace: Smalltalk }"
 Object subclass:#MiniDebugger
 	instanceVariableNames:'tracing stepping traceBlock command commandArg commandCount
-		enteringContext dot nesting inputStream'
+		enteringContext dotProcess dot nesting inputStream'
 	classVariableNames:'NotFirstTimeEntered'
 	poolDictionaries:''
 	category:'System-Debugging-Support'
 !
 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 or the UI/event handler is broken).
 This one is also called for, if an interrupt occurs within the debuger,
 or if CTRL-C is pressed in the controlling tty/console.
 Needs a console.
+You can also enter it explicitly with:
 MiniDebugger enter
 Attention:
 all printing is done via lowLevel _errorPrint messages,
 to ensure that output is to stderr, even if a logger is present,
 moveDotDown
 "/ sigh - must search
 |c|
-c := enteringContext.
+dotProcess isNil ifTrue:[
+c := enteringContext
+] ifFalse:[
+c := dotProcess suspendedContext.
+c isNil ifTrue:[
+'** process is not suspended' _errorPrintCR.
+].
+].
 [ c notNil and:[ c sender ~~ dot ] ] whileTrue:[
 c := c sender.
 ].
 c notNil ifTrue:[
 dot := c.
 doCommand:cmd
 "a single command;
 return true, if command loop should be finished"
-|id proc bool|
+|id proc bool retVal|
 "/ care for argument after command character (pid or '+' or '-')
 commandArg notEmptyOrNil ifTrue:[
 id := Number readFrom:commandArg onError:nil.
 id notNil ifTrue:[
 ]
 ]
 ]
 ].
-('wbTQ' includes:cmd) ifTrue:[
+"/ S -> save
+(cmd == $S) ifTrue:[
+'saving "crash.img"...' _errorPrint.
+ObjectMemory writeCrashImage.
+'done.' _errorPrintCR.
+^ false
+].
+"/ C -> save session changes
+(cmd == $C) ifTrue:[
+|changesFilename|
+changesFilename := Timestamp now
+printStringFormat:'changes_%(year)-%(month)-%(day)__%h:%m:%s.chg'.
+OperatingSystem isMSWINDOWSlike ifTrue:[ changesFilename replaceAll:$: with:$_ ].
+('saving session changes to "',changesFilename,'"...') _errorPrintCR.
+ChangeSet current fileOutAs: changesFilename.
+'done.' _errorPrintCR.
+^ false
+].
+"/ B -> print backtrace of all processes
+(cmd == $B) ifTrue:[
+self printAllBacktraces.
+^ false
+].
+"/ P -> print all processes
+(cmd == $P) ifTrue:[
+self showProcesses:#all.
+^ false
+].
+"/ c -> continue
+(cmd == $c) ifTrue:[^ true].
+"/ s -> single step
+(cmd == $s) ifTrue:[^ true].
+"/ t -> continue with trace
+(cmd == $t) ifTrue:[^ true].
+"/ a -> abort
+(cmd == $a) ifTrue:[
+id isNil ifTrue:[^ true].
+].
+"/ p -> list (alive) processes
+(cmd == $p) ifTrue:[
+self showProcesses:#live.
+^ false
+].
+('wbTQa=' includes:cmd) ifTrue:[
 (id notNil and:[proc isNil]) ifTrue:[
 'no process with id: ' _errorPrint. id _errorPrintCR.
 ^ false.
 ].
+].
+"/ = id -> set current process for dot (to inspect chain/receiver of another thread)
+(cmd == $=) ifTrue:[
+(dotProcess == proc) ifFalse:[
+dotProcess := proc.
+proc isNil ifTrue:[
+dot := enteringContext.
+'switched back to interrupted process (for dot commands): ' _errorPrint. Processor activeProcess _errorPrintCR.
+] ifFalse:[
+dot := proc suspendedContext.
+'switched to process (for dot commands): ' _errorPrint. proc _errorPrintCR.
+].
+].
+^ false.
+].
+(cmd == $a) ifTrue:[
+"/ here a with id-arg
+proc == Processor activeProcess ifTrue:[^ true].
+proc interruptWith:[ AbortOperationRequest raise ].
+^ false.
 ].
 (cmd == $w) ifTrue:[
 proc notNil ifTrue:[
 '-------- walkback of process ' _errorPrint. id _errorPrint. ' -------' _errorPrintCR.
 ]
 ].
 ^ false
 ].
-(cmd == $S) ifTrue:[
-'saving "crash.img"...' _errorPrint.
-ObjectMemory writeCrashImage.
-'done.' _errorPrintCR.
-^ false
-].
-(cmd == $C) ifTrue:[
-|changesFilename|
-changesFilename := Timestamp now
-printStringFormat:'changes_%(year)-%(month)-%(day)__%h:%m:%s.chg'.
-OperatingSystem isMSWINDOWSlike ifTrue:[ changesFilename replaceAll:$: with:$_ ].
-ChangeSet current fileOutAs: changesFilename.
-('saved session changes to "',changesFilename,'".') _errorPrintCR.
-^ false
-].
-(cmd == $B) ifTrue:[
-self printAllBacktraces.
-^ false
-].
-(cmd == $P) ifTrue:[
-self showProcesses:#all.
-^ false
-].
-(cmd == $p) ifTrue:[
-self showProcesses:#live.
-^ false
-].
 (cmd == $r) ifTrue:[
 dot receiver _errorPrintCR.
 ^ false
 ].
 (cmd == $I) ifTrue:[
 self interpreterLoopWith:nil.
 ^ false
 ].
-(cmd == $E) ifTrue:[
+((cmd == $E) or:[(cmd == $e)]) ifTrue:[
-Parser evaluate:commandArg.
+retVal := Parser evaluate:commandArg in:dot receiver:(dot receiver) notifying:nil ifFail:nil.
-^ false
+(cmd == $e) ifTrue:[ retVal _errorPrintCR ].
-].
+^ false
-(cmd == $e) ifTrue:[
+].
-(Parser evaluate:commandArg) _errorPrintCR.
-^ 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.
 '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
+T [id] ... terminate (current) process
 Q [id] ... quick terminate (current) process - no unwinds or cleanup
 p ........ list processes ("P" for full list)
 w [id] ... walkback (of current/process with id)
 b [id] ... full (VM) backtrace with more detail
 S ........ save snapshot into "crash.img"
 C ........ save session changes to a separate change file
 x ........ exit Smalltalk ("X" to exit with core dump)
 Y ........ reopen display, reopen launcher
+= [id] ... set current process for dot commands below
 . ........ 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 ........ print receiver (in dot)
-r ........ receiver (in dot) printString
 i [expr] . inspect expression (or receiver in dot)
 I ........ interpreter (expression evaluator)
 e expr ... evaluate expression & print result ("E" to not print)
 ? c [p] .. help on class c (selectors matching p)
 '  _errorPrintCR.

changeset 25253	c0422fc32176
parent 25251	61b643937051
child 25293	037a1af56749