#!/usr/local/bin/perl

########################################################################
# Perl implementation of Quanterra's macromania program.
# Conforms to Quanterra MSHEAR macromania v23.
#
#	Doug Neuhauser, UC Berkeley Seismological Laboratory
#	doug@seismo.berkeley.edu
#
# 1.0.1	1998.323 v23	First release.
# 1.0.2	1999.160 v23	Bug fixes to $MEND processing, variable substr.
#			(thanks to Luis Rivera)
# 1.0.3 1999.278 v23	Bug fix in keyword replacement and expr check.
# 1.005 2000.131 v23	Corrected key lookup in environment.
#
########################################################################

require 5.002;
use strict;
use Getopt::Std;
use FileHandle;
use vars qw (	$opt_d $opt_h);

########################################################################
#   Global initialization.
########################################################################
my($VERSION, $QVERSION);
my($DEBUG_KEYDEF, $DEBUG_MACRO, $DEBUG_TEMPLATE, $DEBUG_TMACRO);
my($DEBUG_KEYREPLACE, $DEBUG_ARITH, $DEBUG_KEY);
my($DEFAULT_ESC, $DEFAULT_KEYMACROS);
my($ESC, $AP);
my($keymacro, @macrofiles, %keyval, %keymacro, $debug);
# Variables to be reset for each template macro file processed.
my(@ifstack, @body, $macro, %tmacro, $in_macro, $use);

$VERSION = "1.0.3 (1999.278)";
$QVERSION = "Quanterra v23 compatible";

$DEBUG_KEYDEF = 1;
$DEBUG_MACRO = 2;
$DEBUG_TEMPLATE = 4;
$DEBUG_TMACRO = 8;
$DEBUG_KEYREPLACE = 16;
$DEBUG_ARITH = 32;
$DEBUG_KEY = 64;
$DEFAULT_ESC = "%";
$AP = '(?:"[^"]*"|[^\s";]*)';	# Pattern for macro argument.
$DEFAULT_KEYMACROS = "keymacros";

STDERR->autoflush(1);
STDOUT->autoflush(1);

########################################################################
#	print_syntax	- print syntax and exit.
########################################################################
sub print_syntax {
    my($cmdname) = @_;
    $cmdname = $1 if ($cmdname =~ m|^.*/([^/]+)$|);
    printf	
"$cmdname version $VERSION ($QVERSION)
$cmdname - Create output files from template and key files.
Syntax:
$cmdname [-d N] filelist keyfile
where:
	-d N	specifies debug option (may be added together).
		1 = DEBUG_KEYDEF
		2 = DEBUG_KEYMACRO
		4 = DEBUG_TEMPLATE
		8 = DEBUG_TEMPLATE_MACRO
		16 = DEBUG_KEYREPLACE
		32 = DEBUG_ARITH
		64 = DEBUG_KEY (final symboltable)
	filelist
		is the filename containing a list of files to be created.
	keyfile
		is the name of the primary key file to be processed.
";
    exit(0);
}

