prev back next

Advanced debugging support in ST/X

Some short notes on breakpoint debugging and tracing support in ST/X.

Contents

Introduction

This text gives some overview on non-obvious (i.e. not well-known) debugging facilities, which are available in ST/X.

These facilities allow placing a break/trace on any method - even primitives or methods of which no source code is available, can be traced and/or breakpointed. Also, the usual self halt needs a recompilation of the inspected method, while the facilities described below do not modify or recompile any existing method. (thus leaving machine-code methods untouched - instead of converting them into slower interpreted bytecode).
Finally, in contrast to placing a halt into your methods, breakpoints will not be reported in the "changes" file.

Tracing is possible from both an instance or method viewpoint.

Currently, only trace and breakpoints on methods are supported by the user interface; other facilities have to be enabled "manually", by evaluating corresponding expressions in a workspace.

Instance oriented debugging

These allow tracing/trapping sends to a specific instance - the object under consideration must already exist. These facilities are triggered upon a send of a specific selector to an object - no matter if the object responds to that message and - if understood, which class finally provides a method for it.

Breakpoint on selector sent to an object

This kind of breakpoint is installed by:
    MessageTracer trap:anObject selector:aSelector
which arranges that the debugger is entered, whenever aSelector is sent to anObject.
Once in the debugger, use "step", "send" or "continue" to resume execution in the breakpointed method.
The breakpoint is removed by:
    MessageTracer untrap:anObject selector:aSelector
or:
    MessageTracer untrap:anObject
to remove all traps on anObject (if you have traps on other selectors that you want to get rid of).

Example:

    |p1 p2|

    'creating points' printNL.
    p1 := Point x:1 y:1.  p2 := Point x:2 y:2.

    'setting breakpoints' printNL.
    MessageTracer trap:p1 selector:#size.
    MessageTracer trap:p1 selector:#x:.
    MessageTracer trap:p1 selector:#foo.

    "p2 has no breakpoints set: - nothing happens"

    'p2 size' printNL.  p2 size printNL.
    'p2 x:' printNL.    p2 x:22.

    "now let it trap ..."

    'p1 size' printNL.  p1 size printNL.
    'p1 x:' printNL.    p1 x:5.
    'p1 foo' printNL.   p1 foo.

    'remove size-breakpoints' printNL.
    MessageTracer untrap:p1 selector:#size.

    "nothing happens now ..."

    'p1 size' printNL.  p1 size printNL.

    "but here we trap again ..."

    'p1 x:' printNL.    p1 x:5.

    'remove other breakpoints' printNL.
    MessageTracer untrap:p1.

    'p1 size' printNL.  p1 size printNL.
    'p1 x:' printNL.    p1 x:5.

Trace selector sent to an object

A trace is installed by:
    MessageTracer trace:anObject selector:aSelector
this arranges that a trace message is printed to the standard error output (Stderr), both upon entry and exit to/from the method.
The trace is removed with:
    MessageTracer untrace:anObject selector:aSelector
or:
    MessageTracer untrace:anObject
to remove all traces of anObject.

Example:

    |p1 p2|

    p1 := Point x:1 y:1.
    p2 := Point x:2 y:2.

    "set the tracepoints"

    MessageTracer trace:p1 selector:#size.
    MessageTracer trace:p1 selector:#x:.

    'p2 size / p2 x:' errorPrintNL.
    p2 size. p2 x:22.

    'p1 size / p1 x:' errorPrintNL.
    p1 size. p1 x:5.

    'remove tracing of p1 size' errorPrintNL.
    MessageTracer untrace:p1 selector:#size.

    'p1 size / p1 x:' errorPrintNL.
    p1 size.  p1 x:5.

    'remove tracing of p1' errorPrintNL.
    MessageTracer untrace:p1.

    'p1 size / p1 x:' errorPrintNL.
    p1 size.  p1 x:5.

Trace sender of selector sent to an object

    MessageTracer traceSender:anObject selector:aSelector
arranges that the sender is output the standard error, whenever some message is sent. Use untrace:selector: or untrace (as described above), to remove the trace.
    |arr|

    arr := #(1 2 3 4 5).
    MessageTracer traceSender:arr selector:#at:.
    arr collect:[:e | ]
