"
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' }"
Object subclass:#Breakpoint
instanceVariableNames:'position description line isReached method breaksToIgnore
contexts'
classVariableNames:''
poolDictionaries:''
category:'System-Compiler-Debugging'
!
Object subclass:#ContextData
instanceVariableNames:'context nhits'
classVariableNames:''
poolDictionaries:''
privateIn:Breakpoint
!
!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 messages dynamically when a statement
with a breakpoint is about to be executed.
"
! !
!Breakpoint class methodsFor:'instance creation'!
new
"return an initialized instance"
^ self basicNew initialize.
! !
!Breakpoint methodsFor:'accessing'!
breaksToIgnore
^ breaksToIgnore
!
breaksToIgnore:anInteger
breaksToIgnore := anInteger.
!
description
^ description
!
description:aBreakpointDescription
description := aBreakpointDescription.
!
isReached
^ isReached
!
isReached:aBoolean
isReached := aBoolean.
!
line
^ line
!
line:anInteger
line := anInteger.
!
position
^ position
!
position:anInteger
position := anInteger.
"Modified (format): / 02-08-2012 / 09:26:03 / cg"
!
position:positionArg line:lineArg
position := positionArg.
line := lineArg.
"Created: / 02-08-2012 / 09:26:27 / cg"
! !
!Breakpoint methodsFor:'initialization'!
initialize
"Invoked when a new instance is created."
"/ please change as required (and remove this comment)
"/ method := nil.
"/ position := nil.
description := BreakpointDescription new.
"/ line := nil.
breaksToIgnore := 0.
contexts := OrderedCollection new.
"/ super initialize. -- commented since inherited method does nothing
"Modified: / 16-04-2013 / 08:50:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!Breakpoint methodsFor:'printing & storing'!
printOn:aStream
"append a printed representation if the receiver to the argument, aStream"
aStream nextPutAll: 'BPNT at'.
position notNil ifTrue:[
aStream
nextPutAll: ' source position:';
nextPutAll: position printString.
].
line notNil ifTrue:[
aStream
nextPutAll: ' line:';
nextPutAll: line printString.
].
(position isNil and:[line isNil]) ifTrue:[
aStream nextPutAll: ' ???'
]
"Modified: / 24-04-2013 / 20:42:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!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"
!
break
"invoked by the breakPoint's code (see BreakPointNode)"
<resource: #skipInDebuggersWalkBack>
|sender|
description isEnabled ifFalse:[^ self].
sender := thisContext sender.
(description shouldBreakIn: sender) ifTrue:[
BreakPointInterrupt
raiseRequestWith: self
errorString:('Breakpoint encountered at line %1' bindWith:self line)
in:sender.
].
(description shouldTraceIn: sender) ifTrue:[
Transcript
show:Timestamp now;
showCR:(' Trace %1 [%2]' bindWith:sender methodPrintString with:self line)
].
"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: / 27-01-2012 / 14:10:22 / cg"
!
breakInternal
"invoked by the VM when breakpoint is reached. Used by new breakpoint support. "
| sender data i |
sender := thisContext sender sender sender sender sender sender.
breaksToIgnore ~~ 0 ifTrue:[
i := 1.
[ i <= contexts size ] whileTrue:[
(contexts at: i) context isOnMachineStack ifFalse:[
contexts removeIndex: i.
] ifTrue:[
(contexts at: i) context == sender ifTrue:[
data := (contexts at: i)
]
].
i := i + 1.
].
data isNil ifTrue:[
data := ContextData new context: sender; nhits: 0.
contexts add: data.
].
data nhits == 0 ifTrue:[
data nhits: data nhits + 1.
self break.
] ifFalse:[
data nhits == breaksToIgnore ifTrue:[
data nhits:0.
] ifFalse:[
data nhits: data nhits + 1.
].
]
] ifFalse:[
self break.
]
"Created: / 15-04-2013 / 23:58:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-04-2013 / 20:53:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
disable
"disable this breakpoint"
description disable
!
toggle
"toggle this breakpoint"
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"
!
toggleTracing
"toggle this breakpoint"
description toggleTracing
"Created: / 27-01-2012 / 13:56:05 / cg"
! !
!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>"
!
isVisible
^description isVisible
! !
!Breakpoint::ContextData methodsFor:'accessing'!
context
^ context
!
context:something
context := something.
!
nhits
^ nhits
!
nhits:something
nhits := something.
! !
!Breakpoint class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libcomp/Breakpoint.st,v 1.18 2013-12-16 13:40:19 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/libcomp/Breakpoint.st,v 1.18 2013-12-16 13:40:19 cg Exp $'
!
version_SVN
^ '$ Id $'
! !