########################################################################
#   Main program.
########################################################################
{
    my($keyfile, $filelist, $f, $file, @files, $macrofile, @lines, $grp);

    require "getopts.pl";
    &Getopts ('hf:d:T:C:c:');
    &print_syntax($0) if ($opt_h);
    $debug = $opt_d;
    print ("Error: Missing filenames.\n"), print_syntax($0) if (@ARGV != 2);

    $filelist = shift(@ARGV);
    $keyfile = shift(@ARGV);

    # 1.  Read the keys, caching key definitions.
    open (KEYFILE, "<$keyfile") || die "Unable to open keyfile";
    @lines = <KEYFILE>;
    close (KEYFILE);
    print ("===> Start keyfile $keyfile: Pass 1\n") if ($debug & $DEBUG_KEYDEF);
    &process_key(1,@lines);
    print ("===> End keyfile $keyfile: Pass 1\n") if ($debug & $DEBUG_KEYDEF);
    # For debugging, dump keys.
    &dump_keyval() if ($debug & $DEBUG_KEYDEF);

    # 2.  Read all of the keymacro files, caching all keymacros.
    # Process any user-defined keymacro files before default keymacro file.
    foreach $macrofile (@macrofiles, $DEFAULT_KEYMACROS) {
	open (KEYMACROS, "<$macrofile") || die "Unable to open keymacro file $macrofile";
	@lines = <KEYMACROS>;
	close (KEYMACROS);
	&define_keymacro(@lines);
    }
    # For debugging, dump macros.
    &dump_keymacro() if ($debug & $DEBUG_MACRO);

    # 3.  Reprocess key file, expanding keymacros calls.
    open (KEYFILE, "<$keyfile") || die "Unable to open keyfile";
    @lines = <KEYFILE>;
    close (KEYFILE);
    print ("===> Start keyfile $keyfile: Pass 2\n") if ($debug & $DEBUG_KEYDEF);
    &process_key(2,@lines);
    print ("===> End keyfile $keyfile: Pass 2\n") if ($debug & $DEBUG_KEYDEF);
    # For debugging, dump keys.
    &dump_keyval() if ($debug & $DEBUG_KEYDEF || $debug & $DEBUG_KEY);

    # Expand template file(s).
    $grp = $keyval{"GRP"};
    open (FILELIST, "$filelist") || die "Unable to open filelist: $filelist";
    chomp(@files = <FILELIST>);
    close (FILELIST);
    foreach $f (@files) {
	chomp ($f);
	$file = "$f" . "_" . $grp;
	print "processing template file $file\n";
	open (TEMPLATE, "<$file") || die "Unable to open template file $file";
	@lines = <TEMPLATE>;
	close (TEMPLATE);
	$file = $f;
	open (OUTPUT, ">$file") || die "Unable to open output file $file";
	OUTPUT->autoflush(1);
	&process_template(@lines);
	close (OUTPUT);
#	print "finished template file $file\n";
    }
}