in contrast to:
    |arr|

    arr := #(1 2 3 4 5).
    MessageTracer trace:arr selector:#at:.
    arr collect:[:e | ]

General tracing/breakpointing of selector sent to an object

The most flexible (but somewhat complicated) mechanism is to provide your own blocks to be evaluated upon entering/leaving a message send (actually, the above trace and breakpoint facilities are built upon the following mechanism).
This is done with:
    MessageTracer 
	wrap:anObject 
	selector:aSelector 
	onEntry:entryBlock 
	onExit:exitBlock
where anObject and aSelector are as above, entryBlock is a one-argument block to be evaluated on entry into the method. It will get the current context passed as argument.
ExitBlock is a two-argument block to be evaluated on exit from the method. It will get the context and the return value passed as arguments.

This allows conditional breakpoints or conditional tracing.
It can also be used to implement pre- and post conditions a la Eiffel while debugging.

For example, you want to trace any sent to an object with a specific argument, use something like:

    |p|

    p := Point new.
    MessageTracer wrap:p selector:#x:
		  onEntry:[:con |
			    (con args at:1) > 5 ifTrue:[
				Debugger 
				    enter:con
				    withMessage:'hit breakPoint; arg > 5'
			    ]
			  ]
		  onExit:nil.

    p x:4.  "nothing happens"
    p x:-1. "nothing happens."
    p x:10. "bummm"
(in the above example, the first argument is checked for being greater than 5; if so, the debugger is entered)

Postcondition checking can be implemented with this mechanism. For example if you want to check the range of some instance variable after every send of some selector, use:

    MessageTracer 
	wrap:someObject
	selector:someSelector
	onEntry:nil
	onExit:[:con :retVal |
		   (con receiver getInstVar between:min and:max) ifFalse:[
			Debugger 
			    enter:con
			    withMessage:'postcondition violated'
		   ]
	       ]
(in the above, replace getInstVar by an appropriate access selector for the instance variable to be checked)

Method oriented debugging

In method oriented debugging, you are not interrested in sends to a specific object, but in evaluation of specific methods. Thus, these facilities catch execution of specific methods - in contrast to sends if specific messages. This implies, you can only catch implemented methods (i.e. it is not possible to catch sends of unimplemented methods here).
Since the breakpoint/trace is placed on a particular method, you may have to place multiple debugging points if super-sends are involved (which was not the case with the above instance debugging).

Breakpoint on a method

A breakpoint on a particular method is installed with:
    MessageTracer trapMethod:aMethod
this arranges that the debugger is entered, whenever aMethod is about to be executed (no matter, if for instances of the implementing class, or of any subclass).

The browser has a convenient menu function to set this kind of breakpoint, see below or the SystemBrowser documentation.

