Mercurial Mercurial > hg > stx-libbasic / changeset
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | raw | zip | gz | bz2 | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
*** empty log message ***
authorclaus
Wed, 30 Mar 1994 12:29:13 +0200
changeset 74 5fb970c7cb96
parent 73 a6640cc96199
child 75 2c61e28412de
*** empty log message ***
MiniDebug.st file | annotate | diff | comparison | revisions
MiniDebugger.st file | annotate | diff | comparison | revisions
MiniIns.st file | annotate | diff | comparison | revisions
MiniInspector.st file | annotate | diff | comparison | revisions 
--- a/MiniDebug.st	Wed Mar 30 12:26:38 1994 +0200
+++ b/MiniDebug.st	Wed Mar 30 12:29:13 1994 +0200
@@ -26,7 +26,7 @@
 graphics or when the real debugger dies (i.e. an error occurs in
 the graphical debugger).
 
-$Header: /cvs/stx/stx/libbasic/Attic/MiniDebug.st,v 1.5 1994-01-08 16:28:11 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/MiniDebug.st,v 1.6 1994-03-30 10:29:11 claus Exp $
 '!
 
 !MiniDebugger class methodsFor: 'instance creation'!
@@ -121,6 +121,20 @@
         backtrace := backtrace sender
     ].
     ^ backtrace
+!
+
+findContext:aSelector
+    |con|
+
+    con := thisContext sender.
+    [con notNil] whileTrue:[
+        (con isBlockContext not and:[con selector == aSelector]) ifTrue:[
+            "got it"
+            ^ con
+        ].
+        con := con sender
+    ].
+    ^ nil
 ! !
 
 !MiniDebugger methodsFor: 'interrupt handling'!
@@ -136,7 +150,7 @@
         where notNil ifTrue:[
             where fullPrint
         ] ifFalse:[
-            'stepInterrupt: no context' printNewline
+            'stepInterrupt: no context' errorPrintNewline
         ].
         self enter
     ] ifFalse:[
@@ -145,7 +159,7 @@
                 traceBlock value:where
             ]
         ] ifFalse:[
-            'traceInterrupt: no context' printNewline
+            'traceInterrupt: no context' errorPrintNewline
         ].
         ObjectMemory flushInlineCaches.
         StepInterruptPending := true.
@@ -154,34 +168,87 @@
 !
 
 enter
-    |cmd|
+    |cmd stillHere|
+
+    stillHere := true.
+    [stillHere] whileTrue:[
+        cmd := self commandLoop.
 
-    cmd := self commandLoop.
-    (cmd == $s) ifTrue: [
-        self stepping.
-        ObjectMemory flushInlineCaches.
-        ObjectMemory stepInterruptHandler:self.
-        StepInterruptPending := true.
-        InterruptPending := true
-    ].
-    (cmd == $t) ifTrue: [
-        traceBlock := [:where | where fullPrint].
-        ObjectMemory flushInlineCaches.
-        ObjectMemory stepInterruptHandler:self.
-        StepInterruptPending := true.
-        InterruptPending := true
-    ].
-    (cmd == $c) ifTrue: [
-        stepping := false.
-        tracing := false.
-        StepInterruptPending := nil.
-        InterruptPending := nil
+        (cmd == $s) ifTrue: [
+            self stepping.
+            ObjectMemory flushInlineCaches.
+            ObjectMemory stepInterruptHandler:self.
+            stillHere := false.
+            StepInterruptPending := true.
+            InterruptPending := true
+        ].
+        (cmd == $t) ifTrue: [
+            traceBlock := [:where | where fullPrint].
+            ObjectMemory flushInlineCaches.
+            ObjectMemory stepInterruptHandler:self.
+            stillHere := false.
+            StepInterruptPending := true.
+            InterruptPending := true
+        ].
+        (cmd == $c) ifTrue: [
+            stillHere := false.
+            stepping := false.
+            tracing := false.
+            StepInterruptPending := nil.
+            InterruptPending := nil
+        ].
+        (cmd == $a) ifTrue: [
+            "abort"
+            stepping := false.
+            tracing := false.
+            StepInterruptPending := nil.
+            InterruptPending := nil.
+            self doAbort.
+            stillHere := true.
+            "failed abort"
+        ].
     ].
     ^ nil
 ! !
 
 !MiniDebugger methodsFor: 'user commands'!
 
+doAbort
+    |con sig|
+
+    (sig := Object abortSignal) isHandled ifTrue:[
+        sig raise.
+        'abort raise failed' errorPrintNewline.
+    ].
+
+    "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' errorPrintNewline.
+    ].
+
+    'found no context to resume' errorPrintNewline.
+!
+
+showProcesses
+    |active|
+
+    active := Processor activeProcess.
+    'current id=' print. active id print. ' name=' print. active name printNewline.
+
+    Process allInstancesDo:[:p |
+        'proc id=' print. p id print. ' name=' print. p name print. ' state=' print.
+                          p state printNewline.
+    ]
+!
+
 commandLoop
     |cmd done valid context|
 
