"{ Encoding: utf8 }"

"
 COPYRIGHT (c) 2006 by eXept Software AG
              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.
"
"{ Package: 'stx:libcomp' }"

"{ NameSpace: Smalltalk }"

Object subclass:#Breakpoint
	instanceVariableNames:'position description line isReached method'
	classVariableNames:''
	poolDictionaries:''
	category:'System-Compiler-Debugging'
!

!Breakpoint class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2006 by eXept Software AG
              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.
"
!

documentation
"
    statement breakpoint support.
    Instances of me are placed into a (bytecode-) compiled method's
    literal array and are sent #break messages when a statement
    with a breakpoint is about to be executed.
    The actual control is via the breakpoint's description, 
    which contains further constraints about when the breakpoint should stop and enter the debugger
    (for example: constraints on the reciever, the thread, the count, etc.)
"    
! !

!Breakpoint class methodsFor:'instance creation'!

new
    "return an initialized instance"

    ^ self basicNew initialize.
! !

!Breakpoint class methodsFor:'queries'!

breakpointDescriptionClass
    "redefinable in subclasses"
    
    ^ BreakpointDescription
! !

!Breakpoint class methodsFor:'utilities'!

disableAllBreakpoints
    MethodWithBreakpoints allBreakpointedMethods do:[:m |
        m disableAllBreakpoints
    ]

    "Created: / 03-02-2014 / 10:35:55 / cg"
! !

!Breakpoint methodsFor:'accessing'!

description
    ^ description
!

description:aBreakpointDescription
    description := aBreakpointDescription.
!

isReached
    ^ isReached
!

isReached:aBoolean
    isReached := aBoolean.
!

line
    "the lineNr"
    
    ^ line
!

line:lineArg
    self assert:lineArg >= 0.
    line := lineArg.
!

method
    ^ method
!

method:aMethod
    method := aMethod.
!

position
    ^ position
!

position:anInteger
    position := anInteger.

    "Modified (format): / 02-08-2012 / 09:26:03 / cg"
!

position:positionArg line:lineArg
    position := positionArg.
    line := lineArg.
    self assert:lineArg >= 0.

    "Created: / 02-08-2012 / 09:26:27 / cg"
! !

!Breakpoint methodsFor:'hitting'!

break
    "invoked by the breakPoint's code (see BreakPointNode),
     which is compiled into the code as:
        pushLit <theBreakpoint>
        send0 #break
    "

    <resource: #skipInDebuggersWalkBack>

    |sender message|

    description isEnabled ifFalse:[^ self].

    sender := thisContext sender.
    (description shouldBreakIn:sender) ifTrue:[
        message := self breakPointMessageForContext:sender.
        "/ to disable this breakpoint:
        "/ description disable.

        BreakPointInterrupt basicNew
            raiseRequestWith:self 
            errorString:message
            "/ not in sender, because otherwise the debugger won't
            "/ detect the break on the stack
            "/ in:sender.
    ].
    (description shouldTraceIn:sender) ifTrue:[
        sender method numArgs == 0 ifTrue:[
            Transcript showCR:('%1 Trace: %2 [%3]' 
                        bindWith:Timestamp now 
                        with:sender methodPrintString 
                        with:self line)
        ] ifFalse:[    
            Transcript showCR:('%1 Trace: %2 [%3] args: %4' 
                        bindWith:Timestamp now 
                        with:sender methodPrintString 
                        with:self line
                        with:sender argsDisplayStringShort)
        ].
    ].

    "Created: / 15-06-2011 / 12:48:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 11-07-2011 / 18:17:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 21-10-2017 / 15:24:35 / cg"
    "Modified: / 02-07-2019 / 23:49:17 / Claus Gittinger"
!

breakPointMessageForContext:sender
    |mthd where lineNr message 
     source sourceLines sourceLine prevLine nextLine|

    message := 'Breakpoint encountered at line %1 in %2'.
    where := '?'.

    mthd := method.
    mthd notNil ifTrue:[
        mthd mclass isNil ifTrue:[
            mthd := sender method.
        ].
        where := mthd whoString.

        (lineNr := self line) notNil ifTrue:[
            (source := mthd source) notNil ifTrue:[
                sourceLines := source asStringCollection.
                sourceLine := sourceLines at:lineNr ifAbsent:[nil].
                sourceLine notNil ifTrue:[
                    sourceLine := (sourceLine "withoutLeadingSeparators" contractAtEndTo:60) allItalic withColor:Color darkRed.
                    message := 'Breakpoint encountered at line %1 in %2\near:\%3'.
                    lineNr > 1 ifTrue:[
                        prevLine := sourceLines at:(lineNr-1) ifAbsent:[nil].
                        prevLine notEmptyOrNil ifTrue:[
                            "/ prevLine := prevLine withoutLeadingSeparators.
                            prevLine notEmpty ifTrue:[
                                prevLine := (prevLine contractAtEndTo:60) allItalic.
                                lineNr > 2 ifTrue:[
                                    prevLine := '...', Character cr , prevLine.
                                ].
                            ] ifFalse:[
                                prevLine := '...'.
                            ].  
                            prevLine := prevLine allGray.
                            message := 'Breakpoint encountered at line %1 in %2\near:\%4\%3'.
                        ].
                    ].
                    lineNr < (sourceLines size) ifTrue:[
                        nextLine := sourceLines at:(lineNr+1) ifAbsent:[nil].
                        nextLine notEmptyOrNil ifTrue:[
                            "/ nextLine := nextLine withoutLeadingSeparators.
                            nextLine notEmpty ifTrue:[
                                nextLine := (nextLine contractAtEndTo:60) allItalic.
                                lineNr < (sourceLines size - 1) ifTrue:[
                                    nextLine := nextLine , Character cr , '...'.
                                ].    
                            ] ifFalse:[
                                nextLine := '...'.
                            ].    
                            nextLine := nextLine allGray.

                            prevLine notNil ifTrue:[
                                message := 'Breakpoint encountered at line %1 in %2\near:\%4\%3\%5'.
                            ] ifFalse:[
                                message := 'Breakpoint encountered at line %1 in %2\near:\%3\%5'.
                            ].
                        ].
                    ].
                ].    
            ].    
        ].    
    ].
    ^ (message withCRs 
            bindWith:self line 
            with:where 
            with:sourceLine
            with:prevLine
            with:nextLine)
