! sqrsh (sqr shell) ! Copyright (C) 1997 Ray Ontko & Company ! ! This program is free software; you can redistribute it and/or modify ! it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2 of the License, or ! (at your option) any later version. ! ! This program is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! along with this program; if not, write to the Free Software ! Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ! !++ ! ! trace ! ! trace iname oname ! ! inserts #debugt code into a program to enable a procedural trace ! ! trace makes the following formatting changes to your program ! ! o inserts a #debugt show 'ENTERING ' after ! each begin-procedure ! o inserts a #debugt show 'EXITING ' before ! each end-procedure ! !-- ! ! $Id: trace.sqh,v 1.5 2004/08/04 05:50:07 rayo Exp $ ! ! Author ! ! Ray Ontko ! Ray Ontko & Company ! Richmond, In 47375 ! ! $Log: trace.sqh,v $ ! Revision 1.5 2004/08/04 05:50:07 rayo ! Added more comments. ! ! Revision 1.4 2004/08/04 05:35:03 rayo ! Added thoughts about the next release. ! ! ! Notes ! ! We currently do a terrible job of noticing where to insert the ! code following the beginning of a procedure. If we support it ! we should also take care when parsing begin-heading and begin-footing, ! as these now allow many lines worth of command. ! ! Also, we need to beware of declare-variable that might ! immediately follow a local procedure declaration. This ! must be the first statement following the procedure if the ! variables are to be declared correctly. We must follow ! the declarations. ! ! It would be nice to have a feature that removes the code we insert. ! ! It would be nice to be able to call a trace_show_stack function. ! This might be called from on-error or in other error handling ! procedures. ! ! Here's a direction we should consider: ! ! #debugt do trace_enter( 'csv_hdr_out' ) ! #debugt do trace_exit( 'csv_hdr_out' ) ! ! We can also do this for begin-program, begin-report, ! begin-setup, begin-heading, and begin-footing. ! ! #ifdef debugt ! #define TRACE_MIN 1000 ! begin-procedure trace_enter( $procedure_name ) ! add 1 to #_trace_count ! if mod( #_trace_count , 100 ) = 0 ! show ':' ! else ! if mod( #_trace_count , 10 ) = 0 ! show '.' ! end-if ! end-if ! if #_trace_count >= {TRACE_MIN} ! show 'enter ' $procedure_name ! end-if ! add 1 to #_trace_level ! end-procedure ! trace_enter ! ! begin-procedure trace_exit( $procedure_name ) ! subtract 1 from #_trace_level ! if #_trace_count >= {TRACE_MIN} ! show 'exit ' $procedure_name ! end-if ! end-procedure ! trace_exit ! #endif ! !------------------------------------------------------------------ trace begin-procedure trace local move 'trace.tmp' to $tname move 'trace.bak' to $bname if isnull( $_p1 ) input $iname 'Input file' else move $_p1 to $iname end-if if isnull( $_p2 ) input $oname 'Output file' else move $_p2 to $oname end-if do trace_file( $iname , $tname ) do fixup_files( $tname, $oname, $bname ) end-procedure ! trace !------------------------------------------------------------- trace_file begin-procedure trace_file( $infile , $outfile ) ! inserts a #debugt at the beginning and end of each procedure ! open $infile as 1 for-reading record={SQRSH_LINE_MAX}:vary status=#status if #status != 0 show 'error opening "' $infile '" for input' else open $outfile as 2 for-writing record={SQRSH_LINE_MAX}:vary status=#status if #status != 0 show 'error opening "' $outfile '" for output' else read 1 into $line:{SQRSH_LINE_MAX} while not #_end-file unstring $line by ' ' into $p0 $p1 lowercase $p0 evaluate $p0 when = 'begin-procedure' unstring $p1 by '(' into $proc_name let $s = '#debugt show ''ENTERING ' || $proc_name || '''' write 2 from $line write 2 from $s break when = 'end-procedure' let $s = '#debugt show ''EXITING ' || $proc_name || '''' write 2 from $s write 2 from $line break when-other if substr($line,1,13) = '#debugt show ' ! do nothing else write 2 from $line end-if end-evaluate read 1 into $line:{SQRSH_LINE_MAX} end-while close 2 end-if close 1 end-if end-procedure ! trace_file