@@ -197,9 +264,13 @@
             context notNil ifTrue:[
                 context fullPrintAll
             ] ifFalse:[
-                'no context' printNewline
+                'no context' errorPrintNewline
             ]
         ].
+        (cmd == $P) ifTrue:[
+            valid := true.
+            self showProcesses.
+        ].
         (cmd == $r) ifTrue:[
             valid := true.
             context isNil ifTrue: [
@@ -209,7 +280,7 @@
                 "remove Debugger stepinterrupt/halt frame"
                 context sender receiver printNewline
             ] ifFalse:[
-                'no context - dont know receiver' printNewline
+                'no context - dont know receiver' errorPrintNewline
             ]
         ].
         (cmd == $R) ifTrue:[
@@ -221,7 +292,7 @@
                 "remove Debugger stepinterrupt/halt frame"
                 context sender receiver storeOn:Stdout
             ] ifFalse:[
-                'no context - dont know receiver' printNewline
+                'no context - dont know receiver' errorPrintNewline
             ]
         ].
         (cmd == $i) ifTrue:[
@@ -233,7 +304,7 @@
                 "remove Debugger stepinterrupt/halt frame"
                 context sender receiver inspect
             ] ifFalse:[
-                'no context - dont know receiver' printNewline
+                'no context - dont know receiver' errorPrintNewline
             ]
         ].
         (cmd == $I) ifTrue:[
@@ -245,7 +316,7 @@
                 "remove Debugger stepinterrupt/halt frame"
                 self interpreterLoopWith:(context sender receiver)
             ] ifFalse:[
-                'no context - dont know receiver' printNewline.
+                'no context - dont know receiver' errorPrintNewline.
                 self interpreterLoopWith:nil
             ]
         ].
@@ -253,20 +324,25 @@
         (cmd == $c) ifTrue:[valid := true. done := true].
         (cmd == $s) ifTrue:[valid := true. done := true].
         (cmd == $t) ifTrue:[valid := true. done := true].
-        (cmd == $a) ifTrue:[Smalltalk fatalAbort].
+        (cmd == $a) ifTrue:[valid := true. done := true].
+        (cmd == $T) ifTrue:[valid := true. Processor activeProcess terminate].
+        (cmd == $X) ifTrue:[Smalltalk fatalAbort].
         (cmd == $x) ifTrue:[Smalltalk exit].
         valid ifFalse: [
-            'valid commands:' printNewline.
-            '   (c)ontinue'     printNewline.
-            '   (s)tep'         printNewline.
-            '   (t)race'        printNewline.
-            '   (p)rintContext' printNewline.
-            '   (r)eceiver'     printNewline.
-            '   (R)eceiver'     printNewline.
-            '   (i)nspect'      printNewline.
-            '   (I)nterpreter'  printNewline.
-            '   (a)bort'        printNewline.
-            '   (x)exit Smalltalk'  printNewline
+            'valid commands:
+   (c)ontinue
+   (s)tep
+   (t)race
+   (p)rintContext
+   (r)eceiver
+   (R)eceiver
+   (i)nspect
+   (I)nterpreter
+   (a)bort
+   (P)rocesses
+   (T)terminate process
+   (X)exit (+core)
+   (x)exit Smalltalk'  errorPrintNewline
         ]
     ].
     ^ cmd
--- a/MiniDebugger.st	Wed Mar 30 12:26:38 1994 +0200
+++ b/MiniDebugger.st	Wed Mar 30 12:29:13 1994 +0200
@@ -26,7 +26,7 @@
 graphics or when the real debugger dies (i.e. an error occurs in
 the graphical debugger).
 
-$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.5 1994-01-08 16:28:11 claus Exp $
+$Header: /cvs/stx/stx/libbasic/MiniDebugger.st,v 1.6 1994-03-30 10:29:11 claus Exp $
 '!
 
 !MiniDebugger class methodsFor: 'instance creation'!
@@ -121,6 +121,20 @@
         backtrace := backtrace sender
     ].
     ^ backtrace
+!
+
+findContext:aSelector
+    |con|
+
+    con := thisContext sender.
+    [con notNil] whileTrue:[
+        (con isBlockContext not and:[con selector == aSelector]) ifTrue:[
+            "got it"
+            ^ con
+        ].
+        con := con sender
+    ].
+    ^ nil
 ! !
 
 !MiniDebugger methodsFor: 'interrupt handling'!
