--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/MiniDebug.st Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,297 @@
+"
+ COPYRIGHT (c) 1988-93 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+Object subclass:#MiniDebugger
+ instanceVariableNames:'tracing stepping traceBlock'
+ classVariableNames: 'theOneAndOnlyDebugger'
+ poolDictionaries:''
+ category:'System-Support'
+!
+
+MiniDebugger comment:'
+
+COPYRIGHT (c) 1988-93 by Claus Gittinger
+ All Rights Reserved
+
+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).
+
+%W% %E%
+'!
+
+!MiniDebugger class methodsFor: 'instance creation'!
+
+new
+ theOneAndOnlyDebugger printNL.
+ theOneAndOnlyDebugger isNil ifTrue:[
+ theOneAndOnlyDebugger := self basicNew initialize
+ ].
+ ^ theOneAndOnlyDebugger
+!
+
+singleStep:aBlock
+ |aDebugger|
+
+ aDebugger := self new stepping.
+ StepInterruptHandler := aDebugger.
+ StepInterruptPending := true.
+ InterruptPending := true.
+ aBlock value.
+ StepInterruptPending := nil
+!
+
+trace:aBlock
+ self trace:aBlock with:[:where | where printNewline]
+!
+
+trace:aBlock on:aStream
+ self trace:aBlock with:[:where | where printString printOn:aStream.
+ aStream cr]
+!
+
+trace:aBlock with:aTraceBlock
+ |aDebugger|
+
+ aDebugger := self new tracingWith:aTraceBlock.
+ ObjectMemory flushInlineCaches.
+ StepInterruptHandler := aDebugger.
+ StepInterruptPending := true.
+ InterruptPending := true.
+ aBlock value.
+ StepInterruptPending := nil.
+ ^ nil
+!
+
+enterWithMessage:aString
+ |aDebugger|
+
+ StepInterruptPending := nil.
+ aString printNewline.
+ aDebugger := self new.
+ aDebugger enter.
+ ^ nil
+! !
+
+!MiniDebugger methodsFor: 'initialization'!
+
+initialize
+ traceBlock := nil.
+ tracing := false.
+ stepping := false
+! !
+
+!MiniDebugger methodsFor: 'private'!
+
+stepping
+ traceBlock := nil.
+ tracing := false.
+ stepping := true
+!
+
+tracingWith:aBlockOrNil
+ traceBlock := aBlockOrNil.
+ stepping := false.
+ tracing := true
+!
+
+getContext
+ |backtrace|
+ backtrace := thisContext.
+ (backtrace notNil) ifTrue: [
+ "remove Context getContext frame"
+ backtrace := backtrace sender.
+ "remove Debugger showContext frame"
+ backtrace := backtrace sender.
+ "remove Debugger commandLoop frame"
+ backtrace := backtrace sender.
+ "remove Debugger enter frame"
+ backtrace := backtrace sender
+ ].
+ ^ backtrace
+! !
+
+!MiniDebugger methodsFor: 'interrupt handling'!
+
+stepInterrupt
+ |where|
+
+ where := thisContext. "where is stepInterrupt context"
+ where notNil ifTrue:[
+ where := where sender "where is now interrupted methods context"
+ ].
+ stepping ifTrue:[
+ where notNil ifTrue:[
+ where fullPrint
+ ] ifFalse:[
+ 'stepInterrupt: no context' printNewline
+ ].
+ self enter
+ ] ifFalse:[
+ where notNil ifTrue:[
+ traceBlock notNil ifTrue:[
+ traceBlock value:where
+ ]
+ ] ifFalse:[
+ 'traceInterrupt: no context' printNewline
+ ].
+ ObjectMemory flushInlineCaches.
+ StepInterruptPending := true.
+ InterruptPending := true
+ ]
+!
+
+enter
+ |cmd|
+
+ cmd := self commandLoop.
+ (cmd == $s) ifTrue: [
+ self stepping.
+ ObjectMemory flushInlineCaches.
+ StepInterruptHandler := self.
+ StepInterruptPending := true.
+ InterruptPending := true
+ ].
+ (cmd == $t) ifTrue: [
+ traceBlock := [:where | where fullPrint].
+ ObjectMemory flushInlineCaches.
+ StepInterruptHandler := self.
+ StepInterruptPending := true.
+ InterruptPending := true
+ ].
+ (cmd == $c) ifTrue: [
+ stepping := false.
+ tracing := false.
+ StepInterruptPending := nil.
+ InterruptPending := nil
+ ].
+ ^ nil
+! !
+
+!MiniDebugger methodsFor: 'user commands'!
+
+commandLoop
+ |cmd done valid context|
+
+ done := false.
+ [done] whileFalse:[
+ valid := false.
+ cmd := self getCommand.
+ (cmd == $p) ifTrue:[
+ valid := true.
+ context isNil ifTrue: [
+ context := self getContext
+ ].
+ context notNil ifTrue:[
+ context fullPrintAll
+ ] ifFalse:[
+ 'no context' printNewline
+ ]
+ ].
+ (cmd == $r) ifTrue:[
+ valid := true.
+ context isNil ifTrue: [
+ context := self getContext
+ ].
+ context notNil ifTrue:[
+ "remove Debugger stepinterrupt/halt frame"
+ context sender receiver printNewline
+ ] ifFalse:[
+ 'no context - dont know receiver' printNewline
+ ]
+ ].
+ (cmd == $R) ifTrue:[
+ valid := true.
+ context isNil ifTrue: [
+ context := self getContext
+ ].
+ context notNil ifTrue:[
+ "remove Debugger stepinterrupt/halt frame"
+ context sender receiver storeOn:Stdout
+ ] ifFalse:[
+ 'no context - dont know receiver' printNewline
+ ]
+ ].
+ (cmd == $i) ifTrue:[
+ valid := true.
+ context isNil ifTrue: [
+ context := self getContext
+ ].
+ context notNil ifTrue:[
+ "remove Debugger stepinterrupt/halt frame"
+ context sender receiver inspect
+ ] ifFalse:[
+ 'no context - dont know receiver' printNewline
+ ]
+ ].
+ (cmd == $I) ifTrue:[
+ valid := true.
+ context isNil ifTrue: [
+ context := self getContext
+ ].
+ context notNil ifTrue:[
+ "remove Debugger stepinterrupt/halt frame"
+ self interpreterLoopWith:(context sender receiver)
+ ] ifFalse:[
+ 'no context - dont know receiver' printNewline.
+ self interpreterLoopWith:nil
+ ]
+ ].
+ context := nil.
+ (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 == $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
+ ]
+ ].
+ ^ cmd
+!
+
+getCommand
+ |cmd c|
+ 'MiniDebugger> ' print.
+ cmd := Character fromUser.
+ c := cmd.
+ [ c isEndOfLineCharacter ] whileFalse: [
+ c := Character fromUser
+ ].
+ ^ cmd
+!
+
+interpreterLoopWith:anObject
+ |line done|
+ 'read-eval-print loop; exit with empty line' printNewline.
+ done := false.
+ [done] whileFalse:[
+ line := Stdin nextLine.
+ (line size == 0) ifTrue:[
+ done := true
+ ] ifFalse:[
+ (Compiler evaluate:line
+ receiver:anObject
+ notifying:nil) printNewline
+ ]
+ ]
+! !