########################################################################
#   process_key:
#	Function to process key files.
#	Pass 1: Insert new keys and their values to the global key hash table, 
#		and keep track of user-defined macrofile definitions.
#	Pass 2: Expand keymacros, adding new keys to the global key hash table.
#	Global: @keyval, @macrofiles
########################################################################
sub process_key {
    my($pass,@lines) = @_;
    my($line,$key,$value);
    # Parse line into 2 tokens: one mandatory, one optional.
    foreach $line (@lines){
	chomp($line);
# orig:	($key,$value) = $line =~ /^(\S+)\s*(\".*\"|[^\"\s]?\S*|\S*)/;
	($key,$value) = $line =~ /^(\S+)\s*((?:[^\s\"]+|(?:\"[^\"]*\")+)*)/;
	printf ("===> Read:  key='%s', value='%s'\n", $key, $value) if ($debug & $DEBUG_KEYDEF);
	$key =~ tr/[a-z]/[A-Z]/;
	# Process comment.
	if ($key =~ /^\*/) {
	    print ("===> comment: $line\n") if ($debug & $DEBUG_KEYDEF);
	    next;
	}
	# Process macrofile - push onto stack for subsequent processing.
	if ($key =~ /^\$MACROFILE$/i) {
	    die "Missing filename for $key: $line\n" if ($value eq "");
	    if ($pass == 1) {
		push(@macrofiles,$value);
		print ("===> cache: $line\n") if ($debug & $DEBUG_KEYDEF);
	    }
	    else {
		print ("===> cache: $line\n") if ($debug & $DEBUG_KEYDEF);
	    }
	    next;
	}
	# Process include file - process now.
	if ($key =~ /^\$INCLUDE$/i) {
	    die "Missing filename for $key: $line\n" if ($value eq "");
	    my($inclfile) = $value;
	    open (INCLFILE, "<$inclfile") || die "Unable to open include file $inclfile";
	    my(@incllines) = <INCLFILE>;
	    close (INCLFILE);
	    print ("===> start include file: $value\n") if ($debug & $DEBUG_KEYDEF);
	    &process_key($pass,@incllines);
	    print ("===> end include file: $value\n") if ($debug & $DEBUG_KEYDEF);
	    next;
	}
	# Process keymacro - defer to next pass.
	if ($key =~ /^\$/) {
	    if ($pass == 1) {
		print ("===> defer: $line\n") if ($debug & $DEBUG_KEYDEF);
		next;
	    }
	    # Reparse the line, ensuring that we pick up args correctly.
	    ($key,$value) = $line =~ /^(\$\S+)\s*((?:$AP)(?:;$AP)*)/;
	    my(@macrolines) = &keymacro_call($key,$value);
	    print ("===> start process: $line\n") if ($debug & $DEBUG_KEYDEF);
	    process_key($pass,@macrolines);
	    print ("===> end process: $line\n") if ($debug & $DEBUG_KEYDEF);
	    next;
	}
	# Process key definition - push only new key and value on stack.
	# Value may be empty.
	if (! defined($keyval{$key})) {
	    # Remove quotes.
	    $value = $1 if ($value =~ /^"(.*)"$/);
	    $keyval{$key} = $value;
	    printf ("===> Insert: %s=%s\n",$key,$keyval{$key}) if ($debug & $DEBUG_KEYDEF);
	}
	else {
	    printf ("===> Ignore: %s=%s\n",$key,$keyval{$key}) if ($debug & $DEBUG_KEYDEF);
	}
    }
}

########################################################################
#   keymacro_call:
#	Call keymacro, substituting formal arguments with actual arguments.
#	Return lines with arguments replaced.
########################################################################
sub keymacro_call {
    my($key,$args) = @_;
    my(@arg) = splitargs($args);
    my($arglist) = "123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
    my ($i,$j,$body);
    my($formal,@f,$i,$arg,$body);
    $key =~ tr/[a-z]/[A-Z]/;    
    die "Keymacro $key not defined" if (! defined($keymacro{$key}));
    $body = $keymacro{$key};
    # There is no verification of arguments.
    # Any missing format arguments are supplies as empty strings.
    # Substitute the actual arguments for the formal arguments
    # in the macro body.
    # Return the macro body with the arguments replaced.
    # Find each formal argument, and replace it with the actual argument.
    # Substrings are allowed.
    while (($formal) = $body =~ /\$([1-9A-Za-z](:\d+:\d+)?)\$/) {
	@f = split (/:/,$formal);	# Split into (argnum, start, length)
	$f[0] =~ tr/[a-z]/A-Z/;
	$i = index($arglist,$f[0]);	# Find index of actual argument.
	$arg = ($i>=0 && $i<=$#arg) ? $arg[$i] : "";	# Substitute argument.
	$arg = substr($arg,$f[1]-1,$f[2]) if (@f > 1);	# Perform substr.
	$body =~ s/\$$formal\$/$arg/g;	# Replace formal with actual arg.
    }
    return (split(/\n/,$body));
}

########################################################################
#   dump_keyval:
#	Function to dump the keyval table for debugging purposes.
#	Global: @keyval
########################################################################
sub dump_keyval {
    my($key);
    print ("===> Start Dump of keyval.\n");
    foreach $key (sort(keys(%keyval))) {
	printf ("%s=%s\n", $key, $keyval{$key});
    }
    print ("===> End Dump of keyval.\n\n");
}


########################################################################
#   define_keymacro:
#	Function to insert new keymacro into the global keymacro hash table.
#	No argument checking is performed at call time, so the formal 
#	argument list (which is just a comment to the user) is discarded 
#	before insertion into the hash table.
#	Global: @keymacro
########################################################################
sub define_keymacro {
    my(@lines) = @_;
    my($line,$macro,$args,@body);
    my($in_macro) = 0;
    foreach $line (@lines) {
	chomp($line);
	if ($line =~ /^\*/) {
	    next;	# Discard comment lines in keymacros.
	}
	if ($line =~ /^\[/) {
	    die "Error - macro definition within macro at line $. - $line" if ($in_macro);
	    ($macro,$args) = $line =~ /^\[(\S+)\]\s*(\S*)/;	# Allow comment
	    $macro =~ tr/[a-z]/[A-Z]/;
	    $in_macro = 1;
	    next;
	}
	if ($line =~ /^\s*$/) {
	    $in_macro = 0;
	    $keymacro{$macro} = join("\n",@body)
		if ($macro ne "" && (! defined($keymacro{$macro})));
	    $macro = "";
	    @body = ();
	    next;
	}
	if (! $in_macro) {
	    die "Error - macro body line outside of macro definition. Line=$line" 
	}
	push (@body,$line);
    }
    $keymacro{$macro} = join("\n",@body) if ($macro ne "");
}

########################################################################
#   dump_keymacro:
#	Function to dump the keymacro table for debugging purposes.
#	Global: @keymacro
########################################################################
sub dump_keymacro {
    my($key,$line,@lines);
    print ("===> Start dump of keymacro.\n");
    foreach $key (sort(keys(%keymacro))) {
        (@lines) = split(/\n/,$keymacro{$key});
	printf ("keymacro: %s\n", $key);
	foreach $line (@lines) {
	    print ("\t", $line,"\n");
	}
    }
    print ("End dump of keymacro.\n\n");
}

########################################################################
#   process_template:
#	Process input template file, and return output lines.
#   NOTE:   This routine must be called for each user-specified 
#	    template file.  Although expand_template does the work,
#	    this function must allocate local variables for it.
########################################################################
sub process_template {
    my(@lines) = @_;
    my($line);		# line being processed.
    # Empty or initialize the following variables for expand_template.
    @ifstack = (1);	# stack for nested conditional values.
    undef(@body);	# body of macro being saved.
    undef($macro);	# macro named being defined.
    undef(%tmacro);	# storage for template macros.
    # use=1 -> in TRUE conditional (or outside of conditional)
    # use=0 -> in FALSE conditional
    $in_macro = 0;
    $use = 1;
    $ESC = $DEFAULT_ESC;

    &expand_template(@lines);
}

########################################################################
#   expand_template:
#	Expand template input line by line.
#	1.  Process $MEND to end macro caching if in macro, 
#	    or cache line if defining macro.
#	2.  Process $ENDIF to pop ifstack.
#	3.  Process $ELSE to negate eval state on ifstack.
#	4.  Resolve all keys in the line, checking for no_output prefix.
#	5.  Eval explicit arithmetic expressions: @{expr}@.
#	6.  Process all other template file directives:
#	    $MDEFINE, $IF, $IFEQ, $IFDEF, $IFNDEF, $ESCAPE, $INCLUDE
#	    Evaluate $IF and $IFEQ argument as expressions.
#	    Note that $IF     expr == true iff eval(expr) > 0.
#	    Note that $IFEQ   expr == true iff eval(expr) == 0.
#	    Note that $IFDEF  key  == true iff length(trim(str)) > 0.
#	    Note that $IFNDEF key  == true iff length(trim(str)) == 0.
#	6.  Process template_macro calls.
#	8.  Output line if not handled or discarded above.
#
#    NOTE:  Called only by process_template or recursively to process
#	    macro input or include file.  
########################################################################
sub expand_template {
    my(@lines) = @_;
    my($line);		# line being processed.

    foreach $line (@lines) {

	# 1.  Process MEND.
	chomp($line);
        print ("input line: $line\n") if ($debug & $DEBUG_TMACRO);
	# Process MEND line - push macro body onto tmacro hash array.
	if (($line =~ /^\$MEND/i) && $in_macro) {
	    die "Error - template macro end not within macro at line $." if (! $in_macro);
	    if ($macro ne "" && ! defined($tmacro{$macro})) {
		$tmacro{$macro} = join("\n",@body);
		print ("End define tmacro: $macro\n") if ($debug & $DEBUG_TMACRO);
	    }
	    else {
		print ("Discard tmacro: $macro\n") if ($debug & $DEBUG_TMACRO);
	    }
	    $in_macro = 0;
	    $macro = "";
	    @body = ();
	    next;
	}
	# If within a macro, save macro body for later use.
	if ($in_macro) {
	    push(@body,$line);
	    next;
	}

	# 2.  Process $ENDIF
	if ($line =~ /^\$ENDIF/i) {
	    die 'Unexepected $ENDIF found' if (@ifstack <= 1);
	    $use = pop(@ifstack);
	    printf ("pop ifstack, depth=%d, use=%d\n", $#ifstack+1,$use) 
		if ($debug & $DEBUG_TMACRO);
	    next;
	}

	# 3.  Process $ELSE.
	if ($line =~ /^\$ELSE/i) {
	    die 'Unexpected $ELSE found' if (@ifstack <= 0);
	    $use = ((! $use) && $ifstack[$#ifstack]) ? 1 : 0;
	    next;
	}

	# Process conditionals to keep track of stack depth 
	# if we are not using data stream at this time.
	if ($line =~ /^\$(IF|IFDEF|IFEQ|IFNDEF)\s+/i && !$use) {
	    push(@ifstack,$use);
	    $use = 0;
	    printf ("push ifstack, depth=%d, use=%d\n", $#ifstack+1,$use) 
		if ($debug & $DEBUG_TMACRO);
	    next;
	}
	    
	next if (! $use);

	# 4.  Perform key substitution in line.
	# Check for discard line indicator after every substitution.
	$line = &key_replace($line);
	next if ($line =~ /^\*#/);

	# 5.  Evaluate explicit arithmetic expression denoted by @{expr}@.
	while ($line =~ /@\{.*?\}@/) {
	    my($expr,$i,$l,$val,$ival);
	    ($expr) = $line =~ /@\{(.*?)\}@/;
	    die "Invalid arith expression: $expr" if (! ($expr =~ m|^[0-9EDed\.\+\-\*\/\(\)^]+$|));
	    $val = &arith_eval($expr);
	    die "Invalid arith expression: $expr" if ($val eq "");
	    $ival = sprintf ("%.0lf",$val);
	    print ("line before arith: $line\n") if ($debug & $DEBUG_ARITH);
	    print ("arith expr: $expr\n") if ($debug & $DEBUG_ARITH);
	    print ("arith val=$val ival=$ival\n") if ($debug & $DEBUG_ARITH);
	    $i = index($line,$expr);
	    substr($line,$i-2,length($expr)+4) = $ival;
	    print ("line after arith:  $line\n") if ($debug & $DEBUG_ARITH);
	}

	# 6.  Process all other template file directives.
	# $MDEFINE, $IF, $IFEQ, $IFDEF, $IFNDEF, $MDEFINE, $ESCAPE, $INCLUDE
	# Process MDEFINE line - save macro name, start saving macro body.

	if ($line =~ /^\$MDEFINE/i) {
	    die "Error - macro definition within macro at line $." if ($in_macro);
	    ($macro) = $line =~ /^\$MDEFINE\s+\$(\S+)/i;
	    $macro =~ tr/[a-z]/[A-Z]/;
	    print ("Start define tmacro: $macro\n") if ($debug & $DEBUG_TMACRO);
	    $in_macro = 1;
	    next;
	}

	# $IF expression
	# $IFEQ expression
	if ($line =~ /^\$IF(?:EQ)?\s+/i) {
	    my($cond,$expr,$val);
	    push (@ifstack,$use);
	    # If we are not in a TRUE condition, push state to track depth.
	    if (! $use) {
		$use = 0;
		printf ("push ifstack, depth=%d, use=%d\n", $#ifstack+1,$use) 
		    if ($debug & $DEBUG_TMACRO);
		next;
	    }
	    ($cond,$expr) = $line =~ /^\$(IF(?:EQ)?)\s+(\S+)/i;
	    die "Missing conditional expression: $line" if ($expr eq "");
	    die "Invalid arith expression: $expr" if (! ($expr =~ m|^[0-9EDed\.\+\-\*\/\(\)]+$|));
	    $val = &arith_eval($expr);
	    die "Invalid arith expression: $expr" if ($val eq "");
	    $use = (($cond=~/^IF$/i && $val>0) || ($cond=~/^IFEQ$/i && $val==0)) ? 1 : 0;
	    printf ("push ifstack, depth=%d, use=%d\n", $#ifstack+1,$use) 
		if ($debug & $DEBUG_TMACRO);
	    next;
	}

	# $IFDEF expr
	# $IFNDEF expr
	# NOTE:  These should really be IFNBLANK and IFBLANK since they
	# check to see whether the keyword or argument (which was already
	# replaced) is blank or non-blank.
	if ($line =~ /^\$IF(?:N)?DEF/i) {
	    my($cond,$val);
	    push (@ifstack,$use);
	    # If we are not in a TRUE condition, push state to track depth.
	    if (! $use) {
		$use = 0;
		printf ("push ifstack, depth=%d, use=%d\n", $#ifstack+1,$use) 
		    if ($debug & $DEBUG_TMACRO);
		next;
	    }
	    ($cond,$val) = $line =~ /^\$(IF(?:N)?DEF)\s*(\S?.*?\S?)\s*$/i;
 	    $use = (($cond=~/^IFDEF/i && ($val =~ /\S+/)) || 
		    ($cond=~/^IFNDEF/i && ($val =~ /^ *$/))) ? 1 : 0;
	    printf ("push ifstack, depth=%d, use=%d\n", $#ifstack+1,$use) if ($debug & $DEBUG_TMACRO);
	    next;
	}

	# $ESCAPE char.
	if ($line =~ /^\$ESCAPE/i) {
	    my($c);
	    ($c) = $line =~ /^\$ESCAPE\s+(\S)/i;
	    $ESC = ($c eq "") ? $DEFAULT_ESC : '\\' . $c;
	    next;
	}	

	# $INCLUDE (filename)
	if ($line =~ /^\$INCLUDE/i) {
	    my($file) = $line =~ /^\$INCLUDE\s+(\S+)/i;
	    $file = &key_replace($file);
	    next if ($file eq "");
	    open (FILE, "<$file") || die "Unable to open include file $file";
	    my(@lines) = <FILE>;
	    close (FILE);
	    expand_template(@lines);
	    next;
	}

	# 7.  Process template macro calls.
	if ($line =~ /^\$/) {
	    my($key,$val) = $line =~ /^\$(\S+)\s*((?:$AP)(?:;$AP)*)/;
	    $key =~ tr/[a-z]/[A-Z]/;
	    if ($debug & $DEBUG_TMACRO) {
		print ("Calling tmacro: $key\n");
		print ("Argument list: $val\n");
	    }
	    my(@macrolines) = &tmacro_call($key,$val);
	    &expand_template(@macrolines);
	    print ("Done with tmacro: $key\n") if ($debug & $DEBUG_TMACRO);
	    next;
	}	
	
	# 8.  Save final output line.
	print (OUTPUT $line, "\n");
    }
}

########################################################################
#   key_replace:
#	Perform key replacement within a line.
#	Return line when all keys have been replaces, OR when line begins
#	with the "discard_ line" prefix of "*#".
########################################################################
sub key_replace {
    my($input) = @_;
    my($line) = $input;
    my($key,$KEY,$val,$envvar,$i); 
    print ("before replace: $line\n") if ($debug & $DEBUG_KEYREPLACE);
    return ($line) if ($line =~ /^\*#/);
    while (($key) = $line =~ /$ESC([^$ESC]+)$ESC/) {
	($KEY = $key) =~ tr/[a-z]/[A-Z]/;
	if (defined($keyval{$KEY})) {
	    $val = $keyval{$KEY};
	}
	elsif (defined($ENV{$KEY})) {
	    $val = $ENV{$KEY};
	}
        else {
	    die "Key $key not defined: orig=$line\nline=$line\n" 
	}
	$i = index($line, "$ESC$key$ESC");
	substr($line, $i, length($key)+2) = $val;
	last if ($line =~ /^\*#/);
    }
    print ("after replace:  $line\n") if ($debug & $DEBUG_KEYREPLACE);
    return ($line);
}

########################################################################
#   splitargs:
#	Split a string containing 0..N arguments separated by ';' 
#	into a list of individual args.  Unquote each arg if necessary.
#	Return list of arguments.
########################################################################
sub splitargs {
    my($args) = @_;
    my($arg,@arg);
    if (length($args) > 0) {
	do {
	    $args = substr($args,1) if (@arg > 0);
	    ($arg) = $args =~ /^($AP)/;
	    # Skip over argument.	
	    $args = substr($args,length($arg));
	    # Unquote the argument before pushing it on the stack.
	    $arg = $1 if ($arg =~ /^"(.*)"$/);
	    push(@arg,$arg);
	} while (length($args) > 0);
    }
    return (@arg);
}

########################################################################
#   tmacro_call:
#	Call tmacro, substituting formal arguments with actual arguments.
#	Return lines with arguments replaced.
########################################################################
sub tmacro_call {
    my($key,$args) = @_;
    my(@arg) = splitargs($args);
    my($arglist) = "123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
    my ($i,$j,$body);
    my($formal,@f,$i,$arg,$body);
    $key =~ tr/[a-z]/[A-Z]/;    
    die "Template_macro $key not defined" if (! defined($tmacro{$key}));
    if ($debug & $DEBUG_TMACRO) {
	my($i);
	for ($i=0;$i<@arg;$i++) {
	    print ("arg[$i]=$arg[$i]\n");
	}
    }
    $body = $tmacro{$key};
    # There is no verification of arguments.
    # Any missing format arguments are supplies as empty strings.
    # Substitute the actual arguments for the formal arguments
    # in the macro body.
    # Return the macro body with the arguments replaced.
    # Find each formal argument, and replace it with the actual argument.
    # Substrings are allowed.
    while (($formal) = $body =~ /\$([1-9A-Za-z](:\d+:\d+)?)\$/) {
	@f = split (/:/,$formal);	# Split into (argnum, start, length)
	$f[0] =~ tr/[a-z]/A-Z/;
	$i = index($arglist,$f[0]);	# Find index of actual argument.
	$arg = ($i>=0 && $i<=$#arg) ? $arg[$i] : "";	# Substitute argument.
	$arg = substr($arg,$f[1]-1,$f[2]) if (@f > 1);	# Perform substr.
	$body =~ s/\$$formal\$/$arg/g;	# Replace formal with actual arg.
    }
    return (split(/\n/,$body));
}

########################################################################
#   arith_eval:
#	Evaluate arithmetic expression (in passcal format).
#	Translate to lower case.
#	Replace "^" with "**" (exponentiation).
#	Return result.
########################################################################
sub arith_eval {
    my($expr) = @_;
    my($val);
    die "Invalid arith expression: $expr" if (! ($expr =~ m|^[0-9EDed\.\+\-\*\/\(\)]+$|));
    $expr =~ s/\*\*/\^/g;
    $expr =~ tr/[A-Z]/[a-z]/;
    $val = eval($expr);
    return ($val);
}