MiniDebugger.st
changeset 25253 c0422fc32176
parent 25251 61b643937051
child 25293 037a1af56749
--- a/MiniDebugger.st	Thu Feb 06 23:59:25 2020 +0100
+++ b/MiniDebugger.st	Fri Feb 07 12:58:57 2020 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "
  COPYRIGHT (c) 1988 by Claus Gittinger
 	      All Rights Reserved
@@ -15,7 +17,7 @@
 
 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'
@@ -42,10 +44,12 @@
     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:
@@ -464,7 +468,14 @@
     "/ 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.
     ].
@@ -681,7 +692,7 @@
     "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:[
@@ -702,13 +713,89 @@
         ]
     ].
 
-    ('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.
@@ -741,38 +828,6 @@
         ^ 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
@@ -794,19 +849,11 @@
         self interpreterLoopWith:nil.
         ^ false
     ].
-    (cmd == $E) ifTrue:[
-        Parser evaluate:commandArg.
+    ((cmd == $E) or:[(cmd == $e)]) ifTrue:[
+        retVal := Parser evaluate:commandArg in:dot receiver:(dot receiver) notifying:nil ifFail:nil.
+        (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.
@@ -1146,9 +1193,9 @@
    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)
@@ -1168,13 +1215,14 @@
    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)
+   i [expr] . inspect expression (or 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)