"

 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

        ]

    ]

! !