Forum > General
Enter/Exit function/procedure message
440bx:
I figured I'd share my solution to outputting function/procedure enter/exit messages.
First, an example of how the solution is used:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---{$APPTYPE CONSOLE} {$MODESWITCH ADVANCEDRECORDS} program _EnterExitNames; uses CallTracing ; {$include CallTracing.macros.inc} procedure A();begin _ENTER; writeln(_INDENT, 'this message should appear indented (if tracing is active)'); exit; writeln('this should NOT be written'); _EXIT;end; procedure B();begin _ENTER; exit; writeln('this should NOT be written'); _EXIT;end; procedure C();begin _ENTER; exit; writeln('this should NOT be written'); _EXIT;end; procedure D();begin _ENTER; exit; writeln('this should NOT be written'); _EXIT;end; procedure F(); { example procedure with call level indented writeln output }begin _ENTER; writeln(_INDENT, 'this message should appear indented (if tracing is active)'); exit; writeln('this should NOT be written'); _EXIT;end; procedure G();begin _ENTER; F(); exit; writeln('this should NOT be written'); _EXIT;end; procedure H();begin _ENTER; G(); exit; writeln('this should NOT be written'); _EXIT;end; procedure I();begin _ENTER; writeln(_INDENT, 'this message should appear indented (if tracing is active)'); H(); _EXIT;end; procedure J();begin _ENTER; I(); exit; writeln('this should NOT be written'); _EXIT;end; procedure K();begin _ENTER; J(); exit; writeln('this should NOT be written'); _EXIT;end; procedure L();begin _ENTER; K(); exit; writeln('this should NOT be written'); _EXIT;end; procedure E();begin _ENTER; A(); B(); C(); D(); L(); exit; writeln('this should NOT be written'); _EXIT;end; begin { "main" program } _ENTER; A(); B(); C(); D(); E(); { calls functions that in turn call other functions } readln; exit; writeln('this should NOT be written'); _EXIT;end. //// end of file// ----------------------------------------------------------------------------The first requirement is to use the unit "CallTracing" which provides the tracing functions. The second requirement is to include the file "CallTracing.macros.inc" which, as its name implies, provides macros to use the tracing functions in CallTracing.
All that's needed to trace the entry and exit of a function is to put the "_ENTER" macro at the beginning and the "_EXIT" macro at the end.
The call tracing unit is very simple:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---{$MODESWITCH ADVANCEDRECORDS} unit CallTracing; { --------------------------------------------------------------------------- }INTERFACE{ --------------------------------------------------------------------------- } type TROUTINE_LEVEL_RANGE = 0..511; { max call nesting } TROUTINE_NAMES = record { prefix rn_ } strict private rn_index : int32; { also indent level } rn_name : array[TROUTINE_LEVEL_RANGE] of pchar; public procedure rn_push(InProcName : pchar); procedure rn_pop(); function rn_indent() : pchar; end; { --------------------------------------------------------------------------- } var { the variable name must be named CallStack because of the macros. it is } { possible to hide that fact by creating a macro to declare the variable } CallStack : TROUTINE_NAMES; { !! global variable } { --------------------------------------------------------------------------- }IMPLEMENTATION{ --------------------------------------------------------------------------- } const CALL_LEVEL_INDENT = 3; type TSPACES_RANGE = low(TROUTINE_LEVEL_RANGE).. CALL_LEVEL_INDENT * high(TROUTINE_LEVEL_RANGE); {$WRITEABLECONST ON}const { NOTE: the NULL field is to guarantee the array of spaces is always null } { terminated } NTSPACES : record SPACES : array[TSPACES_RANGE] of char; NULL : DWORD; end = (SPACES:' '; NULL:0);{$WRITEABLECONST OFF} { --------------------------------------------------------------------------- } procedure IndentLevel(InLevel : int32);begin { use the array of spaces to output the indent } if InLevel * CALL_LEVEL_INDENT < high(NTSPACES.SPACES) then begin NTSPACES.SPACES[InLevel * CALL_LEVEL_INDENT] := #0; write(NTSPACES.SPACES); NTSPACES.SPACES[InLevel * CALL_LEVEL_INDENT] := ' '; exit; end; { the indent level exceeds the maximum the code can handle, output tha } { maximum number of spaces (which is the most we can do) } write(NTSPACES.SPACES);end; { --------------------------------------------------------------------------- } procedure TROUTINE_NAMES.rn_push(InProcName : pchar);begin rn_name[rn_index] := InProcName; writeln; IndentLevel(rn_index); writeln(rn_index:1, ' >> ', InProcName); inc(rn_index); { index of next available entry }end; { --------------------------------------------------------------------------- } function TROUTINE_NAMES.rn_indent() : pchar;begin IndentLevel(rn_index - 1); result := pchar(@NTSPACES.NULL);end; { --------------------------------------------------------------------------- } procedure TROUTINE_NAMES.rn_pop();begin dec(rn_index); if rn_index < low(TROUTINE_LEVEL_RANGE) then exit; IndentLevel(rn_index); writeln(rn_index:1, ' << ', rn_name[rn_index]); writeln;end; { --------------------------------------------------------------------------- } procedure Init();var i : int32;begin { one time initialization } if NTSPACES.SPACES[high(NTSPACES.SPACES)] <> ' ' then begin for i := low(NTSPACES.SPACES) to high(NTSPACES.SPACES) do begin NTSPACES.SPACES[i] := ' '; end; end;end; { --------------------------------------------------------------------------- } initialization Init();end. //// end of file// ----------------------------------------------------------------------------Code that uses the unit does NOT need to be aware of any of the functions provided by the unit because those are hidden by the macros.
The macros file is as follows:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} --- { the following macro definitions are convenient to have in units where }{ tracing is desired } {$MACRO ON} {$define CALLTRACING} {$if defined(CALLTRACING)} {$define _ENTER:=Try CallStack.rn_push({$I %CURRENTROUTINE})} {$define _EXIT:=Finally CallStack.rn_pop(); end} {$define _INDENT:=CallStack.rn_indent()}{$else} {$define _ENTER:=} {$define _EXIT:=} {$define _INDENT:=''}{$endif} //// end of file// ---------------------------------------------------------------------------- defining/undefining "CallTracing" controls outputting trace messages without having to make changes in the code that uses the tracing facility.
One potentially very important limitation to be aware of is that the tracing mechanism is inherently single threaded since it relies on a global variable. A possible enhancement would be to have that variable be a thread variable (left as an exercise for those who need that improvement.)
Attached is a screenshot of the example's output.
ETA:
added the 7zip file attachment that has all the code (Jeez... I'm really getting old !!)
440bx:
I forgot to mention a couple of things about the code that are important.
the output width of rn_index is currently one (1) (see the writeln statements in the CallTracing unit where rn_index is used), that's the value I was using for testing. It should probably be set to somewhere around 4 to ensure the level number stays aligned when the call depth exceeds 9.
the number of elements in the names stack is currently set to 512 (see the range 0..511) and the code does _not_ check for not overflowing the stack (this is on purpose.) For some unusually complex programs, it might be necessary to change the range to end in a larger value (for most programs 511 should be enough - a call nesting depth of 511 is fortunately quite rare - usually caused by recursive calls.)
HTH.
Navigation
[0] Message Index
[*] Previous page