diff options
Diffstat (limited to 'lib/sbin')
| -rw-r--r-- | lib/sbin/CST | 47 | ||||
| -rw-r--r-- | lib/sbin/CSTUtils.pl | 92 | ||||
| -rw-r--r-- | lib/sbin/GridFuncStuff.pl | 53 | ||||
| -rw-r--r-- | lib/sbin/NewCreateScheduleBindings.pl | 12 | ||||
| -rw-r--r-- | lib/sbin/ScheduleParser.pl | 35 | ||||
| -rw-r--r-- | lib/sbin/interface_parser.pl | 48 | ||||
| -rw-r--r-- | lib/sbin/parameter_parser.pl | 128 |
7 files changed, 303 insertions, 112 deletions
diff --git a/lib/sbin/CST b/lib/sbin/CST index 79a03dfe..7adb7415 100644 --- a/lib/sbin/CST +++ b/lib/sbin/CST @@ -6,7 +6,7 @@ # @desc # Parses the the configuration files for thorns. # @enddesc -# @version $Header: /mnt/data2/cvs2svn/cvs-repositories/Cactus/lib/sbin/CST,v 1.29 1999-09-15 08:56:07 allen Exp $ +# @version $Header: /mnt/data2/cvs2svn/cvs-repositories/Cactus/lib/sbin/CST,v 1.30 1999-09-19 14:16:43 goodale Exp $ #@@*/ # Global parameter to track the number of errors from the CST @@ -63,7 +63,8 @@ if (!-e "$sbin_dir/parameter_parser.pl" ) require "$sbin_dir/parameter_parser.pl"; require "$sbin_dir/interface_parser.pl"; -require "$sbin_dir/schedule_parser.pl"; +#require "$sbin_dir/schedule_parser.pl"; +require "$sbin_dir/ScheduleParser.pl"; require "$sbin_dir/create_c_stuff.pl"; require "$sbin_dir/create_fortran_stuff.pl"; require "$sbin_dir/GridFuncStuff.pl"; @@ -73,7 +74,8 @@ require "$sbin_dir/ImpParamConsistency.pl"; require "$sbin_dir/CSTUtils.pl"; require "$sbin_dir/CreateParameterBindings.pl"; require "$sbin_dir/CreateImplementationBindings.pl"; -require "$sbin_dir/CreateScheduleBindings.pl"; +require "$sbin_dir/NewCreateScheduleBindings.pl"; +#require "$sbin_dir/CreateScheduleBindings.pl"; require "$sbin_dir/BuildHeaders.pl"; ####################################################################### @@ -90,6 +92,7 @@ print "Reading ThornList...\n"; print "Parsing interface files...\n"; %interface_database = &create_interface_database(%thorns); +#$debug_interface = 1; if($debug_interface) { &print_interface_database(%interface_database); @@ -99,6 +102,10 @@ if($debug_interface) print "Parsing parameter files...\n"; %parameter_database = &create_parameter_database(%thorns); +# Parse the schedule.ccl files +print "Parsing schedule files...\n"; +%schedule_database = &create_schedule_database(%thorns); + print "Checking consistency...\n"; %parameter_database = &CheckImpParamConsistency(scalar(keys %interface_database), %interface_database, %parameter_database); @@ -107,9 +114,22 @@ if($debug_parameters) &print_parameter_database(%parameter_database); } +#$debug_interface = 1; +if($debug_interface) +{ + &print_interface_database(%interface_database); +} + +#$debug_schedule = 1; +if($debug_schedule) +{ + &print_schedule_database(%schedule_database); +} + # Create all the bindings print "Creating Thorn-Flesh bindings...\n"; -&CreateBindings($bindings_dir, scalar(keys %parameter_database), %parameter_database, %interface_database); +&CreateBindings($bindings_dir, scalar(keys %parameter_database), scalar(keys %interface_database), + %parameter_database, %interface_database, %schedule_database); # Create header file of active thorns for the code @activethornsheader = &CreateActiveThornsHeader(%thorns); @@ -461,11 +481,17 @@ sub CreateDefineThisThornHeader sub CreateBindings { - local($bindings_dir, $n_param_database, @rest) = @_; + local($bindings_dir, $n_param_database, $n_interface_database, @rest) = @_; local(%parameter_database); local(%interface_database); + local(%schedule_database); local($start_dir); + # Extract the parameter,interface, and schedule databases from the arguments. + %parameter_database = @rest[0..2*$n_param_database-1]; + %interface_database = @rest[2*$n_param_database..2*($n_param_database+$n_interface_database)-1]; + %schedule_database = @rest[2*($n_param_database+$n_interface_database)..$#rest]; + # Extract the parameter and interface databases from the arguments. %parameter_database = @rest[0..2*$n_param_database-1]; %interface_database = @rest[2*$n_param_database..$#rest]; @@ -480,10 +506,15 @@ sub CreateBindings $start_dir = `pwd`; # Create the bindings for the subsystems. - &CreateImplementationBindings($bindings_dir, $n_param_database, @rest); - &CreateParameterBindings($bindings_dir, $n_param_database, @rest); + print " Creating implementation bindings...\n"; + &CreateImplementationBindings($bindings_dir, $n_param_database, %parameter_database, %interface_database); + print " Creating parameter bindings...\n"; + &CreateParameterBindings($bindings_dir, $n_param_database, %parameter_database, %interface_database); + print " Creating variable bindings...\n"; &CreateVariableBindings($bindings_dir, %interface_database); - &CreateScheduleBindings($bindings_dir, scalar(keys %thorns), %thorns,%interface_database); + print " Creating schedule bindings...\n"; + &CreateScheduleBindings($bindings_dir, scalar(keys %interface_database), + %interface_database, %schedule_database); # Place an appropriate make.code.defn in the bindings directory. chdir $bindings_dir; diff --git a/lib/sbin/CSTUtils.pl b/lib/sbin/CSTUtils.pl index 743186ad..e56a85e0 100644 --- a/lib/sbin/CSTUtils.pl +++ b/lib/sbin/CSTUtils.pl @@ -43,5 +43,97 @@ sub CST_error } + +#/*@@ +# @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 +# @hdate Fri Sep 10 10:25:47 1999 @hauthor Tom Goodale +# @hdesc Allows a \ to escape the end of a line. +# @endhistory +#@@*/ + +sub read_file +{ + local($file) = @_; + local(@indata); + local($line); + + open(IN, "<$file") || die("Can't open $file\n"); + + $line = ""; + + while(<IN>) + { + $_ =~ s/\#.*//; + + next if(m/^\s+$/); + + &chompme($_); + + # Add to the currently processed line. + $line .= $_; + + # Check the line for line-continuation + if(m:[^\\]\\$:) + { + $line =~ s:\\$::; + } + else + { + push(@indata, $line); + $line = ""; + } + } + + # Make sure to dump out the last line, even if it ends in a \ + if($line ne "") + { + push(@indata, $line); + } + close IN; + + return @indata; +} + + +#/*@@ +# @routine chompme +# @date Mon 26th April 1999 +# @author Gabrielle Allen +# @desc +# Implements a version of the perl5 chomp function, +# returning the string passed in with the last character +# removed unless it is a newline +# @enddesc +# @calls +# @calledby +# @history +# +# @endhistory +#@@*/ + +sub chompme +{ + local($in) = @_; + + $lastchar = chop($in); + if ($lastchar == "\n") + { + return $_; + } + else + { + return $in; + } +} + + 1; diff --git a/lib/sbin/GridFuncStuff.pl b/lib/sbin/GridFuncStuff.pl index dce01078..a784d3a6 100644 --- a/lib/sbin/GridFuncStuff.pl +++ b/lib/sbin/GridFuncStuff.pl @@ -111,8 +111,10 @@ sub CreateVariableBindings open(OUT, ">$thorn.c") || die "Cannot create $thorn.c"; print OUT "\#include \"cctk_Groups.h\"\n"; + print OUT "\#include \"cctk_FortranWrappers.h\"\n"; # print OUT "#include \"cctk_Flesh.h\"\n"; # print OUT "#include \"StoreVariableData.h\"\n\n"; + print OUT "int CCTKi_BindingsFortranWrapper$thorn(void *GH, void *fpointer);"; print OUT "int CactusBindingsVariables_$thorn"."_Initialise(void)\n{\n"; foreach $block ("PUBLIC", "PROTECTED", "PRIVATE") @@ -124,6 +126,7 @@ sub CreateVariableBindings print OUT "$line\n"; } } + print OUT " CCTK_RegisterFortranWrapper(\"$thorn\", CCTKi_BindingsFortranWrapper$thorn);\n\n"; print OUT " return 0;\n};\n"; close OUT; @@ -131,6 +134,21 @@ sub CreateVariableBindings $filelist .= " $thorn.c"; } + foreach $thorn (split(" ",$interface_database{"THORNS"})) + { + open(OUT, ">$thorn\_FortranWrapper.c") || die "Cannot create $thorn\_FortranWrapper.c"; + + @data = &CreateThornFortranWrapper($thorn); + + foreach $line (@data) + { + print OUT "$line\n"; + } + + close OUT; + $filelist .= " $thorn\_FortranWrapper.c"; + } + open (OUT, ">make.code.defn") || die "Cannot open make.code.defn"; print OUT "SRCS = $filelist\n"; @@ -886,7 +904,7 @@ sub CreateThornArgumentHeaderFile # $print_data = 1; if ($print_data) { - foreach $arg (keys data) + foreach $arg (keys %data) { print "$thorn data: $arg : $data{\"$arg\"}\n"; } @@ -1189,4 +1207,37 @@ sub CreateThornGroupInitialisers } +sub CreateThornFortranWrapper +{ + local($thorn) = @_; + local(@data); + + push(@data, "#define THORN_IS_$thorn"); + push(@data, "#include \"cctk.h\""); + push(@data, "#include \"cctk_Flesh.h\""); + push(@data, "#include \"cctk_Groups.h\""); + push(@data, "#include \"cctk_Comm.h\""); + push(@data, "#include \"cctk_arguments.h\""); + push(@data, ""); + + push(@data, "int CCTKi_BindingsFortranWrapper$thorn(cGH *GH, void *fpointer)"); + push(@data, "{"); + push(@data, " void (*function)(\U$thorn\E_C2F_PROTO);"); + push(@data, ""); + push(@data, " DECLARE_\U$thorn\E_C2F"); + push(@data, " INITIALISE_\U$thorn\E_C2F"); + push(@data, ""); + + push(@data, " function = (void (*)(\U$thorn\E_C2F_PROTO))fpointer;"); + push(@data, ""); + push(@data, " function(PASS_\U$thorn\E_C2F(GH));"); + push(@data, ""); + push(@data, " return 0;"); + push(@data, ""); + + push(@data, "}"); + + return (@data); +} + 1; diff --git a/lib/sbin/NewCreateScheduleBindings.pl b/lib/sbin/NewCreateScheduleBindings.pl index 5d66a7d2..88c8fe4f 100644 --- a/lib/sbin/NewCreateScheduleBindings.pl +++ b/lib/sbin/NewCreateScheduleBindings.pl @@ -22,20 +22,18 @@ # @endhistory # #@@*/ -sub NewCreateScheduleBindings +sub CreateScheduleBindings { - local($bindings_dir, $n_param_database, $n_interface_database, @rest) = @_; - local(%parameter_database); + local($bindings_dir, $n_interface_database, @rest) = @_; local(%interface_database); local(%schedule_database); local($start_dir); local($thorn); local($file_list); - # Extract the parameter,interface, and schedule databases from the arguments. - %parameter_database = @rest[0..2*$n_param_database-1]; - %interface_database = @rest[2*$n_param_database..2*($n_param_database+$n_interface_database)-1]; - %schedule_database = @rest[2*($n_param_database+$n_interface_database)..$#rest]; + # Extract the interface and schedule databases from the arguments. + %interface_database = @rest[0..2*$n_interface_database-1]; + %schedule_database = @rest[2*$n_interface_database..$#rest]; if(! -d $bindings_dir) { diff --git a/lib/sbin/ScheduleParser.pl b/lib/sbin/ScheduleParser.pl index 665dd38b..106111f4 100644 --- a/lib/sbin/ScheduleParser.pl +++ b/lib/sbin/ScheduleParser.pl @@ -39,6 +39,8 @@ sub create_schedule_database # Get the schedule stuff from it @new_schedule_data = &parse_schedule_ccl($thorn, @indata); + + &PrintScheduleStatistics($thorn, @new_schedule_data); # Add the schedule stuff to the master schedule database push (@schedule_data, @new_schedule_data); @@ -155,7 +157,8 @@ sub ParseScheduleBlock local(@comm_groups) = (); local(@trigger_groups) = (); local($keyword) = ""; - local(@current_sched_list); + local(@current_sched_list) = (); + local($where) = ""; #Parse the first line of the schedule block @@ -194,7 +197,7 @@ sub ParseScheduleBlock if($fields[$field] =~ m:^AT$:i) { $field+=2; - if($keyword ne "") + if($where ne "") { print STDERR "Error parsing schedule block line '$data[$line_number]'\n"; print STDERR "Attempt to schedule same block at/in two places.\n"; @@ -215,7 +218,7 @@ sub ParseScheduleBlock elsif($fields[$field] =~ m:^IN$:i) { $field+=2; - if($keyword ne "") + if($where ne "") { print STDERR "Error parsing schedule block line '$data[$line_number]'\n"; print STDERR "Attempt to schedule same block at/in two places.\n"; @@ -308,18 +311,21 @@ sub ParseScheduleBlock push(@while_list, $fields[$field]); } $field++; + $keyword = ""; } elsif(($keyword eq "") && ($field == $#fields) && ($fields[$field] =~ m:\s*\{\s*:)) { # This bit matches a { at the end of a line # I don't like it, but it seems to be already in use 8-( $line_number--; + $keyword = ""; last; } else { print STDERR "Error parsing schedule block line '$data[$line_number]'\n"; $CST_errors++; + $keyword = ""; $field++; } } @@ -452,4 +458,27 @@ sub print_schedule_database } } +#/*@@ +# @routine PrintScheduleStatistics +# @date Sun Sep 19 13:07:08 1999 +# @author Tom Goodale +# @desc +# Prints out statistics about a thorn's schedule.ccl +# @enddesc +# @calls +# @calledby +# @history +# +# @endhistory +# +#@@*/ +sub PrintScheduleStatistics +{ + local($thorn, %schedule_database) = @_; + + print " " . $schedule_database{"\U$thorn\E N_BLOCKS"} . " schedule blocks.\n"; + + return; +} + 1; diff --git a/lib/sbin/interface_parser.pl b/lib/sbin/interface_parser.pl index 0bf4da6f..bccbceb6 100644 --- a/lib/sbin/interface_parser.pl +++ b/lib/sbin/interface_parser.pl @@ -24,7 +24,7 @@ sub create_interface_database # Loop through each thorn's interface file. foreach $thorn (keys %thorns) { - + print " $thorn\n"; # Get the arrangement name for the thorn $thorns{$thorn} =~ m:.*/arrangements/([^/]*)/[^/]*:; $arrangement = $1; @@ -34,6 +34,8 @@ sub create_interface_database # Get the interface data from it @new_interface_data = &parse_interface_ccl($arrangement,$thorn, @indata); + + &PrintInterfaceStatistics($thorn, @new_interface_data); # Add the interface to the master interface database push (@interface_data, @new_interface_data); @@ -750,4 +752,48 @@ sub print_interface_database } } +#/*@@ +# @routine PrintInterfaceStatistics +# @date Sun Sep 19 13:03:23 1999 +# @author Tom Goodale +# @desc +# Prints out some statistics about a thorn's interface.ccl +# @enddesc +# @calls +# @calledby +# @history +# +# @endhistory +# +#@@*/ +sub PrintInterfaceStatistics +{ + local($thorn, %interface_database) = @_; + local($block); + local($sep); + + print " Implements: " . $interface_database{"\U$thorn IMPLEMENTS"} . "\n"; + + if($interface_database{"\U$thorn INHERITS"} ne "") + { + print " Inherits: " . $interface_database{"\U$thorn INHERITS"} . ""; + } + + if($interface_database{"\U$thorn FRIEND"} ne "") + { + print " Friend of: " . $interface_database{"\U$thorn FRIEND"} . ""; + } + + $sep = " "; + foreach $block ("Public", "Protected", "Private") + { + print $sep . scalar(split(" ", $interface_database{"\U$thorn $block\E GROUPS"})) . " $block"; + $sep = ", "; + } + + print " variable groups\n"; + + return; +} + 1; diff --git a/lib/sbin/parameter_parser.pl b/lib/sbin/parameter_parser.pl index a288fda7..12996a36 100644 --- a/lib/sbin/parameter_parser.pl +++ b/lib/sbin/parameter_parser.pl @@ -30,12 +30,15 @@ sub create_parameter_database # Loop through each implementation's parameter file. foreach $thorn (keys %thorns) { + print " $thorn\n"; # Read the data @indata = &read_file("$thorns{$thorn}/param.ccl"); # Get the parameters from it @new_parameter_data = &parse_param_ccl($thorn, @indata); - + + &PrintParameterStatistics($thorn, @new_parameter_data); + # Add the parameters to the master parameter database push (@parameter_data, @new_parameter_data); @@ -84,97 +87,6 @@ sub cross_index_parameters - -#/*@@ -# @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 -# @hdate Fri Sep 10 10:25:47 1999 @hauthor Tom Goodale -# @hdesc Allows a \ to escape the end of a line. -# @endhistory -#@@*/ - -sub read_file -{ - local($file) = @_; - local(@indata); - local($line); - - open(IN, "<$file") || die("Can't open $file\n"); - - $line = ""; - - while(<IN>) - { - $_ =~ s/\#.*//; - - next if(m/^\s+$/); - - &chompme($_); - - # Add to the currently processed line. - $line .= $_; - - # Check the line for line-continuation - if(m:[^\\]\\$:) - { - $line =~ s:\\$::; - } - else - { - push(@indata, $line); - $line = ""; - } - } - - # Make sure to dump out the last line, even if it ends in a \ - if($line ne "") - { - push(@indata, $line); - } - close IN; - - return @indata; -} - - -#/*@@ -# @routine chompme -# @date Mon 26th April 1999 -# @author Gabrielle Allen -# @desc -# Implements a version of the perl5 chomp function, -# returning the string passed in with the last character -# removed unless it is a newline -# @enddesc -# @calls -# @calledby -# @history -# -# @endhistory -#@@*/ - -sub chompme -{ - local($in) = @_; - - $lastchar = chop($in); - if ($lastchar == "\n") - { - return $_; - } - else - { - return $in; - } -} - #/*@@ # @routine parse_param_ccl # @date Wed Sep 16 11:55:33 1998 @@ -387,6 +299,38 @@ sub print_parameter_database } +#/*@@ +# @routine PrintParameterStatistics +# @date Sun Sep 19 13:04:18 1999 +# @author Tom Goodale +# @desc +# Prints out some statistics about a thorn's param.ccl +# @enddesc +# @calls +# @calledby +# @history +# +# @endhistory +# +#@@*/ +sub PrintParameterStatistics +{ + local($thorn, %parameter_database) = @_; + local($block); + local($sep); + + $sep = " "; + foreach $block ("Global", "Restricted", "Private") + { + print $sep . scalar(split(" ", $parameter_database{"\U$thorn $block\E variables"})) . " $block"; + $sep = ", "; + } + + print " parameters\n"; + + return; +} + 1; |