! !

!Breakpoint methodsFor:'initialization'!

initialize
    "Invoked when a new instance is created."

    "/ please change as required (and remove this comment)
    "/ method := nil.
    "/ position := nil.
    description := self class breakpointDescriptionClass new.
    "/ line := nil.

    "/ super initialize.   -- commented since inherited method does nothing

    "Modified: / 21-08-2014 / 09:35:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!Breakpoint methodsFor:'printing & storing'!

inspectorValueStringInListFor:anInspector
    "returns a string to be shown in the inspector's list"

    ^ self printString

    "Created: / 29-05-2019 / 15:14:52 / Claus Gittinger"
!

printBreakpointNrInDebuggerOn:aStream
    "to be redefined for concrete debuggers 
     (some require a bpnt to be registered and use a handle or id to refer to them)"

    "Modified (comment): / 29-05-2019 / 15:11:55 / Claus Gittinger"
!

printOn:aStream
    "append a printed representation of the receiver to the argument, aStream"

    |info|
    
    aStream nextPutAll: 'BPNT'.
    self printBreakpointNrInDebuggerOn:aStream.
    aStream nextPutAll: ' at'.
    self printPositionOrLineNumberOn:aStream.
    self isEnabled ifTrue:[ 
        description condition notNil 
            ifTrue:[info := ' (conditional)']
            ifFalse:[info := ' (enabled)']
    ] ifFalse:[
        info :=' (disabled)'
    ].
    aStream nextPutAll:info

    "Modified: / 24-04-2013 / 20:42:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 29-05-2019 / 15:21:36 / Claus Gittinger"
!

printPositionOrLineNumberOn:aStream
    (position isNil and:[line isNil]) ifTrue:[
        aStream nextPutAll: ' ???'
    ] ifFalse:[
        position notNil ifTrue:[
            aStream
                nextPutAll: ' position:';
                print: position.
        ].
        line notNil ifTrue:[
            aStream
                nextPutAll: ' line:';
                print: line.
        ].
    ].

    "Created: / 29-05-2019 / 15:13:42 / Claus Gittinger"
! !

!Breakpoint methodsFor:'support'!

beInvisible
    "make this breakpoint hidden (in gutter)"

    description beInvisible
!

beTracepoint
    "make this breakpoint a tracepoint"

    description beTracepoint

    "Created: / 27-01-2012 / 13:56:11 / cg"
!

disable
    "disable this breakpoint"

    "/ if there is currently an ignore on this breakpoint in the debugger, remove it
    Debugger notNil ifTrue:[
        DebugView stopIgnoringHaltsFor:method atLineNr:line.
    ].
    description disable

    "Modified: / 02-03-2019 / 11:30:45 / Claus Gittinger"
!

toggle
    "toggle this breakpoint"

    "/ if there is currently an ignore on this breakpoint in the debugger, remove it
    Debugger notNil ifTrue:[
        Debugger stopIgnoringHaltsFor:method atLineNr:line.
    ].
    description toggle

    "Created: / 17-06-2011 / 13:40:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 11-07-2011 / 18:18:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (comment): / 27-01-2012 / 10:41:03 / cg"
    "Modified: / 02-03-2019 / 11:30:31 / Claus Gittinger"
!

toggleTracing
    "toggle tracing of this breakpoint"

    description toggleTracing

    "Created: / 27-01-2012 / 13:56:05 / cg"
    "Modified (comment): / 20-02-2019 / 10:46:54 / Claus Gittinger"
! !

!Breakpoint methodsFor:'testing'!

isEnabled

    "Bad coding here, state should be full object"

    ^description isEnabled

    "Created: / 28-06-2011 / 08:27:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

isTracepoint
    ^description isTracepoint
!

isVisible
    ^description isVisible
! !

!Breakpoint class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
!

version_SVN
    ^ '$ Id $'
! !