Initial import

git-svn-id: http://svn.cactuscode.org/flesh/trunk@2 17b73243-c579-4c4c-a9d2-2d5706c11dac

3 files changed, 420 insertions, 0 deletions

diff --git a/lib/sbin/c_file_processor.pl b/lib/sbin/c_file_processor.pl
new file mode 100644
index 00000000..2e7084ab
--- /dev/null
+++ b/lib/sbin/c_file_processor.pl
@@ -0,0 +1,30 @@
+#!/bin/perl
+
+$home = shift(@ARGV);
+
+$/ = ";";
+$*=1;
+
+if (! -e "$home/fortran_name.pl" ) 
+{
+    die "Unable to get fortran name file!";
+}
+
+require "$home/fortran_name.pl";
+
+while(<>)
+{
+    $line = $_;
+    if($line =~ m:FORTRAN_NAME\s*\(([^\)]*)\):)
+    {
+        $arglist = $1;
+        $arglist =~ s:[\s\n\t]+::g;
+
+	@args = split(",", $arglist );
+
+	$new = &fortran_name($args[$#args]);
+
+	$line =~ s:FORTRAN_NAME\s*\(([^\)]*)\):$new:;
+    }
+    print $line;
+}
diff --git a/lib/sbin/interface_parser.pl b/lib/sbin/interface_parser.pl
new file mode 100644
index 00000000..97c7cd77
--- /dev/null
+++ b/lib/sbin/interface_parser.pl
@@ -0,0 +1,164 @@
+#! /usr/bin/perl
+
+require "parameter_parser.pl";
+
+
+%implementations = ("flesh", "flesh", "test1", "test1", "test2", "test2");
+
+%interface_database = create_interface_database(%implementations);
+
+&print_interface_database(%interface_database);
+
+#/*@@
+#  @routine    create_interface_database
+#  @date       Wed Sep 16 15:07:11 1998
+#  @author     Tom Goodale
+#  @desc 
+#  Creates a database of all the interfaces
+#  @enddesc 
+#  @calls     
+#  @calledby   
+#  @history 
+#
+#  @endhistory 
+#@@*/
+
+sub create_interface_database
+{
+    local(%thorns) = @_;
+    local($thorn, @indata);
+    local(@new_interface_data);
+    local(@interface_data);
+
+#  Loop through each  thorn's interface file.
+    foreach $thorn (keys %thorns)
+    {
+#       Read the data
+	@indata = read_file("$thorns{$thorn}/interface.ccl");
+	
+#       Get the interface data from it
+	@new_interface_data = &parse_interface_ccl($thorn, @indata);
+
+#       Add the interface to the master interface database
+	push (@interface_data, @new_interface_data);
+
+    }
+
+    return @interface_data;
+}
+
+
+#/*@@
+#  @routine    parse_interface_ccl
+#  @date       Wed Sep 16 15:07:11 1998
+#  @author     Tom Goodale
+#  @desc 
+#  Parses an interface.ccl file and generates a database of the values.
+#  @enddesc 
+#  @calls     
+#  @calledby   
+#  @history 
+#
+#  @endhistory 
+#@@*/
+
+sub parse_interface_ccl
+{
+    local($thorn, @data) = @_;
+    local($linenum, $line, $block, $type, $variable, $description, $nerrors);
+    local($current_friend, $new_ranges, $new_desc);
+    local($data, %interface_db);
+    local($implementation);
+
+#   The default block is private.
+    $block = "PRIVATE";
+
+    for($linenum = 0; $linenum < @data; $linenum++)
+    {
+	$line = $data[$linenum];
+
+#       Parse the line
+	if($line =~ m/^\s*(PUBLIC|PROTECTED|PRIVATE)\s*$/i)
+	{
+#           It's a new block.
+	    $block = "\U$1\E";
+	} 
+	elsif ($line =~ m/^\s*IMPLEMENTS:\s*([a-z]+[a-z_0-9]*)\s*$/i)
+	{
+	    if($implementation == 0)
+	    {
+		$implementation = $1;
+		$interface_db{"\U$thorn\E IMPLEMENTS"} = $implementation;
+	    }
+	    else
+	    {
+		print "Error:  Only one implements line allowed.\n";
+	    }
+	}
+	elsif ($line =~ m/^\s*(INHERITS|FRIEND)\s*:((\s*[a-z]+[a-z_0-9]*)*\s*)$/i)
+	{
+	    $interface_db{"\U$thorn $1\E"} .= $2;
+	}
+	elsif ($line =~ m/^\s*(PUBLIC|PROTECTED|PRIVATE)\s*:\s*$/i)
+	{
+	    $block = "\U$1\E";
+	}
+	elsif ($line =~ m/^\s*GROUP\s*([a-z]+[a-z_0-9]+)\s*$/i)
+	{
+	    $current_group = $1;
+
+	    $interface_db{"\U$thorn $block GROUPS \E"} .= " $1";
+
+	    $linenum++;
+	    if($data[$linenum] =~ m/^\s*\{\s*$/)
+	    {
+		$linenum++;
+		while($data[$linenum] =~ m/^\s*GF\s*\(([a-z]+[a-z_0-9]*)((,.*)*)\)\s*$/i)
+		{
+		    $interface_db{"\U$thorn GROUP $current_group\E"} .= " $1";
+		    $interface_db{"\U$thorn $1 TYPE\E"} = "GF";
+		    $interface_db{"\U$thorn $1 DATA\E"} = $2;
+		    $linenum++;
+		}
+		if(! $data[$linenum] =~ m/^\s*\}\s*/)
+		{
+		    print STDERR "Expected }, got $data[$linenum]\n";
+		}
+	    }
+	    else
+	    {
+		print STDERR "Expected {, got $data[$linenum]\n";
+	    }
+	}
+	elsif($line =~ m/^\s*(INTEGER|REAL)\s*\(([a-z]+[a-z_0-9]*)\)\s*$/i)
+	{
+	    $interface_db{"\U$thorn $block SCALARS\E"} .= " $2";
+	    $interface_db{"\U$thorn $2 TYPE\E"} = "$1";
+	}
+	else
+	{
+	    if($line =~ m:\{:)
+	    {
+		print "...Skipping block with missing keyword....\n";
+		$linenum++ until ($data[$linenum] =~ m:\}:);
+	    }
+	    else
+	    {
+		print "Unknown line $line!!!\n";
+	    }
+	}
+    }
+
+    return %interface_db;
+}
+
+
+sub print_interface_database
+{
+    local(%database) = @_;
+    local($field);
+
+    foreach $field ( sort keys %database ){
+	print "$field has value $database{$field}\n";
+    }
+}
diff --git a/lib/sbin/parameter_parser.pl b/lib/sbin/parameter_parser.pl
new file mode 100644
index 00000000..b07a37f3
--- /dev/null
+++ b/lib/sbin/parameter_parser.pl
@@ -0,0 +1,226 @@
+#! /usr/bin/perl
+
+#%implementations = ("flesh", "flesh", "test1", "test1", "test2", "test2");
+
+#%parameter_database = create_parameter_database(%implementations);
+
+#&print_parameter_database(%parameter_database);
+
+#/*@@
+#  @routine    create_parameter_database
+#  @date       Wed Sep 16 11:45:18 1998
+#  @author     Tom Goodale
+#  @desc 
+#  Creates a database of all the parameters
+#  @enddesc 
+#  @calls     
+#  @calledby   
+#  @history 
+#
+#  @endhistory 
+#@@*/
+
+sub create_parameter_database
+{
+    local(%implementations) = @_;
+    local($imp, @indata);
+    local(@new_parameter_data);
+    local(@parameter_data);
+
+#  Loop through each implementation's parameter file.
+    foreach $imp (keys %implementations)
+    {
+#       Read the data
+	@indata = read_file("$implementations{$imp}/param.ccl");
+	
+#       Get the parameters from it
+	@new_parameter_data = &parse_param_ccl($imp, @indata);
+
+#       Add the parameters to the master parameter database
+	push (@parameter_data, @new_parameter_data);
+
+    }
+
+    return @parameter_data;
+}
+
+
+#/*@@
+#  @routine    read_file
+#  @date       Wed Sep 16 11:54:38 1998
+#  @author     Tom Goodale
+#  @desc 
+#  Reads a file deleting comments and blank lines. 
+#  @enddesc 
+#  @calls     
+#  @calledby   
+#  @history 
+# 
+#  @endhistory 
+#@@*/
+
+sub read_file
+{
+    local($file) = @_;
+    local(@indata);
+
+    open(IN, "<$file") || die("Can't open $file\n");
+
+    while(<IN>)
+    {
+	$_ =~ s/\#.*//;
+	
+	next if(m/^\s+$/);
+	
+	chop;
+	
+	push(@indata, $_);
+    }
+
+    close IN;
+
+    return @indata;
+}
+
+
+#/*@@
+#  @routine    parse_param_ccl
+#  @date       Wed Sep 16 11:55:33 1998
+#  @author     Tom Goodale
+#  @desc 
+#  Parses a param.ccl file and generates a database of the values.
+#  @enddesc 
+#  @calls     
+#  @calledby   
+#  @history 
+#
+#  @endhistory 
+#@@*/
+
+sub parse_param_ccl
+{
+    local($implementation, @data) = @_;
+    local($linenum, $line, $block, $type, $variable, $description, $nerrors);
+    local($current_friend, $new_ranges, $new_desc);
+    local($data, %parameter_db);
+
+#   The default block is private.
+    $block = "PRIVATE";
+
+    for($linenum = 0; $linenum < @data; $linenum++)
+    {
+	$line = $data[$linenum];
+
+#       Parse the line
+	if($line =~ m/(PUBLIC|PROTECTED|PRIVATE|FRIEND)\s*:(.*)/i)
+	{
+#           It's a new block.
+	    $block = "\U$1\E";
+	    if($block eq "FRIEND")
+	    {
+		$current_friend = $2;
+		$current_friend =~ s:\s::;
+
+#               It's a friend block.
+		$block .= " \U$current_friend\E";
+	    }
+	}
+	elsif($line =~ m:(EXTENDS )?\s*(INTEGER|REAL|KEYWORD|STRING)\s*([a-zA-Z]+[a-zA-Z0-9_]*) \s*(\"[^\"]*\"):i)
+	{
+
+#           This is a parameter definition.
+	    $type = "\U$2\E";
+	    $variable = $3;
+	    $description = $4;
+
+	    if($1 =~ m:EXTENDS:i && $block ne "FRIEND")
+	    {
+#               Can only extend a friend variable.
+		print "Parse error at line $linenum\n";
+		$nerrors++;
+		$linenum++ while($line[$linenum] !=~ m:\}:);
+	    }
+	    elsif(! $data[$linenum+1] =~ m:^\s*\{\s*$:)
+	    {
+#               Since the data should have no blank lines, the next
+#               line should have { on it.
+		print "Parse error at line $linenum\n";
+		$nerrors++;
+#               Move past the end of this block.
+		$linenum++ while($line[$linenum] !=~ m:\}:);
+	    }
+	    else
+	    {
+#               Move past {
+		$linenum++;
+		$linenum++;
+
+#               Store data about this variable.
+		$parameter_db{"\U$implementation $block\E variables"} .= $variable." ";
+		$parameter_db{"\U$implementation $variable\E type"} = $type;
+		$parameter_db{"\U$implementation $variable\E description"} = $description;
+		$parameter_db{"\U$implementation $variable\E ranges"} = 0;
+
+#               Parse the allowed values and their descriptions.
+		while(($new_ranges, $new_desc) = $data[$linenum] =~ m/(.*)::(.*)/)
+		{
+		    $parameter_db{"\U$implementation $variable\E ranges"}++;
+		    $parameter_db{"\U$implementation $variable\E range $parameter_db{\"\U$implementation $variable\E ranges\"} range"} = $new_ranges;
+		    $parameter_db{"\U$implementation $variable\E range $parameter_db{\"\U$implementation $variable\E ranges\"} description"} = $new_desc;
+		    $linenum++;
+		}
+		if(! $block =~ m:FRIEND:)
+		{
+		    if($data[$linenum] =~ m:\s*\}\s*(.+):)
+		    {
+			$parameter_db{"\U$implementation $variable\E default"} = $1;
+		    }
+		    else
+		    {
+			print STDERR "Unable to find default for $variable\n";
+			$nerrors++;
+		    }		
+		}
+	    }
+	}
+	else
+	{
+	    if($line =~ m:\{:)
+	    {
+		print "...Skipping block with missing keyword....\n";
+		$linenum++ until ($data[$linenum] =~ m:\}:);
+	    }
+	    else
+	    {
+		print "Unknown line $line!!!\n";
+	    }
+	}
+    }
+
+    return %parameter_db;
+}
+
+#/*@@
+#  @routine    print_parameter_database
+#  @date       Wed Sep 16 14:58:52 1998
+#  @author     Tom Goodale
+#  @desc 
+#  Prints out a parameter database.
+#  @enddesc 
+#  @calls     
+#  @calledby   
+#  @history 
+#
+#  @endhistory 
+#@@*/
+sub print_parameter_database
+{
+    local(%parameter_database) = @_;
+    local($field);
+
+    foreach $field ( sort keys %parameter_database ){
+	print "$field has value $parameter_database{$field}\n";
+    }
+}
+
+1;