#!/usr/local/bin/perl -w

#
# instrument_program.perl
#
# Analyzes C program for recursive functions,
# inserts profiling instrumentation code
#
# Stefan U. Haenssgen 04-jul-97
#
#
# 04-jul-97	1st version with inspirations from PSP LOC counter
#		- read_lines to read source code
#		- find_procedures to identify procedure code at top
#		   bracket {} level
#		- find_calls to identify procedure invocations at
#		   non-top bracket level
#		- find_recursives to check transitive hull of
#		   procedure calls and identify recursions
#		   using the unique_sort_names subroutine
# 06-jul-97	More comments, added ToDos
#		If procedure is identified, check if such a procedure
#		 has been "identified" before and overwrite that one,
#		 guessing that the first occurence was just a declaration
#		 and not the procedure code itself
#		Also remember correct ending line in this case
#		Sort procedures for starting line number (find_calls
#		 assumes that subsequent entries have increasing line
#		 numbers!)
#		Also match procedures with pointer (*) before them
#		Don't match calls with substrings of procedure names
#		 in them (e.g. "old_main(" shouldn't match "main(")
# 07-jul-97	Added string recognition and elimination
#		Added single line comment handling (thanks to perlop manpage)
#		 and multi-line handling
#		Added procedure header recognition, also headers
#		 spanning multiple lines. Recognize declarations (no
#		 code after header), too.
#		Also handle comments in function call extraction
#		Also recognize calls in one-lined procedures
#		Preparations for instrumentation
#		Renamed "bracket" -> "brace"
# 09-jul-97	Remember where procedure calls occur in @procwherecalled
#		Map procedure name to index using %procnameindex
#		Instrument main program with instument_main (add includes,
#		 add procedure profile entries etc)
#		Skip to after procedure's header with skip_proc_head
# 		Also accept "!" before procedure calls
#		Add generation of profile init code in main
#		Add generation of profile counters in each recursive procedure
#		Find start of procedure's parameters (in parentheses) using
#		 proc_param_start
#		Sub skip_to_end_of_statement for general use, ditto
#		 skip_to_start_of_startement
#		Examine each place where a recursive procedure is called,
#		 add depth parameter, and if the call is recursive (within
#		 the procedure itself), add a branch_count++ after it
#		Added a hack to initialize the profile within main()'s
#		 declarations
# 10-jul-97	Remember old declarations before overwriting them, so that
#		 we can update them later when we add depth parameters etc
#		proc_param_start takes line number again, not procedure's
#		 name, to enable us to handle declarations, too
#		Send final output (instrumented program) to file if
#		 environment IP_OUT set, else stdout
#		Use pattern match variables:
#		 $x (x=1..0) for corresponding parenthesis,
#		 $MATCH for string that was matched, $PREMATCH and
#		 $POSTMATCH for string parts before/after match
#		Cleaned up code (more spaces/free lines etc)
#		Also remember positions of starting parenthesis of
#		 procedure's parameters for each procedure header and call
#		Use that information to make several searches (e.g.
#		 for procedure header) faster and less error-prone,
#		 since the original header detection makes sure no
#		 comments are involved etc
# 11-jul-97	Debugging (correct incides for old declarations)
#		Made procdecls a associative array indexed by procedure
#		 name, so finding things again later is easier (procs
#		 get sorted in between!)
#		Also recognize returns during the scanning phase
#		 and remember their positions for later instrumentation
#		 in array "returns"
#		Use that information for better recognition of returns
#		 in instrumentation
#		Better handling of closing "}" - append to ";" if that
#		 closes the statement (avoiding "if () {xxx}; else..."
#		 syntax error!), prepend it otherwise
#		Major modification: use "change requests" for modifying
#		 program code, don't modify at once but remember where
#		 what has to be inserted, then sort the requests and
#		 handle them in reverse line order. Should eliminate
#		 the possibility of changes modifying the program so
#		 that later analysis or already known offsets fail!
# 12-jul-97	Added a unified procedure to look for end of current statement
#		 (i.e. next "{", "}", ";") taking comments and strings
#		 into account!
#		Use this procedure skip_to_delimiter to make the
#		 old procedures skip_to_{begin,end}_of_statement and
#		 skip_proc_head simpler and more robust
#		Recognize mutual recursion, i.e., don't classify mutual
#		 recursive calls as "external". Handle special case
#		 where one mutually procedure is just used from the
#		 other one and from nowhere else - don't increase the
#		 depth parameter when calling it; mark them with
#		 $mutualonly[$i]=1. Otherwise, increase depth as usual
#		 (pass own depth + 1)
#		Introduced directcalls[] with calls that procedure
#		 directly makes, in addition to allcalls[] which is
#		 the transitive hull of calls (former calledprocs)
#		Add "branch_count++" before (!) the recursive call,
#		 otherwise it might be inside a "return" and nothing
#		 is incremented.
#		Better return matching, also "{}" OK before/after
#		Use ";}" as closing encapsulation to avoid "return x}" which
#		 seems to annoy gcc
#		Completed handling of mutual recursions
# 14-jul-97	Introduced debug level (0=nothing, 1=infos (default), 2=high,
#		 3=detailed)
#		Prefixed any non-essential output with debug level
#		Added argument handling and arguments:
#		- debug N for debug level N
#		- quiet for debug level 0
#		- verbose for debug level 2
#		- noisy for debug level 3
#		- degree N for profile branching degree initialization N
#		- depth N for profile depth init N
#		Check if given file exists and just one file is given
#		Indent program code when adding code in add_change
#		Added use of "atexit" to instrumentation to assure
#		 profile is printed at program's exit - don't need
#		 instrumentation of main()'s end with ProfilePrint
#		 any more, since exit is called implicitly anyway
#		Skip statement at end of procedure that might still be
#		 there before adding code
#		Also allow "=" before procedure call in pattern
# [rest -> parallelize_program.perl]
# 17-jul-97	Split the instrumentation off again, removed parallelization
#		 (handled in separate programs now!)
# 18-jul-97	Understand ThreadWrapper_FNAME functions (introduced
#		 by parallelization) and don't add depth=0 parameter to
#		 calls of FNAME inside them
#		Also ignore ThreadWrapper_FNAME for mutualonly analysis
# 21-jul-97	Use @recursivecalls to keep track of other recursive
#		 procedures that are called directly by this one
# 25-jul-97	Added option -out as alternative to environment variable
#		Added option -noprofile to omit profile generation, just
#		 supplying the branch_count and depth parameters (for
#		 parallel programs that do not collect profile info)
#		 -> use $noprofile flag
# 28-jul-97	Filter out typedefs from procedure recognition
# 04-aug-97	Renamed "-debut" to "-detail"
# 27-aug-97	Added insertion of tree stats (record the whole recursion
#		 tree); only usable for single recursive procedures at first
#		Added switch "-record" to activate tree stat recording
#		Use $initdegree for treestats, too
#		Prefix treestats data with "ts_" to be unique
#		Modified skip_to_delimiter to ignore leading/trailing
#		 blanks when searching backwards, i.e. skip_to_start_*
#	   	 returns the statement's first non-blank character
# 28-aug-97	Extended recording: One statistics tree for each recursive
#		 procedure, i.e. no more problems with programs using more
#		 than one recursion
#		Treestat variable names now contain their procedure's name
#		New semantics for mutual recursions (i.e. not just-self,
#		 not just-hierarchical): Use the tree of the procedure
#		 that was called externally for all mutual recursions.
#		 Pass its treeindex and treestats as parameters through
#		 all recursions (tree stats array and pointer to index),
#		 leave function name out of leafindex and tsindex
# 04-sep-97	Also record code number of procedure (index in recursives
#		 array) and output it in the "()" tree output
#		Define procedure numbers for each recursive procedure
#		 and set them just before returning from the procedure
#		Add subtree timing code if $timetree is set ("-time"),
#		 before each return etc as well as timing output
#		Only sort joinlines if there is at least one
#		New DEPTH semantics: Don't start depth with each non-mutual
#		 external call. Instead, set depth to 0 with each outside
#		 call and pass depth+1 through to all other recursive
#		 procedures! Thus, depth is the depth of the complete
#		 recursion tree, independent of the procedure type
#		 (matches the tree recording semantics better)
#		Eliminated the mutualonly-distinction, no longer valid
# 15-sep-97	(debug) Added declaration of @joinlines 
# 19-dec-97	(debug) Added newline after branch_count++;
# 15-jan-98	Output usage instructions also if unknown option given
#		New annotation NOSTATS for procedures that shouldn't
#		 collect statistics (hash %thisnostats)
#		New option "-autonostats" that makes all NOPARALLEL 
#		 procedures also NOSTATS
# 16-jan-98	Mark REAPAR output (profiles etc) with machine-recognizable
#		 begin/end separators: BEGIN/END REAPAR PROFILES/TREES/PROCINFO
#		Output procedure numbers/names/lines and call information
#		Also measure wallclock runtime -> REAPAR RSCINFO (end of
#		 measurement in profile or tree output, 1st call to
#		 GetProfileTime ends it)
#		Added getrusage() call and corresponding resources to
#		 RSCINFO output... only u/s time available in Solaris..
# 07-mar-98	Added "-rchunk" option to set chunk size of tree recording
#
#
# Restrictions:
#
# IF-ELSEs AND FORs HAVE TO BE ENCAPSULATED IN BRACES {}
# else the statement recognition/skipping code is confused by source
# code like "if (a) f(b); else g(c);"
#

# TODO:
#	- handle calls with parameters on different lines, e.g.
#		a = f <NEWLINE> (a,b,c)
#	- handle #defines
#

use English;				# Long internal names (e.g. "$MATCH")

# Global variables:

$bracelevel	= 0;			# Level of {} braces
$procnum	= 0;			# Number of procedure
$linenum	= 0;			# Physical line number
@procname       = ("toplevel");		# List of procedure names
%procnameindex  = ("toplevel",0);	# Their indices (toplevel stays at 0)
@allcalls	= ("main:");		# Procedures this one called
@directcalls	= ("main:");		# Procedures this one called directly
@procstartline  = (1);			# Source line this proc starts in
@procstartpos   = (0);			#  and character pos of starting "("
@procendline    = (1);			# Source line this proc ends in
@procwherecalled= ("toplevel|0,0:");	# Where this proc is called directly
%procdecls	= ();			#  and was declared earlier. Format:
					#  "from_line,pos_in_line-to_line:..."
