Hi,
I've moved the MiniDebugger from examples to packages/debug/debugger.
It uses the new syntax and prints temporary and argument names and values.
The context part has been updated with a new method that prints temporary
and argument names and values.
Gwen
>From 26b813db1a3e5b36fb75f64b94a0d01e7c26ea80 Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio <mrg...@gmail.com>
Date: Thu, 15 Aug 2013 17:02:18 +0200
Subject: [PATCH] MiniDebugger becomes a package and add a print context state
method.
MiniDebugger becomes the Debugger package and it has been updated to
print the arguments and temporaries variables names and values.
ContextPart has a new method for variables and temporaries printing.
---
ChangeLog | 4 +
configure.ac | 1 +
examples/MiniDebugger.st | 520 -------------------------------
kernel/ContextPart.st | 42 +++
packages/debug/ChangeLog | 4 +
packages/debug/DebugTools.st | 7 +
packages/debug/debugger/ChangeLog | 7 +
packages/debug/debugger/Extensions.st | 50 +++
packages/debug/debugger/MiniDebugger.st | 369 ++++++++++++++++++++++
packages/debug/debugger/MiniInspector.st | 159 ++++++++++
packages/debug/debugger/MiniTool.st | 110 +++++++
packages/debug/debugger/package.xml | 11 +
packages/debug/debugger/stamp-classes | 0
13 files changed, 764 insertions(+), 520 deletions(-)
delete mode 100644 examples/MiniDebugger.st
create mode 100644 packages/debug/debugger/ChangeLog
create mode 100644 packages/debug/debugger/Extensions.st
create mode 100644 packages/debug/debugger/MiniDebugger.st
create mode 100644 packages/debug/debugger/MiniInspector.st
create mode 100644 packages/debug/debugger/MiniTool.st
create mode 100644 packages/debug/debugger/package.xml
create mode 100644 packages/debug/debugger/stamp-classes
diff --git a/ChangeLog b/ChangeLog
index d4c410f..a1261f1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2013-08-15 Gwenael Casaccio <gwenael.casac...@gmail.com>
+
+ * kernel/ContextPart.st: Print context args and temps names and their value.
+
2013-08-10 Gwenael Casaccio <gwenael.casac...@gmail.com>
* kernel/BlkClosure.st: Add >>#method: setter.
diff --git a/configure.ac b/configure.ac
index e53b6c2..6c6bea6 100644
--- a/configure.ac
+++ b/configure.ac
@@ -413,6 +413,7 @@ GST_PACKAGE_ENABLE([Complex], [complex])
GST_PACKAGE_ENABLE([Continuations], [continuations])
GST_PACKAGE_ENABLE([CParser], [cpp])
GST_PACKAGE_ENABLE([DebugTools], [debug])
+GST_PACKAGE_ENABLE([Debugger], [debug/debugger])
GST_PACKAGE_ENABLE([ObjectDumper], [object-dumper])
GST_PACKAGE_ENABLE([DBD-MySQL], [dbd-mysql])
diff --git a/examples/MiniDebugger.st b/examples/MiniDebugger.st
deleted file mode 100644
index d3f540e..0000000
--- a/examples/MiniDebugger.st
+++ /dev/null
@@ -1,520 +0,0 @@
-"======================================================================
-|
-| Minimal inspector and debugger using DebugTools
-|
-|
- ======================================================================"
-
-
-"======================================================================
-|
-| Copyright 2002, 2006, 2007 Free Software Foundation, Inc.
-| Written by Paolo Bonzini.
-|
-| This file is part of GNU Smalltalk.
-|
-| GNU Smalltalk is free software; you can redistribute it and/or modify it
-| under the terms of the GNU General Public License as published by the Free
-| Software Foundation; either version 2, or (at your option) any later version.
-|
-| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
-| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-| FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
-| details.
-|
-| You should have received a copy of the GNU General Public License along with
-| GNU Smalltalk; see the file COPYING. If not, write to the Free Software
-| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
-|
- ======================================================================"
-
-PackageLoader fileInPackage: #DebugTools!
-
-Object subclass: #MiniTool
- instanceVariableNames: 'commandArg command'
- classVariableNames:''
- poolDictionaries:''
- category: 'Debugging-Support'
-!
-
-MiniTool subclass: #MiniInspector
- instanceVariableNames: 'inspectedObject depth'
- classVariableNames:''
- poolDictionaries:''
- category: 'Debugging-Support'
-!
-
-MiniTool subclass: #MiniDebugger
- instanceVariableNames: 'debugger activeContext depth methodSourceCodeCache'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'System-Debugging-Support'
-!
-
-MiniInspector comment:
-'I implement a primitive inspector which is launched by the MiniDebugger.'!
-
-MiniDebugger comment:
-'I implement 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). The interface is vaguely similar to GDB.'!
-
-
-!MiniTool class methodsFor: 'disabling debugging'!
-
-debuggerClass
- ^nil
-! !
-
-!MiniTool methodsFor: 'rep loop'!
-
-interpreterLoopWith: anObject
- | line |
- 'read-eval-print loop; exit with empty line
-' displayNl.
-
- [
- '(rep) ' display.
-
- line := stdin nextLine.
- line isEmpty
- ] whileFalse: [
- self eval: line to: anObject
- ]
-!
-
-eval: line to: anObject
- | result |
- result := Behavior
- evaluate: line
- to: anObject
- ifError: [ :f :l :e | e printNl. ^self ].
-
- result printNl
-! !
-
-!MiniTool methodsFor: 'instance creation'!
-
-showPrompt
- self subclassResponsibility
-!
-
-eofCommand
- self subclassResponsibility
-!
-
-doCommand
- self subclassResponsibility
-!
-
-getCommand
- | cmd |
- self showPrompt.
-
- cmd := stdin atEnd
- ifTrue: [ { self eofCommand } ]
- ifFalse: [ stdin nextLine substrings ].
-
- cmd isEmpty ifFalse: [
- command := (cmd at: 1) at: 1.
- commandArg := cmd copyFrom: 2.
- "Else repeat the last command."
- ].
-
- self doCommand ifFalse: [
- (command = $h) ifFalse: [ 'invalid command' displayNl ].
- self help displayNl
- ].
-!
-
-
-help
- self subclassResponsibility
-! !
-
-
-!MiniInspector class methodsFor: 'instance creation'!
-
-openOn: anObject
- self openOn: anObject depth: 0
-!
-
-openOn: anObject depth: n
- self new initializeFor: anObject depth: n; commandLoop
-! !
-
-!MiniInspector methodsFor: 'command loop'!
-
-help
- ^'inspector commands:
- (e)val start read-eval-print loop
- (i)nstvars print all instvars
- (i)nstvars NUMBER inspect n-th instvar (negative=fixed, positive=indexed)
- (p)rint print object
- (p)rint NUMBER print n-th instvar (negative=fixed, positive=indexed)
- (q)uit'
-!
-
-doCommand
- (command = $p) ifTrue: [
- stdout space: depth.
- commandArg isEmpty
- ifFalse: [ (self nthInstvar: commandArg first asInteger) printNl ]
- ifTrue: [ inspectedObject printNl ].
- ^true
- ].
-
- (command = $e) ifTrue: [
- self interpreterLoopWith: inspectedObject.
- ^true
- ].
-
- (command = $i) ifTrue: [
- commandArg isEmpty
- ifFalse: [ self inspectInstvar: commandArg first asInteger ]
- ifTrue: [ self printInstVarsOf: inspectedObject ].
- ^true
- ].
-
- ^command = $q
-!
-
-eofCommand
- ^'q'
-!
-
-commandLoop
- self printHeader.
- [
- self getCommand.
- command = $q
- ] whileFalse.
-!
-
-showPrompt
- stdout space: depth.
- '(insp) ' display.
-! !
-
-!MiniInspector methodsFor: 'commands'!
-
-inspectInstvar: which
- self doInspect: (self nthInstvar: which).
- self printHeader.
-!
-
-printInstVarsOf: anObject
- stdout space: depth.
- anObject inspect.
-! !
-
-!MiniInspector methodsFor: 'private'!
-
-initializeFor: anObject depth: n
- inspectedObject := anObject.
- depth := n.
- ^self
-!
-
-printHeader
- stdout space: depth.
- '-- inspector: ' display.
- inspectedObject basicPrintNl.
-!
-
-doInspect: anObject
- self class openOn: anObject depth: depth + 1
-!
-
-nthInstvar: which
- which < 0
- ifTrue: [ ^inspectedObject instVarAt: which negated ].
-
- ^inspectedObject basicSize = 0
- ifTrue: [ inspectedObject instVarAt: which ]
- ifFalse: [ inspectedObject basicAt: which ]
-! !
-
-
-!MiniDebugger class methodsFor: 'class attributes'!
-
-debuggingPriority
- ^FloatD infinity
-! !
-
-!MiniDebugger class methodsFor: 'instance creation'!
-
-open: aString
- [ :debugger || continuation arg |
- Processor activeProcess name: 'Debugger'.
- arg := Continuation currentDo: [ :cc |
- continuation := cc.
- aString ].
- arg printNl.
- [ self new debugger: debugger; commandLoop ]
- on: SystemExceptions.DebuggerReentered
- do: [ :ex | continuation value: ex messageText ]
- ] forkDebugger
-! !
-
-!MiniDebugger methodsFor: 'commands'!
-
-debugger: aDebugger
- debugger := aDebugger.
-!
-
-commandLoop
-
- "Show meaningful source code to the user."
- [ debugger suspendedContext isInternalExceptionHandlingContext ]
- whileTrue: [ debugger slowFinish ].
-
- depth := 0.
- activeContext := debugger suspendedContext.
- debugger suspendedContext backtrace.
- self printCurrentLine.
- [
- self getCommand.
- debugger isActive
- ] whileTrue.
- Processor activeProcess suspend
-!
-
-
-!MiniDebugger methodsFor: 'commands'!
-
-step
- debugger step.
- self resetContext!
-
-next
- debugger next.
- self resetContext!
-
-finish
- debugger finish: activeContext.
- self resetContext!
-
-continue
- debugger continue!
-
-resetContext
- activeContext := debugger suspendedContext.
- depth := 0!
-
-up
- activeContext parentContext isNil ifTrue: [ ^self ].
- activeContext := activeContext parentContext.
- depth := depth + 1.
-!
-
-down
- depth > 0 ifFalse: [ ^self ].
- depth := depth - 1.
- activeContext := debugger suspendedContext.
- depth timesRepeat: [ activeContext := activeContext parentContext ]
-! !
-
-!MiniDebugger methodsFor: 'printing'!
-
-printCurrentMethod
- | source |
- source := self currentMethodSource.
- source isNil ifTrue: [ ^self ].
- source keysAndValuesDo: [ :line :code |
- self rightJustify: line.
- stdout
- space;
- nextPutAll: code;
- nl
- ]
-!
-
-printCurrentLine
- | line source |
- activeContext isNil ifTrue: [ ^self ].
- source := self currentMethodSource.
- source isNil ifTrue: [ ^self ].
- line := Debugger currentLineIn: activeContext.
- line = 0 ifTrue: [ ^self ].
-
- self rightJustify: line.
- stdout
- space;
- nextPutAll: (source at: line ifAbsent: [ '' ]);
- nl
-! !
-
-
-!MiniDebugger methodsFor: 'user commands'!
-
-doStepCommand
- | context arg |
- ('udsnfc' includes: command) ifFalse: [ ^false ].
-
- context := activeContext.
- arg := commandArg at: 1 ifAbsent: [ 1 ].
- arg := arg asInteger.
-
- arg timesRepeat: [
- (command == $u) ifTrue: [ self up ].
- (command == $d) ifTrue: [ self down ].
- (command == $s) ifTrue: [ self step ].
- (command == $n) ifTrue: [ self next ].
- (command == $f) ifTrue: [ self finish ].
- (command == $c) ifTrue: [ self continue ].
- ].
-
- activeContext isNil ifFalse: [
- activeContext == context ifFalse: [ activeContext printNl ].
- self printCurrentLine ].
-
- ^true
-!
-
-doProcessCommand
- | id processes terminated |
- ('TSKb' includes: command) ifFalse: [ ^false ].
-
- (commandArg isEmpty and: [ command == $b ]) ifTrue: [
- activeContext backtrace.
- ^true ].
-
- processes := commandArg collect: [ :each || stream proc |
- stream := each readStream.
- id := Number readFrom: stream.
- stream atEnd
- ifFalse: [ 'please supply a valid process id' displayNl. ^true ].
-
- proc := id asObject.
- (proc isKindOf: Process)
- ifFalse: [ 'please supply a valid process id' displayNl. ^true ].
-
- proc ].
-
- processes isEmpty ifTrue: [ processes := {debugger process} ].
- terminated := false.
- processes do: [ :proc |
- proc suspendedContext isNil
- ifTrue: [('%1: process was terminated' % { proc asOop }) displayNl]
- ifFalse: [
- (command == $b) ifTrue: [
- processes size > 1 ifTrue: [
- ('backtrace for process %1' % { proc asOop }) displayNl].
- proc context backtrace ].
- (command == $S) ifTrue: [ proc suspend ].
- (command == $K) ifTrue: [ proc primTerminate ].
- (command == $T) ifTrue: [
- proc terminate.
- terminated := terminated or: [proc == debugger process]]]].
-
- terminated ifTrue: [ self continue ].
- ^true
-!
-
-doCommand
- self doStepCommand ifTrue: [ ^true ].
- self doProcessCommand ifTrue: [ ^true ].
-
- ('PriIelwgxX' includes: command) ifFalse: [ ^false ].
-
- (command == $h) ifTrue: [ ^true ].
-
- commandArg isEmpty
- ifFalse: [ 'no argument needed for this command' displayNl. ^true ].
-
- (command == $P) ifTrue: [ self showProcesses ].
- (command == $r) ifTrue: [ activeContext receiver printNl ].
- (command == $i) ifTrue: [ MiniInspector openOn: activeContext receiver ].
- (command == $I) ifTrue: [ MiniInspector openOn: activeContext ].
- (command == $e) ifTrue: [ self interpreterLoopWith: activeContext receiver ].
- (command == $l) ifTrue: [ self printCurrentMethod ].
- (command == $w) ifTrue: [ activeContext printNl. self printCurrentLine ].
- (command == $g) ifTrue: [ ObjectMemory globalGarbageCollect ].
- (command == $X) ifTrue: [ ObjectMemory abort ].
- (command == $x) ifTrue: [ ObjectMemory quit ].
- ^true
-!
-
-eofCommand
- ^'T'
-!
-
-showPrompt
- '(debug) ' display.
-!
-
-help
- ^'Control flow commands:
- s [n] step N times
- n [n] next (step over send) N times
- f [n] finish current method N times
- c continue
-
-Process commands: no ID means debugged process
- P show process list
- T [id]... terminate process
- K [id]... kill process - no unwinds or cleanup
- b [id]... backtrace
-
-Examining state:
- r print receiver on stdout
- i inspect (enter MiniInspector on current receiver)
- I inspect context (enter MiniInspector on current context)
- e eval (enter read-eval-print loop on current receiver)
-
-Examining the call stack:
- u [n] go N frames up (default 1)
- d [n] go N frames down (default 1)
- l print current method
- w print current frame
-
-Other commands:
- g collect all garbage
- X exit Smalltalk, and dump core
- x exit Smalltalk'
-! !
-
-!MiniDebugger methodsFor: 'private'!
-
-currentMethodSource
- activeContext isNil ifTrue: [ ^#() ].
- methodSourceCodeCache isNil ifTrue: [
- methodSourceCodeCache := WeakKeyIdentityDictionary new ].
- ^methodSourceCodeCache at: activeContext method ifAbsentPut: [
- activeContext method methodSourceString lines ]
-!
-
-rightJustify: n
- | printString |
- printString := n printString.
- stdout
- space: (7 - printString size max: 0);
- nextPutAll: printString
-!
-
-showProcesses
- self rightJustify: debugger process asOop.
- '>' display.
- debugger process printNl.
-
- Process allSubinstancesDo: [ :each |
- each == debugger process ifFalse: [
- self rightJustify: each asOop.
- ' ' display.
- each printNl ] ]
-! !
-
-!UndefinedObject methodsFor: 'polymorphism'!
-
-lines
- ^nil
-! !
-
-
-
-!Behavior methodsFor: 'debugging'!
-
-debuggerClass
- ^MiniDebugger
-! !
diff --git a/kernel/ContextPart.st b/kernel/ContextPart.st
index e57cec3..16ba83c 100644
--- a/kernel/ContextPart.st
+++ b/kernel/ContextPart.st
@@ -77,6 +77,48 @@ methods that can be used in inspection or debugging.'>
]
+
+ printContextState [
+ <category: 'printing'>
+
+ self printContextStateOn: Transcript
+ ]
+
+ printContextStateOn: aStream [
+ <category: 'printing'>
+
+ | i |
+ i := 0.
+
+ aStream
+ nextPutAll: 'args:';
+ nl.
+
+ self method arguments do: [ :each |
+ i := i + 1.
+
+ aStream
+ space: 4;
+ nextPutAll: each;
+ nextPutAll: ' -> ';
+ print: (self at: i);
+ nl ].
+
+ aStream
+ nextPutAll: 'temps:';
+ nl.
+
+ self method temporaries do: [ :each |
+ i := i + 1.
+
+ aStream
+ space: 4;
+ nextPutAll: each;
+ nextPutAll: ' -> ';
+ print: (self at: i);
+ nl ].
+ ]
+
backtrace [
"Print a backtrace from the receiver to the bottom of the stack on the
Transcript."
diff --git a/packages/debug/ChangeLog b/packages/debug/ChangeLog
index cffb9b4..4909104 100644
--- a/packages/debug/ChangeLog
+++ b/packages/debug/ChangeLog
@@ -1,3 +1,7 @@
+2013-08-15 Gwenael Casaccio <gwenael.casac...@gmail.com>
+
+ * DebugTools.st: Add support for block debugging
+
2011-07-27 Paolo Bonzini <bonz...@gnu.org>
* DebugTools.st: Improve 2011-07-15 change to fix testsuite failures.
diff --git a/packages/debug/DebugTools.st b/packages/debug/DebugTools.st
index 49033bd..1461dfd 100644
--- a/packages/debug/DebugTools.st
+++ b/packages/debug/DebugTools.st
@@ -381,5 +381,12 @@ BlockClosure extend [
forkAt: Processor unpreemptedPriority
]
+ debug [
+ <category: 'instance creation'>
+ <exceptionHandlingInternal: false>
+
+ self class debuggerClass debug: 'Debugger'.
+ self value
+ ]
]
diff --git a/packages/debug/debugger/ChangeLog b/packages/debug/debugger/ChangeLog
new file mode 100644
index 0000000..ab89576
--- /dev/null
+++ b/packages/debug/debugger/ChangeLog
@@ -0,0 +1,7 @@
+2013-08-13 Gwenael Casaccio <gwenael.casac...@gmail.com>
+
+ * Extensions.st: Import and split it from examples/MiniDebugger.st
+ * MiniDebugger.st: Import and split it from examples/MiniDebugger.st
+ * MiniInspector.st: Import and split it from examples/MiniDebugger.st
+ * MiniTool.st: Import and split it from examples/MiniDebugger.st
+
diff --git a/packages/debug/debugger/Extensions.st b/packages/debug/debugger/Extensions.st
new file mode 100644
index 0000000..dd6b0fe
--- /dev/null
+++ b/packages/debug/debugger/Extensions.st
@@ -0,0 +1,50 @@
+"======================================================================
+|
+| Minimal inspector and debugger using DebugTools
+|
+|
+ ======================================================================"
+
+
+"======================================================================
+|
+| Copyright 2002, 2006, 2007 Free Software Foundation, Inc.
+| Written by Paolo Bonzini.
+|
+| This file is part of GNU Smalltalk.
+|
+| GNU Smalltalk is free software; you can redistribute it and/or modify it
+| under the terms of the GNU General Public License as published by the Free
+| Software Foundation; either version 2, or (at your option) any later version.
+|
+| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
+| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+| FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+| details.
+|
+| You should have received a copy of the GNU General Public License along with
+| GNU Smalltalk; see the file COPYING. If not, write to the Free Software
+| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+UndefinedObject extend [
+
+ lines [
+ <category: '*DebugTools-Debugger'>
+
+ ^ nil
+ ]
+]
+
+
+
+Behavior extend [
+
+ debuggerClass [
+ <category: '*DebugTools-Debugger'>
+
+ ^ MiniDebugger
+ ]
+]
+
diff --git a/packages/debug/debugger/MiniDebugger.st b/packages/debug/debugger/MiniDebugger.st
new file mode 100644
index 0000000..00cc6d3
--- /dev/null
+++ b/packages/debug/debugger/MiniDebugger.st
@@ -0,0 +1,369 @@
+"======================================================================
+|
+| Minimal inspector and debugger using DebugTools
+|
+|
+ ======================================================================"
+
+
+"======================================================================
+|
+| Copyright 2002, 2006, 2007 Free Software Foundation, Inc.
+| Written by Paolo Bonzini.
+|
+| This file is part of GNU Smalltalk.
+|
+| GNU Smalltalk is free software; you can redistribute it and/or modify it
+| under the terms of the GNU General Public License as published by the Free
+| Software Foundation; either version 2, or (at your option) any later version.
+|
+| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
+| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+| FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+| details.
+|
+| You should have received a copy of the GNU General Public License along with
+| GNU Smalltalk; see the file COPYING. If not, write to the Free Software
+| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+MiniTool subclass: MiniDebugger [
+
+ | debugger activeContext depth methodSourceCodeCache |
+
+ <category: 'System-Debugging-Support'>
+
+ <comment: 'I implement 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). The interface is vaguely similar to GDB.'>
+
+ MiniDebugger class >> debuggingPriority [
+ <category: 'class attributes'>
+
+ ^ FloatD infinity
+ ]
+
+ MiniDebugger class >> open: aString [
+ <category: 'instance creation'>
+
+ [ :debugger || continuation arg |
+ Processor activeProcess name: 'Debugger'.
+ arg := Continuation currentDo: [ :cc |
+ continuation := cc.
+ aString ].
+ arg printNl.
+ [ self new debugger: debugger; skipUselessContext; commandLoop ]
+ on: SystemExceptions.DebuggerReentered
+ do: [ :ex | continuation value: ex messageText ]
+ ] forkDebugger
+ ]
+
+ MiniDebugger class >> debug: aString [
+ <category: 'instance creation'>
+
+ [ :debugger || continuation arg |
+ Processor activeProcess name: 'Debugger'.
+ arg := Continuation currentDo: [ :cc |
+ continuation := cc.
+ aString ].
+ arg printNl.
+ [ self new debugger: debugger; skipUselessContext; skipFirstCtxt; commandLoop ]
+ on: SystemExceptions.DebuggerReentered
+ do: [ :ex | continuation value: ex messageText ]
+ ] forkDebugger
+ ]
+
+ debugger: aDebugger [
+ <category: 'commands'>
+
+ debugger := aDebugger.
+ ]
+
+ skipUselessContext [
+ <category: 'private'>
+
+ "Show meaningful source code to the user."
+ [ debugger suspendedContext isInternalExceptionHandlingContext ]
+ whileTrue: [ debugger slowFinish ].
+ ]
+
+ skipFirstCtxt [
+ <category: 'private'>
+
+ debugger
+ step;
+ step.
+ ]
+
+ commandLoop [
+ <category: 'commands'>
+
+ depth := 0.
+ activeContext := debugger suspendedContext.
+ debugger suspendedContext backtrace.
+ self printCurrentLine.
+ [
+ self getCommand.
+ debugger isActive
+ ] whileTrue.
+ Processor activeProcess suspend
+ ]
+
+ step [
+ <category: 'commands'>
+
+ debugger step.
+ self resetContext
+ ]
+
+ next [
+ <category: 'commands'>
+
+ debugger next.
+ self resetContext
+ ]
+
+ finish [
+ <category: 'commands'>
+
+ debugger finish: activeContext.
+ self resetContext
+ ]
+
+ continue [
+ <category: 'commands'>
+
+ debugger continue
+ ]
+
+ resetContext [
+ <category: 'commands'>
+
+ activeContext := debugger suspendedContext.
+ depth := 0
+ ]
+
+ up [
+ <category: 'commands'>
+
+ activeContext parentContext isNil ifTrue: [ ^self ].
+ activeContext := activeContext parentContext.
+ depth := depth + 1.
+ ]
+
+ down [
+ <category: 'commands'>
+
+ depth > 0 ifFalse: [ ^self ].
+ depth := depth - 1.
+ activeContext := debugger suspendedContext.
+ depth timesRepeat: [ activeContext := activeContext parentContext ]
+ ]
+
+ printCurrentMethod [
+ <category: 'printing'>
+
+ | source |
+ source := self currentMethodSource.
+ source isNil ifTrue: [ ^self ].
+ source keysAndValuesDo: [ :line :code |
+ self rightJustify: line.
+ stdout
+ space;
+ nextPutAll: code;
+ nl
+ ]
+ ]
+
+ printCurrentLine [
+ <category: 'printing'>
+
+ | line source |
+ activeContext isNil ifTrue: [ ^self ].
+ source := self currentMethodSource.
+ source isNil ifTrue: [ ^self ].
+ line := Debugger currentLineIn: activeContext.
+ line = 0 ifTrue: [ ^self ].
+
+ self rightJustify: line.
+ stdout
+ space;
+ nextPutAll: (source at: line ifAbsent: [ '' ]);
+ nl
+ ]
+
+ doStepCommand [
+ <category: 'user commands'>
+
+ | context arg |
+ ('udsnfc' includes: command) ifFalse: [ ^false ].
+
+ context := activeContext.
+ arg := commandArg at: 1 ifAbsent: [ 1 ].
+ arg := arg asInteger.
+
+ arg timesRepeat: [
+ (command == $u) ifTrue: [ self up ].
+ (command == $d) ifTrue: [ self down ].
+ (command == $s) ifTrue: [ self step ].
+ (command == $n) ifTrue: [ self next ].
+ (command == $f) ifTrue: [ self finish ].
+ (command == $c) ifTrue: [ self continue ].
+ ].
+
+ activeContext isNil ifFalse: [
+ activeContext == context ifFalse: [ activeContext printNl; printContextState ].
+ self printCurrentLine ].
+
+ ^true
+ ]
+
+ doProcessCommand [
+ <category: 'user commands'>
+
+ | id processes terminated |
+ ('TSKb' includes: command) ifFalse: [ ^false ].
+
+ (commandArg isEmpty and: [ command == $b ]) ifTrue: [
+ activeContext backtrace.
+ ^true ].
+
+ processes := commandArg collect: [ :each || stream proc |
+ stream := each readStream.
+ id := Number readFrom: stream.
+ stream atEnd
+ ifFalse: [ 'please supply a valid process id' displayNl. ^true ].
+
+ proc := id asObject.
+ (proc isKindOf: Process)
+ ifFalse: [ 'please supply a valid process id' displayNl. ^true ].
+
+ proc ].
+
+ processes isEmpty ifTrue: [ processes := {debugger process} ].
+ terminated := false.
+ processes do: [ :proc |
+ proc suspendedContext isNil
+ ifTrue: [('%1: process was terminated' % { proc asOop }) displayNl]
+ ifFalse: [
+ (command == $b) ifTrue: [
+ processes size > 1 ifTrue: [
+ ('backtrace for process %1' % { proc asOop }) displayNl].
+ proc context backtrace ].
+ (command == $S) ifTrue: [ proc suspend ].
+ (command == $K) ifTrue: [ proc primTerminate ].
+ (command == $T) ifTrue: [
+ proc terminate.
+ terminated := terminated or: [proc == debugger process]]]].
+
+ terminated ifTrue: [ self continue ].
+ ^true
+ ]
+
+ doCommand [
+ <category: 'user commands'>
+
+ self doStepCommand ifTrue: [ ^true ].
+ self doProcessCommand ifTrue: [ ^true ].
+
+ ('PriIelwgxX' includes: command) ifFalse: [ ^false ].
+
+ (command == $h) ifTrue: [ ^true ].
+
+ commandArg isEmpty
+ ifFalse: [ 'no argument needed for this command' displayNl. ^true ].
+
+ (command == $P) ifTrue: [ self showProcesses ].
+ (command == $r) ifTrue: [ activeContext receiver printNl ].
+ (command == $i) ifTrue: [ MiniInspector openOn: activeContext receiver ].
+ (command == $I) ifTrue: [ MiniInspector openOn: activeContext ].
+ (command == $e) ifTrue: [ self interpreterLoopWith: activeContext receiver ].
+ (command == $l) ifTrue: [ self printCurrentMethod ].
+ (command == $w) ifTrue: [ activeContext printNl. self printCurrentLine ].
+ (command == $g) ifTrue: [ ObjectMemory globalGarbageCollect ].
+ (command == $X) ifTrue: [ ObjectMemory abort ].
+ (command == $x) ifTrue: [ ObjectMemory quit ].
+ ^true
+ ]
+
+ eofCommand [
+ <category: 'user commands'>
+
+ ^'T'
+ ]
+
+ showPrompt [
+ <category: 'user commands'>
+
+ '(debug) ' display.
+ ]
+
+ help [
+ <category: 'user commands'>
+
+ ^'Control flow commands:
+ s [n] step N times
+ n [n] next (step over send) N times
+ f [n] finish current method N times
+ c continue
+
+Process commands: no ID means debugged process
+ P show process list
+ T [id]... terminate process
+ K [id]... kill process - no unwinds or cleanup
+ b [id]... backtrace
+
+Examining state:
+ r print receiver on stdout
+ i inspect (enter MiniInspector on current receiver)
+ I inspect context (enter MiniInspector on current context)
+ e eval (enter read-eval-print loop on current receiver)
+
+Examining the call stack:
+ u [n] go N frames up (default 1)
+ d [n] go N frames down (default 1)
+ l print current method
+ w print current frame
+
+Other commands:
+ g collect all garbage
+ X exit Smalltalk, and dump core
+ x exit Smalltalk'
+ ]
+
+ currentMethodSource [
+ <category: 'private'>
+
+ activeContext isNil ifTrue: [ ^#() ].
+ methodSourceCodeCache isNil ifTrue: [
+ methodSourceCodeCache := WeakKeyIdentityDictionary new ].
+ ^methodSourceCodeCache at: activeContext method ifAbsentPut: [
+ activeContext method methodSourceString lines ]
+ ]
+
+ rightJustify: n [
+ <category: 'private'>
+
+ | printString |
+ printString := n printString.
+ stdout
+ space: (7 - printString size max: 0);
+ nextPutAll: printString
+ ]
+
+ showProcesses [
+ <category: 'private'>
+
+ self rightJustify: debugger process asOop.
+ '>' display.
+ debugger process printNl.
+
+ Process allSubinstancesDo: [ :each |
+ each == debugger process ifFalse: [
+ self rightJustify: each asOop.
+ ' ' display.
+ each printNl ] ]
+ ]
+]
+
diff --git a/packages/debug/debugger/MiniInspector.st b/packages/debug/debugger/MiniInspector.st
new file mode 100644
index 0000000..8692d81
--- /dev/null
+++ b/packages/debug/debugger/MiniInspector.st
@@ -0,0 +1,159 @@
+"======================================================================
+|
+| Minimal inspector and debugger using DebugTools
+|
+|
+ ======================================================================"
+
+
+"======================================================================
+|
+| Copyright 2002, 2006, 2007 Free Software Foundation, Inc.
+| Written by Paolo Bonzini.
+|
+| This file is part of GNU Smalltalk.
+|
+| GNU Smalltalk is free software; you can redistribute it and/or modify it
+| under the terms of the GNU General Public License as published by the Free
+| Software Foundation; either version 2, or (at your option) any later version.
+|
+| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
+| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+| FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+| details.
+|
+| You should have received a copy of the GNU General Public License along with
+| GNU Smalltalk; see the file COPYING. If not, write to the Free Software
+| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+MiniTool subclass: MiniInspector [
+
+ | inspectedObject depth |
+
+ <category: 'Debugging-Support'>
+
+ <comment: 'I implement a primitive inspector which is launched by the MiniDebugger.'>
+
+ MiniInspector class >> openOn: anObject [
+ <category: 'instance creation'>
+
+ self openOn: anObject depth: 0
+ ]
+
+ MiniInspector class >> openOn: anObject depth: n [
+ <category: 'instance creation'>
+
+ self new initializeFor: anObject depth: n; commandLoop
+ ]
+
+ help [
+ <category: 'command loop'>
+
+ ^'inspector commands:
+ (e)val start read-eval-print loop
+ (i)nstvars print all instvars
+ (i)nstvars NUMBER inspect n-th instvar (negative=fixed, positive=indexed)
+ (p)rint print object
+ (p)rint NUMBER print n-th instvar (negative=fixed, positive=indexed)
+ (q)uit'
+ ]
+
+ doCommand [
+ <category: 'command loop'>
+
+ (command = $p) ifTrue: [
+ stdout space: depth.
+ commandArg isEmpty
+ ifFalse: [ (self nthInstvar: commandArg first asInteger) printNl ]
+ ifTrue: [ inspectedObject printNl ].
+ ^true
+ ].
+
+ (command = $e) ifTrue: [
+ self interpreterLoopWith: inspectedObject.
+ ^true
+ ].
+
+ (command = $i) ifTrue: [
+ commandArg isEmpty
+ ifFalse: [ self inspectInstvar: commandArg first asInteger ]
+ ifTrue: [ self printInstVarsOf: inspectedObject ].
+ ^true
+ ].
+
+ ^command = $q
+ ]
+
+ eofCommand [
+ <category: 'command loop'>
+
+ ^'q'
+ ]
+
+ commandLoop [
+ <category: 'command loop'>
+
+ self printHeader.
+ [
+ self getCommand.
+ command = $q
+ ] whileFalse.
+ ]
+
+ showPrompt [
+ <category: 'command loop'>
+
+ stdout space: depth.
+ '(insp) ' display.
+ ]
+
+ inspectInstvar: which [
+ <category: 'commands'>
+
+ self doInspect: (self nthInstvar: which).
+ self printHeader.
+ ]
+
+ printInstVarsOf: anObject [
+ <category: 'commands'>
+
+ stdout space: depth.
+ anObject inspect.
+ ]
+
+ initializeFor: anObject depth: n [
+ <category: 'private'>
+
+ inspectedObject := anObject.
+ depth := n.
+ ^self
+ ]
+
+ printHeader [
+ <category: 'private'>
+
+ stdout space: depth.
+ '-- inspector: ' display.
+ inspectedObject basicPrintNl.
+ ]
+
+ doInspect: anObject [
+ <category: 'private'>
+
+ self class openOn: anObject depth: depth + 1
+ ]
+
+ nthInstvar: which [
+ <category: 'private'>
+
+ which < 0
+ ifTrue: [ ^inspectedObject instVarAt: which negated ].
+
+ ^inspectedObject basicSize = 0
+ ifTrue: [ inspectedObject instVarAt: which ]
+ ifFalse: [ inspectedObject basicAt: which ]
+ ]
+]
+
diff --git a/packages/debug/debugger/MiniTool.st b/packages/debug/debugger/MiniTool.st
new file mode 100644
index 0000000..f4d6b7a
--- /dev/null
+++ b/packages/debug/debugger/MiniTool.st
@@ -0,0 +1,110 @@
+"======================================================================
+|
+| Minimal inspector and debugger using DebugTools
+|
+|
+ ======================================================================"
+
+
+"======================================================================
+|
+| Copyright 2002, 2006, 2007 Free Software Foundation, Inc.
+| Written by Paolo Bonzini.
+|
+| This file is part of GNU Smalltalk.
+|
+| GNU Smalltalk is free software; you can redistribute it and/or modify it
+| under the terms of the GNU General Public License as published by the Free
+| Software Foundation; either version 2, or (at your option) any later version.
+|
+| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
+| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+| FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
+| details.
+|
+| You should have received a copy of the GNU General Public License along with
+| GNU Smalltalk; see the file COPYING. If not, write to the Free Software
+| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+Object subclass: MiniTool [
+
+ | commandArg command |
+
+ <category: 'Debugging-Support'>
+
+ MiniTool class >> debuggerClass [
+ <category: 'disabling debugging'>
+ ^ nil
+ ]
+
+ showPrompt [
+ <category: 'instance creation'>
+
+ self subclassResponsibility
+ ]
+
+ eofCommand [
+ <category: 'instance creation'>
+
+ self subclassResponsibility
+ ]
+
+ doCommand [
+ <category: 'instance creation'>
+
+ self subclassResponsibility
+ ]
+
+ getCommand [
+ <category: 'instance creation'>
+
+ | cmd |
+ self showPrompt.
+
+ cmd := stdin atEnd
+ ifTrue: [ { self eofCommand } ]
+ ifFalse: [ stdin nextLine substrings ].
+
+ cmd isEmpty ifFalse: [
+ command := (cmd at: 1) at: 1.
+ commandArg := cmd copyFrom: 2.
+ "Else repeat the last command."
+ ].
+
+ self doCommand ifFalse: [
+ (command = $h) ifFalse: [ 'invalid command' displayNl ].
+ self help displayNl
+ ].
+ ]
+
+ help [
+ <category: 'instance creation'>
+
+ self subclassResponsibility
+ ]
+
+ interpreterLoopWith: anObject [
+ | line |
+ 'read-eval-print loop; exit with empty line' displayNl.
+
+ [
+ '(rep) ' display.
+
+ line := stdin nextLine.
+ line isEmpty
+ ] whileFalse: [ self eval: line to: anObject ]
+ ]
+
+ eval: line to: anObject [
+ | result |
+ result := Behavior
+ evaluate: line
+ to: anObject
+ ifError: [ :f :l :e | e printNl. ^self ].
+
+ result printNl
+ ]
+]
+
diff --git a/packages/debug/debugger/package.xml b/packages/debug/debugger/package.xml
new file mode 100644
index 0000000..017fb06
--- /dev/null
+++ b/packages/debug/debugger/package.xml
@@ -0,0 +1,11 @@
+<package>
+ <name>Debugger</name>
+
+ <prereq>DebugTools</prereq>
+
+ <filein>MiniTool.st</filein>
+ <filein>MiniInspector.st</filein>
+ <filein>MiniDebugger.st</filein>
+ <filein>Extensions.st</filein>
+ <file>ChangeLog</file>
+</package>
diff --git a/packages/debug/debugger/stamp-classes b/packages/debug/debugger/stamp-classes
new file mode 100644
index 0000000..e69de29
--
1.8.1.2
_______________________________________________
help-smalltalk mailing list
help-smalltalk@gnu.org
https://lists.gnu.org/mailman/listinfo/help-smalltalk
