diff options
| -rw-r--r-- | lib/sbin/BuildHeaders.pl | 8 | ||||
| -rw-r--r-- | lib/sbin/CST | 63 | ||||
| -rw-r--r-- | lib/sbin/CSTUtils.pl | 20 | ||||
| -rw-r--r-- | lib/sbin/CreateImplementationBindings.pl | 29 | ||||
| -rw-r--r-- | lib/sbin/CreateParameterBindings.pl | 250 | ||||
| -rw-r--r-- | lib/sbin/CreateScheduleBindings.pl | 263 | ||||
| -rw-r--r-- | lib/sbin/GridFuncStuff.pl | 158 | ||||
| -rw-r--r-- | lib/sbin/ImpParamConsistency.pl | 12 | ||||
| -rw-r--r-- | lib/sbin/MakeUtils.pl | 16 | ||||
| -rw-r--r-- | lib/sbin/Orderer.pl | 36 | ||||
| -rw-r--r-- | lib/sbin/ParamLatex.pl | 4 | ||||
| -rw-r--r-- | lib/sbin/Runtest.pl | 8 | ||||
| -rw-r--r-- | lib/sbin/ScheduleParser.pl | 60 | ||||
| -rw-r--r-- | lib/sbin/checkout.pl | 10 | ||||
| -rw-r--r-- | lib/sbin/create_c_stuff.pl | 176 | ||||
| -rw-r--r-- | lib/sbin/create_fortran_stuff.pl | 80 | ||||
| -rw-r--r-- | lib/sbin/f_file_processor.pl | 4 | ||||
| -rw-r--r-- | lib/sbin/interface_parser.pl | 106 | ||||
| -rw-r--r-- | lib/sbin/output_config.pl | 6 | ||||
| -rw-r--r-- | lib/sbin/parameter_parser.pl | 44 |
20 files changed, 548 insertions, 805 deletions
diff --git a/lib/sbin/BuildHeaders.pl b/lib/sbin/BuildHeaders.pl index 9dbd6e58..75d6a3b4 100644 --- a/lib/sbin/BuildHeaders.pl +++ b/lib/sbin/BuildHeaders.pl @@ -18,8 +18,8 @@ require "$sbin_dir/CSTUtils.pl"; sub BuildHeaders { - local($cctk_home,$bindings_dir,%database) = @_; - local($start_dir,$thorn,$inc_file,$inc_file1,$inc_file2); + my($cctk_home,$bindings_dir,%database) = @_; + my($start_dir,$thorn,$inc_file,$inc_file1,$inc_file2); $start_dir = `pwd`; chdir $bindings_dir; @@ -34,7 +34,7 @@ sub BuildHeaders } } -# Add the local headers from thorns +# Add the my headers from thorns foreach $thorn (split(" ",$interface_database{"THORNS"})) { @@ -85,7 +85,7 @@ sub BuildHeaders { foreach $inc_file1 (split(" ",$interface_database{"\U$thorn USES HEADER"})) { - &WriteFile($inc_file1,$data{"$inc_file1"}); + &WriteFile($inc_file1,\$data{"$inc_file1"}); } } diff --git a/lib/sbin/CST b/lib/sbin/CST index 2991b314..863297cf 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.31 1999-10-24 11:45:00 allen Exp $ +# @version $Header: /mnt/data2/cvs2svn/cvs-repositories/Cactus/lib/sbin/CST,v 1.32 1999-10-24 22:55:48 goodale Exp $ #@@*/ # Global parameter to track the number of errors from the CST @@ -68,7 +68,6 @@ require "$sbin_dir/create_c_stuff.pl"; require "$sbin_dir/create_fortran_stuff.pl"; require "$sbin_dir/GridFuncStuff.pl"; require "$sbin_dir/output_config.pl"; -require "$sbin_dir/Orderer.pl"; require "$sbin_dir/ImpParamConsistency.pl"; require "$sbin_dir/CSTUtils.pl"; require "$sbin_dir/CreateParameterBindings.pl"; @@ -126,8 +125,7 @@ if($debug_schedule) # Create all the bindings print "Creating Thorn-Flesh bindings...\n"; -&CreateBindings($bindings_dir, scalar(keys %parameter_database), scalar(keys %interface_database), - %parameter_database, %interface_database, %schedule_database); +&CreateBindings($bindings_dir, \%parameter_database, \%interface_database, \%schedule_database); # Create header file of active thorns for the code @activethornsheader = &CreateActiveThornsHeader(%thorns); @@ -196,9 +194,9 @@ exit; sub CreateThornList { - local($cctk_home, $activethorns) = @_; - local(%thornlist); - local($thorn, $package, $thorn_name); + my($cctk_home, $activethorns) = @_; + my(%thornlist); + my($thorn, $package, $thorn_name); open(ACTIVE, "<$activethorns") || die "Cannot open ActiveThorns file $activethorns !"; @@ -281,9 +279,9 @@ sub CreateThornList sub get_global_parameters { - local(%parameter_database) = @_; - local(%global_parameters); - local($param); + my(%parameter_database) = @_; + my(%global_parameters); + my($param); foreach $param (split(/ /,$parameter_database{"GLOBAL PARAMETERS"})) { @@ -315,9 +313,9 @@ sub get_global_parameters sub CreateMakeThornlist { - local(%thorns) = @_; - local($thorn); - local($thornlist); + my(%thorns) = @_; + my($thorn); + my($thornlist); $thornlist = "THORNS ="; foreach $thorn (keys %thorns) @@ -351,8 +349,8 @@ sub CreateMakeThornlist sub CreateActiveThornsHeader { - local(%thorns) = @_; - local($header,$thorn,$nthorns); + my(%thorns) = @_; + my($header,$thorn,$nthorns); $nthorns = 0; @@ -396,8 +394,8 @@ sub CreateActiveThornsHeader sub CreateDefineThornsHeader { - local(%thorns) = @_; - local($header,$thorn,$nthorns); + my(%thorns) = @_; + my($header,$thorn,$nthorns); $nthorns = 0; @@ -437,8 +435,8 @@ sub CreateDefineThornsHeader sub CreateDefineThisThornHeader { - local(%thorns) = @_; - local($header,$thorn,$nthorns); + my(%thorns) = @_; + my($header,$thorn,$nthorns); $nthorns = 0; @@ -479,20 +477,8 @@ sub CreateDefineThisThornHeader sub CreateBindings { - 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]; + my($bindings_dir, $rhparameter_db, $rhinterface_db, $rhschedule_db) = @_; + my($start_dir); # Create the bindings directory if it doesn't exist. if(! -d $bindings_dir) @@ -505,21 +491,20 @@ sub CreateBindings # Create the bindings for the subsystems. print " Creating implementation bindings...\n"; - &CreateImplementationBindings($bindings_dir, $n_param_database, %parameter_database, %interface_database); + &CreateImplementationBindings($bindings_dir, $rhparameter_db, $rhinterface_db); print " Creating parameter bindings...\n"; - &CreateParameterBindings($bindings_dir, $n_param_database, %parameter_database, %interface_database); + &CreateParameterBindings($bindings_dir, $rhparameter_db, $rhinterface_db); print " Creating variable bindings...\n"; - &CreateVariableBindings($bindings_dir, %interface_database); + &CreateVariableBindings($bindings_dir, $rhinterface_db); print " Creating schedule bindings...\n"; - &CreateScheduleBindings($bindings_dir, scalar(keys %interface_database), - %interface_database, %schedule_database); + &CreateScheduleBindings($bindings_dir, $rhinterface_db, $rhschedule_db); # Place an appropriate make.code.defn in the bindings directory. chdir $bindings_dir; $dataout = "SRCS = \n"; $dataout .= "SUBDIRS = Implementations Parameters Variables Schedule\n"; - &WriteFile("make.code.defn",$dataout); + &WriteFile("make.code.defn",\$dataout); # Go back to where we started. chdir $start_dir; diff --git a/lib/sbin/CSTUtils.pl b/lib/sbin/CSTUtils.pl index 3c79d096..ea83787f 100644 --- a/lib/sbin/CSTUtils.pl +++ b/lib/sbin/CSTUtils.pl @@ -11,7 +11,7 @@ sub CST_error { - local($level,$mess,$line,$file) = @_; + my($level,$mess,$line,$file) = @_; if ($full_warnings) { @@ -61,9 +61,9 @@ sub CST_error sub read_file { - local($file) = @_; - local(@indata); - local($line); + my($file) = @_; + my(@indata); + my($line); open(IN, "<$file") || die("Can't open $file\n"); @@ -121,10 +121,10 @@ sub read_file sub chompme { - local($in) = @_; + my($in) = @_; $lastchar = chop($in); - if ($lastchar == "\n") + if ($lastchar eq "\n") { return $_; } @@ -150,8 +150,8 @@ sub chompme sub WriteFile { - local ($filename,$data) = @_; - local ($data_in); + my ($filename,$rdata) = @_; + my ($data_in); # Read in file $data_in = ""; @@ -164,11 +164,11 @@ sub WriteFile } } - if ($data ne $data_in) + if ($$rdata ne $data_in) { # print "Creating new file $filename\n"; open(OUT, ">$filename") || die("Can't open $filename\n"); - print OUT $data; + print OUT $$rdata; close OUT; } diff --git a/lib/sbin/CreateImplementationBindings.pl b/lib/sbin/CreateImplementationBindings.pl index 91017d4a..529de247 100644 --- a/lib/sbin/CreateImplementationBindings.pl +++ b/lib/sbin/CreateImplementationBindings.pl @@ -9,15 +9,10 @@ sub CreateImplementationBindings { - local($bindings_dir, $n_param_database, @rest) = @_; - local(%parameter_database); - local(%interface_database); - local($start_dir); - local($thorn); - local(@data); - - %parameter_database = @rest[0..(2*$n_param_database)-1]; - %interface_database = @rest[2*$n_param_database..$#rest]; + my($bindings_dir, $rhparameter_db, $rhinterface_db) = @_; + my($start_dir); + my($thorn); + my(@data); if(! -d $bindings_dir) { @@ -48,10 +43,10 @@ sub CreateImplementationBindings push(@data, "int CCTKi_BindingsImplementationsInitialise(void)\n{\n"); - foreach $thorn (sort split(" ", $interface_database{"THORNS"})) + foreach $thorn (sort split(" ", $rhinterface_db->{"THORNS"})) { push(@data, " CCTKi_RegisterThorn(\"$thorn\",\"" . - $interface_database{"\U$thorn\E IMPLEMENTS"} ."\");\n"); + $rhinterface_db->{"\U$thorn\E IMPLEMENTS"} ."\");\n"); } push(@data, "\n return 0;\n}\n"); @@ -59,16 +54,12 @@ sub CreateImplementationBindings &OutputFile(".", "ImplementationBindings.c", @data); -# open (OUT, ">make.code.defn"); -# print OUT <<EOF; -$dataout = ""; -$dataout .= "\n"; -$dataout .= "SRCS = ImplementationBindings.c\n\n"; + $dataout = ""; + $dataout .= "\n"; + $dataout .= "SRCS = ImplementationBindings.c\n\n"; - &WriteFile("make.code.defn",$dataout); -#EOF + &WriteFile("make.code.defn",\$dataout); -# close OUT; chdir $_start_dir; } diff --git a/lib/sbin/CreateParameterBindings.pl b/lib/sbin/CreateParameterBindings.pl index a2646107..b2d4ce13 100644 --- a/lib/sbin/CreateParameterBindings.pl +++ b/lib/sbin/CreateParameterBindings.pl @@ -25,20 +25,16 @@ sub CreateParameterBindings { - local($bindings_dir, $n_param_database, @rest) = @_; - local(%parameter_database); - local(%interface_database); - local($start_dir); - local($line); - local(%these_parameters); - local($implementation, $thorn); - local($files); - local(%routines); - local($structure, %structures); - local(%header_files); - - %parameter_database = @rest[0..(2*$n_param_database)-1]; - %interface_database = @rest[2*$n_param_database..$#rest]; + my($bindings_dir, $rhparameter_db, $rhinterface_db) = @_; + my($start_dir); + my($line); + my(%these_parameters); + my($implementation, $thorn); + my($files); + my(%routines); + my($structure, %structures); + my(%header_files); + if(! -d $bindings_dir) { @@ -62,16 +58,16 @@ sub CreateParameterBindings # Generate all global parameters - %these_parameters = &get_global_parameters(%parameter_database); + %these_parameters = &get_global_parameters($rhparameter_db); - @data = &CreateParameterBindingFile("CCTK_BindingsParametersGlobal", "GLOBAL_PARAMETER_STRUCT", scalar(keys %these_parameters), %these_parameters, %parameter_database); + @data = &CreateParameterBindingFile("CCTK_BindingsParametersGlobal", "GLOBAL_PARAMETER_STRUCT", \%these_parameters, $rhparameter_db); $dataout = ""; foreach $line (@data) { $dataout .= "$line\n"; } - &WriteFile("Global.c",$dataout); + &WriteFile("Global.c",\$dataout); $files = "Global.c"; $structures{"GLOBAL_PARAMETER_STRUCT"} = "cctk_params_global"; @@ -81,14 +77,14 @@ sub CreateParameterBindings chdir ".."; chdir "include"; - @data = &CreateCStructureParameterHeader("CCTK_BindingsParametersGlobal", "GLOBAL_PARAMETER_STRUCT", scalar(keys %these_parameters), %these_parameters, %parameter_database); + @data = &CreateCStructureParameterHeader("CCTK_BindingsParametersGlobal", "GLOBAL_PARAMETER_STRUCT", \%these_parameters, $rhparameter_db); $dataout = ""; foreach $line (@data) { $dataout .= "$line\n"; } - &WriteFile("ParameterCGlobal.h",$dataout); + &WriteFile("ParameterCGlobal.h",\$dataout); $header_files{"GLOBAL"} = "ParameterCGlobal.h"; @@ -96,24 +92,24 @@ sub CreateParameterBindings chdir "Parameters"; # Generate all restricted parameters - foreach $implementation (split(" ",$interface_database{"IMPLEMENTATIONS"})) + foreach $implementation (split(" ",$rhinterface_db->{"IMPLEMENTATIONS"})) { - $interface_database{"IMPLEMENTATION \U$implementation\E THORNS"} =~ m:([^ ]+):; + $rhinterface_db->{"IMPLEMENTATION \U$implementation\E THORNS"} =~ m:([^ ]+):; $thorn = $1; - %these_parameters = &GetThornParameterList($thorn, "RESTRICTED", %parameter_database); + %these_parameters = &GetThornParameterList($thorn, "RESTRICTED", $rhparameter_db); if((keys %these_parameters > 0)) { - @data = &CreateParameterBindingFile("CCTK_BindingsParameters$implementation"."_restricted", "RESTRICTED_\U$implementation\E_STRUCT", scalar(keys %these_parameters), %these_parameters, %parameter_database); + @data = &CreateParameterBindingFile("CCTK_BindingsParameters$implementation"."_restricted", "RESTRICTED_\U$implementation\E_STRUCT", \%these_parameters, $rhparameter_db); $dataout = ""; foreach $line (@data) { $dataout .= "$line\n"; } - &WriteFile("\U$implementation\E". "_restricted.c",$dataout); + &WriteFile("\U$implementation\E". "_restricted.c",\$dataout); $files .= " \U$implementation\E". "_restricted.c"; @@ -125,7 +121,7 @@ sub CreateParameterBindings chdir ".."; chdir "include"; - @data = &CreateCStructureParameterHeader("CCTK_BindingsParameters$implementation"."_restricted", "RESTRICTED_\U$implementation\E_STRUCT", scalar(keys %these_parameters), %these_parameters, %parameter_database); + @data = &CreateCStructureParameterHeader("CCTK_BindingsParameters$implementation"."_restricted", "RESTRICTED_\U$implementation\E_STRUCT", \%these_parameters, $rhparameter_db); $dataout = ""; @@ -133,7 +129,7 @@ sub CreateParameterBindings { $dataout .= "$line\n"; } - &WriteFile("ParameterCRestricted\U$implementation\E".".h",$dataout); + &WriteFile("ParameterCRestricted\U$implementation\E".".h",\$dataout); $header_files{"\U$implementation\E RESTRICTED"} = "ParameterCRestricted\U$implementation\E".".h"; @@ -144,13 +140,13 @@ sub CreateParameterBindings } # Generate all private parameters - foreach $thorn (split(" ",$interface_database{"THORNS"})) + foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) { - %these_parameters = &GetThornParameterList($thorn, "PRIVATE", %parameter_database); + %these_parameters = &GetThornParameterList($thorn, "PRIVATE", $rhparameter_db); if((keys %these_parameters > 0)) { - @data = &CreateParameterBindingFile("CCTK_BindingsParameters$thorn"."_private", "PRIVATE_\U$thorn\E_STRUCT", scalar(keys %these_parameters), %these_parameters, %parameter_database); + @data = &CreateParameterBindingFile("CCTK_BindingsParameters$thorn"."_private", "PRIVATE_\U$thorn\E_STRUCT", \%these_parameters, $rhparameter_db); $dataout = ""; @@ -158,7 +154,7 @@ sub CreateParameterBindings { $dataout .= "$line\n"; } - &WriteFile("\U$thorn\E"."_private.c",$dataout); + &WriteFile("\U$thorn\E"."_private.c",\$dataout); $files .= " \U$thorn\E". "_private.c"; @@ -169,7 +165,7 @@ sub CreateParameterBindings chdir ".."; chdir "include"; - @data = &CreateCStructureParameterHeader("CCTK_BindingsParameters$thorn"."_private", "PRIVATE_\U$thorn\E_STRUCT", scalar(keys %these_parameters), %these_parameters, %parameter_database); + @data = &CreateCStructureParameterHeader("CCTK_BindingsParameters$thorn"."_private", "PRIVATE_\U$thorn\E_STRUCT", \%these_parameters, $rhparameter_db); $structures{"PRIVATE_\U$thorn\E_STRUCT"} = "$thorn"."priv"; @@ -179,7 +175,7 @@ sub CreateParameterBindings { $dataout .= "$line\n"; } - &WriteFile("ParameterCPrivate\U$thorn\E".".h",$dataout); + &WriteFile("ParameterCPrivate\U$thorn\E".".h",\$dataout); $header_files{"\U$thorn\E PRIVATE"} = "ParameterCPrivate\U$thorn\E".".h"; @@ -202,18 +198,17 @@ sub CreateParameterBindings foreach $routine ((keys %routines), "CCTK_BindingsParametersGlobal") { $dataout .= "int $routine"."Initialise(void);\n"; - $dataout .= "int $routine"."Help(const char *param, const char *format, FILE *file);\n"; } $dataout .= "int CCTKi_BindingsParametersInitialise(void)\n"; $dataout .= "\{\n\n"; - foreach $thorn (split(" ",$interface_database{"THORNS"})) + foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) { $dataout .= " CCTKi_BindingsCreate$thorn"."Parameters();\n\n"; } - foreach $thorn (split(" ",$interface_database{"THORNS"})) + foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) { $dataout .= " CCTKi_Bindings$thorn"."ParameterExtensions();\n\n"; } @@ -221,89 +216,33 @@ sub CreateParameterBindings $dataout .= "return 0;\n"; $dataout .= "}\n\n"; - $dataout .= "int CCTKi_BindingsParameterHelp(const char *identifier, const char *format, FILE *file)\n"; - $dataout .= "{\n"; - $dataout .=" int retval = 1;\n"; - $dataout .=" int temp_retval;\n"; - $dataout .=" char *implementation = NULL;\n"; - $dataout .=" char *param_name = NULL;\n\n"; + &WriteFile("BindingsParameters.c",\$dataout); - $dataout .=" if(! identifier )\n"; - $dataout .=" {\n"; - $dataout .=" retval = CCTK_BindingsParametersGlobalHelp(identifier, format, file);\n\n"; - - foreach $routine (keys %routines, "CCTK_BindingsParametersGlobal") - { - - $dataout .= " temp_retval = $routine"."Help(param_name, format, file);"; - - $dataout .= "\n"; - $dataout .=" if(!temp_retval)\n"; - $dataout .=" {\n"; - $dataout .=" retval = 0;\n"; - $dataout .=" }\n"; - } - - $dataout .=" }\n\n"; - - $dataout .=" Util_SplitString(\&implementation, ¶m_name, identifier, \"::\");\n\n"; - - $dataout .=" if(!implementation)\n"; - $dataout .=" {\n"; - $dataout .=" retval = CCTK_BindingsParametersGlobalHelp(identifier, format, file);\n"; - $dataout .=" }\n"; - $dataout .=" else\n"; - $dataout .=" { \n"; - - foreach $routine (keys %routines, "CCTK_BindingsParametersGlobal") - { - $dataout .= "\n"; - $dataout .=" if(CCTK_Equals(implementation, \"$routines{$routine}\"))\n"; - $dataout .=" {\n"; - $dataout .= " temp_retval = $routine"."Help(param_name, format, file);"; - - $dataout .= "\n"; - $dataout .=" if(!temp_retval) \n"; - $dataout .=" {\n"; - $dataout .=" retval = 0;\n"; - $dataout .=" }\n"; - $dataout .=" }\n"; - } - - $dataout .=" }\n"; - $dataout .="\n"; - $dataout .=" free(implementation);\n"; - $dataout .=" free(param_name);\n"; - $dataout .=" return retval;\n"; - $dataout .="}\n\n"; - - &WriteFile("BindingsParameters.c",$dataout); - - $newfilelist = NewParamStuff($n_param_database, @rest); + $newfilelist = NewParamStuff($rhparameter_db, $rhinterface_db); $dataout = ""; $dataout .= "SRCS = BindingsParameters.c $files $newfilelist\n"; - &WriteFile("make.code.defn",$dataout); + &WriteFile("make.code.defn",\$dataout); # Create the appropriate thorn parameter headers chdir ".."; chdir "include"; - foreach $thorn (split(" ",$interface_database{"THORNS"})) + foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) { - @data = &CreateFortranThornParameterBindings($thorn, $n_param_database, @rest); + @data = &CreateFortranThornParameterBindings($thorn, $rhparameter_db, $rhinterface_db); $dataout = ""; foreach $line (@data) { $dataout .= "$line\n"; } - &WriteFile("\U$thorn\E"."_FParameters.h",$dataout); + &WriteFile("\U$thorn\E"."_FParameters.h",\$dataout); $dataout = ""; - $implementation = $interface_database{"\U$thorn\E IMPLEMENTS"}; + $implementation = $rhinterface_db->{"\U$thorn\E IMPLEMENTS"}; $dataout .= "\#ifndef _\U$thorn\E_PARAMETERS_H_\n\n"; $dataout .= "\#define _\U$thorn\E_PARAMETERS_H_\n\n"; @@ -325,19 +264,19 @@ sub CreateParameterBindings $dataout .= "\n"; @data = (); - foreach $friend (split(" ",$parameter_database{"\U$thorn\E SHARES implementations"})) + foreach $friend (split(" ",$rhparameter_db->{"\U$thorn\E SHARES implementations"})) { - $friend_implementation = $interface_database{"\U$friend\E IMPLEMENTS"}; + $friend_implementation = $rhinterface_db->{"\U$friend\E IMPLEMENTS"}; $dataout .= "#include \"ParameterCRestricted\U$friend\E.h\"\n"; - $interface_database{"IMPLEMENTATION \U$friend\E THORNS"} =~ m:([^ ]*):; + $rhinterface_db->{"IMPLEMENTATION \U$friend\E THORNS"} =~ m:([^ ]*):; $friend_thorn = $1; - foreach $parameter (split(" ",$parameter_database{"\U$thorn SHARES $friend\E variables"})) + foreach $parameter (split(" ",$rhparameter_db->{"\U$thorn SHARES $friend\E variables"})) { - $type = $parameter_database{"\U$friend_thorn $parameter\E type"}; + $type = $rhparameter_db->{"\U$friend_thorn $parameter\E type"}; $type_string = &get_c_type_string($type); @@ -375,7 +314,7 @@ sub CreateParameterBindings $dataout .= "\n"; $dataout .= "#endif\n"; - &WriteFile("\U$thorn\E"."_CParameters.h",$dataout); + &WriteFile("\U$thorn\E"."_CParameters.h",\$dataout); } @@ -401,27 +340,27 @@ sub CreateParameterBindings } close IN; - &WriteFile("CParameterStructNames.h",$dataout); + &WriteFile("CParameterStructNames.h",\$dataout); $dataout = ""; $dataout .= "#include \"CParameterStructNames.h\"\n\n"; - foreach $thorn (split(" ",$interface_database{"THORNS"})) + foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) { $dataout .= "\#ifdef THORN\_IS\_$thorn\n"; $dataout .= "\#include \"\U$thorn\E"."\_CParameters.h\"\n"; $dataout .= "\#endif\n\n"; } - &WriteFile("CParameters.h",$dataout); + &WriteFile("CParameters.h",\$dataout); $dataout = ""; - foreach $thorn (split(" ",$interface_database{"THORNS"})) + foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) { $dataout .= "\#ifdef THORN_IS\_$thorn\n"; $dataout .= "\#include \"\U$thorn\E"."\_FParameters.h\"\n"; $dataout .= "\#endif\n\n"; } - &WriteFile("FParameters.h",$dataout); + &WriteFile("FParameters.h",\$dataout); $dataout = ""; $dataout .= "#ifdef CCODE\n"; @@ -430,7 +369,7 @@ sub CreateParameterBindings $dataout .= "#ifdef FCODE\n"; $dataout .= "#include \"FParameters.h\"\n"; $dataout .= "#endif\n\n"; - &WriteFile("cctk_parameters.h",$dataout); + &WriteFile("cctk_parameters.h",\$dataout); chdir $start_dir; @@ -440,29 +379,23 @@ sub CreateParameterBindings sub NewParamStuff { - local($n_param_database, @rest) = @_; - local(%parameter_database); - local(%interface_database); - local($line); - local(%these_parameters); - local($implementation, $thorn); - local($files); - local(%routines); - local($structure, %structures); - local(%header_files); - local($thorn, $block); - local($filelist); - local(@creationdata); - local(@extensiondata); - local(@data); - - %parameter_database = @rest[0..(2*$n_param_database)-1]; - %interface_database = @rest[2*$n_param_database..$#rest]; - - - foreach $thorn (split(" ",$interface_database{"THORNS"})) + my($rhparameter_db, $rhinterface_db) = @_; + my($line); + my(%these_parameters); + my($implementation, $thorn); + my($files); + my(%routines); + my($structure, %structures); + my(%header_files); + my($thorn, $block); + my($filelist); + my(@creationdata); + my(@extensiondata); + my(@data); + + foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) { - $imp = $interface_database{"\U$thorn\E IMPLEMENTS"}; + $imp = $rhinterface_db->{"\U$thorn\E IMPLEMENTS"}; push(@data, "#include <stdarg.h>"); push(@data, ""); @@ -473,7 +406,7 @@ sub NewParamStuff foreach $block ("GLOBAL", "RESTRICTED", "PRIVATE") { - %these_parameters = &GetThornParameterList($thorn, $block, %parameter_database); + %these_parameters = &GetThornParameterList($thorn, $block, $rhparameter_db); if((keys %these_parameters > 0)) { @@ -495,21 +428,21 @@ sub NewParamStuff } # print "Generating $block parameters for $thorn, providing $imp\n"; - push(@creationdata,&CreateParameterRegistrationStuff($block, $thorn, $imp, scalar(keys %these_parameters), %these_parameters, %parameter_database)); + push(@creationdata,&CreateParameterRegistrationStuff($block, $thorn, $imp, $rhparameter_db, %these_parameters)); } } # Now the parameter extensions -# print $parameter_database{"\U$thorn\E SHARES implementations"} . "\n"; +# print $rhparameter_db->{"\U$thorn\E SHARES implementations"} . "\n"; - foreach $block (split(" ",$parameter_database{"\U$thorn\E SHARES implementations"})) + foreach $block (split(" ",$rhparameter_db->{"\U$thorn\E SHARES implementations"})) { push(@data, "#include \"ParameterCRestricted\U$block\E.h\""); # print "Generating $block extension from $thorn\n"; - push(@extensiondata,&CreateParameterExtensionStuff($block, $thorn, %parameter_database)); + push(@extensiondata,&CreateParameterExtensionStuff($block, $thorn, $rhparameter_db)); } @@ -534,7 +467,7 @@ sub NewParamStuff { $dataout .= "$line\n"; } - &WriteFile("Create$thorn"."Parameters.c",$dataout); + &WriteFile("Create$thorn"."Parameters.c",\$dataout); @data=(); @creationdata=(); @@ -548,15 +481,10 @@ sub NewParamStuff sub CreateParameterRegistrationStuff { - local($block, $thorn, $imp, $n_params, @rest) = @_; - local(%these_parameters); - local(%parameter_database); - local(@data); - local($line); - local($structure, $type, $n_ranges); - - %these_parameters = @rest[0..(2*$n_params)-1]; - %parameter_database = @rest[2*$n_params..$#rest]; + my($block, $thorn, $imp, $rhparameter_db, %these_parameters) = @_; + my(@data); + my($line); + my($structure, $type, $n_ranges); if($block eq "GLOBAL") { @@ -583,15 +511,15 @@ sub CreateParameterRegistrationStuff # print "This param is $parameter\n"; - $type = $parameter_database{"\U$thorn $parameter\E type"}; + $type = $rhparameter_db->{"\U$thorn $parameter\E type"}; # print "Type is $type\n"; - $n_ranges = $parameter_database{"\U$thorn $parameter\E ranges"}; + $n_ranges = $rhparameter_db->{"\U$thorn $parameter\E ranges"}; # print "N_ranges is $n_ranges\n"; - $quoted_default = $parameter_database{"\U$thorn $parameter\E default"}; + $quoted_default = $rhparameter_db->{"\U$thorn $parameter\E default"}; # $quoted_default =~ s:\"::g; The database now strips all unescaped quotes. @@ -600,15 +528,15 @@ sub CreateParameterRegistrationStuff " \"$type\" /* The parameter type */,\n". " \"$block\", /* The scoping block */\n". " 0, /* Is it steerable ? */\n". - " " . $parameter_database{"\U$thorn $parameter\E description"} . ", /* The description */\n" . + " " . $rhparameter_db->{"\U$thorn $parameter\E description"} . ", /* The description */\n" . " \"" . $quoted_default . "\", /* The default value */\n" . " &($structure.$parameter), /* The actual data pointer */\n". " $n_ranges /* How many allowed ranges it has */"; for($range=1; $range <= $n_ranges; $range++) { - $quoted_range = $parameter_database{"\U$thorn $parameter\E range $range range"}; - $range_description = $parameter_database{"\U$thorn $parameter\E range $range description"}; + $quoted_range = $rhparameter_db->{"\U$thorn $parameter\E range $range range"}; + $range_description = $rhparameter_db{"\U$thorn $parameter\E range $range description"}; if($range_description !~ m:\":) { @@ -637,21 +565,21 @@ sub CreateParameterRegistrationStuff sub CreateParameterExtensionStuff { - local($block, $thorn, %parameter_database) = @_; - local(@data); - local($line); - local($structure, $type, $n_ranges, $range, $quoted_range, $range_description); + my($block, $thorn, $rhparameter_db) = @_; + my(@data); + my($line); + my($structure, $type, $n_ranges, $range, $quoted_range, $range_description); # print "Extending $block from $thorn\n"; - foreach $parameter (split(" ",$parameter_database{"\U$thorn\E SHARES \U$block\E variables"})) + foreach $parameter (split(" ",$rhparameter_db->{"\U$thorn\E SHARES \U$block\E variables"})) { - $n_ranges = $parameter_database{"\U$thorn $parameter\E ranges"}; + $n_ranges = $rhparameter_db->{"\U$thorn $parameter\E ranges"}; for($range=1; $range <= $n_ranges; $range++) { - $quoted_range = $parameter_database{"\U$thorn $parameter\E range $range range"}; - $range_description = $parameter_database{"\U$thorn $parameter\E range $range description"}; + $quoted_range = $rhparameter_db->{"\U$thorn $parameter\E range $range range"}; + $range_description = $rhparameter_db->{"\U$thorn $parameter\E range $range description"}; if($range_description !~ m:\":) { diff --git a/lib/sbin/CreateScheduleBindings.pl b/lib/sbin/CreateScheduleBindings.pl index bb477f3b..da3f7f8f 100644 --- a/lib/sbin/CreateScheduleBindings.pl +++ b/lib/sbin/CreateScheduleBindings.pl @@ -24,17 +24,12 @@ #@@*/ sub CreateScheduleBindings { - local($bindings_dir, $n_interface_database, @rest) = @_; - local(%interface_database); - local(%schedule_database); - local($start_dir); - local($thorn); - local($file_list); - - # 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]; - + my($bindings_dir, $rhinterface_db, $rhschedule_db) = @_; + my($start_dir); + my($thorn); + my($file_list); + my($rsbuffer); + if(! -d $bindings_dir) { mkdir("$bindings_dir", 0755) || die "Unable to create $bindings_dir"; @@ -57,37 +52,24 @@ sub CreateScheduleBindings $file_list = ""; - foreach $thorn (sort split(" ", $interface_database{"THORNS"})) + foreach $thorn (sort split(" ", $rhinterface_db->{"THORNS"})) { - $buffer = &ScheduleCreateFile($thorn, scalar(keys %interface_database), - %interface_database, %schedule_database); - -# open(OUT, ">Schedule$thorn.c") || die "Unable to open Schedule$thorn.c"; - - &WriteFile("Schedule$thorn.c",$buffer); + $rsbuffer = &ScheduleCreateFile($thorn, $rhinterface_db, $rhschedule_db); -# close OUT; + &WriteFile("Schedule$thorn.c",$rsbuffer); $file_list .= " Schedule$thorn.c"; } - $buffer = ScheduleCreateBindings(scalar(keys %interface_database), - %interface_database, %schedule_database); + $rsbuffer = &ScheduleCreateBindings($rhinterface_db, $rhschedule_db); - -# open(OUT, ">BindingsSchedule.c") || die "Unable to open BindingsSchedule.c"; - - &WriteFile("BindingsSchedule.c",$buffer); - -# close OUT; + &WriteFile("BindingsSchedule.c",$rsbuffer); $file_list .= " BindingsSchedule.c"; -# open(OUT, ">make.code.defn") || die "Unable to open make.code.defn"; - - &WriteFile("make.code.defn","SRCS = $file_list\n"); + $line = "SRCS = $file_list\n"; -# close OUT; + &WriteFile("make.code.defn",\$line); chdir "$start_dir"; } @@ -108,48 +90,41 @@ sub CreateScheduleBindings #@@*/ sub ScheduleCreateFile { - local($thorn, $n_interface_database, @rest) = @_; - local(%interface_database); - local(%schedule_database); - - local($implementation); - local($buffer, $prototypes); - local($block, $block_buffer, $block_prototype); - local($statement, $statement_buffer, $statement_prototype); - local($indent, $language, $function); - local(@mem_groups); - local(@comm_groups); - local(@trigger_groups); - local(@before_list); - local(@after_list); - local(@while_list); - local($outfile); - local($outbuf); - - # 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]; + my($thorn, $rhinterface_db, $rhschedule_db) = @_; + + my($implementation); + my($buffer, $prototypes); + my($block, $block_buffer, $block_prototype); + my($statement, $statement_buffer, $statement_prototype); + my($indent, $language, $function); + my(@mem_groups); + my(@comm_groups); + my(@trigger_groups); + my(@before_list); + my(@after_list); + my(@while_list); + my($outfile); + my($outbuf); + + $implementation = $rhinterface_db->{"\U$thorn\E IMPLEMENTS"}; - $implementation = $interface_database{"\U$thorn\E IMPLEMENTS"}; - - $buffer = $schedule_database{"\U$thorn\E FILE"}; + $buffer = $rhschedule_db->{"\U$thorn\E FILE"}; # Process each schedule block - for($block = 0 ; $block < $schedule_database{"\U$thorn\E N_BLOCKS"}; $block++) + for($block = 0 ; $block < $rhschedule_db->{"\U$thorn\E N_BLOCKS"}; $block++) { ($block_buffer, $block_prototype) = &ScheduleBlock($thorn, $implementation, $block, - $n_interface_database, - @rest); + $rhinterface_db, $rhschedule_db); $buffer =~ s:\@BLOCK\@$block:$block_buffer:; $prototypes .= "$block_prototype"; } # Process each schedule statement - for($statement = 0 ; $statement < $schedule_database{"\U$thorn\E N_STATEMENTS"}; $statement++) + for($statement = 0 ; $statement < $rhschedule_db->{"\U$thorn\E N_STATEMENTS"}; $statement++) { ($statement_buffer, $statement_prototype) = &ScheduleStatement($thorn, $implementation, $statement, - $n_interface_database, - @rest); + $rhinterface_db, $rhschedule_db); + $buffer =~ s:\@STATEMENT\@$statement:$statement_buffer:; $prototypes .= "$statement_prototype"; } @@ -192,7 +167,7 @@ sub ScheduleCreateFile $outbuf .= "}\n"; $outbuf .= "\n"; - return $outbuf; + return \$outbuf; } @@ -213,24 +188,17 @@ sub ScheduleCreateFile #@@*/ sub ScheduleCreateBindings { - local($n_interface_database, @rest) = @_; - local(%interface_database); - local(%schedule_database); + my($rhinterface_db, $rhschedule_db) = @_; - local($outbuf); + my($outbuf); - # 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]; - - $outbuf = ""; $outbuf .= "\#include \"SKBinTree.h\"\n"; $outbuf .= "\#include \"cctk_ActiveThorns.h\"\n"; $outbuf = "\n"; $outbuf .= "/* Prototypes for functions to be registered. */"; - foreach $thorn (sort split(" ", $interface_database{"THORNS"})) + foreach $thorn (sort split(" ", $rhinterface_db->{"THORNS"})) { $outbuf .= "void CCTKi_BindingsSchedule_$thorn(void);\n"; } @@ -251,7 +219,7 @@ sub ScheduleCreateBindings $outbuf .= "\@\@*/\n"; $outbuf .= "int CCTKi_BindingsScheduleInitialise(void)\n"; $outbuf .= "{\n"; - foreach $thorn (sort split(" ", $interface_database{"THORNS"})) + foreach $thorn (sort split(" ", $rhinterface_db->{"THORNS"})) { $outbuf .= " if(CCTK_IsThornActive(\"$thorn\"))\n"; $outbuf .= " {\n"; @@ -262,7 +230,7 @@ sub ScheduleCreateBindings $outbuf .= "}\n"; $outbuf .= "\n"; - return $outbuf; + return \$outbuf; } #/*@@ # @routine ScheduleBlock @@ -280,74 +248,67 @@ sub ScheduleCreateBindings #@@*/ sub ScheduleBlock { - local($thorn, $implementation, $block, $n_interface_database, @rest) = @_; - local(%interface_database); - local(%schedule_database); + my($thorn, $implementation, $block, $rhinterface_db, $rhschedule_db) = @_; - local($buffer, $prototype); - local($indent, $language, $function); - local(@mem_groups); - local(@comm_groups); - local(@trigger_groups); - local(@before_list); - local(@after_list); - local(@while_list); - - - # 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]; + my($buffer, $prototype); + my($indent, $language, $function); + my(@mem_groups); + my(@comm_groups); + my(@trigger_groups); + my(@before_list); + my(@after_list); + my(@while_list); # Extract group and routine information from the databases @mem_groups = &ScheduleSelectGroups($thorn, $implementation, - $schedule_database{"\U$thorn\E BLOCK_$block STOR"}, - %interface_database); + $rhschedule_db->{"\U$thorn\E BLOCK_$block STOR"}, + $rhinterface_db); @comm_groups = &ScheduleSelectGroups($thorn, $implementation, - $schedule_database{"\U$thorn\E BLOCK_$block COMM"}, - %interface_database); + $rhschedule_db->{"\U$thorn\E BLOCK_$block COMM"}, + $rhinterface_db); @trigger_groups = &ScheduleSelectGroups($thorn, $implementation, - $schedule_database{"\U$thorn\E BLOCK_$block TRIG"}, - %interface_database); + $rhschedule_db->{"\U$thorn\E BLOCK_$block TRIG"}, + $rhinterface_db); @before_list = &ScheduleSelectRoutines($thorn, $implementation, - $schedule_database{"\U$thorn\E BLOCK_$block BEFORE"}, - %schedule_database); + $rhschedule_db->{"\U$thorn\E BLOCK_$block BEFORE"}, + $rhschedule_db); @after_list = &ScheduleSelectRoutines($thorn, $implementation, - $schedule_database{"\U$thorn\E BLOCK_$block AFTER"}, - %schedule_database); + $rhschedule_db->{"\U$thorn\E BLOCK_$block AFTER"}, + $rhschedule_db); @while_list = &ScheduleSelectVars($thorn, $implementation, - $schedule_database{"\U$thorn\E BLOCK_$block WHILE"}, - %interface_database); + $rhschedule_db->{"\U$thorn\E BLOCK_$block WHILE"}, + $rhinterface_db); # Start writing out the data - if($schedule_database{"\U$thorn\E BLOCK_$block TYPE"} eq "GROUP") + if($rhschedule_db->{"\U$thorn\E BLOCK_$block TYPE"} eq "GROUP") { $prototype = ""; $buffer = " CCTK_ScheduleGroup("; $indent = " "; $language = ""; } - elsif($schedule_database{"\U$thorn\E BLOCK_$block TYPE"} eq "FUNCTION") + elsif($rhschedule_db->{"\U$thorn\E BLOCK_$block TYPE"} eq "FUNCTION") { - if($schedule_database{"\U$thorn\E BLOCK_$block LANG"} =~ m:^\s*C\s*$:i ) + if($rhschedule_db->{"\U$thorn\E BLOCK_$block LANG"} =~ m:^\s*C\s*$:i ) { $language = "C"; - $function = $schedule_database{"\U$thorn\E BLOCK_$block NAME"}; + $function = $rhschedule_db->{"\U$thorn\E BLOCK_$block NAME"}; } - elsif($schedule_database{"\U$thorn\E BLOCK_$block LANG"} =~ m:^\s*(F|F77|FORTRAN|F90)\s*$:i ) + elsif($rhschedule_db->{"\U$thorn\E BLOCK_$block LANG"} =~ m:^\s*(F|F77|FORTRAN|F90)\s*$:i ) { $language = "Fortran"; - $function = "FORTRAN_NAME(".$schedule_database{"\U$thorn\E BLOCK_$block NAME"} .")"; + $function = "FORTRAN_NAME(".$rhschedule_db->{"\U$thorn\E BLOCK_$block NAME"} .")"; } else { - print STDERR "Unknown language " .$schedule_database{"\U$thorn\E BLOCK_$block LANG"} ."\n"; + print STDERR "Unknown language " .$rhschedule_db->{"\U$thorn\E BLOCK_$block LANG"} ."\n"; $CST_errors++; return ("", ""); } @@ -358,16 +319,16 @@ sub ScheduleBlock } else { - print STDERR "Internal error: Unknown schedule block type " . $schedule_database{"\U$thorn\E BLOCK_$block TYPE"} . "\n"; + print STDERR "Internal error: Unknown schedule block type " . $rhschedule_db->{"\U$thorn\E BLOCK_$block TYPE"} . "\n"; return ("", ""); $CST_errors++; } - $buffer .= "\"" . $schedule_database{"\U$thorn\E BLOCK_$block NAME"} . "\"" . ",\n"; + $buffer .= "\"" . $rhschedule_db->{"\U$thorn\E BLOCK_$block NAME"} . "\"" . ",\n"; $buffer .= $indent . "\"" . $thorn . "\"" . ",\n"; $buffer .= $indent . "\"" . $implementation . "\"" . ",\n"; - $buffer .= $indent . "\"" . $schedule_database{"\U$thorn\E BLOCK_$block DESCRIPTION"} . "\"" . ",\n"; - $buffer .= $indent . "\"" . $schedule_database{"\U$thorn\E BLOCK_$block WHERE"} . "\"" . ",\n"; + $buffer .= $indent . "\"" . $rhschedule_db->{"\U$thorn\E BLOCK_$block DESCRIPTION"} . "\"" . ",\n"; + $buffer .= $indent . "\"" . $rhschedule_db->{"\U$thorn\E BLOCK_$block WHERE"} . "\"" . ",\n"; if($language ne "") { $buffer .= $indent . "\"" . $language . "\"" . ",\n"; @@ -406,34 +367,28 @@ sub ScheduleBlock #@@*/ sub ScheduleStatement { - local($thorn, $implementation, $statement, $n_interface_database, @rest) = @_; - local(%interface_database); - local(%schedule_database); - - local($buffer, $prototype); - local(@groups); - local($group); + my($thorn, $implementation, $statement, $rhinterface_db, $rhschedule_db) = @_; - # 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]; + my($buffer, $prototype); + my(@groups); + my($group); # Extract the groups. @groups = &ScheduleSelectGroups($thorn, $implementation, - $schedule_database{"\U$thorn\E STATEMENT_$statement GROUPS"}, - %interface_database); + $rhschedule_db->{"\U$thorn\E STATEMENT_$statement GROUPS"}, + $rhinterface_db); - if($schedule_database{"\U$thorn\E STATEMENT_$statement TYPE"} eq "STOR") + if($rhschedule_db->{"\U$thorn\E STATEMENT_$statement TYPE"} eq "STOR") { $function = "CCTK_ScheduleGroupStorage("; } - elsif($schedule_database{"\U$thorn\E STATEMENT_$statement TYPE"} eq "COMM") + elsif($rhschedule_db->{"\U$thorn\E STATEMENT_$statement TYPE"} eq "COMM") { $function = "CCTK_ScheduleGroupComm("; } else { - print STDERR "Unknown statement type '" .$schedule_database{"\U$thorn\E STATEMENT_$statement TYPE"} ."'\n"; + print STDERR "Unknown statement type '" .$rhschedule_db{"\U$thorn\E STATEMENT_$statement TYPE"} ."'\n"; $CST_errors++; return ("", ""); } @@ -464,11 +419,11 @@ sub ScheduleStatement #@@*/ sub ScheduleSelectGroups { - local($thorn, $implementation, $group_list, %interface_database) = @_; - local(@groups); - local(@temp_list); - local($group); - local($other_imp, $other_thorn, $foundit, $block); + my($thorn, $implementation, $group_list, $rhinterface_db) = @_; + my(@groups); + my(@temp_list); + my($group); + my($other_imp, $other_thorn, $foundit, $block); @temp_list = split(/[,\s\n]+/, $group_list); @@ -487,11 +442,11 @@ sub ScheduleSelectGroups { # The name has been given completely specified but it isn't this thorn. - if($interface_database{"IMPLEMENTATION \U$implementation\E ANCESTORS"} =~ m:\b$other_imp\b:i) + if($rhinterface_db->{"IMPLEMENTATION \U$implementation\E ANCESTORS"} =~ m:\b$other_imp\b:i) { $block = "PUBLIC"; } - elsif($interface_database{"IMPLEMENTATION \U$implementation\E FRIENDS"} =~ m:\b$other_imp\b:i) + elsif($rhinterface_db->{"IMPLEMENTATION \U$implementation\E FRIENDS"} =~ m:\b$other_imp\b:i) { $block = "PROTECTED"; } @@ -502,10 +457,10 @@ sub ScheduleSelectGroups next; } - $interface_database{"IMPLEMENTATION \U$other_imp\E THORNS"} =~ m:(\w+):; + $rhinterface_db->{"IMPLEMENTATION \U$other_imp\E THORNS"} =~ m:(\w+):; $other_thorn = $1; - if($interface_database{"\U$other_thorn\E $block GROUPS"} =~ m:\b$group\b:i) + if($rhinterface_db->{"\U$other_thorn\E $block GROUPS"} =~ m:\b$group\b:i) { push(@groups, "$other_imp\::$group"); next; @@ -519,15 +474,15 @@ sub ScheduleSelectGroups } } - if($interface_database{"\U$thorn\E PRIVATE GROUPS"} =~ m:\b$group\b:i) + if($rhinterface_db->{"\U$thorn\E PRIVATE GROUPS"} =~ m:\b$group\b:i) { push(@groups, "$thorn\::$group"); } - elsif($interface_database{"\U$thorn\E PROTECTED GROUPS"} =~ m:\b$group\b:i) + elsif($rhinterface_db->{"\U$thorn\E PROTECTED GROUPS"} =~ m:\b$group\b:i) { push(@groups, "$implementation\::$group"); } - elsif($interface_database{"\U$thorn\E PUBLIC GROUPS"} =~ m:\b$group\b:i) + elsif($rhinterface_db->{"\U$thorn\E PUBLIC GROUPS"} =~ m:\b$group\b:i) { push(@groups, "$implementation\::$group"); } @@ -535,12 +490,12 @@ sub ScheduleSelectGroups { $foundit = 0; # Check ancestors and friends - foreach $other_imp (split(" ", $interface_database{"IMPLEMENTATION \U$implementation\E ANCESTORS"})) + foreach $other_imp (split(" ", $rhinterface_db->{"IMPLEMENTATION \U$implementation\E ANCESTORS"})) { - $interface_database{"IMPLEMENTATION \U$other_imp\E THORNS"} =~ m:(\w+):; + $rhinterface_db->{"IMPLEMENTATION \U$other_imp\E THORNS"} =~ m:(\w+):; $other_thorn = $1; - if($interface_database{"\U$other_thorn\E PUBLIC GROUPS"} =~ m:\b$group\b:i) + if($rhinterface_db->{"\U$other_thorn\E PUBLIC GROUPS"} =~ m:\b$group\b:i) { push(@groups, "$other_imp\::$group"); $foundit = 1; @@ -549,12 +504,12 @@ sub ScheduleSelectGroups } if(! $foundit) { - foreach $other_imp (split(" ", $interface_database{"IMPLEMENTATION \U$implementation\E FRIENDS"})) + foreach $other_imp (split(" ", $rhinterface_db->{"IMPLEMENTATION \U$implementation\E FRIENDS"})) { - $interface_database{"IMPLEMENTATION \U$other_imp\E THORNS"} =~ m:(\w+):; + $rhinterface_db->{"IMPLEMENTATION \U$other_imp\E THORNS"} =~ m:(\w+):; $other_thorn = $1; - if($interface_database{"\U$other_thorn\E PROTECTED GROUPS"} =~ m:\b$group\b:i) + if($rhinterface_db->{"\U$other_thorn\E PROTECTED GROUPS"} =~ m:\b$group\b:i) { push(@groups, "$other_imp\::$group"); $foundit = 1; @@ -595,10 +550,10 @@ sub ScheduleSelectGroups #@@*/ sub ScheduleSelectRoutines { - local($thorn, $implementation, $routine_list, %schedule_database) = @_; - local(@routines); - local(@temp_list); - local($routine); + my($thorn, $implementation, $routine_list, $rhschedule_db) = @_; + my(@routines); + my(@temp_list); + my($routine); @temp_list = split(/[,\s\n]+/, $routine_list); @@ -630,10 +585,10 @@ sub ScheduleSelectRoutines #@@*/ sub ScheduleSelectVars { - local($thorn, $implementation, $var_list, %interface_database) = @_; - local(@vars); - local(@temp_list); - local($var); + my($thorn, $implementation, $var_list, $rhinterface_db) = @_; + my(@vars); + my(@temp_list); + my($var); @temp_list = split(/[,\s\n]+/, $var_list); diff --git a/lib/sbin/GridFuncStuff.pl b/lib/sbin/GridFuncStuff.pl index 75f721c7..0b4411c0 100644 --- a/lib/sbin/GridFuncStuff.pl +++ b/lib/sbin/GridFuncStuff.pl @@ -27,9 +27,9 @@ sub CreateVariableBindings { - local($bindings_dir, %interface_database) = @_; - local($thorn, @data); - local($line, $block, $filelist); + my($bindings_dir, $rhinterface_db) = @_; + my($thorn, @data); + my($line, $block, $filelist); if(! -d $bindings_dir) { @@ -46,10 +46,10 @@ sub CreateVariableBindings chdir "include"; - foreach $thorn (split(" ",$interface_database{"THORNS"})) + foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) { - @data = &CreateThornArgumentHeaderFile($thorn, %interface_database); + @data = &CreateThornArgumentHeaderFile($thorn, $rhinterface_db); $dataout = ""; # open(OUT, ">$thorn"."_arguments.h"); @@ -59,14 +59,14 @@ sub CreateVariableBindings $dataout .= "$line\n"; } - &WriteFile("$thorn\_arguments.h",$dataout); + &WriteFile("$thorn\_arguments.h",\$dataout); # close OUT; } # open(OUT, ">cctk_arguments.h"); $dataout = ""; - foreach $thorn (split(" ",$interface_database{"THORNS"})) + foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) { $dataout .= "#ifdef THORN_IS_$thorn\n"; $dataout .= "#include \"$thorn"."_arguments.h\"\n"; @@ -77,7 +77,7 @@ sub CreateVariableBindings $dataout .= "#endif\n\n"; } - &WriteFile("cctk_arguments.h",$dataout); + &WriteFile("cctk_arguments.h",\$dataout); # close OUT; chdir ".."; @@ -94,7 +94,7 @@ sub CreateVariableBindings $dataout = ""; - foreach $thorn (split(" ",$interface_database{"THORNS"})) + foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) { $dataout .= "int CactusBindingsVariables_$thorn"."_Initialise(void);\n"; } @@ -103,18 +103,18 @@ sub CreateVariableBindings $dataout .= "int CCTKi_BindingsVariablesInitialise(void)\n{\n"; - foreach $thorn (split(" ",$interface_database{"THORNS"})) + foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) { $dataout .= " CactusBindingsVariables_$thorn"."_Initialise();\n"; } $dataout .= " return 0;\n}\n\n"; - &WriteFile("BindingsVariables.c",$dataout); + &WriteFile("BindingsVariables.c",\$dataout); # close OUT; - foreach $thorn (split(" ",$interface_database{"THORNS"})) + foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) { $dataout = ""; @@ -129,7 +129,7 @@ sub CreateVariableBindings $dataout .= "int CactusBindingsVariables_$thorn"."_Initialise(void)\n{\n"; foreach $block ("PUBLIC", "PROTECTED", "PRIVATE") { - @data = &CreateThornGroupInitialisers($thorn, $block, %interface_database); + @data = &CreateThornGroupInitialisers($thorn, $block, $rhinterface_db); foreach $line (@data) { @@ -140,13 +140,13 @@ sub CreateVariableBindings $dataout .= " return 0;\n};\n"; - &WriteFile("$thorn.c",$dataout); + &WriteFile("$thorn.c",\$dataout); # close OUT; $filelist .= " $thorn.c"; } - foreach $thorn (split(" ",$interface_database{"THORNS"})) + foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) { # open(OUT, ">$thorn\_FortranWrapper.c") || die "Cannot create $thorn\_FortranWrapper.c"; $dataout = ""; @@ -158,14 +158,14 @@ sub CreateVariableBindings $dataout .= "$line\n"; } - &WriteFile("$thorn\_FortranWrapper.c",$dataout); + &WriteFile("$thorn\_FortranWrapper.c",\$dataout); # close OUT; $filelist .= " $thorn\_FortranWrapper.c"; } # open (OUT, ">make.code.defn") || die "Cannot open make.code.defn"; $dataout = "SRCS = $filelist\n"; - &WriteFile("make.code.defn",$dataout); + &WriteFile("make.code.defn",\$dataout); # close OUT; chdir $start_dir; @@ -189,22 +189,22 @@ sub CreateVariableBindings #@@*/ sub GetThornArguments { - local($this_thorn, $block, %interface_database) = @_; - local(%arguments); - local(@other_imps); - local($my_imp); - local($imp); - local($thorn, $group, $variable, $vtype, $gtype, $type); + my($this_thorn, $block, $rhinterface_db) = @_; + my(%arguments); + my(@other_imps); + my($my_imp); + my($imp); + my($thorn, $group, $variable, $vtype, $gtype, $type); - $my_imp = $interface_database{"\U$this_thorn IMPLEMENTS"}; + $my_imp = $rhinterface_db->{"\U$this_thorn IMPLEMENTS"}; if($block eq "PUBLIC") { - @other_imps = split(" ",$interface_database{"IMPLEMENTATION \U$my_imp\E ANCESTORS"}); + @other_imps = split(" ",$rhinterface_db->{"IMPLEMENTATION \U$my_imp\E ANCESTORS"}); } elsif($block eq "PROTECTED") { - @other_imps = split(" ", $interface_database{"IMPLEMENTATION \U$my_imp\E FRIENDS"}); + @other_imps = split(" ", $rhinterface_db->{"IMPLEMENTATION \U$my_imp\E FRIENDS"}); } elsif($block eq "PRIVATE") { @@ -230,16 +230,16 @@ sub GetThornArguments } else { - $interface_database{"IMPLEMENTATION \U$imp\E THORNS"} =~ m:([^ ]*):; + $rhinterface_db->{"IMPLEMENTATION \U$imp\E THORNS"} =~ m:([^ ]*):; $thorn = $1; } - foreach $group (split(" ",$interface_database{"\U$thorn $block GROUPS\E"})) + foreach $group (split(" ",$rhinterface_db->{"\U$thorn $block GROUPS\E"})) { - $vtype = $interface_database{"\U$thorn GROUP $group VTYPE\E"}; - $gtype = $interface_database{"\U$thorn GROUP $group GTYPE\E"}; - $ntimelevels = $interface_database{"\U$thorn GROUP $group TIMELEVELS\E"}; + $vtype = $rhinterface_db->{"\U$thorn GROUP $group VTYPE\E"}; + $gtype = $rhinterface_db->{"\U$thorn GROUP $group GTYPE\E"}; + $ntimelevels = $rhinterface_db->{"\U$thorn GROUP $group TIMELEVELS\E"}; $type = "$vtype"; @@ -247,7 +247,7 @@ sub GetThornArguments { $type .= " ("; $sep = ""; - for($dim =0; $dim < $interface_database{"\U$thorn GROUP $group DIM\E"}; $dim++) + for($dim =0; $dim < $rhinterface_db->{"\U$thorn GROUP $group DIM\E"}; $dim++) { $type .= "$sep$group$dim"; $sep = ","; @@ -276,7 +276,7 @@ sub GetThornArguments # print "Group is $group, resulting type is $type\n"; - foreach $variable (split(" ", $interface_database{"\U$thorn GROUP $group\E"})) + foreach $variable (split(" ", $rhinterface_db->{"\U$thorn GROUP $group\E"})) { $arguments{$variable} = $type; } @@ -304,10 +304,10 @@ sub GetThornArguments sub CreateFortranArgumentDeclarations { - local(%arguments) = @_; - local($argument); - local(@declarations) = (); - local($suffix); + my(%arguments) = @_; + my($argument); + my(@declarations) = (); + my($suffix); # Put all storage arguments first. foreach $argument (sort keys %arguments) @@ -419,11 +419,11 @@ sub CreateFortranArgumentDeclarations sub CreateCArgumentDeclarations { - local(%arguments) = @_; - local($argument); - local(@declarations) = (); - local($suffix); - local($imp); + my(%arguments) = @_; + my($argument); + my(@declarations) = (); + my($suffix); + my($imp); # Now deal with the rest of the arguments @@ -528,10 +528,10 @@ sub CreateCArgumentDeclarations sub CreateFortranArgumentList { - local(%arguments) = @_; - local($argument); - local($argumentlist) = ""; - local($sep); + my(%arguments) = @_; + my($argument); + my($argumentlist) = ""; + my($sep); $sep = ""; # Put all storage arguments first. @@ -603,9 +603,9 @@ sub CreateFortranArgumentList sub CreateCArgumentStatics { - local(%arguments) = @_; - local($argument); - local(@declarations) = (); + my(%arguments) = @_; + my($argument); + my(@declarations) = (); foreach $argument (sort keys %arguments) { @@ -636,9 +636,9 @@ sub CreateCArgumentStatics sub CreateCArgumentInitialisers { - local(%arguments) = @_; - local($argument); - local(@initialisers) = (); + my(%arguments) = @_; + my($argument); + my(@initialisers) = (); foreach $argument (sort keys %arguments) { @@ -670,10 +670,10 @@ sub CreateCArgumentInitialisers sub CreateCArgumentPrototype { - local(%arguments) = @_; - local($argument); - local($prototype) = ""; - local($sep); + my(%arguments) = @_; + my($argument); + my($prototype) = ""; + my($sep); $sep = ""; @@ -785,10 +785,10 @@ sub CreateCArgumentPrototype sub CreateCArgumentList { - local(%arguments) = @_; - local($argument); - local($arglist) = ""; - local($sep); + my(%arguments) = @_; + my($argument); + my($arglist) = ""; + my($sep); $sep = ""; @@ -902,17 +902,17 @@ sub CreateCArgumentList sub CreateThornArgumentHeaderFile { - local($thorn, %interface_database) = @_; - local($line); - local(@returndata) = (); - local(%hasvars); + my($thorn, $rhinterface_db) = @_; + my($line); + my(@returndata) = (); + my(%hasvars); # Create the basic thorn block definitions foreach $block ("PRIVATE", "PROTECTED", "PUBLIC") { - %data = &GetThornArguments($thorn, $block, %interface_database); + %data = &GetThornArguments($thorn, $block, $rhinterface_db); # $print_data = 1; if ($print_data) @@ -1186,25 +1186,25 @@ sub CreateThornArgumentHeaderFile sub CreateThornGroupInitialisers { - local($thorn, $block, %interface_database) = @_; - local($imp); - local($group, @variables); - local($line); - local(@definitions); + my($thorn, $block, $rhinterface_db) = @_; + my($imp); + my($group, @variables); + my($line); + my(@definitions); - $imp = $interface_database{"\U$thorn\E IMPLEMENTS"}; + $imp = $rhinterface_db->{"\U$thorn\E IMPLEMENTS"}; - foreach $group (split(" ", $interface_database{"\U$thorn $block GROUPS"})) + foreach $group (split(" ", $rhinterface_db->{"\U$thorn $block GROUPS"})) { - @variables = split(" ", $interface_database{"\U$thorn GROUP $group\E"}); + @variables = split(" ", $rhinterface_db->{"\U$thorn GROUP $group\E"}); $line = " CCTK_CreateGroup(\"\U$group\",\"$thorn\",\"$imp\",\n" - . " \"" . $interface_database{"\U$thorn GROUP $group\E GTYPE"} . "\",\n" - . " \"" . $interface_database{"\U$thorn GROUP $group\E VTYPE"} . "\",\n" + . " \"" . $rhinterface_db->{"\U$thorn GROUP $group\E GTYPE"} . "\",\n" + . " \"" . $rhinterface_db->{"\U$thorn GROUP $group\E VTYPE"} . "\",\n" . " \"" . $block . "\",\n" - . " " . $interface_database{"\U$thorn GROUP $group\E DIM"} . ",\n" - . " " . $interface_database{"\U$thorn GROUP $group\E TIMELEVELS"} . ",\n" + . " " . $rhinterface_db->{"\U$thorn GROUP $group\E DIM"} . ",\n" + . " " . $rhinterface_db->{"\U$thorn GROUP $group\E TIMELEVELS"} . ",\n" . " ". scalar(@variables); foreach $variable (@variables) { @@ -1222,8 +1222,8 @@ sub CreateThornGroupInitialisers sub CreateThornFortranWrapper { - local($thorn) = @_; - local(@data); + my($thorn) = @_; + my(@data); push(@data, "#define THORN_IS_$thorn"); push(@data, "#include \"cctk.h\""); diff --git a/lib/sbin/ImpParamConsistency.pl b/lib/sbin/ImpParamConsistency.pl index d6a720cc..27b3afb8 100644 --- a/lib/sbin/ImpParamConsistency.pl +++ b/lib/sbin/ImpParamConsistency.pl @@ -9,12 +9,12 @@ sub CheckImpParamConsistency { - local($n_interface_data, @indata) = @_; - local(%interface_database); - local(%parameter_database); - local(@thorns); - local($thorn, $friend, $implementation, $other_thorn); - local($range); + my($n_interface_data, @indata) = @_; + my(%interface_database); + my(%parameter_database); + my(@thorns); + my($thorn, $friend, $implementation, $other_thorn); + my($range); # Extract the arguments %interface_database = @indata[0..2*$n_interface_data-1]; diff --git a/lib/sbin/MakeUtils.pl b/lib/sbin/MakeUtils.pl index 1b4e086e..36da0200 100644 --- a/lib/sbin/MakeUtils.pl +++ b/lib/sbin/MakeUtils.pl @@ -21,9 +21,9 @@ sub buildthorns { - local($arrangement_dir,$choice) = @_; - local(@arrangements); - local(%info); + my($arrangement_dir,$choice) = @_; + my(@arrangements); + my(%info); chdir $arrangement_dir || die "Can't change directory to $arrangement_dir\n"; @@ -127,11 +127,11 @@ sub buildthorns #@@*/ sub ThornInfo { - local($thorn) = @_; - local($implementation) = ""; - local($friends) = ""; - local($inherits) = ""; - local($shares) = ""; + my($thorn) = @_; + my($implementation) = ""; + my($friends) = ""; + my($inherits) = ""; + my($shares) = ""; open(INTERFACE, "<$thorn/interface.ccl") || die "Unable to open $thorn/interface.ccl"; diff --git a/lib/sbin/Orderer.pl b/lib/sbin/Orderer.pl index 54a8277b..300e0815 100644 --- a/lib/sbin/Orderer.pl +++ b/lib/sbin/Orderer.pl @@ -25,8 +25,8 @@ sub TestOrderList { - local(%data); - local($sorted_things); + my(%data); + my($sorted_things); # Create a list of data and rules to sort them. %data = ("thorns", "c b a d e f", @@ -87,11 +87,11 @@ sub TestOrderList sub OrderList { - local($error_string, $fieldname, %database) = @_; - local(@things); - local($thing, $other_thing); - local($nerrors); - local(@thing_list); + my($error_string, $fieldname, %database) = @_; + my(@things); + my($thing, $other_thing); + my($nerrors); + my(@thing_list); $nerrors = 0; @things = split(" ", $database{$fieldname}); @@ -206,9 +206,9 @@ sub OrderList #@@*/ sub RecurseThings { - local($thing, $keyword, $nthings, @indata) = @_; - local(%things); - local(%database); + my($thing, $keyword, $nthings, @indata) = @_; + my(%things); + my(%database); # Extract the hash tables if($nthings > 0) @@ -280,9 +280,9 @@ sub RecurseThings #@@*/ sub CheckThings { - local($error_string, $thing, $keyword, %database) = @_; - local($other_thing); - local($nerrors); + my($error_string, $thing, $keyword, %database) = @_; + my($other_thing); + my($nerrors); if($database{"\U$thing $keyword"}) { @@ -342,10 +342,10 @@ sub CheckThings #@@*/ sub SortThings { - local($before, $after, $n_things, @rest) = @_; - local(@things); - local(%database); - local(@sorted_things); + my($before, $after, $n_things, @rest) = @_; + my(@things); + my(%database); + my(@sorted_things); # Extract the list of things and the database if($n_things) @@ -409,7 +409,7 @@ sub SortThings #@@*/ sub ThingSorter { - local($retval); + my($retval); if($database{"\U$a $before"} =~ m:\b$b\b:i) { # print "$b in $a $before list - " . $database{"\U$a $before"} . "\n"; diff --git a/lib/sbin/ParamLatex.pl b/lib/sbin/ParamLatex.pl index e5db6241..e9a3ae16 100644 --- a/lib/sbin/ParamLatex.pl +++ b/lib/sbin/ParamLatex.pl @@ -26,8 +26,8 @@ $thorn{"WaveToy"} = "arrangements/CactusApplications/WaveToy"; #@@*/ sub latex_database { - local(%parameter_database) = @_; - local($field); + my(%parameter_database) = @_; + my($field); $nvars = 0; diff --git a/lib/sbin/Runtest.pl b/lib/sbin/Runtest.pl index 39c3d7a5..f83421e3 100644 --- a/lib/sbin/Runtest.pl +++ b/lib/sbin/Runtest.pl @@ -264,7 +264,7 @@ else } sub runtest { - local ($inpf,$inthorn,$num) = @_; + my ($inpf,$inthorn,$num) = @_; $inpf = "arrangements/$inthorn/test/$inpf"; $tsttop = ".${sep}TEST"; @@ -400,8 +400,8 @@ sub runtest { } sub defprompt { - local ($pr, $de) = @_; - local ($res); + my ($pr, $de) = @_; + my ($res); print "$pr [$de] \n"; print " --> "; $res = <STDIN>; @@ -414,7 +414,7 @@ sub defprompt { } sub fpabs { - local ($val) = $_[0]; + my ($val) = $_[0]; $val > 0 ? $val:-$val; } diff --git a/lib/sbin/ScheduleParser.pl b/lib/sbin/ScheduleParser.pl index 5ecb200d..ea10d041 100644 --- a/lib/sbin/ScheduleParser.pl +++ b/lib/sbin/ScheduleParser.pl @@ -25,10 +25,10 @@ #@@*/ sub create_schedule_database { - local(%thorns) = @_; - local($thorn, @indata); - local(@new_schedule_data); - local(@schedule_data); + my(%thorns) = @_; + my($thorn, @indata); + my(@new_schedule_data); + my(@schedule_data); # Loop through each implementation's schedule file. foreach $thorn (keys %thorns) @@ -68,16 +68,16 @@ sub create_schedule_database #@@*/ sub parse_schedule_ccl { - local($thorn, @data) = @_; - local($line_number); - local(%schedule_db); - local($buffer); - local($n_blocks); - local($n_statements); - local($name, $type, $description, $where, $language, + my($thorn, @data) = @_; + my($line_number); + my(%schedule_db); + my($buffer); + my($n_blocks); + my($n_statements); + my($name, $type, $description, $where, $language, $mem_groups, $comm_groups, $trigger_groups, $before_list, $after_list, $while_list); - local($type, $groups); + my($type, $groups); $buffer = ""; $n_blocks = 0; @@ -144,21 +144,21 @@ sub parse_schedule_ccl #@@*/ sub ParseScheduleBlock { - local($line_number, @data) = @_; - local($name, $type, $description, $where, $language, + my($line_number, @data) = @_; + my($name, $type, $description, $where, $language, $mem_groups, $comm_groups, $trigger_groups, $before_list, $after_list, $while_list); - local(@fields); - local($field); - local(@before_list) = (); - local(@after_list) = (); - local(@while_list) = (); - local(@mem_groups) = (); - local(@comm_groups) = (); - local(@trigger_groups) = (); - local($keyword) = ""; - local(@current_sched_list) = (); - local($where) = ""; + my(@fields); + my($field); + my(@before_list) = (); + my(@after_list) = (); + my(@while_list) = (); + my(@mem_groups) = (); + my(@comm_groups) = (); + my(@trigger_groups) = (); + my($keyword) = ""; + my(@current_sched_list) = (); + my($where) = ""; #Parse the first line of the schedule block @@ -423,8 +423,8 @@ sub ParseScheduleBlock #@@*/ sub ParseScheduleStatement { - local($line_number, @data) = @_; - local($type, $groups); + my($line_number, @data) = @_; + my($type, $groups); $data[$line_number] =~ m/^\s*(STOR|COMM)[^:]*:\s*([\w\s\,]*)/i; @@ -450,8 +450,8 @@ sub ParseScheduleStatement #@@*/ sub print_schedule_database { - local(%schedule_database) = @_; - local($field); + my(%schedule_database) = @_; + my($field); foreach $field ( sort keys %schedule_database ) { @@ -475,7 +475,7 @@ sub print_schedule_database #@@*/ sub PrintScheduleStatistics { - local($thorn, %schedule_database) = @_; + my($thorn, %schedule_database) = @_; print " " . $schedule_database{"\U$thorn\E N_BLOCKS"} . " schedule blocks.\n"; diff --git a/lib/sbin/checkout.pl b/lib/sbin/checkout.pl index d271715d..aec16a43 100644 --- a/lib/sbin/checkout.pl +++ b/lib/sbin/checkout.pl @@ -73,8 +73,8 @@ while () sub get_arrangements { - local(%info); - local($arrangement); + my(%info); + my($arrangement); print "\nYou already have arrangements: \n\n"; %info = &buildthorns("arrangements/","arrangements"); @@ -151,8 +151,8 @@ sub get_arrangements sub get_thorns { - local(%info); - local($thorn); + my(%info); + my($thorn); print "\nYou already have thorns: \n\n"; @@ -353,7 +353,7 @@ sub print_help sub CheckOut { - local($file) = @_; + my($file) = @_; print("Checking out $file\n"); system("cvs -z9 -q checkout $file"); diff --git a/lib/sbin/create_c_stuff.pl b/lib/sbin/create_c_stuff.pl index 3616a366..771f8d37 100644 --- a/lib/sbin/create_c_stuff.pl +++ b/lib/sbin/create_c_stuff.pl @@ -27,15 +27,11 @@ sub CreateParameterBindingFile { - local($prefix, $structure, $n_parameters, @rest) = @_; - local(%parameter_database); - local($line,@data); - local(%parameters); - local($type, $type_string); - local(@data); - - %parameters = @rest[0..2*$n_parameters-1]; - %parameter_database = @rest[2*$n_parameters..$#rest]; + my($prefix, $structure, $rhparameters, $rhparameter_db) = @_; + my($line,@data); + my(%parameters); + my($type, $type_string); + my(@data); # Header Data $line = "\#include <stdio.h>"; @@ -60,9 +56,9 @@ sub CreateParameterBindingFile push(@data,( "struct ", "{")); - foreach $parameter (&order_params(scalar(keys %parameters), %parameters,%parameter_database)) + foreach $parameter (&order_params($rhparameters,$rhparameter_db)) { - $type = $parameter_database{"\U$parameters{$parameter} $parameter\E type"}; + $type = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E type"}; $type_string = &get_c_type_string($type); @@ -72,7 +68,7 @@ sub CreateParameterBindingFile } # Some compilers don't like an empty structure. - if((keys %parameters) == 0) + if((keys %$rhparameters) == 0) { push(@data, " int dummy_parameter;"); } @@ -81,26 +77,6 @@ sub CreateParameterBindingFile push(@data, ""); - # Help subroutine - - push(@data, ("int $prefix"."Help(const char *param, const char *format, FILE *file)", "{")); - push(@data, (" int retval;", " retval = 1;", "")); - - - foreach $parameter (sort(keys %parameters)) - { - push(@data, &help_parameter_code($structure,$parameters{$parameter}, - $parameter, %parameter_database)); - push(@data, ""); - - } - - push(@data, " return retval;"); - - push(@data, "}"); - - push(@data, ""); - return @data; } @@ -121,8 +97,8 @@ sub CreateParameterBindingFile sub get_c_type_string { - local($type) = @_; - local($type_string); + my($type) = @_; + my($type_string); if($type eq "KEYWORD" || @@ -194,10 +170,10 @@ sub get_c_type_string sub GetThornParameterList { - local($thorn, $block, %parameter_database) = @_; - local(%parameter_list); + my($thorn, $block, $rhparameter_db) = @_; + my(%parameter_list); - $params = $parameter_database{"\U$thorn $block\E variables"}; + $params = $rhparameter_db->{"\U$thorn $block\E variables"}; foreach $parameter (split(" ", $params)) { @@ -212,25 +188,21 @@ sub GetThornParameterList sub CreateCStructureParameterHeader { - local($prefix, $structure, $n_parameters, @rest) = @_; - local(%parameter_database); - local($line,@data); - local(%parameters); - local($type, $type_string); - local(@data); - local(@definition); - - %parameters = @rest[0..2*$n_parameters-1]; - %parameter_database = @rest[2*$n_parameters..$#rest]; + my($prefix, $structure, $rhparameters, $rhparameter_db) = @_; + my($line,@data); + my(%parameters); + my($type, $type_string); + my(@data); + my(@definition); # Create the structure push(@data,("#ifdef __cplusplus", "extern \"C\"", "{", "#endif")); push(@data,( "extern struct ", "{")); - foreach $parameter (&order_params(scalar(keys %parameters), %parameters,%parameter_database)) + foreach $parameter (&order_params($rhparameters, $rhparameter_db)) { - $type = $parameter_database{"\U$parameters{$parameter} $parameter\E type"}; + $type = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E type"}; $type_string = &get_c_type_string($type); @@ -244,7 +216,7 @@ sub CreateCStructureParameterHeader } # Some compilers don't like an empty structure. - if((keys %parameters) == 0) + if((keys %$rhparameters) == 0) { push(@data, " int dummy_parameter;"); } @@ -269,19 +241,14 @@ sub CreateCStructureParameterHeader sub order_params { - local($nparams, @rest) = @_; - local(%parameters); - local(%parameter_database); - local(@float_params) = ();; - local(@int_params) = (); - local(@string_params)= (); - - %parameters = @rest[0..2*$nparams-1]; - %parameter_database = @rest[2*$nparams..$#rest]; + my($rhparameters, $rhparameter_db) = @_; + my(@float_params) = ();; + my(@int_params) = (); + my(@string_params)= (); - foreach $parameter (sort(keys %parameters)) + foreach $parameter (sort(keys %$rhparameters)) { - $type = $parameter_database{"\U$parameters{$parameter} $parameter\E type"}; + $type = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E type"}; if($type eq "KEYWORD" || $type eq "STRING" || @@ -309,87 +276,16 @@ sub order_params return (@float_params, @string_params, @int_params); } -sub get_parameter_code -{ - local($structure, $implementation,$parameter, %parameter_database) = @_; - local($type, $type_string); - local($line, @lines); - local($range); - local($quoted_range); - - $type = $parameter_database{"\U$implementation $parameter\E type"}; - - push(@lines,(" if(CCTK_Equals(param, \"$parameter\"))", " {")); - - if( $type eq "KEYWORD") - { - $line = " *value = $structure.$parameter;\n" ; - $line .= " retval = PARAMETER_KEYWORD;" ; - } - elsif( $type eq "STRING") - { - $line = " *value = $structure.$parameter;\n" ; - $line .= " retval = PARAMETER_STRING;" ; - } - elsif( $type eq "SENTENCE") - { - $line = " *value = $structure.$parameter;\n" ; - $line .= " retval = PARAMETER_SENTENCE;" ; - } - elsif($type eq "INT") - { - $line = " *value = \&($structure.$parameter);\n" ; - $line .= " retval = PARAMETER_INTEGER;" ; - } - elsif($type eq "REAL") - { - $line = " *value = \&($structure.$parameter);\n" ; - $line .= " retval = PARAMETER_REAL;" ; - } - elsif($type eq "BOOLEAN") - { - $line = " *value = \&($structure.$parameter);\n" ; - $line .= " retval = PARAMETER_BOOLEAN;" ; - } - else - { - print "Unknown parameter type $type\n"; - } - - push(@lines, ($line, " }")); - - return @lines; -} - -sub help_parameter_code -{ - local($structure, $implementation,$parameter, %parameter_database) = @_; - local($type, $type_string); - local($line, @lines); - local($range); - local($quoted_range); - - $type = $parameter_database{"\U$implementation $parameter\E type"}; - - push(@lines,(" if(param == NULL || CCTK_Equals(param, \"$parameter\"))", " {")); - - push(@lines, " printf(\"Help asked for parameter: $implementation\::$parameter.\\n\");"); - push(@lines, ($line, " }")); - - return @lines; -} - - sub create_parameter_code { - local($structure, $implementation,$parameter, %parameter_database) = @_; - local($type, $type_string); - local($line, @lines); - local($default); - local($temp_default); + my($structure, $implementation,$parameter, $rhparameter_db) = @_; + my($type, $type_string); + my($line, @lines); + my($default); + my($temp_default); - $default = $parameter_database{"\U$implementation $parameter\E default"}; - $type = $parameter_database{"\U$implementation $parameter\E type"}; + $default = $rhparameter_db->{"\U$implementation $parameter\E default"}; + $type = $rhparameter_db->{"\U$implementation $parameter\E type"}; $type_string = &get_c_type_string($type); @@ -425,7 +321,7 @@ sub create_parameter_code } $line = "ParameterCreate($parameter, $implementation, - \"foobar\",\"" . $parameter_database{"\U$implementation $parameter\E type"}."\" + \"foobar\",\"" . $rhparameter_db->{"\U$implementation $parameter\E type"}."\" const char *scope, int steerable, const char *description, diff --git a/lib/sbin/create_fortran_stuff.pl b/lib/sbin/create_fortran_stuff.pl index 6bc6ec79..e7b1d74e 100644 --- a/lib/sbin/create_fortran_stuff.pl +++ b/lib/sbin/create_fortran_stuff.pl @@ -12,27 +12,22 @@ $BindingsAliasNum = 0; sub CreateFortranThornParameterBindings { - local($thorn, $n_param_database, @rest) = @_; - local(%parameter_database); - local(%interface_database); - local($line); - local(%these_parameters); - local($implementation); - local(@data); - local(@file); - local(%alias_names); - - %parameter_database = @rest[0..(2*$n_param_database)-1]; - %interface_database = @rest[2*$n_param_database..$#rest]; + my($thorn, $rhparameter_db, $rhinterface_db) = @_; + my($line); + my(%these_parameters); + my($implementation); + my(@data); + my(@file); + my(%alias_names); push(@file, "#define DECLARE_CCTK_PARAMETERS \\"); # Generate all global parameters - %these_parameters = &get_global_parameters(%parameter_database); + %these_parameters = &get_global_parameters($rhparameter_db); if((keys %these_parameters) > 0) { - @data = &CreateFortranCommonDeclaration("cctk_params_global", 0, scalar(keys %these_parameters), %these_parameters, %parameter_database); + @data = &CreateFortranCommonDeclaration("cctk_params_global", \%these_parameters, $rhparameter_db); foreach $line (@data) { @@ -41,13 +36,13 @@ sub CreateFortranThornParameterBindings } # Generate all restricted parameters of this thorn - %these_parameters = &GetThornParameterList($thorn, "RESTRICTED", %parameter_database); + %these_parameters = &GetThornParameterList($thorn, "RESTRICTED", $rhparameter_db); if((keys %these_parameters > 0)) { - $implementation = $interface_database{"\U$thorn\E IMPLEMENTS"}; + $implementation = $rhinterface_db->{"\U$thorn\E IMPLEMENTS"}; - @data = &CreateFortranCommonDeclaration("$implementation"."rest", 0, scalar(keys %these_parameters), %these_parameters, %parameter_database); + @data = &CreateFortranCommonDeclaration("$implementation"."rest", \%these_parameters, $rhparameter_db); foreach $line (@data) { @@ -56,11 +51,11 @@ sub CreateFortranThornParameterBindings } # Generate all private parameters of this thorn - %these_parameters = &GetThornParameterList($thorn, "PRIVATE", %parameter_database); + %these_parameters = &GetThornParameterList($thorn, "PRIVATE", $rhparameter_db); if((keys %these_parameters > 0)) { - @data = &CreateFortranCommonDeclaration("$thorn"."priv", 0,scalar(keys %these_parameters), %these_parameters, %parameter_database); + @data = &CreateFortranCommonDeclaration("$thorn"."priv", \%these_parameters, $rhparameter_db); foreach $line (@data) { @@ -69,22 +64,22 @@ sub CreateFortranThornParameterBindings } # Parameters from friends - foreach $friend (split(" ",$parameter_database{"\U$thorn\E SHARES implementations"})) + foreach $friend (split(" ",$rhparameter_db->{"\U$thorn\E SHARES implementations"})) { # Determine which thorn provides this friend implementation - $interface_database{"IMPLEMENTATION \U$friend\E THORNS"} =~ m:([^ ]*):; + $rhinterface_db->{"IMPLEMENTATION \U$friend\E THORNS"} =~ m:([^ ]*):; $friend_thorn = $1; - %these_parameters = &GetThornParameterList($friend_thorn, "RESTRICTED", %parameter_database); + %these_parameters = &GetThornParameterList($friend_thorn, "RESTRICTED", $rhparameter_db); %alias_names = (); foreach $parameter (sort(keys %these_parameters)) { # Alias the parameter unless it is one we want. - if(($parameter_database{"\U$thorn SHARES $friend\E variables"} =~ m:( )*$parameter( )*:) && (length($1) > 0)||length($2)>0||$1 eq $parameter_database{"\U$thorn SHARES $friend\E variables"}) + if(($rhparameter_db->{"\U$thorn SHARES $friend\E variables"} =~ m:( )*$parameter( )*:) && (length($1) > 0)||length($2)>0||$1 eq $rhparameter_db->{"\U$thorn SHARES $friend\E variables"}) { $alias_names{$parameter} = "$parameter"; } @@ -95,7 +90,7 @@ sub CreateFortranThornParameterBindings } } - @data = &CreateFortranCommonDeclaration("$friend"."rest", 1, scalar(keys %these_parameters), %these_parameters, %alias_names, %parameter_database); + @data = &CreateFortranCommonDeclaration("$friend"."rest", \%these_parameters, $rhparameter_db, \%alias_names); foreach $line (@data) { @@ -112,25 +107,20 @@ sub CreateFortranThornParameterBindings sub CreateFortranCommonDeclaration { - local($common_block, $aliases, $n_parameters, @rest) = @_; - local(%parameter_database); - local($line,@data); - local(%parameters); - local($type, $type_string); - local($definition); - local(%alias_names); - - if($aliases == 0) + my($common_block, $rhparameters, $rhparameter_db, $rhaliases) = @_; + my($line,@data); + my(%parameters); + my($type, $type_string); + my($definition); + my($aliases); + + if(defined $rhaliases) { - %parameters = @rest[0..2*$n_parameters-1]; - %alias_names = (); - %parameter_database = @rest[2*$n_parameters..$#rest]; + $aliases = scalar(keys %$rhaliases); } else { - %parameters = @rest[0..2*$n_parameters-1]; - %alias_names = @rest[2*$n_parameters..4*$n_parameters-1]; - %parameter_database = @rest[4*$n_parameters..$#rest]; + $aliases = 0; } # Create the data @@ -139,9 +129,9 @@ sub CreateFortranCommonDeclaration $sepchar = ""; - foreach $parameter (&order_params(scalar(keys %parameters), %parameters,%parameter_database)) + foreach $parameter (&order_params($rhparameters,$rhparameter_db)) { - $type = $parameter_database{"\U$parameters{$parameter} $parameter\E type"}; + $type = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E type"}; $type_string = &get_fortran_type_string($type); @@ -151,7 +141,7 @@ sub CreateFortranCommonDeclaration } else { - $line = "$type_string $alias_names{$parameter}"; + $line = "$type_string $rhaliases->{$parameter}"; } push(@data, $line); @@ -162,7 +152,7 @@ sub CreateFortranCommonDeclaration } else { - $definition .= "$sepchar$alias_names{$parameter}"; + $definition .= "$sepchar$rhaliases->{$parameter}"; } @@ -177,8 +167,8 @@ sub CreateFortranCommonDeclaration sub get_fortran_type_string { - local($type) = @_; - local($type_string); + my($type) = @_; + my($type_string); if($type eq "KEYWORD" || diff --git a/lib/sbin/f_file_processor.pl b/lib/sbin/f_file_processor.pl index 8e8c89e8..e4bbe525 100644 --- a/lib/sbin/f_file_processor.pl +++ b/lib/sbin/f_file_processor.pl @@ -1,4 +1,4 @@ -#!/usr/local/bin/perl +#!/usr/my/bin/perl # # Version: $Id$ # @@ -58,7 +58,7 @@ while (<>) { sub splitline { - local ($LINE) = @_; + my ($LINE) = @_; # Remove ,, and , \) from blank thorns while ($LINE =~ s/,\s*,/,/) {} $LINE =~ s/,\s*\)/\)/; diff --git a/lib/sbin/interface_parser.pl b/lib/sbin/interface_parser.pl index 20b9bfab..4fbebf8d 100644 --- a/lib/sbin/interface_parser.pl +++ b/lib/sbin/interface_parser.pl @@ -16,10 +16,10 @@ sub create_interface_database { - local(%thorns) = @_; - local($thorn, @indata); - local(@new_interface_data); - local(@interface_data); + my(%thorns) = @_; + my($thorn, @indata); + my(@new_interface_data); + my(@interface_data); # Loop through each thorn's interface file. foreach $thorn (keys %thorns) @@ -52,13 +52,13 @@ sub create_interface_database sub cross_index_interface_data { - local($n_thorns, @indata) = @_; - local(@thorns); - local(%interface_data); - local(%implementations); - local($implementation); - local(%ancestors); - local(%friends); + my($n_thorns, @indata) = @_; + my(@thorns); + my(%interface_data); + my(%implementations); + my($implementation); + my(%ancestors); + my(%friends); @thorns = @indata[0..$n_thorns-1]; %interface_data = @indata[$n_thorns..$#indata]; @@ -123,12 +123,12 @@ sub cross_index_interface_data sub get_friends_of_me { - local($implementation, $n_implementations,@indata) = @_; - local(@implementations); - local(%interface_data); - local($other_implementation); - local($thorn); - local($friend,$friends); + my($implementation, $n_implementations,@indata) = @_; + my(@implementations); + my(%interface_data); + my($other_implementation); + my($thorn); + my($friend,$friends); @implementations = @indata[0..$n_implementations-1]; %interface_data = @indata[$n_implementations..$#indata]; @@ -158,13 +158,13 @@ sub get_friends_of_me sub get_implementation_friends { - local($implementation, $n_friends, @indata) = @_; - local(%friends); - local(%interface_data); - local($thorn); - local($friend, $friends); - local($friends_of_me); - local($other_implementation); + my($implementation, $n_friends, @indata) = @_; + my(%friends); + my(%interface_data); + my($thorn); + my($friend, $friends); + my($friends_of_me); + my($other_implementation); if($n_friends > 0) { @@ -204,11 +204,11 @@ sub get_implementation_friends sub get_implementation_ancestors { - local($implementation, $n_ancestors, @indata) = @_; - local(%ancestors); - local(%interface_data); - local($thorn); - local($ancestor, $ancestors); + my($implementation, $n_ancestors, @indata) = @_; + my(%ancestors); + my(%interface_data); + my($thorn); + my($ancestor, $ancestors); if($n_ancestors > 0) { @@ -246,18 +246,18 @@ sub get_implementation_ancestors sub check_interface_consistency { - local($implementation, %interface_data) = @_; - local(@thorns); - local($thorn); - local($thing); - local(%inherits); - local(%friend); - local(%public_groups); - local(%private_groups); - local(%variables); - local($n_errors); - local($group); - local(%attributes); + my($implementation, %interface_data) = @_; + my(@thorns); + my($thorn); + my($thing); + my(%inherits); + my(%friend); + my(%public_groups); + my(%private_groups); + my(%variables); + my($n_errors); + my($group); + my(%attributes); # Find out which thorns provide this implementation. @thorns = split(" ", $interface_data{"IMPLEMENTATION \U$implementation\E THORNS"}); @@ -548,13 +548,13 @@ sub check_interface_consistency sub parse_interface_ccl { - local($arrangement, $thorn, @data) = @_; - local($line_number, $line, $block, $type, $variable, $description); - local($data, %interface_db); - local($implementation); - local($option,%options); - local(%known_groups); - local(%known_variables); + my($arrangement, $thorn, @data) = @_; + my($line_number, $line, $block, $type, $variable, $description); + my($data, %interface_db); + my($implementation); + my($option,%options); + my(%known_groups); + my(%known_variables); # Initialise some stuff to prevent perl -w from complaining. @@ -783,8 +783,8 @@ sub parse_interface_ccl sub print_interface_database { - local(%database) = @_; - local($field); + my(%database) = @_; + my($field); foreach $field ( sort keys %database ){ print "$field has value $database{$field}\n"; @@ -807,9 +807,9 @@ sub print_interface_database #@@*/ sub PrintInterfaceStatistics { - local($thorn, %interface_database) = @_; - local($block); - local($sep); + my($thorn, %interface_database) = @_; + my($block); + my($sep); print " Implements: " . $interface_database{"\U$thorn IMPLEMENTS"} . "\n"; diff --git a/lib/sbin/output_config.pl b/lib/sbin/output_config.pl index ed1193e0..6d632bd9 100644 --- a/lib/sbin/output_config.pl +++ b/lib/sbin/output_config.pl @@ -10,9 +10,8 @@ sub OutputFile { - local($directory, $file, @data) = @_; + my($directory, $file, @data) = @_; -# open(OUT, ">$directory/$file") || die "Can't open $file in $directory\n"; $dataout = ""; foreach $line (@data) @@ -20,8 +19,7 @@ sub OutputFile $dataout .= "$line\n"; } - &WriteFile("$directory/$file",$dataout); -# close OUT; + &WriteFile("$directory/$file",\$dataout); } diff --git a/lib/sbin/parameter_parser.pl b/lib/sbin/parameter_parser.pl index eef5f376..63de8736 100644 --- a/lib/sbin/parameter_parser.pl +++ b/lib/sbin/parameter_parser.pl @@ -22,10 +22,10 @@ sub create_parameter_database { - local(%thorns) = @_; - local($thorn, @indata); - local(@new_parameter_data); - local(@parameter_data); + my(%thorns) = @_; + my($thorn, @indata); + my(@new_parameter_data); + my(@parameter_data); # Loop through each implementation's parameter file. foreach $thorn (keys %thorns) @@ -51,13 +51,13 @@ sub create_parameter_database sub cross_index_parameters { - local($n_thorns, @indata) = @_; - local(@thorns); - local(%parameter_database); - local(@module_file); - local($line); - local(@data); - local($thorn); + my($n_thorns, @indata) = @_; + my(@thorns); + my(%parameter_database); + my(@module_file); + my($line); + my(@data); + my($thorn); @thorns = @indata[0..$n_thorns-1]; %parameter_database = @indata[$n_thorns..$#indata]; @@ -103,12 +103,12 @@ sub cross_index_parameters sub parse_param_ccl { - local($thorn, @data) = @_; - local($line_number, $line, $block, $type, $variable, $description); - local($current_friend, $new_ranges, $new_desc); - local($data, %parameter_db); - local(%friends); - local(%defined_parameters); + my($thorn, @data) = @_; + my($line_number, $line, $block, $type, $variable, $description); + my($current_friend, $new_ranges, $new_desc); + my($data, %parameter_db); + my(%friends); + my(%defined_parameters); # The default block is private. @@ -296,8 +296,8 @@ sub parse_param_ccl #@@*/ sub print_parameter_database { - local(%parameter_database) = @_; - local($field); + my(%parameter_database) = @_; + my($field); foreach $field ( sort keys %parameter_database ) { @@ -322,9 +322,9 @@ sub print_parameter_database #@@*/ sub PrintParameterStatistics { - local($thorn, %parameter_database) = @_; - local($block); - local($sep); + my($thorn, %parameter_database) = @_; + my($block); + my($sep); $sep = " "; foreach $block ("Global", "Restricted", "Private") |