%variables	= ();			# Procedure's variable list
%proctypes	= ();			# Proc's type (before name in declar.)
@returns	= ();			# All return statements "line,pos"
$returnnum	= 0;			# How many there were
@recursives	= ("");			# Recursive procedures
$allrecursives	= ":";			# Names of all recursive procedures
$recursivenum   = 0;
@recursivecalls = ("");			# Direct calls to other recursive procs
@source         = ("");			# Whole program code
@requests	= ("");			# Program code insertion requests for
$requestnum	= 0;			#  instrumentation - "line:pos:text"
					#  (text is inserted BEFORE pos)
$changeprio     = 3;			# Priority for changes
$debuglevel	= 1;			# Verbosity of output
$initdegree	= 12;			# Default profile initialization degree
$initdepth	= 90;			# Ditto depth
$rchunk		= 100000;		# Chunk size for tree recording

$noprofile	= 0;			# Parallel only (no profile generated)
$recordtree	= 0;			# Recursion tree recording on/off
$timetree	= 0;			# Subtree timing on/off

%nostats	= ();			# Procedures annotated "no statistics"
$autonostats	= 0;			# Make NOPARALLEL procs also NOSTATS

$defaulttype    = "int";		# Type for procs with empty type

$outfilename	= "";			# Default = stdout

$instructions   = "
usage: $0 [options] filename

       Instruments ANSI C source to collect recursion information profiles.

       Options:
       -detail N    Output detail level. 0=none, 1=informative (default),
                    2=verbose, 3=very detailed, 4=chatterbox
       -degree N    Set max. profile branching degree to N (default = $initdegree)
       -depth N     Set max. profile recursion depth to N (default = $initdepth)
       -noisy       Same as -detail 3
       -autonostats Automatically annotate NOPARALLEL procedures NOSTATS
       -noprofile   Only generate additional parameters but no profile
       -out F       Write instrumented program to file F (default = stdout)
       -quiet       Same as -detail 0
       -rchunk N    Sets chunk size for tree recording (default = 100000)
       -record      Record the complete recursion tree for later analysis
       -time        Get timings for each recursion subtree (implies -record)
       -verbose     Same as -detail 2

";
    
# Debugging output - print text if level >= debug level
#
sub dprint {
    my $level = shift;
    my $text  = shift;

    if ($level <= $debuglevel) {
	print $text;
    }
}


# Handle parameters - parse command line for arguments, give usage
# information when none found, check if given file exists etc.
#
sub handle_arguments {

    if (!defined($ARGV[0])) {
	die $instructions;
    }

    if (defined($ENV{"IP_OUT"})) {	# Handle environment
        $outfilename = $ENV{"IP_OUT"};
    }
 
    while ($ARGV[0] =~ /^-(\S+)/) {
	$arg = $1;
	shift @ARGV;

	if (($arg eq "out")	 	# Arguments that need string parameter
	   ) {
	    my $x;
	    
	    if (!defined($ARGV[0])) {
		die "ERROR, '-$arg' needs string parameter\n";
	    }
	    $x = $ARGV[0];
	    shift @ARGV;
	    
	    if ($arg eq "out") {
		$outfilename = $x;	# Set output file
	    }
	    
	} elsif (($arg eq "detail")  ||	# Arguments that need integer parameter
	         ($arg eq "degree") ||
	         ($arg eq "depth") ||
	         ($arg eq "rchunk")
	   ) {
	    my $x;
	    
	    if ( (!defined($ARGV[0])) || (!($ARGV[0] =~ /^[0-9]+$/)) ) {
		die "ERROR, '-$arg' needs integer parameter\n";
	    }
	    $x = $ARGV[0];
	    shift @ARGV;
	    
	    if ($arg eq "detail") {
		$debuglevel = int($x);		# Set debug level
		if (($x < 0) || ($x > 4)) {
		    die "ERROR, detail level must be between 0 and 4\n";
		}
	    } elsif ($arg eq "degree") {
		$initdegree = int($x);		# Set profile degree
		if ($x < 1) {
		    die "ERROR, profile degree must be > 0\n";
		}
	    } elsif ($arg eq "depth") {
		$initdepth = int($x);		# Set profile depth
		if ($x < 1) {
		    die "ERROR, profile depth must be > 0\n";
		}
	    } elsif ($arg eq "rchunk") {
		$rchunk = int($x);		# Set tree recording chunk size
		if ($x < 1) {
		    die "ERROR, recording chunk size must be > 0\n";
		}
	    }

	} elsif ($arg eq "quiet") {
	    $debuglevel = 0;
	} elsif ($arg eq "verbose") {
	    $debuglevel = 2;
	} elsif ($arg eq "noisy") {
	    $debuglevel = 3;
	} elsif ($arg eq "noprofile") {
	    $noprofile = 1;
	} elsif ($arg eq "record") {
	    $recordtree = 1;
	} elsif ($arg eq "time") {
	    $recordtree = 1;
	    $timetree   = 1;
	} elsif ($arg eq "autonostats") {
	    $autonostats = 1;
	} else {
	    die $instructions;
	}
    }

    if ($#ARGV >= 1) {
        die "ERROR, only one file can be processed at a time!\n";
    }
    
    if (!stat($ARGV[0])) {
	die "ERROR, cannot open input file '$ARGV[0]'\n";
    }

    if ($noprofile == 1) {
	dprint 1,"(Instrumentation of parameters only, no profile addition)\n";
    }
    dprint 2,"detail level = $debuglevel\n";
    dprint 2,"profile degree = $initdegree, depth = $initdepth\n";

}


sub read_lines {
    while (<>) {
	chomp;
	$linenum++;
	$source[$linenum] = $_;
	dprint 4, "$linenum $source[$linenum]\n";
    }
}

