>From 5f44994b1e32ad58e5d86b934619255b91976318 Mon Sep 17 00:00:00 2001 From: Gwenael Casaccio Date: Wed, 21 Aug 2013 13:45:33 +0200 Subject: [PATCH] Create a debugger package from example/MiniDebugger.st, split it in multiple files and migrate them to the new syntax. --- ChangeLog | 4 + configure.ac | 1 + examples/MiniDebugger.st | 520 ------------------------------- examples/README | 4 - packages.xml | 1 - 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 + 11 files changed, 711 insertions(+), 525 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 diff --git a/ChangeLog b/ChangeLog index acdf5c0..fecdd74 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,9 @@ 2013-08-20 Gwenael Casaccio + * examples/MiniDebugger.st: Removed. + +2013-08-20 Gwenael Casaccio + * kernel/ContextPart.st: Print context args and temps names and their value while inspecting them. 2013-08-10 Gwenael Casaccio 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/examples/README b/examples/README index d29b809..6df7514 100644 --- a/examples/README +++ b/examples/README @@ -56,10 +56,6 @@ Methods.st Examples of subclassing CompiledMethod... 'nuff said! by Ian Piumarta and me -MiniDebugger.st A simplified debugger which shows how to use the single step -by me primitives to implement an interface that vaguely resembles - gdb. - PackageBuilder.st A simple script to make package.xml file from a Smalltalk by Stefan Schmiedl description. You may find it useful! diff --git a/packages.xml b/packages.xml index c3b6514..2c8ad6c 100644 --- a/packages.xml +++ b/packages.xml @@ -58,7 +58,6 @@ JSON.st Richards.st Bench.st - MiniDebugger.st MemUsage.st Methods.st README diff --git a/packages/debug/debugger/ChangeLog b/packages/debug/debugger/ChangeLog new file mode 100644 index 0000000..e8859be --- /dev/null +++ b/packages/debug/debugger/ChangeLog @@ -0,0 +1,7 @@ +2013-08-20 Gwenael Casaccio + + * 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 [ + + + ^ nil + ] +] + + + +Behavior extend [ + + debuggerClass [ + + + ^ 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 | + + + + + + MiniDebugger class >> debuggingPriority [ + + + ^ FloatD infinity + ] + + MiniDebugger class >> open: aString [ + + + [ :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 [ + + + [ :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 [ + + + debugger := aDebugger. + ] + + skipUselessContext [ + + + "Show meaningful source code to the user." + [ debugger suspendedContext isInternalExceptionHandlingContext ] + whileTrue: [ debugger slowFinish ]. + ] + + skipFirstCtxt [ + + + debugger + step; + step. + ] + + commandLoop [ + + + depth := 0. + activeContext := debugger suspendedContext. + debugger suspendedContext backtrace. + self printCurrentLine. + [ + self getCommand. + debugger isActive + ] whileTrue. + Processor activeProcess suspend + ] + + 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 ] + ] + + 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 + ] + + 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; printContextState ]. + 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' + ] + + 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 ] ] + ] +] + 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 | + + + + + + MiniInspector class >> openOn: anObject [ + + + self openOn: anObject depth: 0 + ] + + MiniInspector class >> openOn: anObject depth: n [ + + + self new initializeFor: anObject depth: n; commandLoop + ] + + 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. + ] + + inspectInstvar: which [ + + + self doInspect: (self nthInstvar: which). + self printHeader. + ] + + printInstVarsOf: anObject [ + + + stdout space: depth. + anObject inspect. + ] + + 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 ] + ] +] + 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 | + + + + MiniTool class >> debuggerClass [ + + ^ nil + ] + + 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 + ] + + 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 @@ + + Debugger + + DebugTools + + MiniTool.st + MiniInspector.st + MiniDebugger.st + Extensions.st + ChangeLog + -- 1.8.1.2