Example:

    |p1 p2|

    'creating points' printNL.
    p1 := Point x:1 y:1.
    p2 := Point x:2 y:2.

    'setting breakpoints' printNL.
    MessageTracer trapMethod:(Point compiledMethodAt:#printOn:).
    MessageTracer trapMethod:(Point compiledMethodAt:#x:).

    "all Points will trap"

    'p2' printNL.      p2 printNL.
    'p2 x:' printNL.   p2 x:22.
    'p1' printNL.      p1 printNL.
    'p1 x:' printNL.   p1 x:5.

    'remove size-breakpoints' printNL.
    MessageTracer untrapMethod:(Point compiledMethodAt:#printOn:).

    "nothing happens now ..."

    'p1' printNL.      p1 printNL.

    "but now ..."

    'p1 x:' printNL.   p1 x:5.

    'remove other breakpoints' printNL.
    MessageTracer untrapMethod:(Point compiledMethodAt:#x:).

    'p1' printNL.      p1 printNL.
    'p1 x:' printNL.   p1 x:5.

Tracing a method

Like with instance debugging, you can also install a trace for a method:
    MessageTracer traceMethod:aMethod

Example:

    MessageTracer traceMethod:(Integer compiledMethodAt:#factorial).
    5 factorial.
    MessageTracer untraceMethod:(Integer compiledMethodAt:#factorial)

Tracing the sender of a method

Tracing the sender only is done with:
    MessageTracer traceMethodSender:aMethod

Example:

    MessageTracer traceMethodSender:(Integer compiledMethodAt:#factorial).
    5 factorial.
    MessageTracer untraceMethod:(Integer compiledMethodAt:#factorial)

General tracing/breakpointing of methods

The general wrapping mechanism is also available for methods:
    MessageTracer 
	wrapMethod:aMethod 
	onEntry:entryBlock 
	onExit:exitBlock

Example 1: catching a specific factorial invocation:

    MessageTracer wrapMethod:(Integer compiledMethodAt:#factorial)
		     onEntry:[:con |
				con receiver == 3 ifTrue:[
				    Debugger 
					enter:con
					withMessage:'3 factorial encountered'
				]
			     ]
		      onExit:[:con :val |
				'leaving ' errorPrint.
				con errorPrint. ' -> ' errorPrint.
				val errorPrintNL.
			     ].
    5 factorial.
cleanup with:
    MessageTracer unwrapMethod:(Integer compiledMethodAt:#factorial)
Example 2: tracing file-open of specific files:
    MessageTracer wrapMethod:(FileStream compiledMethodAt:#openWithMode:)
		     onEntry:[:con |
				(con receiver pathName endsWith:'.st') ifTrue:[
				    'opening ' errorPrint.
				    con receiver pathName errorPrintNL
				]
			     ]
		       onExit:nil.

    "now, play around with systembrowser (look at methods source-code)
     or look at files with the filebrowser ...
     And watch the output in the xterm window."
cleanup with:
    MessageTracer unwrapMethod:(FileStream compiledMethodAt:#openWithMode:)
Example 3: traping access to a specific file:
    MessageTracer wrapMethod:(FileStream compiledMethodAt:#openWithMode:)
		     onEntry:[:con |
				(con receiver name = 'test') ifTrue:[
				    Debugger
					enter:con
					withMessage:'opening file named ''test'''
				]
			     ]
		       onExit:nil.

    "now, create a file named 'test' with the filebrowser ..."
cleanup with:
    MessageTracer unwrapMethod:(FileStream compiledMethodAt:#openWithMode:)

Browser support for breakpoints and/or tracing

The Systembrowser allows setting/clearing of simple breakpoints and simple tracepoints from the method-menu. Methods being traced or which have a breakpoint are shown with an exclamation mark '!' behind their name (in the top-right method list).

Warning / dangers

Currently the tracing facilities are not smart enough, to detect recursive invocation of trace methods. Thus, if a trace is placed on a method, which is needed for tracing itself, the system will enter some bad (recursive) loop. This may bring you into the debugger or - if the recursion occurs again in the debugger - even into the miniDebugger.

For example, placing a trace on Context>>sender will lead to this situation, because that method is indirectly called by the trace-code. Thus the process will run into recursion overflow problems, and start up a debugger; this debugger itself will run into the same problem, since during its startup, it reads the context chain using Context>>sender. Finally, ST/X's runtime system will kill the (lightweight) process.

If you are lucky, the system is in a condition to enter the MiniDebugger.
In this case, try to repair things with:

    MiniDebugger> I                     <- I-command; gets you into a 
					   line-by-line expression evaluator

    MessageTracer unwrapAllMethods      <- remove all breakpoints

					<- empty line to leave the
					   expression evaluator

    MiniDebugger> a                     <- abort

Example:

ATTENTION: save your work before evaluating this
    MessageTracer traceMethodSender:(Context compiledMethodAt:#sender).
    thisContext sender.
    MessageTracer untraceMethod:(Context compiledMethodAt:#sender).
after the above, you should repair things, by opening a workspace, and evaluating:
    MessageTracer unwrapAllmethods
(this will remove the tracers, and allow normal use of the debugger again).

Critical methods are all context methods, string concatenation and printing methods.
To trace these critical methods, use the instance debugging facilities described above, instead of method debugging - if possible (it is not possible for context-related methods though).

It is difficult to offer a satisfying solution to this problem - the obvious fix (to simply check for recursion in the wrapper method) would prevent the tracing or breakpointing of recursive methods, such as the factorial-example above.

Future versions may provide better solutions - for now, be warned.


Copyright © Claus Gittinger Development & Consulting, all rights reserved

(cg@ssw.de)