@@ -136,7 +150,7 @@
         where notNil ifTrue:[
             where fullPrint
         ] ifFalse:[
-            'stepInterrupt: no context' printNewline
+            'stepInterrupt: no context' errorPrintNewline
         ].
         self enter
     ] ifFalse:[
@@ -145,7 +159,7 @@
                 traceBlock value:where
             ]
         ] ifFalse:[
-            'traceInterrupt: no context' printNewline
+            'traceInterrupt: no context' errorPrintNewline
         ].
         ObjectMemory flushInlineCaches.
         StepInterruptPending := true.
@@ -154,34 +168,87 @@
 !
 
 enter
-    |cmd|
+    |cmd stillHere|
+
+    stillHere := true.
+    [stillHere] whileTrue:[
+        cmd := self commandLoop.
 
-    cmd := self commandLoop.
-    (cmd == $s) ifTrue: [
-        self stepping.
-        ObjectMemory flushInlineCaches.
-        ObjectMemory stepInterruptHandler:self.
-        StepInterruptPending := true.
-        InterruptPending := true
-    ].
-    (cmd == $t) ifTrue: [
-        traceBlock := [:where | where fullPrint].
-        ObjectMemory flushInlineCaches.
-        ObjectMemory stepInterruptHandler:self.
-        StepInterruptPending := true.
-        InterruptPending := true
-    ].
-    (cmd == $c) ifTrue: [
-        stepping := false.
-        tracing := false.
-        StepInterruptPending := nil.
-        InterruptPending := nil
+        (cmd == $s) ifTrue: [
+            self stepping.
+            ObjectMemory flushInlineCaches.
+            ObjectMemory stepInterruptHandler:self.
+            stillHere := false.
+            StepInterruptPending := true.
+            InterruptPending := true
+        ].
+        (cmd == $t) ifTrue: [
+            traceBlock := [:where | where fullPrint].
+            ObjectMemory flushInlineCaches.
+            ObjectMemory stepInterruptHandler:self.
+            stillHere := false.
+            StepInterruptPending := true.
+            InterruptPending := true
+        ].
+        (cmd == $c) ifTrue: [
+            stillHere := false.
+            stepping := false.
+            tracing := false.
+            StepInterruptPending := nil.
+            InterruptPending := nil
+        ].
+        (cmd == $a) ifTrue: [
+            "abort"
+            stepping := false.
+            tracing := false.
+            StepInterruptPending := nil.
+            InterruptPending := nil.
+            self doAbort.
+            stillHere := true.
+            "failed abort"
+        ].
     ].
     ^ nil
 ! !
 
 !MiniDebugger methodsFor: 'user commands'!
 
+doAbort
+    |con sig|
+
+    (sig := Object abortSignal) isHandled ifTrue:[
+        sig raise.
+        'abort raise failed' errorPrintNewline.
+    ].
+
+    "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' errorPrintNewline.
+    ].
+
+    'found no context to resume' errorPrintNewline.
+!
+
+showProcesses
+    |active|
+
+    active := Processor activeProcess.
+    'current id=' print. active id print. ' name=' print. active name printNewline.
+
+    Process allInstancesDo:[:p |
+        'proc id=' print. p id print. ' name=' print. p name print. ' state=' print.
+                          p state printNewline.
+    ]
+!
+
 commandLoop
     |cmd done valid context|
 
@@ -197,9 +264,13 @@
             context notNil ifTrue:[
                 context fullPrintAll
             ] ifFalse:[
-                'no context' printNewline
+                'no context' errorPrintNewline
             ]
         ].
+        (cmd == $P) ifTrue:[
+            valid := true.
+            self showProcesses.
+        ].
         (cmd == $r) ifTrue:[
             valid := true.
             context isNil ifTrue: [
@@ -209,7 +280,7 @@
                 "remove Debugger stepinterrupt/halt frame"
                 context sender receiver printNewline
             ] ifFalse:[
-                'no context - dont know receiver' printNewline
+                'no context - dont know receiver' errorPrintNewline
             ]
         ].
         (cmd == $R) ifTrue:[
@@ -221,7 +292,7 @@
                 "remove Debugger stepinterrupt/halt frame"
                 context sender receiver storeOn:Stdout
             ] ifFalse:[
-                'no context - dont know receiver' printNewline
+                'no context - dont know receiver' errorPrintNewline
             ]
         ].
         (cmd == $i) ifTrue:[
@@ -233,7 +304,7 @@
                 "remove Debugger stepinterrupt/halt frame"
                 context sender receiver inspect
             ] ifFalse:[
-                'no context - dont know receiver' printNewline
+                'no context - dont know receiver' errorPrintNewline
             ]
         ].
         (cmd == $I) ifTrue:[
@@ -245,7 +316,7 @@
                 "remove Debugger stepinterrupt/halt frame"
                 self interpreterLoopWith:(context sender receiver)
             ] ifFalse:[
-                'no context - dont know receiver' printNewline.
+                'no context - dont know receiver' errorPrintNewline.
                 self interpreterLoopWith:nil
             ]
         ].