sub find_procedures {

    my $n = 0;
    my $line = "";
    my $originalline = "";
    my @pline = ("");
    my @pname = ("");
    my @bopens = ("");
    my @bcloses = ("");			# Opening/closing braces in line
    my $oldbracelevel = $bracelevel;
    my $thisprocnum = $procnum;		# For $procendline[x] - x may be !=
    					#  $procnum if it redefines something
    my @tmpprocs = ("");
    my @joinlines = ("");
    my @tmpjoins = ("");
    
    my $cs = 0;				# Position of comment start in line
    my $ce = 0;				# ditto comment's end
    my $inside_comment = 0;		# True if inside comment/quotes

    my $inside_procedure = 0;		# True if inside procedure

    my $inside_header = 0;		# True if inside procedure header
    my $pc = 0;				# Parentheis/brace count for header
    my $bc = 0;
    my $maxbc = 0;			# Maximum brace count reached
    my $thisvars = "";			# Procedure's variables
    my $thistype = "";			# Procedure's type (all before name :)
    my $thisnostats = 0;		# Is proc. annotated NOSTATS?
    
    while ($n < $linenum) {
	$n++;
	$line = $source[$n];
	$originalline = $line;

	$line =~ s/\"[^\"]*\"//g;	# Remove quotes (ASSUMES that
					#  quotes don't span lines)
	
        # Check if the "/* NOSTATS */" annotation can be found.
        # Remember that for the procedure.
	# Also assume NOSTATS if NOPARRALLEL found and "-autonostats" given
        #
	if (($line =~ /\/\*[\s]*NOSTATS[\s]*\*\//) ||
	    (($line =~ /\/\*[\s]*NOPARALLEL[\s]*\*\//) && ($autonostats))) {
	    
	    $thisnostats = 1;
	}
	
	# Remove comments to avoid interference with analysis
	#
        $line =~ s {
                     /\*     (?# Match the opening delimiter.)
                     .*?     (?# Match a minimal number of characters.)
                     \*/     (?# Match the closing delimiter.)
                   } []gsx;		# Remove inline comments (see perlop :)

	$cs = index($line, "/*");	# Catch multi-line comments
	$ce = index($line, "*/");

        if ($ce >= 0) {	
	    $line =~ s/^.*\*\///g;	# Remove anything before end of comment
	    $inside_comment = 0;	# Now no longer inside comment
	}
        if ($cs >= 0) {	
	    $line =~ s/\/\*.*$//g;	# Remove anything past start of comment
	    $inside_comment = 1;	# Now inside multi-line comment
	}

        if ($inside_comment == 0) {	# Ignore anything inside comments

        # Remember old brace level and compute new one from
        # difference of opening and closing braces
        # ("x" used to ensure that "} abc" yields TWO blocks, not
        # just one because the brace is at the beginning of the line)
        #
        $oldbracelevel = $bracelevel;	# Remember Br.Level before this line
        @bopens  = split( /\{/ , "x".$line."x");
        @bcloses = split( /\}/ , "x".$line."x");
        $bracelevel = $bracelevel + $#bopens - $#bcloses;

        # brace level should also take multiple statements into account,
        # e.g.
        #       x = y(); { etc pp
	#
	# !!! DOES IT ???

        dprint 2,"$n [$oldbracelevel] $originalline\n";

	# Recognize return statements for later use
	# !!! DOES NOT RECOGNIZE TWO RETURNS IN A SINGLE LINE
	#
        if ($line =~ /([\;\}\{\s]+|^)return([^a-zA-Z_0-9]+|$)/ ) {
	    
	    my $mat  = $MATCH;		# Pre/post/match for patterns
	    my $pre  = $PREMATCH;
	    my $post = $POSTMATCH;
	    $mat =~ /return/;

	    # Remember position of return in line (the "r" character's one)
	    #
	    my $pos = length($pre.$PREMATCH);

	    $returnnum++;
	    $returns[$returnnum] = $n.",".$pos;
	    
	    dprint 2,"      -> RETURN at line $n,$pos\n";
	    
	}
	    
        #
        # Look for procedure headers... pattern is:
        #
        #    type1 type2 proc_name(atype1 arg1, atype2 arg2)
        #
        # Types can contain "*()&", names only whitespace.
        # Procedure code must be at top brace level (0)
        #
        # !!! TODO: more stable recognition, also {} () etc check
        #
        if ($oldbracelevel == 0) {

	  # Not yet inside a procedure? Check if we find something
	  # that looks like a proecdure head
	  # While we're at it, remember procedure's variables (all inside
	  # parenthesis) and type (all before procedure's name)...
	  #
          if ($inside_procedure == 0) {
	      
            if ( $line =~ /^([\(\)\&\*\s]*[a-zA-Z][a-zA-Z_0-9]*[\(\)\&\*\s]+)*[a-zA-Z][a-zA-Z_0-9]*[\s]*\(/ ){

                my $isnew = 1;                  # 1 if proc. not already known
                my $thisname = "";
                my $j = 0;
	        my $mat  = $MATCH;		# Pre/post/match for patterns
	        my $pre  = $PREMATCH;
	        my $post = $POSTMATCH;
		my $pos = length($pre.$mat)-1;	# Position of parenthesis
						#  that starts the proc.header
		$thisvars = "";			# Reset potential variables
		$thistype = $MATCH;		# Remember type (w/o proc.name)
		$thistype =~ s/[a-zA-Z][a-zA-Z_0-9]*[\s]*\($//;
		$thistype =~ s/^[\s]*//;
		$thistype =~ s/[\s]*$//;	# Cut off whitespace

		dprint 3,"PRE:MATCH:POST[pos]=$pre:$mat:$post\[$pos\]\n";

                @pline = split(/\(/,
			       $mat." ");	# Extract procedure's name
                @pname = split(/\s/,		#  as last "word" before last
			    $pline[$#pline-1]);	#  opening parenthesis "("
                $thisname = $pname[$#pname];    
                $thisname =~ s/\*//g;           # Remove "*" for ptr. proc's

		# Avoid "recognition" of lines like "typedef void (*proc)();"
		#
		if ($thistype =~ /[\s]*typedef([^a-zA-Z_0-9]+|$)/) {
		    dprint 3,"(Just a typedef, ignoring it)\n";
		} else {
			
                # Check if procedure is already known. If yes, assume
                # that the latest occurence is the real procedure and
                # anything before was a forward declaration.
		# Remember the forward declaration's lines for later
		# (adding new parameters etc)
                #
                for ($j=1; $j <= $procnum; $j++) {
                    if ($thisname eq $procname[$j]) {
			
                        dprint 2,"       -> REDEFINES $thisname".
                              " at lines $procstartline[$j],".
		  	      "$procstartpos[$j] ".
                              " to $procendline[$j]\n";
                        $isnew = 0;
			#
			# Remember old declaration(s)
			#
                        $procdecls{$procname[$j]} = $procstartline[$j].",".
			                       $procstartpos[$j]."-".
			                       $procendline[$j].":";
			#
			# Redefine procedure $j
			#
                        $procname[$j] = $thisname;
                        $procstartline[$j] = $n;
			$procstartpos[$j] = $pos;
                        $procendline[$j] = $n;
                        $thisprocnum = $j;
                    }
                }

                # If procedure is really new, initialize its information
                #
                if ($isnew == 1) {
		    
                    $procnum++;
                    $procname[$procnum] = $thisname;
                    $directcalls[$procnum] = "";    # No calls found inside yet
		    $procwherecalled[$procnum] = "";# Neither calls to it
                    $procdecls{$thisname} = "";	    # No other declarations yet
                    $procstartline[$procnum] = $n;
		    $procstartpos[$procnum] = $pos;
                    $procendline[$procnum] = $n;
                    dprint 2,"      -> START $thistype $procname[$procnum]\n";
                    $thisprocnum = $procnum;
		    $variables{$thisname} = "";	    # Remember proc's variables
		    $nostats{$thisname} = 0;        # No NOSTATS annot.found
		    
		    if ($thistype eq "") {
			dprint 2,"      WARNING - empty type set to ".
			         "$defaulttype\n";
			$thistype = $defaulttype;   # Avoid empty types
		    }
		    $proctypes{$thisname} = $thistype; # Remember type
                }

		# Now we've found a procedure and are inside its header
		#
                $inside_procedure = 1;
		$inside_header = 1;

		# Cut all before and including procedure's name
		# for further analysis (esp. for header information)
		# i.e. take the part after the proedure-detection-match!
		#
		$line = "(".$post;	# "(" was still in match, re-supply it
		$pc = 0;			
		$maxbc = 0;
		$bc = 0;
	    }
            }
	    
          } elsif ($inside_header == 0) {

	      # Complain if inside procedure (outside of header!) and
	      # old brace level still is zero!
	      #
              print "SHOULD NOT HAPPEN: OLD BRACE LEVEL = 0".
		    " AND INSIDE PROCEDURE\n";
	      
          }
        }

	# Examine header: Header ends if
	# - first "{" encountered at top-parenthesis-level "()",
	#    we have a normal procedure then
	# - first ";" encountered at that level, then we just have
	#    a declaration with no code
	#
	if ($inside_header == 1) {
	    
	    @pline = split(//, $line);
	    for ($j=0; $j <= $#pline; $j++) {
		
		if      ($pline[$j] eq "(") {
		    $pc++;
		} elsif ($pline[$j] eq ")") {
		    $pc--;
		} elsif ($pline[$j] eq "{") {
		    $bc++;
		    $maxbc=$bc;
		    if ($pc == 0) {
			$inside_header=0;
		    }
		} elsif ($pline[$j] eq "}") {
		    $bc--;
		}
		
                # Semicolon after header ends procedure (i.e.
                # it was only a procedure declaration)
                #
    		  elsif ($pline[$j] eq ";"){
                     if (($pc == 0) && ($bc == 0)) {
			 
			$inside_header=0;
			$procendline[$thisprocnum] = $n;
			dprint 2,"      -> END   $procname[$thisprocnum]\n";
			if ($maxbc == 0) {
			    dprint 2,"         (was only a declaration)\n";
			}
			$inside_procedure = 0;
			if ($thisnostats == 1) {
			    dprint 2,"         (annoted NOSTATS)\n";
			    $nostats{$procname[$thisprocnum]} = 1;
			}
	    		$thisnostats = 0;	# Reset annotation recognition
		    }
                }
		if ($inside_header == 0) {
		    $j = $#pline;		# Abort analysis if end of hdr
		} else {
		    $thisvars = $thisvars.$pline[$j];
		}
	    }
	}

	# Procedure ends if we were inside a procedure and the current
	# brace level reaches zero
	#
        if (($inside_header == 0) &&
            ($inside_procedure == 1) &&
	    ($bracelevel == 0)) {
	    
            $procendline[$thisprocnum] = $n;    # Remember procedure's end
            dprint 2,"      -> END   $procname[$thisprocnum]\n";
            $inside_procedure = 0;
	    if ($thisnostats == 1) {
		dprint 2,"         (annoted NOSTATS)\n";
		$nostats{$procname[$thisprocnum]} = 1;
	    }

	    # Remove training ")" from procedure's variables
	    # and save them in %variables
	    #
	    $thisvars =~ s/[\s]*\)[\s]*$//g;	# No trailing ")"
	    $thisvars =~ s/^[\s]*\([\s]*//g;	# No leading "("
	    $thisvars =~ s/[\s]*\,[\s]*/\,/g;	# No whitespace around ","
	    
	    $variables{$procname[$thisprocnum]} = $thisvars;
	    dprint 2,"         VARs  $thisvars\n";
	    $thisvars = "";
	    $thisnostats = 0;
        }

      } else {# inside comment - output comment's text anyway
		  
        dprint 2,"$n [$oldbracelevel] $originalline\n";
	
      }
    }

    # OK, now we have found all procedures...
    #
    # Sort the resulting procedure information according to their
    # starting line number (necessary for find_calls later)
    # [Trick: Use lexical sorting but expand start line number with zeroes]
    #
    for ($j=0; $j<=$procnum; $j++) {
	
	$tmpprocs[$j] = sprintf("%010d", $procstartline[$j]).":".
	                $procstartpos[$j].":".
	                $procendline[$j].":".
			$procname[$j];
    }
    dprint 4, "Procedures = \n".join("\n",@tmpprocs)."\n";

    @tmpprocs = sort { $a cmp $b }  @tmpprocs;	      # Do the sort
    for ($j=0; $j<=$procnum; $j++) {
	
	($procstartline[$j], $procstartpos[$j],
	 $procendline[$j], $procname[$j] ) =
	    split(/:/, $tmpprocs[$j]);
	$procnameindex{$procname[$j]} = $j;
	$procstartline[$j] = int($procstartline[$j]); # Remove leading 0s again
	$procstartpos[$j] = int($procstartpos[$j]);
	$procendline[$j] = int($procendline[$j]);
    }
    dprint 3, "Sorted procedures by starting line number\n";
    dprint 4, "Procedures sorted = \n".join("\n",@tmpprocs)."\n";
	
    # Add all returns to the join lines (i.e. places where we
    # will have to join the threads generated in a procedure)
    # and sort them by line number
    #
    $joinlinenum = 0;
    for ($j=1; $j<=$returnnum; $j++) {
	$joinlinenum++;
	$joinlines[$joinlinenum] = $returns[$j];
    }
    if ($joinlinenum >= 1) {
        dprint 3, "Added returns to join lines\n";
        dprint 4, "Join lines = \n".join("\n",@joinlines)."\n";
        for ($j=1; $j<=$joinlinenum; $j++) {
    	    my $n;
    	    my $l;
    	    ($n, $l) = split(/,/, $joinlines[$j]);
	    $tmpjoins[$j] = sprintf("%010d,%d", $n, $l);
        }
        @tmpjoins = sort { $a cmp $b }  @tmpjoins;	# Do the sort
        for ($j=1; $j<=$joinlinenum; $j++) {
       	    my $n;
	    my $l;
	    ($n, $l) = split(/,/, $tmpjoins[$j]);
	    $joinlines[$j] = int($n).",".int($j);
        }
        dprint 3, "Sorted join lines by line number\n";
        dprint 4, "Join lines sorted = \n".join("\n",@tmpjoins)."\n";
    } else {
	dprint 3, "(No join lines at all)\n";
    }
			      
}

sub find_calls {

    my $n = 0;
    my $line = "";
    my $originalline = "";
    my @bopens = ("");
    my @bcloses = ("");			# Opening/closing braces in line
    my $oldbracelevel = $bracelevel;
    my $j = 0;
    my $thisprocnum = 0;
    my $thisprocname = $procname[$thisprocnum];
    my $thisprocstartline = $procstartline[$thisprocnum];
    my $thisprocstartpos = $procstartpos[$thisprocnum];
    my $nextprocstart = $procstartline[$thisprocnum+1];
    #
    # !!! THIS ASSUMES THAT WE HAVE AT LEAST 2 PROCS!

    my $cs = 0;				# Position of comment start in line
    my $ce = 0;				# ditto comment's end
    my $inside_comment = 0;		# True if inside comment/quotes

 
    # !!! OR - GIANT PATTERN THAT MATCHES ALL AND THEN /o[nce] ??
    # !!! MIGHT BE MORE EFFICIENT
    
    while ($n < $linenum) {
	
	$n++;
	$line = $source[$n];
	$originalline = $line;
	
	$line =~ s/\"[^\"]*\"//g;	# Remove quotes (ASSUMES that
					#  quotes don't span lines)
        $line =~ s {
                     /\*     (?# Match the opening delimiter.)
                     .*?     (?# Match a minimal number of characters.)
                     \*/     (?# Match the closing delimiter.)
                   } []gsx;		# Remove inline comments (see perlop :)

	$cs = index($line, "/*");	# Catch multi-line comments
	$ce = index($line, "*/");

        if ($ce >= 0) {	
	    $line =~ s/^.*\*\///g;	# Remove anything before end of comment
	    $inside_comment = 0;	# Now no longer inside comment
	}
        if ($cs >= 0) {	
	    $line =~ s/\/\*.*$//g;	# Remove anything past start of comment
	    $inside_comment = 1;	# Now inside multi-line comment
	}

        if ($inside_comment == 0) {	# Ignore anything inside comments

	# Keep track of procedure we're in at the moment
	#
	if ( ($n >= $nextprocstart) ) {
	    
	    $thisprocnum++;
	    $thisprocname = $procname[$thisprocnum];
	    $thisprocstartline = $procstartline[$thisprocnum];
	    $thisprocstartpos = $procstartpos[$thisprocnum];
	    
	    if ($thisprocnum < $procnum) {
		$nextprocstart = $procstartline[$thisprocnum+1];
	    } else {				# If this is the last proc,
		$nextprocstart = $linenum+1;	#  continue until end of source
	    }
	}

	# Remember old brace level and compute new one from
	# difference of opening and closing braces
	# ("x" used to ensure that "} abc" yields TWO blocks, not
	# just one because the brace is at the beginning of the line)
	#
        $oldbracelevel = $bracelevel;	# Remember Br.Level before this line
	@bopens  = split( /\{/ , "x".$line."x");
	@bcloses = split( /\}/ , "x".$line."x");
	$bracelevel = $bracelevel + $#bopens - $#bcloses;

	dprint 2,"$n [$oldbracelevel] $originalline\n";

	$line =~ s/\"[^\"]*\"//g;	# Get rid of quoted strings
	    

	# Look for procedure usages, i.e. known procedure names
	# within another procedure.
	# (Trick: ap/prepend space so the search pattern is easier,
	# no explicit handling of start-of-lines)
	#
	if (($oldbracelevel > 0) ||
	    (($#bopens == $#bcloses) && ($#bopens>0))
	   ) {
	    
	    for ($j=1; $j <= $procnum; $j++) {
		
		my $pn = $procname[$j];
	        my $myline = " ".$line." ";
		my $prepos = 0;
		my $pos = 0;

		# Check for one-liner procedure calls. Remove anything
		# before the procedure's body ("...{") for them, so their
		# own procedure name cannot be falsely taken for a call
		#
		if ($oldbracelevel==0) {
		    $myline =~ s/^.*{//;
		    $myline = " ".$myline; # Guarantee space again
		    $prepos = length($MATCH)-1;
		} else {
		    $prepos = 0;	   # Offset for procedure itself
		}
		    
		my $pattern = "[\\s\\*\\(\\&\\)\\!\\=\\}\\;]+([^\\s]+[\\s]+)*".
		              $pn."[\\s]*\\(";
		if ( $myline =~ /$pattern/ ) {

		    # Remember position of opening parenthesis
		    # of procedure call's parameters
		    #
		    $pos = $prepos + length($PREMATCH) + length($MATCH) - 2;
		    dprint 2,"       -> CALL of $pn by $thisprocname\n";
		    $directcalls[$thisprocnum] =
			               $directcalls[$thisprocnum].
				       $pn.":";
		    #
		    # Remember where this procedure call occured
		    # (list structure: "name1|line1,pos1:name2|line2,pos2:...")
		    #
		    $procwherecalled[$j] = $procwherecalled[$j].
			               $thisprocname."|".$n.",".$pos.":";
		}
	    }
	}
	    
      } else {# inside comment - output code 1:1
		  
        dprint 2,"$n [$oldbracelevel] $originalline\n";
	
      }
    }

}

# Sorts names in string alphabetically, delimited by ":",
# and removes duplicates
#
sub unique_sort_names {
    $_ = shift;
    s/[\:]+/\:/g;
    s/\:$//g;
    s/^\://g;				# Remove leading/trailing/2x ":"
    
    if ($_ eq "") {			# Handle empty input
	return "::";
    }
    
    my @names = split( /:/ , $_);	# Split into array and sort it
    @names = sort(@names);
    my $i=0;
    my $j=0;
    my $l=$#names;
    while ($i < $l) {			# Find duplicates and remove them
	
	if ($names[$i] eq $names[$i+1]) {	# THERE HAS TO BE A BETTER WAY
	    for ($j=$i; $j<$l; $j++) {
		$names[$j] = $names[$j+1];
	    }
	    $names[$l] = "";
	    $l--;
	    $i--;
	}
	$i++;
    }
    
    my $r = ":".join(":", @names).":";	# Supply leading/trailing ":" again
    $r =~ s/[\:]+/\:/g;			# Remove duplicate ":"s
    return($r);
}


sub find_recursives {
    my $changes = 1;
    my $oldallcalls = "";
    my $pattern = "";
    my @procs = ();
    my $i;
    my $j;

    # Sort procedure calls within each proc and remove duplicates
    # to eliminate ambiguity.
    # Initialize transitive hull of calls (allcalls)
    #
    for ($i=1; $i<=$procnum; $i++) {	# Start with 1 ignores toplevel (0)
	$directcalls[$i]=unique_sort_names($directcalls[$i]);
	$allcalls[$i]=$directcalls[$i];
    }

    # Examine each procedure: For each procedure that is called inside it,
    # add the procedures called from THAT procedure etc etc until the
    # transitive hull of calls doesn't change any more
    #
    for ($i=1; $i<=$procnum; $i++) {
	dprint 2,"Examining $procname[$i]...\n";
	
	if ($allcalls[$i] eq "::") {
	    
	    dprint 3,"  No calls at all, skipping this one...\n";
	    
	} else {
	    
	  dprint 2,"  Inital list of calls: $directcalls[$i]\n";
	  $changes = 1;
	  while ($changes) {
	    $changes=0;

	    # For this procedure: check if this procedure's call list
	    # contains any other procedure. If yes, add those procedure's
	    # call list to the one's examined (transitive hull)
	    # until no more changes occur.
	    #
	    for ($j=1; $j<=$procnum; $j++) {
		
		$pattern = ":".$procname[$j].":";
		if ( $allcalls[$i] =~ /$pattern/) {
		    
		    $oldallcalls = $allcalls[$i];
		    $allcalls[$i] = unique_sort_names(
				$allcalls[$i].":".$allcalls[$j]);
		    
		    if ($oldallcalls ne $allcalls[$i]) {
			$changes=1;
		    }
		}
	    }
	  }
        }
	dprint 2,"  Final list of calls:  $allcalls[$i]\n";
    }
    dprint 2,"\n";

    # Now, each procedure that appears in its own all-calls list
    # is recursive, either directly or indirectly
    #
    $recursivenum=0;
    for ($i=1; $i<=$procnum; $i++) {
	$recursivecalls[$i] = "";		# Direct calls to other recurs.
	
	$pattern = ":".$procname[$i].":";
	if ( $allcalls[$i] =~ /$pattern/) {
	    $recursivenum++;
	    $recursives[$recursivenum]=$i;	# Remember index of rec. procs
	    $allrecursives = $allrecursives.$procname[$i].":";
	}
    }

    dprint 4,"allrecursives = $allrecursives\n";
    
    # Build list of direct calls to other recursive procedures
    # called from this one
    #
    for ($i=1; $i<=$recursivenum; $i++) {
	my $pn_i = $recursives[$i];		# Regular procedure index for i
	my $pns_i = $procname[$pn_i];
	my $j;

	for ($j=1; $j<=$recursivenum; $j++) {	# Check vs. all other recurs.
	    my $pn_j = $recursives[$j];
	    my $pns_j = $procname[$pn_j];
	    my $pattern = ":".$pns_j.":";
	    
	    if ($directcalls[$pn_i] =~ /$pattern/) {
	        $recursivecalls[$pn_i] = $recursivecalls[$pn_i].":".
		 			 $pns_j;
		if (($recordtree) &&
		    ($nostats{$pns_j} == 0) &&
		    ($nostats{$pns_i} == 1)) {
		    die "ERROR - Procedure '$pns_j' called by '$pns_i'
        which is annotated NOSTATS.
        A NOSTATS procedure cannot call a procedure using stats
        when tree recording is activated!\n"
		}
	    }

	}
        $recursivecalls[$pn_i] = $recursivecalls[$pn_i].":";	# Add delimiter
	dprint 3,"Recursive calls in $procname[$pn_i] = ".
	         "$recursivecalls[$pn_i]\n";
    }

    # (completely eliminated former mutual-only-recursion handling here)

}


# For a given procedure's name, returns the line and the position-in-line
# of the real start of the procedure (i.e. the "{") (0=1st)
#
# !!! recycled from find_procedures - SHARE CODE WITH THAT SUB?
#
sub skip_proc_head {
    my $thisname         = shift;	# Procedure's name
    my $n                = 0;		# Start line of procedure
    my $l                = 0;		# Position within line
    my $maxbc;				# Max. braces level encountered
    my $c;

    $n = $procstartline[$procnameindex{$thisname}];
    $l = $procstartpos[$procnameindex{$thisname}];

    # Skip forward to end of header (i.e. next "{" or ";")
    #
    ($n, $l, $c, $maxbc) = skip_to_delimiter($n, $l, 1);

    # If header ended at ";" and no braces pairs were found in between,
    # we just have a declaration. Too bad.
    #
    if (($c eq ";") && ($maxbc == 0) ) {
	print "skip_proc_head: ERROR, $thisname has only a declaration!\n";
	$l=0;
	$n=0;
    }
    return($n,$l);
}


# Skip from the current position (line, position) in the direction given
# (+/-1) until end of statement is encountered, i.e.
#	 "{", ";", "}"
# Takes strings and comments into account.
#
# Returns line, position and delimiting character encountered
# (when skipping backward, the position returned is the position of
# the last non-blank character before the delimiting character - this
# is to avoid situations like
#	main () {
#	   foo(x);}
# where skipping would reach the opening brace of main, thus placing
# all code added there BEFORE any variable declarations added to main!)
#
# ?!? WHAT HAPPENS TO "a = f(b)" or "a = (int) f(b)" ?!? -> "(" and ")" ?
# ?!? WHAT ABOUT "if (a) f(b); else f(c)" ?!?		 -> "else" ?
#
# "{", ";" and "}" are sure candidates, however...
#
sub skip_to_delimiter {
    my $n   = shift;			# Line number
    my $l   = shift;			# Position within line
    my $dir = shift;			# Search direction (1 or -1)

    my $j;
    my $pc;				# Parenthesis open/close count
    my $bc;				# Ditto braces
    my $maxbc;				# Max. braces level encountered
    my @pline;
    my $found_delim = 0;		# True if delimiter found
    my $inside_comment = 0;		# guess :)
    my $inside_string = 0;
    my $last_n = $n;			# For skipping backwards over blanks
    my $last_l = $l;

    if (($dir != -1) && ($dir != 1)) {
	print "ERROR: direction in skip_to_delimiter must be +/-1\n";
	return (0,0,"x",0);
    }
    
    dprint 3,"SKIP_TO_DELIMITER: line $n, pos $l length ".length($source[$n]).
	     " : $source[$n]\n";
    $pc = 0;
    $maxbc = 0;
    $bc = 0;
    $line = $source[$n];
    
    while ($found_delim == 0) {

        $j = $l;
	@pline = split(//, $line);
	while ( ($found_delim == 0) &&
                ( ( ($dir>0) && ($j <= $#pline) ) ||	# Until begin/end
	          ( ($dir<0) && ($j >= 0      ) )	#  of line, as long
		)					#  as delimiter not
	      )   {					#  found

	    dprint 4,"line[$j] = $pline[$j]\n";

	    # Ignore contents of strings and comments
	    #
            if ( ($inside_string == 0) &&
		 ($inside_comment == 0) ) {
	        if      ($pline[$j] eq "(") {
		    $pc++;
		} elsif ($pline[$j] eq ")") {
		    $pc--;
		} elsif ($pline[$j] eq "{") {	# Opening/closing brace and ";"
		    $bc++;			#  surely mean statement's end
		    $maxbc=$bc;
# NOT GOOD FOR a=(f(x)+f(y))!		    if ($pc == 0) {
			$found_delim=1;
#		    }
		} elsif ($pline[$j] eq "}") {
		    $bc--;
# ditto		    if ($pc == 0) {
			$found_delim=1;
#		    }
		} elsif ($pline[$j] eq ";"){
# ditto		    if (($pc == 0) && ($bc == 0)) {
		    if ($bc == 0) {
			$found_delim=1;
		    }
		} elsif ($pline[$j] eq "/"){	# Start of comment? I.e.
		    				#  "/" + "*" in current dir.
		    if ( (($dir>0) && ($j<$#pline) && ($pline[$j+1] eq "*")) ||
			 (($dir<0) && ($j>0      ) && ($pline[$j-1] eq "*")) )
		    {
			$inside_comment = 1;	# Yepp, and skip the "*", too
			$j = $j + $dir;
		    }
		} elsif ($pline[$j] eq "\""){	# Start of string?
		    if ( (($dir>0) && ($j<$#pline) && ($pline[$j+1] eq "'")) ||
			 (($dir<0) && ($j>0      ) && ($pline[$j-1] eq "'")) )
 		    {
		        $inside_string = 0;	# Don't see '"' as string
		    } else {
		        $inside_string = 1;	# Anything else starts string
		    }
		}
		# When searching backwards, ignore whitespace before
		# delimiter, i.e. remember last non-whitespace position
		# (later return delimiter $c nevertheless, but use $last_n/l)
		#
		if ( ($inside_comment == 0) && ($inside_string == 0) &&
		     ($dir < 0) && ($found_delim == 0) &&
		     ($pline[$j] =~ /\S/) ) {
		    $last_n = $n;
		    $last_l = $j;
		}
	    }
	    # Handle inside of string (
	    #
	    elsif ($inside_string == 1) {
		if ($pline[$j] eq "\""){	# End of string?
		    if ( ($j > 0) && ($pline[$j-1] eq "\\") ) {
		        $inside_string = 1;	# \" -> still inside string
		    } else {
		        $inside_string = 0;	# Else (no \") we're outside
		    }
		}
	    }
	    # Handle inside of comment
	    #
	    elsif ($inside_comment == 1) {
		if ($pline[$j] eq "*"){		# End of comment ?
		    if ( (($dir>0) && ($j<$#pline) && ($pline[$j+1] eq "/")) ||
			 (($dir<0) && ($j>0      ) && ($pline[$j-1] eq "/")) )
		    {
			$inside_comment = 0;	# Yepp, and skip the "/", too
			$j = $j + $dir;
		    }
		}
	    }
            if ($found_delim == 1) {
		$l = $j;		# Remember where statement ended
	    }
	    $j = $j + $dir;		# Continue in that direction
	}
	if ($found_delim == 0) {	# Still inside stmt, examine next line
	    
	    if ( ($n <= 1) || ($n >= $linenum) ) {
		print "WARNING: skip_to_delimiter - ";
		if ($dir > 0) {
		    print "END";	# Start/end of program? Warn and
		} else {		#  return last character there
		    print "START";
		}
		print " of program reached!\n";
		return ($n, $j-$dir, $pline[$j-$dir], $maxbc);
	    }
  	    $n = $n + $dir;
	    $line = $source[$n];	# Check next line, and set position
	    if ($dir > 0) {		#  to start resp. end (depending on
		$l=0;			#  search direction
	    } else {
		$l=length($source[$n])-1;
	    }
	}

    }

    if ($dir < 0) {
        return ($last_n, $last_l, $pline[$l], $maxbc);
    } else {
        return ($n, $l, $pline[$l], $maxbc);
    }

}


# For a given procedure's name and starting line, returns the line
# and the position-in-line of the opening parenthesis of the procedure's
# parameters (0=1st)
#
#
sub proc_param_start{
    my $thisname         = shift;	# Procedure's name
    my $n                = shift;	# Start line of procedure
    my $l                = 0;		# Position within line
    my $line;
    my $prefix;
    my @pline;

    # Remove all before and including the procedure name from the 1st line
    # (position of first parenthesis after procedure's name
    # taken from $procstartpos, computed when procedure was first found)
    #
    $prefix = $procstartpos[$procnameindex{$thisname}];

    return ($n, $prefix);

    # ??? DO WE NEED THE REMAINING CODE ???

    $line = $source[$n];

    # (We CAN BE sure that nothing changed in the source, since
    # all is handled by change requests that are applied at the end of
    # the instrumentation, so we have no moving targets here :)

    # Examine rest of line for first opening parenthesis
    #
    @pline = split(//, $line);
    for ($j=$prefix; $j <= $#pline; $j++) {
	if ($pline[$j] eq "(") {
	    if ($l == 0) {
		$l = $j+length($prefix);
	    }
	}
    }
    if ($l == 0) {
	print "proc_param_start: ERROR, $thisname has only a declaration!\n";
	$n = 0;
	$l = 0;
    }
    return($n,$l);
}


# Starts at the given position (line, index in line starting with 0)
# and returns the position where that statement ends, possibly several
# lines afterwards, as well as the character that ended the search and
# the maximum brace count encountered:
#	(line, position, char, max_bc)
# Returns (0,0,"x",0) if error occured.
# Looks for matching parenthesis etc. Statement ends if parenthesis
# level = 0 and either ";", "{" or "}" are encountered.
#
sub skip_to_end_of_statement {
    my $n = shift;			# Line number to start from
    my $l = shift;			# Position to start from

    dprint 3,"SKIP_TO_END_OF_STATEMENT: line $n, pos $l, length ".
	     length($source[$n])." -> $source[$n]\n";

    return skip_to_delimiter($n, $l, 1);
    
}


# Starts at the given position (line, index in line starting with 0)
# and returns the position where that statement began, possibly several
# lines afterwards, as well as the character that ended the search and
# the maximum brace count encountered:
#	(line, position, char, max_bc)
# Returns (0,0,"x",0) if error occured.
# Looks for matching parenthesis etc. Statement begins if parenthesis
# level = 0 and either ";", "{" or "}" are encountered.
#
sub skip_to_start_of_statement {
    my $n = shift;			# Line number to start from
    my $l = shift;			# Position to start from

    return skip_to_delimiter($n, $l, -1);
    
}


# Add a change request to the list, i.e. a string to be inserted
# before a given line number and position
# (at end of line, 1 character behind EOL is OK, will be recognized
# by insertion later)
# Also add the current change priority (global variable)
#
sub add_change {
    my $n      = shift;		# Line number
    my $l      = shift;		# Position in line
    my $text   = shift;		# Text to be inserted there
    my $spaces = "\n";		# For indentation
    
    dprint 3,"  ADD_CHANGE: line $n, pos $l, prio $changeprio: $text\n";

    # Retain program's indentation - simple heuristic, just add the
    # same whitespace sequence after newline as the line before had
    #
    if ($n > 1) {
	if ($source[$n] =~ /^[\s]+/) {
	    $spaces = "\n".$MATCH;
	}
    }
    $text =~ s/\n([^\#]|$)/$spaces$+/g;	# Do not indent #defines etc

    $requestnum++;
    $requests[$requestnum] = sprintf("%06d",$n).":".
	                     sprintf("%06d",$l).":".
	                     sprintf("%06d",$changeprio).":".
	                     $text;
}


# Applies the globally collected change requests to the source code.
# Sorts them by descending line/position so that changes applied earlier
# do not interfere with later changes (work from last line of program
# to first). Also ensures that high priority changes occur first;
#
sub perform_changes {
    my $j;
    my $n;
    my $l;
    my $prio;
    my @pline;
    
    dprint 2,"\nPerforming change requests\n";
    
    @requests = sort { $a cmp $b } @requests;

    dprint 4,"\n".join("\n", @requests)."\n\n";
    
    for ($j=$#requests; $j>=1; $j--) {
	my @text;
	my $change;

	($n,$l,$prio,@text) = split(":", $requests[$j]);
	$n = int($n);
	$l = int($l);

	$change = join(":", @text);
	
        dprint 4,"SOURCE ($source[$n]) $source[$n]\n";
        dprint 4,"CHANGE ($n,$l) -> $change\n";

	@pline = split(//, $source[$n]);

	if ($l > $#pline) {
	    $source[$n] = $source[$n].$change;
	} else {
	    $pline[$l] = $change.$pline[$l];
	    $source[$n] = join("", @pline);
	}
	dprint 4,"  ->   $source[$n]\n";
	
    }

    $requestnum = 0;		# Reset requests again
    undef(@requests);
    @requests = ("");
    
}

sub instrument_program {
    my $n;			# Line number
    my $l;			# Position in line
    my $j;
    my @pline;
    my $line;
    my @ncalls;
    my $nc;
    my $c;
    my $maxbc;
    my $icode;			# Code additions for instrumentation

    my $tree_declare_tmpl = "
/* Global tree statistic variables for #FNAME# */

ts_treestat_entry *ts_treestats_#FNAME#;/* Array for tree statistics         */
int ts_treeindex_#FNAME# = 0;           /* First unused entry in array       */
int ts_treeindexsize_#FNAME# = TS_TREESTATSIZE;

int *ts_iterstarts_#FNAME#;             /* Array of start index of iterations*/
int ts_itercount_#FNAME# = 0;           /* Iteration counter                 */
int ts_itersize_#FNAME#;                /* Size of last iteration            */

#define TS_PROCNUM_#FNAME# #FNUM#       /* Procedure number for treestats    */

";

    
    # Add include directive right at start of program,
    # 
    #
    if ($noprofile == 0) {
        add_change(1, 0, "#include \"profile.h\"\n\n".
		         "#include <sys/resource.h>\n".
		         "#include <unistd.h>\n".
		         "#include <sys/time.h>\n".
			 "struct rusage profile_rusage;		/* Resources measurements */\n".
		         "struct timeval profile_starttime;	/* Wallclock timer        */\n".
			 "struct timeval profile_endtime;\n\n");
    }

    # Add recursion tree recording definitions etc
    # as well as timing initializations (if timing activated)
    # and tree data structures for each recursive function
    #
    if ($recordtree) {
	my $treeinit = "";

	if ($timetree) {
	    $treeinit = "#include <time.h>   /* Necessary for clock() */\n\n".
	    "/* Division factor to make sure cputime is in milliseconds */\n".
	    "#ifdef __linux__\n".
	    "/* Linux has 100HZ clock */\n".
	    "#define TS_CLOCKDIVIDE 1*10\n".
	    "#else\n".
	    "/* Default: Solaris with microsecond clock rate (!) */\n".
	    "#define TS_CLOCKDIVIDE 1000\n".
	    "#endif\n\n";
	}
	$treeinit = $treeinit."
/* Initial size of tree statistics - must be large enough for one iteration */
#define TS_TREESTATSIZE ".$rchunk."

/* Maximum number of iterations for recursive procedure */
#define TS_MAXTREEITER 1024

typedef struct {
  int  index[$initdegree];          /* Index of children in array or 0      */
  int  procnum;			    /* Number code for the node's procedure */";
	if ($timetree) {
	    $treeinit = $treeinit."
  long cputime;                     /* Used CPU time for this subtree in ms */";
	}
	$treeinit = $treeinit."
} ts_treestat_entry;

";
	# Individualize initializations for each recursive procedure
	#
	for ($j=1; $j<=$recursivenum; $j++) {
	    my $t   = $tree_declare_tmpl;
            my $pns = $procname[$recursives[$j]];

	    if ($nostats{$pns} == 0) {		# (not if NOSTATS!)
		$t =~ s/\#FNAME\#/$pns/g;
		$t =~ s/\#FNUM\#/$j/g;
		$treeinit = $treeinit.$t;
	    }
	}
	
        add_change(1, 0, $treeinit);
    }
    
    # Find main's header and skip it
    #
    ($n,$l) = skip_proc_head("main");
    if (($n == 0) && ($l == 0)) {
	die "ERROR in instrument_program: Could not find main's header!\n";
    }

    # Add profile initialization code and
    # initialization for all recursive procedures
    # (HACK - add dummy declaration of int dummy_profile_init
    # which calls the profile initialization itself :)
    #
    if ($noprofile == 0) {
      add_change($n, $l+1,"\n  int dummy_profile_init = do_profile_init();\n");
    }

    # Ditto for tree stats and timing (if activated)
    #
    if ($recordtree) {
      add_change($n, $l+1,"\n  int dummy_ts_init = do_treestats_init();\n");
      if ($timetree) {
	  add_change($n, $l+1,
		     "\n  clock_t ts_myclock = clock(); /* Start timer */\n");
      }
    }
 
    # Add profile initialization procedure just before main
    # (not in same line as main, else we get conflicts later
    # when inserting thread code just after main's header...)
    #
    # Collect both profile and treestats related initializations in $icode
    #
    if ($noprofile == 0) {

	# Define atexit handler and timings
	#
        $icode = "
void ProfileGetTime() {		/* Measure runtime, if not already done */
  if ((profile_endtime.tv_sec == 0) && (profile_endtime.tv_usec == 0)) {
      gettimeofday(&profile_endtime, NULL);
      getrusage(RUSAGE_SELF, &profile_rusage);
  }
}

void ProfilePrintDefault() {

  ProfileGetTime();		/* Might have been called before, checks it! */

  printf(\"BEGIN REAPAR RSCINFO\\n\");
  printf(\"Wallclock time = %.2f seconds\\n\",
         (profile_endtime.tv_sec - profile_starttime.tv_sec) +
         (profile_endtime.tv_usec - profile_starttime.tv_usec)/1000000.0);
  printf(\"User time      = %.2f seconds\\n\",
 	 profile_rusage.ru_utime.tv_sec +
         profile_rusage.ru_utime.tv_usec/1000000.0);
  printf(\"System time    = %.2f seconds\\n\",
 	 profile_rusage.ru_stime.tv_sec +
         profile_rusage.ru_stime.tv_usec/1000000.0);
  /* Solaris: \"Only the timeval fields of struct rusage  are  supported  in
     this implementation.\" ...
  printf(\"Max RSS = %d bytes\\n\", profile_rusage.ru_maxrss * getpagesize());
  printf(\"Int RSS = %d bytes\\n\", profile_rusage.ru_idrss * getpagesize());
  */
  printf(\"END REAPAR RSCINFO\\n\");
  printf(\"BEGIN REAPAR PROCINFO\\n\");";

        for ($j=1; $j<=$recursivenum; $j++) {	# Add procedure information
						#  for each recursive proc.
	    my $pn  = $recursives[$j];
	    my $pns = $procname[$pn];
	    
	    $icode = $icode.
		    "  printf(\"Procedure (%2d) %-20s at line %4d\",\n".
		    "         ".$j.", \"".$pns."\", ".
		 	      $procstartline[$pn].");\n".
		    "  printf(\" calls ".$recursivecalls[$pn]."\\n\");\n"
        }
	$icode = $icode.
	         "  printf(\"END REAPAR PROCINFO\\n\");\n".
	         "  printf(\"BEGIN REAPAR PROFILES\\n\");\n".
	         "  ProfilePrint(profile_stat);\n".
	         "  printf(\"END REAPAR PROFILES\\n\");\n".
	         "}\n\n";

        $icode = $icode."int do_profile_init(){\n\n".
	         "  gettimeofday(&profile_starttime, NULL);\n".
	         "  profile_endtime.tv_sec = 0;\n".
	         "  profile_endtime.tv_usec = 0;\n\n".
	         "  profile_stat = ProfileNewStats(".
	         "$linenum, ".
	         "$initdepth, ".		# Max. recursion depth
	         "$initdegree".			# Max. branching degree
	         ");\n\n";

        for ($j=1; $j<=$recursivenum; $j++) {	# Add profile initialization
						#  for each recursive proc.
	    my $pn  = $recursives[$j];
	    my $pns = $procname[$pn];
	    
	    if ($nostats{$pns} == 0) {		# (not if NOSTATS!)
		$icode = $icode.
		    "  ProfileInitLine(profile_stat,".
		    $procstartline[$pn].",".
		    "\"".$pns."\");\n";
	    }
        }
        # Printing the profile at exit saves us an insertion of
        # ProfilePrint at the end of main(), since even if exit isn't
        # called directly, it's called implicitly at the program's end
        # anyway, and thus ProfilePrint is called by atexit

        $icode = $icode."\n  atexit(ProfilePrintDefault);\n".
	                "  return 0;\n}\n\n";	# Print profile at exit

	dprint 3,"ADD_PROFILE_INIT: Profile init added\n";

    } else {
	$icode = "";
    }

    # Add treestats initialization procedures as well
    # (instantiate an output loop and initializations for each
    # recursive procedure)
    #
    if ($recordtree) {
	my $j;
	my $loopcode_tmpl = "
    for (i=0; i<ts_itercount_#FNAME#; i++) {
        printf(\"\\nRecursion Tree for '#FNAME#', Number #FNUM#, iteration %d:\\n\\n\", i);
        ts_treestat_print_list(ts_treestats_#FNAME#,
			       ts_iterstarts_#FNAME#[i],1);
    }
";
	my $initcode_tmpl = "	
    ts_treestats_#FNAME# = (ts_treestat_entry*) malloc(sizeof(ts_treestat_entry) *
                                               TS_TREESTATSIZE);
    bzero( (void *) ts_treestats_#FNAME#, sizeof(ts_treestat_entry) * TS_TREESTATSIZE);
    ts_treeindexsize_#FNAME# = TS_TREESTATSIZE;
    ts_treeindex_#FNAME# = 0;

    ts_iterstarts_#FNAME# = (int*) malloc(sizeof(int) * $initdegree);
    bzero( (void *) ts_iterstarts_#FNAME#, sizeof(int) * $initdegree);
    ts_itercount_#FNAME# = 0;
";
        $icode = $icode."

/* Output given recursion tree as list structure,
 * e.g. (()()) is a binary tree depth 2
 */
void ts_treestat_print_list(ts_treestat_entry *ts_treestats,
                            int index, char first)
 {
    int i;";
	if ($timetree) {
	    $icode = $icode."
    printf(\"(%d:%d\",ts_treestats[index].procnum, ts_treestats[index].cputime);";
	} else {
	    $icode = $icode."
    printf(\"(%d\",ts_treestats[index].procnum);";
	};
	$icode = $icode."
    for (i=0; i<$initdegree; i++)
        if (ts_treestats[index].index[i])
            ts_treestat_print_list(ts_treestats,
                                   ts_treestats[index].index[i],0);
    printf(\")\");
    if (first)
        printf(\"\\n\");           /* newline after 1st entry's end */
}

/* Print tree statistics for all iterations and all recursive procedures
 */
void ts_treestat_print_all() {
    int i;

    ProfileGetTime();		/* Might have been called before, checks it! */

    printf(\"BEGIN REAPAR TREES\\n\");
";

        for ($j=1; $j<=$recursivenum; $j++) {
	    my $t = "    printf(\"Procedure number #FNUM# = #FNAME#\\n\");\n";
	    my $pns = $procname[$recursives[$j]];
		
	    if ($nostats{$pns} == 0) {
		$t =~ s/\#FNAME\#/$pns/g;
		$t =~ s/\#FNUM\#/$j/g;
		$icode = $icode.$t;
	    }
        }
        for ($j=1; $j<=$recursivenum; $j++) {
	    my $t   = $loopcode_tmpl;	# Instantiate output loop template
	    my $pns = $procname[$recursives[$j]];
	    if ($nostats{$pns} == 0) {
		$t =~ s/\#FNAME\#/$pns/g;
		$t =~ s/\#FNUM\#/$j/g;
		$icode = $icode.$t;
	    }
        }

	$icode = $icode."
    printf(\"END REAPAR TREES\\n\");
}

/* Init tree statistics
 * (has to hold at least one iteration, is increased automagically
 * after iterations if not enough space is left for next one
 */
int do_treestats_init() {
";
	
        for ($j=1; $j<=$recursivenum; $j++) {
	    my $t   = $initcode_tmpl;	# Instantiate initialization template
	    my $pns = $procname[$recursives[$j]];
	    
	    if ($nostats{$pns} == 0) {
		$t =~ s/\#FNAME\#/$pns/g;
		$icode = $icode.$t;
	    }
        }

	$icode = $icode."

    atexit(ts_treestat_print_all);
    return 0;

}
";
       dprint 3,"ADD_PROFILE_INIT: Treestat init added\n";
    }

    # Add all that just at the end of the last line before main
    #
    if ($recordtree || ($noprofile == 0)) {
        $n = $procstartline[$procnameindex{"main"}]-1;
        add_change($n, length($source[$n])+1, $icode);
        dprint 3,"ADD_PROFILE_INIT: $source[$n]\n";
    }


    # Instrument each recursive procedure: Add profile depth
    # parameter to header and header of declarations (if any),
    # add branch counter, add profile information addition
    # before each return and the procedure's end
    #
    # Also add recursion tree recording.
    #
    # If NOSTATS annotation is present, just add depth parameter
    # and let the rest be
    #
    for ($j=1; $j<=$recursivenum; $j++) {

	my $k;
	my $depthname = "";
	my $addstats  = "";
	my $varcode;
	my $pns;

	$pn  = $recursives[$j];
	$pns = $procname[$pn];
        dprint 2,"\nEXAMINING $pns...\n\n";

        ($n,$l) = proc_param_start($pns,		# Find proc's params
				   $procstartline[$pn]);
	
        if (($n == 0) && ($l == 0)) {
	    print "instrument_program: Could not find ".
		  $pns."'s parameters!\n";
  	    return;
        }

	# Prepend profile depth parameter to parameter list
	# and remember it in the variable list, too
	#
	# Also prepend tree recording parameter as second parameter
	# if tree recording active and no NOSTATS annotation present
	#
        $depthname = "profile_depth_".$pns;
	$varcode = "int ".$depthname.",";
	if (($recordtree) && ($nostats{$pns} == 0)) {
	    $varcode = $varcode."int tsindex,".
		       "ts_treestat_entry *ts_treestats,".
		       "int *ts_treeindex,";
	}
        add_change($n, $l+1, $varcode);
        dprint 3,"ADD_DEPTH_PARAM: $source[$n]\n";

	$variables{$pns} = $varcode.$variables{$pns};

	    
	# Also handle previous declarations, if there were any,
	# and prepend depth parameter there, too
	#
	if ($procdecls{$pns} ne "") {
	    
	    my $p_i;
	    my $p_dd = substr($procdecls{$pns}, # (ignore last ":")
			      0,length($procdecls{$pns})-1);
	    my @p_ds = split(/:/, $p_dd);	# All decl's (from,pos-to:..)
	    my $p_n;
	    my $p_l;
	    my $dummy;
	    
	    for ($p_i=0; $p_i<=$#p_ds; $p_i++) {
		
		($p_n,$p_l,$dummy) = split(/[\|\-\,]/,
				 $p_ds[$p_i]);	# Get line & pos of declaration

		# (Declarations are OK since nothing changes in the code
		# until all changes are applied at once after analysis!)
		
		if (($p_n == 0) && ($p_l == 0)) {
		    print "instrument_program: Could not find ".
			  $pns."'s declaration's parameters (line ".
			  $p_n.",".$p_l.") !\n";
		    return;
		}
		# Add declaration
		#
		add_change($p_n, $p_l+1, $varcode);	
		dprint 3,"ADD_DEPTH_DECLAR_PARAM: $source[$p_n]\n";
		
	    }
        }

	# Add branch count to variable declarations
	# (only if no NOSTATS annotation in effect)
	#
	($n,$l) = skip_proc_head($procname[$pn]);
	if (($n == 0) && ($l == 0)) {
	    
	    print "instrument_program: Could not find".
		  $procname[$pn]."'s header!\n";
	    return;
	}

	if ($nostats{$pns} == 0) {
	    $varcode = "\nint branch_count = 0;\n";
	    if ($recordtree) {
		$varcode = $varcode."int ts_leafindex;\n";
		if ($timetree) {
		    $varcode = $varcode.
		    "clock_t ts_clock = clock(); /* CPU Time computation */\n";
		}
	    }
	    add_change($n, $l+1, $varcode);
	    dprint 3,"ADD_BRANCH_COUNT: $source[$n]\n";
	}

	if ($noprofile == 0) {

	  if ($nostats{$pns} == 0) {	# No branch count etc if NOSTATS annot.
	      
    	    # Add Statistics update at end of procedure
            # (after a statement that might still be there)
	    #
	    $addstats = "\n    ProfileAddStat(profile_stat, ".
	                $procstartline[$pn].", ".
		        $depthname.", ".
		        "branch_count, ".
		        "1);\n";
	    #
	    # Add procedure number for this treestat node.
	    # Also add subtree timing code before return.
	    # !!! THIS ONLY WORKS IF THE RETURN ITSELF DOES NOT COMPUTE
	    # !!! TOO MUCH, OTHERWISE TIMINGS ARE DISTORTED
	    #
	    if ($recordtree) {
		$addstats = $addstats.
	        "    /* Remember which procedure executed this node      */\n".
	        "    ts_treestats[tsindex].procnum = TS_PROCNUM_".
		$procname[$pn].";\n";
		if ($timetree) {
		    $addstats = $addstats.
		    "    /* Remember time spent in this procedure (subtree)  */\n".
	            "    ts_treestats[tsindex].cputime = ".
                    "(clock() - ts_clock)/TS_CLOCKDIVIDE;\n";
		}
	    }
	    $n = $procendline[$pn];
            ($n, $l, $c, $maxbc) = skip_to_end_of_statement($n,0);
	
	    add_change($n,0,$addstats);
	    dprint 3,"ADD_STATS: $source[$n]\n";

	    # Also add statistics before each "return", encapsulating
	    # the call and return with "{}"
	    #
	    for ($k=1; $k<=$returnnum; $k++) {	# Check all ret's found earlier

	        ($n,$l) = split(/,/, $returns[$k]);	# Get line & position

	        # If this return is within the line range of our procedure,
	        # apply our encapsulation
	        #
	        if (($n >= $procstartline[$pn]) &&
		    ($n <= $procendline[$pn])) {

		    my $c;
		    my $maxbc;

		    add_change($n, $l, "{".$addstats);
		    dprint 3,"REPLACE_BEFORE_RETURN: $source[$n]\n";

		    # Find end of return statement
		    #
 		    $l = $l + length("return");
		    ($n, $l, $c, $maxbc) = skip_to_end_of_statement($n, $l);
		    # !!! ERROR HANDLING
		
		    if ($c eq ";") {		# Avoid "...}; else ..."
		        add_change($n, $l+1, ";}");
		    } else {
		        add_change($n, $l, ";}");
	  	    }
		    dprint 3,"REPLACE_AFTER_RETURN: $source[$n]\n";
		}
	    }
	  } # if nostats
	}


        # Handle procedure's calls:
	# If inside the procedure itself, append a "branch_count++"
	# and add the depth counter.
	# If outside the procedure, just add the depth counter "0"

	@ncalls = split(":", $procwherecalled[$pn]);
	    
        for ($nc=0; $nc<=$#ncalls; $nc++) {
	    
	    my $pattern;
	    my $prefix;
	    my $offset;
	    my $c;
	    my $maxbc;
	    my $pos;
	    my $num;
	    my $linecalled = $ncalls[$nc];
	    my $othername = "";		# Procedure in which this 1 was called
	    my $alsorecursive=0;	# True if other procedure is also rec.
	    				#  with this one (maybe indirectly)

	    # Directly read where-procedure-was-called information
	    # (start line and position of proc's parameters in
	    # that line) from call information
	    #
	    ($othername, $n, $l) = split(/[\,\|]/, $linecalled);
	    $line = $source[$n];

	    dprint 3,"FIND_RECURSION: $source[$n]\n".
                    "               -> call in $othername, line $n, pos $l\n";
	    $pos = $l;
	    $num = $n;			     # Remember position of call
	    @pline = split(//,$source[$n]);  # ALL source here, not w/o prefix

	    # !!! THE FOLLOWING SHOULD BE NO LONGER NECESSARY ???
	    # SINCE WE ALREADY HAVE THE CALL INFO & POS
	    #
	    while (($l <= $#pline) && ($pline[$l] ne "(")) {
		$l++;
	    }				      # Look for starting parenthesis
	    
            if ( ($n < $procstartline[$pn]) ||
		 ($n > $procendline[$pn]) ) {

		# Call from outside our procedure. Check in which procedure
		# the call occured - if this one is also a recursive procedure,
		# just pass its own depth + 1 to us.
		# If it is not recursive, this is an external call,
		# so add "0" as starting depth parameter
		#
	        my $other = $procnameindex{$othername};
		my $pattern = ":".$othername.":";

		if ($allrecursives =~ /$pattern/) {	# Is other recursive?
		    my $ocode;

		    # Other is recursive, too (maybe indirectly).
		    # Add its own depth variable to the call invoking us.
		    #
                    my $otherdepthname = "profile_depth_".
			                 $procname[$other];

		    $ocode = $otherdepthname."+1, ";

		    if (($recordtree) &&	# Only if both have stats
			($nostats{$pns} == 0) &&
			($nostats{$othername} == 0)) {
			$ocode = $ocode."ts_leafindex, ts_treestats,".
			                "ts_treeindex, ";
		    }
		    add_change($n, $l+1, $ocode);
		    $alsorecursive = 1;
		    
		    dprint 3,"REPLACE_DEPTHNAME_OTHER: $source[$n]\n";
		    
    	        } else {

		    # Other is not recursive.
		    # This must be an external call starting the recursion
		    # we're part of.
		    # Initialize depth with 0 and treeindex
		    #
		    # EXCEPTION: this function's name = ThreadWrapper_FNAME,
		    # then it was introduced by parallelization and already
		    # contains the correct depth. Don't touch that!
		    #
		    if ($othername eq "ThreadWrapper_$procname[$pn]") {
		        dprint 3,"REPLACE_DEPTHNAME_EXTERN: Didn't touch ".
			    "line since it was inside $othername ".
		   	    "(parallel!)\n";
		    } else {
			my $code = "0, ";
			if (($recordtree) &&	# Only if both procs have stats
			    ($nostats{$pns} == 0) &&
			    ($nostats{$othername} == 0)) {
			    $code = $code.
				    "ts_treeindex_".$procname[$pn]."-1, ".
			            "ts_treestats_".$procname[$pn].", ".
				    "&ts_treeindex_".$procname[$pn].", ";
			}
		        add_change($n, $l+1, $code);
			$alsorecursive = 0;
			dprint 3,"REPLACE_DEPTHNAME_EXTERN: $source[$n]\n";

			# For tree recording, also add iteration management
			# code etc
			#
			if (($recordtree) &&	# Only if both procs have stats
			    ($nostats{$pns} == 0) &&
			    ($nostats{$othername} == 0)) {
			    my $rn;
			    my $rl;
			    my $rc;
			    my $rmaxbc;
			    
			    $changeprio--;	# Apply this change after all
			    			#  others
			    ($rn, $rl, $rc, $rmaxbc) =
				skip_to_start_of_statement($n,$l);
			    $code = "
 {
    /* Remember start of this iteration */
    ts_iterstarts_".$procname[$pn]."[ts_itercount_".$procname[$pn].
                                    "++] = ts_treeindex_".$procname[$pn].";
    ts_treeindex_".$procname[$pn]."++;

    ";
			    add_change($rn, $rl, $code);

			    $changeprio++;

                            ($rn, $rl, $rc, $rmaxbc) =
				skip_to_end_of_statement($n,$l);
			    $code = ";
     
   /* Check how many tree statistic cells N were used in this iteration
    * and increase number of cells if 2*N > current cell number avaibale.
    * Initialize newly won space with zeroes.
    */
   if (ts_itercount_#FNAME# > 1) {
       ts_itersize_#FNAME# = ts_treeindex_#FNAME# - ts_iterstarts_#FNAME#[ts_itercount_#FNAME#-1];
   } else {
       ts_itersize_#FNAME# = ts_treeindex_#FNAME#;
   }
   if (ts_treeindex_#FNAME# + 2*ts_itersize_#FNAME# > ts_treeindexsize_#FNAME#) {
       /*printf(\"Increasing treestat size for #FNAME# from %d to %d\\n\",
              ts_treeindexsize_#FNAME#, ts_treeindexsize_#FNAME#+TS_TREESTATSIZE);*/
       ts_treeindexsize_#FNAME# = ts_treeindexsize_#FNAME# + TS_TREESTATSIZE;
       ts_treestats_#FNAME# = (ts_treestat_entry*) realloc(ts_treestats_#FNAME#,
                             sizeof(ts_treestat_entry) * ts_treeindexsize_#FNAME#);
       bzero( (void *) (ts_treestats_#FNAME# + ts_treeindexsize_#FNAME# - TS_TREESTATSIZE),
                        sizeof(ts_treestat_entry) * TS_TREESTATSIZE);
   }
}";
			    $code =~ s/\#FNAME\#/$procname[$pn]/g;
			    add_change($rn, $rl, $code);


			}
		    }
		}
		
	    } else {

		# Call from inside the procedure itself, add corresponding
		# depth parameter + 1 to call as well as leafindex
		#
		my $code = $depthname."+1, ";
		
		if (($recordtree) &&		# Only if both have stats
		    ($nostats{$pns} == 0) &&
		    ($nostats{$othername} == 0)) {
		    $code = $code."ts_leafindex, ts_treestats, ts_treeindex, ";
		}
		add_change($n, $l+1, $code);
		$alsorecursive = 1;
		dprint 3,"REPLACE_DEPTHNAME_INTERN: $source[$n]\n";

	    }

	    # (Here, only check if othername has stats, because it's
	    #  ITS branch counter)
	    if (($alsorecursive == 1) &&
		($nostats{$othername} == 0)) {
		# If call to us occured in own procedure or in one
		# that is in our transitive call hull (i.e. recursive
		# with us):
		# Add "branch_count++" before the recursive call,
		# encapsulating the call and the ++ with braces
		# (skipping backward to start of call statement for the
		# starting brace, in case it was inside an expression)
		#
		# Also add tree recording
		#
                # (using the old $num in spite of the added depth
		# does not matter, since it didn't shift the call's starting
		# point)
		#
		($n, $l, $c, $maxbc) = skip_to_start_of_statement($num,$pos-1);
		# !!! ERROR HANDLING

		my $precode  = "{\nbranch_count++;\n";
		my $postcode = ";}\n";

		if (($recordtree) &&		# Only if both have stats
		    ($nostats{$pns} == 0)) {	# (o.n. already checked above)
		    $precode = $precode."
    /* (treeindex is global variable, only OK for sequential use */
    ts_leafindex = (*ts_treeindex)++;  /* Get index for child    */
    ts_treestats[tsindex].index[branch_count-1] =
                 ts_leafindex;         /* Remember child indices */
";
		}
		
		add_change($n, $l, $precode);
		dprint 3,"REPLACE_BEFORE_RECURSION: $source[$n]\n";

		($n, $l, $c, $maxbc) = skip_to_end_of_statement($num,$pos);
		
		add_change($n, $l, $postcode);
		dprint 3,"REPLACE_AFTER_RECURSION: $source[$n]\n";
		
	    }
		
	}

    }

    &perform_changes();		# Apply code insertions and reset requests
    
}



# Main program


my $j;
	    

&handle_arguments();

dprint 1,"\nReading source code...\n";
dprint 1,"\n";
&read_lines();

dprint 1,"\nIdentifying procedures...\n";
dprint 1,"\n";
&find_procedures();

dprint 1,"\nFound the following procedures:\n\n";
for ($j=1; $j<=$procnum; $j++) {
    my $s;
    $s=sprintf("%3d) procedure %-20s from line %4d to %4d\n",
	      $j, $procname[$j], $procstartline[$j], $procendline[$j]);
    dprint 1,$s;
    if ($procdecls{$procname[$j]} ne "") {
	$s=sprintf("        declared at %s\n",
	           $procdecls{$procname[$j]});
	dprint 1,$s;
    }
    if (defined($proctypes{$procname[$j]})) {
	dprint 1,"        type: ".$proctypes{$procname[$j]}."\n";
    } else {
	dprint 1,"        no type?!?\n";
    }
    if (defined($variables{$procname[$j]})) {
	dprint 1,"        parameters:".
	         join("\n           ",	# Multi-line display :-)
		      split(/\,/," ,".$variables{$procname[$j]})).
		 "\n";
    } else {
	dprint 1,"        no parameters?!?\n";
    }
}
dprint 1,"\n";

dprint 1,"\nIdentifying procedure calls...\n";
dprint 1,"\n";
&find_calls();

dprint 1,"\nFound the following calls:\n\n";
for ($j=1; $j<=$procnum; $j++) {
    my $s;
    $s=sprintf("%3d) %-20s called in %s\n",
	      $j, $procname[$j], $procwherecalled[$j]);
    dprint 1,$s;
}
dprint 1,"\n";

dprint 1,"\nIdentifying recursive procedures...\n";
dprint 1,"\n";
&find_recursives();	

dprint 1,"\nFound the following recursive procedures:\n\n";
for ($j=1; $j<=$recursivenum; $j++) {
    my $s;
    my $pns = $procname[$recursives[$j]];
    $s=sprintf("%3d) %-20s", $j, $pns);
    if ($nostats{$pns}) {
	$s=sprintf("%s (annoted NOSTATS)", $s);
    }
    dprint 1,$s."\n";
}
dprint 1,"\n";

dprint 1,"\nInstrumenting program...\n";
dprint 1,"\n";
&instrument_program();
dprint 1,"\n";

dprint 1,"\nResulting program:\n\n";

if ($outfilename ne "") {
    my $OUTFILE = $outfilename;

    print "Writing output to file '".$outfilename."' ...\n\n";
    open($OUTFILE, ">".$outfilename) ||
	die "Cannot open output file!\n";
    for ($j=1; $j<=$linenum; $j++) {
        print $OUTFILE $source[$j]."\n";
    }
    close($OUTFILE);
} else {
    print "(Neither -out given nor environment IP_OUT not defined, ".
	  "printing to stdout...)\n\n";
    for ($j=1; $j<=$linenum; $j++) {
	print $source[$j]."\n";
    }
}