@@ -253,20 +324,25 @@
         (cmd == $c) ifTrue:[valid := true. done := true].
         (cmd == $s) ifTrue:[valid := true. done := true].
         (cmd == $t) ifTrue:[valid := true. done := true].
-        (cmd == $a) ifTrue:[Smalltalk fatalAbort].
+        (cmd == $a) ifTrue:[valid := true. done := true].
+        (cmd == $T) ifTrue:[valid := true. Processor activeProcess terminate].
+        (cmd == $X) ifTrue:[Smalltalk fatalAbort].
         (cmd == $x) ifTrue:[Smalltalk exit].
         valid ifFalse: [
-            'valid commands:' printNewline.
-            '   (c)ontinue'     printNewline.
-            '   (s)tep'         printNewline.
-            '   (t)race'        printNewline.
-            '   (p)rintContext' printNewline.
-            '   (r)eceiver'     printNewline.
-            '   (R)eceiver'     printNewline.
-            '   (i)nspect'      printNewline.
-            '   (I)nterpreter'  printNewline.
-            '   (a)bort'        printNewline.
-            '   (x)exit Smalltalk'  printNewline
+            'valid commands:
+   (c)ontinue
+   (s)tep
+   (t)race
+   (p)rintContext
+   (r)eceiver
+   (R)eceiver
+   (i)nspect
+   (I)nterpreter
+   (a)bort
+   (P)rocesses
+   (T)terminate process
+   (X)exit (+core)
+   (x)exit Smalltalk'  errorPrintNewline
         ]
     ].
     ^ cmd
--- a/MiniIns.st	Wed Mar 30 12:26:38 1994 +0200
+++ b/MiniIns.st	Wed Mar 30 12:29:13 1994 +0200
@@ -25,7 +25,7 @@
 a primitive (non graphical) inspector for use on systems without
 graphics or when the real inspector dies.
 
-$Header: /cvs/stx/stx/libbasic/Attic/MiniIns.st,v 1.4 1993-10-13 02:12:48 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Attic/MiniIns.st,v 1.5 1994-03-30 10:29:13 claus Exp $
 '!
 
 !MiniInspector class methodsFor:'instance creation'!
@@ -83,11 +83,11 @@
         ].
         (cmd == $q) ifTrue:[valid := true. done := true ].
         valid ifFalse: [
-            'valid commands:' printNewline.
-            '   (i)nstvars'   printNewline.
-            '   (p)rint'      printNewline.
-            '   (1-9) inspect instvar'      printNewline.
-            '   (q)uit'       printNewline
+            'valid commands:
+   (i)nstvars
+   (p)rint
+   (1-9) inspect instvar
+   (q)uit'       errorPrintNewline
         ]
     ].
     ^ cmd
--- a/MiniInspector.st	Wed Mar 30 12:26:38 1994 +0200
+++ b/MiniInspector.st	Wed Mar 30 12:29:13 1994 +0200
@@ -25,7 +25,7 @@
 a primitive (non graphical) inspector for use on systems without
 graphics or when the real inspector dies.
 
-$Header: /cvs/stx/stx/libbasic/MiniInspector.st,v 1.4 1993-10-13 02:12:48 claus Exp $
+$Header: /cvs/stx/stx/libbasic/MiniInspector.st,v 1.5 1994-03-30 10:29:13 claus Exp $
 '!
 
 !MiniInspector class methodsFor:'instance creation'!
@@ -83,11 +83,11 @@
         ].
         (cmd == $q) ifTrue:[valid := true. done := true ].
         valid ifFalse: [
-            'valid commands:' printNewline.
-            '   (i)nstvars'   printNewline.
-            '   (p)rint'      printNewline.
-            '   (1-9) inspect instvar'      printNewline.
-            '   (q)uit'       printNewline
+            'valid commands:
+   (i)nstvars
+   (p)rint
+   (1-9) inspect instvar
+   (q)uit'       errorPrintNewline
         ]
     ].
     ^ cmd
hg/stx-libbasic