summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorallen <allen@17b73243-c579-4c4c-a9d2-2d5706c11dac>1999-10-20 12:46:22 +0000
committerallen <allen@17b73243-c579-4c4c-a9d2-2d5706c11dac>1999-10-20 12:46:22 +0000
commit91d9f35c351b54547d7cab6d69c1ccc554d22d17 (patch)
tree27eb648bc7abc83a8c687c390e60fbf56c8c58f6
parent019f6271792eba1d1d4d9c385bd545638d8d3cc4 (diff)
CST only writes files which have changed (still a couple more writes
to replace). Also a bug fix for Build Headers for when the file to be included is in the include directory of the thorn. git-svn-id: http://svn.cactuscode.org/flesh/trunk@1068 17b73243-c579-4c4c-a9d2-2d5706c11dac
-rw-r--r--lib/sbin/BuildHeaders.pl88
-rw-r--r--lib/sbin/CSTUtils.pl39
-rw-r--r--lib/sbin/CreateImplementationBindings.pl14
-rw-r--r--lib/sbin/CreateParameterBindings.pl316
-rw-r--r--lib/sbin/CreateScheduleBindings.pl634
-rw-r--r--lib/sbin/GridFuncStuff.pl87
-rw-r--r--lib/sbin/Runtest.pl2
-rw-r--r--lib/sbin/output_config.pl8
8 files changed, 891 insertions, 297 deletions
diff --git a/lib/sbin/BuildHeaders.pl b/lib/sbin/BuildHeaders.pl
index 9ab4e6eb..9dbd6e58 100644
--- a/lib/sbin/BuildHeaders.pl
+++ b/lib/sbin/BuildHeaders.pl
@@ -14,6 +14,7 @@
# @endhistory
#@@*/
+require "$sbin_dir/CSTUtils.pl";
sub BuildHeaders
{
@@ -24,35 +25,12 @@ sub BuildHeaders
chdir $bindings_dir;
chdir include;
-# First delete all global include files since we will be appending
+# First set all data strings
foreach $thorn (split(" ",$interface_database{"THORNS"}))
{
foreach $inc_file (split(" ",$interface_database{"\U$thorn USES HEADER"}))
{
- if (-e $inc_file)
- {
- system("rm $inc_file");
- }
- }
- }
-
-# Create all the global include files used by thorns
- foreach $thorn (split(" ",$interface_database{"THORNS"}))
- {
- foreach $inc_file (split(" ",$interface_database{"\U$thorn USES HEADER"}))
- {
- if (!-e $inc_file)
- {
- open(OUT,">$inc_file") || die "Cannot open $inc_dir";
- print OUT "/* Include file $inc_file used by $thorn */\n";
- close OUT;
- }
- else
- {
- open(OUT,">>$inc_file") || die "Cannot open $inc_dir";
- print OUT "/* Include file $inc_file used by $thorn */\n";
- close OUT;
- }
+ $data{"$inc_file"} = "/* Include file $inc_file used by $thorn */\n";
}
}
@@ -69,42 +47,48 @@ sub BuildHeaders
$inc_file1 =~ s/ //g;
$inc_file2 = $interface_database{"\U$thorn ADD HEADER $inc_file1 TO"};
- # Write information to the global include file
- open(OUT,">>$inc_file2") || die "Cannot open $inc_dir2";
- print OUT "/* Including file $inc_file1 from $thorn */\n";
+ # Write information to the global include file
+ $data{"$inc_file2"} .= "/* Including file $inc_file1 from $thorn */\n";
- # Now have to find the include file and copy it
- if (-e "$cctk_home/arrangements/$arrangement/$thorn/src/$inc_file1")
+ # Now have to find the include file and copy it
+ if (-e "$cctk_home/arrangements/$arrangement/$thorn/src/$inc_file1")
+ {
+ open(HEADER,"<$cctk_home/arrangements/$arrangement/$thorn/src/$inc_file1");
+ while (<HEADER>)
{
- open(HEADER,"<$cctk_home/arrangements/$arrangement/$thorn/src/$inc_file1");
- while (<HEADER>)
- {
- print OUT;
- }
- print OUT "\n\n\n";
- close HEADER;
+ $data{"$inc_file2"} .= $_;
}
- elsif (-e "$cctk_home/arrangements/$arrangement/$thorn/src/include/$inc_file1")
+ $data{"$inc_file2"} .= "\n\n\n";
+ close HEADER;
+ }
+ elsif (-e "$cctk_home/arrangements/$arrangement/$thorn/src/include/$inc_file1")
+ {
+ open(HEADER,"<$cctk_home/arrangements/$arrangement/$thorn/src/include/$inc_file1");
+ while (<HEADER>)
{
- open(HEADER,"<$cctk_home/arrangements/$arrangement/$thorn/src/$inc_file1");
- while (<HEADER>)
- {
- print OUT;
- }
- print OUT "\n\n\n";
- close HEADER;
+ $data{"$inc_file2"} .= $_;
}
- else
- {
- $message = "Include file $inc_file1 not found in $arrangement/$thorn\n";
- &CST_error(0,$message,__LINE__,__FILE__);
- }
- print OUT "/* End of include file $inc_file1 from $thorn */\n";
- close OUT;
+ $data{"$inc_file2"} .= "\n\n\n";
+ close HEADER;
+ }
+ else
+ {
+ $message = "Include file $inc_file1 not found in $arrangement/$thorn\n";
+ &CST_error(0,$message,__LINE__,__FILE__);
+ }
+ $data{"$inc_file2"} .= "/* End of include file $inc_file1 from $thorn */\n";
}
}
}
+ foreach $thorn (split(" ",$interface_database{"THORNS"}))
+ {
+ foreach $inc_file1 (split(" ",$interface_database{"\U$thorn USES HEADER"}))
+ {
+ &WriteFile($inc_file1,$data{"$inc_file1"});
+ }
+ }
+
chdir $start_dir;
return;
diff --git a/lib/sbin/CSTUtils.pl b/lib/sbin/CSTUtils.pl
index e56a85e0..20966453 100644
--- a/lib/sbin/CSTUtils.pl
+++ b/lib/sbin/CSTUtils.pl
@@ -134,6 +134,45 @@ sub chompme
}
}
+#/*@@
+# @routine WriteFile
+# @date Tue Oct 19 21:09:12 CEST 1999
+# @author Gabrielle Allen
+# @desc
+# Writes a file only if the contents haven't changed
+# @enddesc
+# @calls
+# @calledby
+# @history
+#
+# @endhistory
+#@@*/
+
+sub WriteFile
+{
+ local ($filename,$data) = @_;
+ local ($data_in);
+
+# Read in file
+ $data_in = "";
+ if (-e $filename)
+ {
+ open(IN, "<$filename");
+ while (<IN>)
+ {
+ $data_in .= $_;
+ }
+ }
+
+ if ($data ne $data_in)
+ {
+ print "Creating new file $filename\n";
+ open(OUT, ">$filename") || die("Can't open $filename\n");
+ print OUT $data;
+ close OUT;
+ }
+
+}
1;
diff --git a/lib/sbin/CreateImplementationBindings.pl b/lib/sbin/CreateImplementationBindings.pl
index 93d62d07..91017d4a 100644
--- a/lib/sbin/CreateImplementationBindings.pl
+++ b/lib/sbin/CreateImplementationBindings.pl
@@ -59,14 +59,16 @@ sub CreateImplementationBindings
&OutputFile(".", "ImplementationBindings.c", @data);
- open (OUT, ">make.code.defn");
- print OUT <<EOF;
-
-SRCS = ImplementationBindings.c
+# open (OUT, ">make.code.defn");
+# print OUT <<EOF;
+$dataout = "";
+$dataout .= "\n";
+$dataout .= "SRCS = ImplementationBindings.c\n\n";
-EOF
+ &WriteFile("make.code.defn",$dataout);
+#EOF
- close OUT;
+# close OUT;
chdir $_start_dir;
}
diff --git a/lib/sbin/CreateParameterBindings.pl b/lib/sbin/CreateParameterBindings.pl
index 2eae2c6f..79f551bb 100644
--- a/lib/sbin/CreateParameterBindings.pl
+++ b/lib/sbin/CreateParameterBindings.pl
@@ -65,14 +65,17 @@ sub CreateParameterBindings
@data = &CreateParameterBindingFile("CCTK_BindingsParametersGlobal", "GLOBAL_PARAMETER_STRUCT", scalar(keys %these_parameters), %these_parameters, %parameter_database);
- open (OUT, ">Global.c") || die "Cannot open Global.c";
+# open (OUT, ">Global.c") || die "Cannot open Global.c";
+
+ $dataout = "";
foreach $line (@data)
{
- print OUT "$line\n";
+ $dataout .= "$line\n";
}
- close OUT;
+ &WriteFile("Global.c",$dataout);
+# close OUT;
$files = "Global.c";
$structures{"GLOBAL_PARAMETER_STRUCT"} = "cctk_params_global";
@@ -84,14 +87,15 @@ sub CreateParameterBindings
@data = &CreateCStructureParameterHeader("CCTK_BindingsParametersGlobal", "GLOBAL_PARAMETER_STRUCT", scalar(keys %these_parameters), %these_parameters, %parameter_database);
- open (OUT, ">ParameterCGlobal.h") || die "Cannot open ParameterCGlobal.h";
+# open (OUT, ">ParameterCGlobal.h") || die "Cannot open ParameterCGlobal.h";
+ $dataout = "";
foreach $line (@data)
{
- print OUT "$line\n";
+ $dataout .= "$line\n";
}
-
- close OUT;
+ &WriteFile("ParameterCGlobal.h",$dataout);
+# close OUT;
$header_files{"GLOBAL"} = "ParameterCGlobal.h";
@@ -111,14 +115,14 @@ sub CreateParameterBindings
{
@data = &CreateParameterBindingFile("CCTK_BindingsParameters$implementation"."_restricted", "RESTRICTED_\U$implementation\E_STRUCT", scalar(keys %these_parameters), %these_parameters, %parameter_database);
- open (OUT, ">\U$implementation\E". "_restricted.c") || die "Cannot open \U$implementation\E"."_restricted.c";
-
+# open (OUT, ">\U$implementation\E". "_restricted.c") || die "Cannot open \U$implementation\E"."_restricted.c";
+ $dataout = "";
foreach $line (@data)
{
- print OUT "$line\n";
+ $dataout .= "$line\n";
}
-
- close OUT;
+ &WriteFile("\U$implementation\E". "_restricted.c",$dataout);
+# close OUT;
$files .= " \U$implementation\E". "_restricted.c";
$routines{"CCTK_BindingsParameters$implementation"."_restricted"} = "$implementation";
@@ -131,14 +135,16 @@ sub CreateParameterBindings
@data = &CreateCStructureParameterHeader("CCTK_BindingsParameters$implementation"."_restricted", "RESTRICTED_\U$implementation\E_STRUCT", scalar(keys %these_parameters), %these_parameters, %parameter_database);
- open (OUT, ">ParameterCRestricted\U$implementation\E".".h") || die "Cannot open ParameterCRestricted\U$implementation\E".".h";
+# open (OUT, ">ParameterCRestricted\U$implementation\E".".h") || die "Cannot open ParameterCRestricted\U$implementation\E".".h";
+ $dataout = "";
foreach $line (@data)
{
- print OUT "$line\n";
+ $dataout .= "$line\n";
}
- close OUT;
+ &WriteFile("ParameterCRestricted\U$implementation\E".".h",$dataout);
+# close OUT;
$header_files{"\U$implementation\E RESTRICTED"} = "ParameterCRestricted\U$implementation\E".".h";
@@ -157,14 +163,15 @@ sub CreateParameterBindings
{
@data = &CreateParameterBindingFile("CCTK_BindingsParameters$thorn"."_private", "PRIVATE_\U$thorn\E_STRUCT", scalar(keys %these_parameters), %these_parameters, %parameter_database);
- open (OUT, ">\U$thorn\E"."_private.c") || die "Cannot open \U$thorn\E"."_private.c";
+# open (OUT, ">\U$thorn\E"."_private.c") || die "Cannot open \U$thorn\E"."_private.c";
+ $dataout = "";
foreach $line (@data)
{
- print OUT "$line\n";
+ $dataout .= "$line\n";
}
-
- close OUT;
+ &WriteFile("\U$thorn\E"."_private.c",$dataout);
+# close OUT;
$files .= " \U$thorn\E". "_private.c";
$routines{"CCTK_BindingsParameters$thorn"."_private"} = "$thorn";
@@ -178,14 +185,16 @@ sub CreateParameterBindings
$structures{"PRIVATE_\U$thorn\E_STRUCT"} = "$thorn"."priv";
- open (OUT, ">ParameterCPrivate\U$thorn\E".".h") || die "Cannot open ParameterCPrivate\U$thorn\E".".h";
+# open (OUT, ">ParameterCPrivate\U$thorn\E".".h") || die "Cannot open ParameterCPrivate\U$thorn\E".".h";
+ $dataout = "";
foreach $line (@data)
{
- print OUT "$line\n";
+ $dataout .= "$line\n";
}
- close OUT;
+ &WriteFile("ParameterCPrivate\U$thorn\E".".h",$dataout);
+# close OUT;
$header_files{"\U$thorn\E PRIVATE"} = "ParameterCPrivate\U$thorn\E".".h";
@@ -195,32 +204,33 @@ sub CreateParameterBindings
}
}
- open (OUT, ">BindingsParameters.c") || die "Cannot open BindingsParameters.c";
+# open (OUT, ">BindingsParameters.c") || die "Cannot open BindingsParameters.c";
+ $dataout = "";
- print OUT <<EOT;
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include "config.h"
-#include "cctk_Misc.h"
-#include "cctk_WarnLevel.h"
+# print OUT <<EOT;
+$dataout .= "\#include <stdio.h>\n";
+$dataout .= "\#include <stdlib.h>\n";
+$dataout .= "\#include <string.h>\n";
+$dataout .= "\#include \"config.h\"\n";
+$dataout .= "\#include \"cctk_Misc.h\"\n";
+$dataout .= "\#include \"cctk_WarnLevel.h\"\n";
-EOT
+#EOT
foreach $routine ((keys %routines), "CCTK_BindingsParametersGlobal")
{
- print OUT "int $routine"."Initialise(void);\n";
+ $dataout .= "int $routine"."Initialise(void);\n";
# print OUT "int $routine"."Set(const char *param, const char *value);\n";
# print OUT "int $routine"."Get(const char *param, void **data);\n";
- print OUT "int $routine"."Help(const char *param, const char *format, FILE *file);\n";
+ $dataout .= "int $routine"."Help(const char *param, const char *format, FILE *file);\n";
}
-print OUT <<EOT;
+#print OUT <<EOT;
-int CCTKi_BindingsParametersInitialise(void)
-{
+$dataout .= "int CCTKi_BindingsParametersInitialise(void)\n";
+$dataout .= "\{\n\n";
-EOT
+#EOT
# foreach $routine (keys %routines, "CCTK_BindingsParametersGlobal")
# {
@@ -229,20 +239,20 @@ EOT
foreach $thorn (split(" ",$interface_database{"THORNS"}))
{
- print OUT " CCTKi_BindingsCreate$thorn"."Parameters();\n\n";
+ $dataout .= " CCTKi_BindingsCreate$thorn"."Parameters();\n\n";
}
foreach $thorn (split(" ",$interface_database{"THORNS"}))
{
- print OUT " CCTKi_Bindings$thorn"."ParameterExtensions();\n\n";
+ $dataout .= " CCTKi_Bindings$thorn"."ParameterExtensions();\n\n";
}
- print OUT <<EOT;
+# print OUT <<EOT;
- return 0;
-}
+$dataout .= "return 0;\n";
+$dataout .= "}\n\n";
-EOT
+#EOT
#int CCTKi_BindingsParameterSet(const char *identifier, const char *value)
#{
@@ -347,88 +357,91 @@ EOT
# return retval;
#}
- print OUT <<EOT;
-int CCTKi_BindingsParameterHelp(const char *identifier, const char *format, FILE *file)
-{
- int retval = 1;
- int temp_retval;
- char *implementation = NULL;
- char *param_name = NULL;
+# print OUT <<EOT;
+$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";
- if(! identifier )
- {
- retval = CCTK_BindingsParametersGlobalHelp(identifier, format, file);
+$dataout .=" if(! identifier )\n";
+$dataout .=" {\n";
+$dataout .=" retval = CCTK_BindingsParametersGlobalHelp(identifier, format, file);\n\n";
-EOT
+#EOT
foreach $routine (keys %routines, "CCTK_BindingsParametersGlobal")
{
- print OUT " temp_retval = $routine"."Help(param_name, format, file);";
+ $dataout .= " temp_retval = $routine"."Help(param_name, format, file);";
- print OUT <<EOT;
-
- if(!temp_retval)
- {
- retval = 0;
- }
-EOT
+# print OUT <<EOT;
+$dataout .= "\n";
+$dataout .=" if(!temp_retval)\n";
+$dataout .=" {\n";
+$dataout .=" retval = 0;\n";
+$dataout .=" }\n";
+#EOT
}
- print OUT <<EOT;
+# print OUT <<EOT;
- return retval;
- }
+#$dataout .=" return retval;\n";
+$dataout .=" }\n\n";
- Util_SplitString(&implementation, &param_name, identifier, "::");
+$dataout .=" Util_SplitString(\&implementation, &param_name, identifier, \"::\");\n\n";
- if(!implementation)
- {
- retval = CCTK_BindingsParametersGlobalHelp(identifier, format, file);
- }
- else
- {
-EOT
+$dataout .=" if(!implementation)\n";
+$dataout .=" {\n";
+$dataout .=" retval = CCTK_BindingsParametersGlobalHelp(identifier, format, file);\n";
+$dataout .=" }\n";
+$dataout .=" else\n";
+$dataout .=" { \n";
+#EOT
foreach $routine (keys %routines, "CCTK_BindingsParametersGlobal")
{
- print OUT <<EOT;
-
- if(CCTK_Equals(implementation, \"$routines{$routine}\"))
- {
-EOT
- print OUT " temp_retval = $routine"."Help(param_name, format, file);";
+# print OUT <<EOT;
+$dataout .= "\n";
+$dataout .=" if(CCTK_Equals(implementation, \"$routines{$routine}\"))\n";
+$dataout .=" {\n";
+#EOT
+ $dataout .= " temp_retval = $routine"."Help(param_name, format, file);";
- print OUT <<EOT;
-
- if(!temp_retval)
- {
- retval = 0;
- }
- }
-EOT
- }
-
- print OUT <<EOT;
+# print OUT <<EOT;
+$dataout .= "\n";
+$dataout .=" if(!temp_retval) \n";
+$dataout .=" {\n";
+$dataout .=" retval = 0;\n";
+$dataout .=" }\n";
+$dataout .=" }\n";
+#EOT
}
- free(implementation);
- free(param_name);
- return retval;
-}
+# print OUT <<EOT;
+$dataout .=" }\n";
+$dataout .="\n";
+$dataout .=" free(implementation);\n";
+$dataout .=" free(param_name);\n";
+$dataout .=" return retval;\n";
+$dataout .="}\n\n";
-EOT
+#EOT
- close OUT;
+ &WriteFile("BindingsParameters.c",$dataout);
+# close OUT;
$newfilelist = NewParamStuff($n_param_database, @rest);
- open (OUT, ">make.code.defn") || die "Cannot open make.code.defn";
+# open (OUT, ">make.code.defn") || die "Cannot open make.code.defn";
+ $dataout = "";
- print OUT "SRCS = BindingsParameters.c $files $newfilelist\n";
+ $dataout .= "SRCS = BindingsParameters.c $files $newfilelist\n";
- close OUT;
+ &WriteFile("make.code.defn",$dataout);
+# close OUT;
# Create the appropriate thorn parameter headers
@@ -440,50 +453,53 @@ EOT
@data = &CreateFortranThornParameterBindings($thorn, $n_param_database, @rest);
- open(OUT, ">\U$thorn\E"."_FParameters.h") || die "Cannot open \U$thorn\E"."_FParameters.h";
+# open(OUT, ">\U$thorn\E"."_FParameters.h") || die "Cannot open \U$thorn\E"."_FParameters.h";
+ $dataout = "";
foreach $line (@data)
{
- print OUT "$line\n";
+ $dataout .= "$line\n";
}
- close OUT;
+ &WriteFile("\U$thorn\E"."_FParameters.h",$dataout);
+# close OUT;
- open(OUT, ">\U$thorn\E"."_CParameters.h") || die "Cannot open \U$thorn\E"."_CParameters.h";
+# open(OUT, ">\U$thorn\E"."_CParameters.h") || die "Cannot open \U$thorn\E"."_CParameters.h";
+ $dataout = "";
$implementation = $interface_database{"\U$thorn\E IMPLEMENTS"};
- print OUT <<EOT;
+# print OUT <<EOT;
-\#ifndef _\U$thorn\E_PARAMETERS_H_
+$dataout .= "\#ifndef _\U$thorn\E_PARAMETERS_H_\n\n";
-\#define _\U$thorn\E_PARAMETERS_H_
+$dataout .= "\#define _\U$thorn\E_PARAMETERS_H_\n\n";
-EOT
+#EOT
if($header_files{"GLOBAL"})
{
- print OUT "#include \"". $header_files{"GLOBAL"} ."\"\n";
+ $dataout .= "#include \"". $header_files{"GLOBAL"} ."\"\n";
}
if($header_files{"\U$implementation\E RESTRICTED"})
{
- print OUT "#include \"". $header_files{"\U$implementation\E RESTRICTED"}."\"\n";
+ $dataout .= "#include \"". $header_files{"\U$implementation\E RESTRICTED"}."\"\n";
}
if($header_files{"\U$thorn\E PRIVATE"})
{
- print OUT "#include \"".$header_files{"\U$thorn\E PRIVATE"}."\"\n";
+ $dataout .= "#include \"".$header_files{"\U$thorn\E PRIVATE"}."\"\n";
}
- print OUT "\n";
+ $dataout .= "\n";
@data = ();
foreach $friend (split(" ",$parameter_database{"\U$thorn\E SHARES implementations"}))
{
$friend_implementation = $interface_database{"\U$friend\E IMPLEMENTS"};
- print OUT "#include \"ParameterCRestricted\U$friend\E.h\"\n";
+ $dataout .= "#include \"ParameterCRestricted\U$friend\E.h\"\n";
$interface_database{"IMPLEMENTATION \U$friend\E THORNS"} =~ m:([^ ]*):;
@@ -502,39 +518,41 @@ EOT
}
}
- print OUT "#define DECLARE_CCTK_PARAMETERS \\\n";
+ $dataout .= "#define DECLARE_CCTK_PARAMETERS \\\n";
$decl = "DECLARE_GLOBAL_PARAMETER_STRUCT_PARAMS";
if($header_files{"GLOBAL"})
{
- print OUT "$decl \\\n";
+ $dataout .= "$decl \\\n";
}
$decl = "DECLARE_RESTRICTED_\U$implementation\E_STRUCT_PARAMS";
if($header_files{"\U$implementation\E RESTRICTED"})
{
- print OUT "$decl \\\n";
+ $dataout .= "$decl \\\n";
}
$decl = "DECLARE_PRIVATE_\U$thorn\E_STRUCT_PARAMS";
if($header_files{"\U$thorn\E PRIVATE"})
{
- print OUT "$decl \\\n";
+ $dataout .= "$decl \\\n";
}
foreach $line (@data)
{
- print OUT $line . "\\\n";
+ $dataout .= $line . "\\\n";
}
- print OUT "\n";
+ $dataout .= "\n";
- print OUT "#endif\n";
+ $dataout .= "#endif\n";
- close OUT;
+ &WriteFile("\U$thorn\E"."_CParameters.h",$dataout);
+# close OUT;
}
- open(OUT, "| perl $cctk_home/lib/sbin/c_file_processor.pl $top/config-data > CParameterStructNames.h") || die "Cannot create CParameterStructNames.h by running c_file_procesor.pl";
+ open(OUT, "| perl $cctk_home/lib/sbin/c_file_processor.pl $top/config-data > CParameterStructNames.h") || die "Cannot create CParameterStructNames.h by running c_file_processor.pl";
+
foreach $structure (keys %structures)
{
print OUT "#define $structure FORTRAN_COMMON_NAME($structures{$structure})\n";
@@ -544,42 +562,46 @@ EOT
close OUT;
- open(OUT, ">CParameters.h") || die "Cannot open CParameters.h";
-
- print OUT "#include \"CParameterStructNames.h\"\n\n";
+# open(OUT, ">CParameters.h") || die "Cannot open CParameters.h";
+ $dataout = "";
+ $dataout .= "#include \"CParameterStructNames.h\"\n\n";
foreach $thorn (split(" ",$interface_database{"THORNS"}))
{
- print OUT "#ifdef THORN_IS_$thorn\n";
- print OUT "#include \"\U$thorn\E"."_CParameters.h\"\n";
- print OUT "#endif\n\n";
+ $dataout .= "\#ifdef THORN\_IS\_$thorn\n";
+ $dataout .= "\#include \"\U$thorn\E"."\_CParameters.h\"\n";
+ $dataout .= "\#endif\n\n";
}
+ &WriteFile("CParameters.h",$dataout);
+# close OUT;
- close OUT;
+# open(OUT, ">FParameters.h") || die "Cannot open FParameters.h";
- open(OUT, ">FParameters.h") || die "Cannot open FParameters.h";
+ $dataout = "";
foreach $thorn (split(" ",$interface_database{"THORNS"}))
{
- print OUT "#ifdef THORN_IS_$thorn\n";
- print OUT "#include \"\U$thorn\E"."_FParameters.h\"\n";
- print OUT "#endif\n\n";
+ $dataout .= "\#ifdef THORN_IS\_$thorn\n";
+ $dataout .= "\#include \"\U$thorn\E"."\_FParameters.h\"\n";
+ $dataout .= "\#endif\n\n";
}
+ &WriteFile("FParameters.h",$dataout);
+# close OUT;
- close OUT;
-
- open(OUT, ">cctk_parameters.h") || die "Cannot open cctk_parameters.h";
+# open(OUT, ">cctk_parameters.h") || die "Cannot open cctk_parameters.h";
+ $dataout = "";
- print OUT "#ifdef CCODE\n";
- print OUT "#include \"CParameters.h\"\n";
- print OUT "#endif\n\n";
+ $dataout .= "#ifdef CCODE\n";
+ $dataout .= "#include \"CParameters.h\"\n";
+ $dataout .= "#endif\n\n";
- print OUT "#ifdef FCODE\n";
- print OUT "#include \"FParameters.h\"\n";
- print OUT "#endif\n\n";
-
- close OUT;
+ $dataout .= "#ifdef FCODE\n";
+ $dataout .= "#include \"FParameters.h\"\n";
+ $dataout .= "#endif\n\n";
+
+ &WriteFile("cctk_parameters.h",$dataout);
+# close OUT;
chdir $start_dir;
@@ -677,14 +699,16 @@ sub NewParamStuff
push(@data, "}");
- open (OUT, ">Create$thorn"."Parameters.c");
+# open (OUT, ">Create$thorn"."Parameters.c");
+ $dataout = "";
foreach $line (@data)
{
- print OUT "$line\n";
+ $dataout .= "$line\n";
}
- close OUT;
+ &WriteFile("Create$thorn"."Parameters.c",$dataout);
+# close OUT;
@data=();
@creationdata=();
diff --git a/lib/sbin/CreateScheduleBindings.pl b/lib/sbin/CreateScheduleBindings.pl
index c2a06e6f..bb477f3b 100644
--- a/lib/sbin/CreateScheduleBindings.pl
+++ b/lib/sbin/CreateScheduleBindings.pl
@@ -1,19 +1,19 @@
#/*@@
# @file CreateScheduleBindings.pl
-# @date Sun Jul 25 00:53:43 1999
+# @date Thu Sep 16 23:30:21 1999
# @author Tom Goodale
# @desc
-# Schedule bindings stuff
+# New schedule stuff. Should be renamed !!!
# @enddesc
+# @version $Header$
#@@*/
-
#/*@@
# @routine CreateScheduleBindings
-# @date Thu Jan 28 15:27:16 1999
+# @date Fri Sep 17 14:16:23 1999
# @author Tom Goodale
# @desc
-# Create the bindings used for the scheduler.
+# Creates the schedule bindings.
# @enddesc
# @calls
# @calledby
@@ -24,97 +24,627 @@
#@@*/
sub CreateScheduleBindings
{
- local($bindings_dir,$n_thorns,@rest) = @_;
- local(%thorns);
+ local($bindings_dir, $n_interface_database, @rest) = @_;
local(%interface_database);
- local($wrapper, $rfr, $startup, %schedule_data);
-
- %thorns = @rest[0..2*$n_thorns-1];
- %interface_database = @rest[2*$n_thorns..$#rest];
+ 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];
+
if(! -d $bindings_dir)
{
mkdir("$bindings_dir", 0755) || die "Unable to create $bindings_dir";
}
$start_dir = `pwd`;
+
chdir $bindings_dir;
if(! -d "Schedule")
{
mkdir("Schedule", 0755) || die "Unable to create Schedule directory";
}
- chdir "Schedule";
- # Parse the schedule.ccl files
- if ($CST_debug)
+ if(! -d "include")
{
- print "DEBUG: Parsing schedule.ccl files\n";
+ mkdir("include", 0755) || die "Unable to create include directory";
}
- ($wrapper,$rfr,$startup, %schedule_data) = &create_schedule_code($bindings_dir,$n_thorns,%thorns,%interface_database);
- @rfr_files = split(" ",$rfr);
+ chdir "Schedule";
+
+ $file_list = "";
- # Write the contents of BindingsScheduleRegisterRFR.c
- if ($CST_debug)
+ foreach $thorn (sort split(" ", $interface_database{"THORNS"}))
{
- print "DEBUG: Creating RFR registration files\n";
+ $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);
+
+# close OUT;
+
+ $file_list .= " Schedule$thorn.c";
}
- &create_RegisterRFR($bindings_dir,scalar(@rfr_files), @rfr_files, %schedule_data);
- # Write the contents of BindingsScheduleRegisterSTARTUP.c
+ $buffer = ScheduleCreateBindings(scalar(keys %interface_database),
+ %interface_database, %schedule_database);
+
+
+# open(OUT, ">BindingsSchedule.c") || die "Unable to open BindingsSchedule.c";
+
+ &WriteFile("BindingsSchedule.c",$buffer);
+
+# close OUT;
+
+ $file_list .= " BindingsSchedule.c";
+
+# open(OUT, ">make.code.defn") || die "Unable to open make.code.defn";
+
+ &WriteFile("make.code.defn","SRCS = $file_list\n");
+
+# close OUT;
+
+ chdir "$start_dir";
+}
+
+#/*@@
+# @routine ScheduleCreateFile
+# @date Fri Sep 17 17:34:26 1999
+# @author Tom Goodale
+# @desc
+# Creates a string containing all the data which should go into a schedule file.
+# @enddesc
+# @calls
+# @calledby
+# @history
+#
+# @endhistory
+#
+#@@*/
+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];
- if ($CST_debug)
+ $implementation = $interface_database{"\U$thorn\E IMPLEMENTS"};
+
+ $buffer = $schedule_database{"\U$thorn\E FILE"};
+
+ # Process each schedule block
+ for($block = 0 ; $block < $schedule_database{"\U$thorn\E N_BLOCKS"}; $block++)
+ {
+ ($block_buffer, $block_prototype) = &ScheduleBlock($thorn, $implementation, $block,
+ $n_interface_database,
+ @rest);
+ $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++)
{
- print "DEBUG: Creating STARTUP registration files\n";
+ ($statement_buffer, $statement_prototype) = &ScheduleStatement($thorn, $implementation, $statement,
+ $n_interface_database,
+ @rest);
+ $buffer =~ s:\@STATEMENT\@$statement:$statement_buffer:;
+ $prototypes .= "$statement_prototype";
}
- &create_RegisterSTARTUP($bindings_dir,split(" ",$startup));
+
+ # Actually create the string
+
+ # Header stuff
+ $outbuf = "";
+ $outbuf .= "\#define THORN_IS_$thorn\n";
+ $outbuf .= "\n";
+ $outbuf .= "\#include <stdarg.h>\n";
+ $outbuf .= "\n";
+ $outbuf .= "\#include \"cctk.h\"\n";
+ $outbuf .= "\#include \"cctk_parameters.h\"\n";
+ $outbuf .= "\#include \"cctk_schedule.h\"\n";
+ $outbuf .= "\#include \"cctk_Flesh.h\"\n";
+ $outbuf .= "\#include \"cctk_Comm.h\"\n";
+ $outbuf .= "\n";
+ $outbuf .= "/* Prototypes for functions to be registered. */\n";
+ $outbuf .= "$prototypes\n";
+ $outbuf .= "\n";
+ $outbuf .= "/*\@\@\n";
+ $outbuf .= " \@routine CCTKi_BindingsSchedule_$thorn\n";
+ $outbuf .= " \@date \n";
+ $outbuf .= " \@author \n";
+ $outbuf .= " \@desc \n";
+ $outbuf .= " Creates the schedule bindings for thorn $thorn\n";
+ $outbuf .= " \@enddesc \n";
+ $outbuf .= " \@calls \n";
+ $outbuf .= " \@calledby \n";
+ $outbuf .= " \@history \n";
+ $outbuf .= "\n";
+ $outbuf .= " \@endhistory\n";
+ $outbuf .= "\n";
+ $outbuf .= "\@\@*/\n";
+ $outbuf .= "void CCTKi_BindingsSchedule_$thorn(void)\n";
+ $outbuf .= "{\n";
+ $outbuf .= " DECLARE_CCTK_PARAMETERS\n";
+ $outbuf .= "$buffer\n";
+ $outbuf .= "}\n";
+ $outbuf .= "\n";
+
+ return $outbuf;
+
+}
+
+#/*@@
+# @routine ScheduleCreateBindings
+# @date Fri Sep 17 18:17:13 1999
+# @author Tom Goodale
+# @desc
+# Creates a string containing all the data which should go into the master
+# schedule bindings file.
+# @enddesc
+# @calls
+# @calledby
+# @history
+#
+# @endhistory
+#
+#@@*/
+sub ScheduleCreateBindings
+{
+ local($n_interface_database, @rest) = @_;
+ local(%interface_database);
+ local(%schedule_database);
+
+ 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];
- open (OUT, ">BindingsSchedule.c") || die "Cannot open BindingsSchedule.c";
+
+ $outbuf = "";
+ $outbuf .= "\#include \"SKBinTree.h\"\n";
+ $outbuf .= "\#include \"cctk_ActiveThorns.h\"\n";
+ $outbuf = "\n";
+ $outbuf .= "/* Prototypes for functions to be registered. */";
- print OUT <<EOT;
-#include <stdio.h>
-
- int CCTKi_BindingsScheduleInitialise(void)
+ foreach $thorn (sort split(" ", $interface_database{"THORNS"}))
{
- return 0;
+ $outbuf .= "void CCTKi_BindingsSchedule_$thorn(void);\n";
}
- int CCTKi_BindingsScheduleRegister(const char *type, void *data)
+ $outbuf .= "/*\@\@\n";
+ $outbuf .= " \@routine CCTKi_BindingsScheduleInitialise\n";
+ $outbuf .= " \@date \n";
+ $outbuf .= " \@author \n";
+ $outbuf .= " \@desc \n";
+ $outbuf .= " Calls all the thorn schedule bindings file if the thorns are active.\n";
+ $outbuf .= " \@enddesc \n";
+ $outbuf .= " \@calls \n";
+ $outbuf .= " \@calledby \n";
+ $outbuf .= " \@history \n";
+ $outbuf .= "\n";
+ $outbuf .= " \@endhistory\n";
+ $outbuf .= "\n";
+ $outbuf .= "\@\@*/\n";
+ $outbuf .= "int CCTKi_BindingsScheduleInitialise(void)\n";
+ $outbuf .= "{\n";
+ foreach $thorn (sort split(" ", $interface_database{"THORNS"}))
{
-
- if (CCTK_Equals(type,"STARTUP"))
+ $outbuf .= " if(CCTK_IsThornActive(\"$thorn\"))\n";
+ $outbuf .= " {\n";
+ $outbuf .= " CCTKi_BindingsSchedule_$thorn();\n";
+ $outbuf .= " }\n";
+ }
+ $outbuf .= " return 0;\n";
+ $outbuf .= "}\n";
+ $outbuf .= "\n";
+
+ return $outbuf;
+}
+#/*@@
+# @routine ScheduleBlock
+# @date Fri Sep 17 17:37:59 1999
+# @author Tom Goodale
+# @desc
+# Creates the code for a given schedule block
+# @enddesc
+# @calls
+# @calledby
+# @history
+#
+# @endhistory
+#
+#@@*/
+sub ScheduleBlock
+{
+ local($thorn, $implementation, $block, $n_interface_database, @rest) = @_;
+ local(%interface_database);
+ local(%schedule_database);
+
+ 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];
+
+ # Extract group and routine information from the databases
+ @mem_groups = &ScheduleSelectGroups($thorn, $implementation,
+ $schedule_database{"\U$thorn\E BLOCK_$block STOR"},
+ %interface_database);
+
+ @comm_groups = &ScheduleSelectGroups($thorn, $implementation,
+ $schedule_database{"\U$thorn\E BLOCK_$block COMM"},
+ %interface_database);
+
+ @trigger_groups = &ScheduleSelectGroups($thorn, $implementation,
+ $schedule_database{"\U$thorn\E BLOCK_$block TRIG"},
+ %interface_database);
+
+
+ @before_list = &ScheduleSelectRoutines($thorn, $implementation,
+ $schedule_database{"\U$thorn\E BLOCK_$block BEFORE"},
+ %schedule_database);
+
+ @after_list = &ScheduleSelectRoutines($thorn, $implementation,
+ $schedule_database{"\U$thorn\E BLOCK_$block AFTER"},
+ %schedule_database);
+
+ @while_list = &ScheduleSelectVars($thorn, $implementation,
+ $schedule_database{"\U$thorn\E BLOCK_$block WHILE"},
+ %interface_database);
+
+
+ # Start writing out the data
+ if($schedule_database{"\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")
+ {
+ if($schedule_database{"\U$thorn\E BLOCK_$block LANG"} =~ m:^\s*C\s*$:i )
{
- Cactus_RegisterSTARTUP();
- }
- else if (CCTK_Equals(type,"RFRINIT"))
+ $language = "C";
+ $function = $schedule_database{"\U$thorn\E BLOCK_$block NAME"};
+ }
+ elsif($schedule_database{"\U$thorn\E BLOCK_$block LANG"} =~ m:^\s*(F|F77|FORTRAN|F90)\s*$:i )
{
- Cactus_RegisterRFR(data);
- } else {
- printf ("Unknown type in CCTKi_BindingsScheduleRegister");
+ $language = "Fortran";
+ $function = "FORTRAN_NAME(".$schedule_database{"\U$thorn\E BLOCK_$block NAME"} .")";
}
+ else
+ {
+ print STDERR "Unknown language " .$schedule_database{"\U$thorn\E BLOCK_$block LANG"} ."\n";
+ $CST_errors++;
+ return ("", "");
+ }
+ $prototype = "extern int $function(void); /* Note that this is a cheat, we just need a function pointer. */\n";
+ $buffer = " CCTK_ScheduleFunction($function,\n";
+ $indent = " ";
+ $buffer .= "$indent";
+ }
+ else
+ {
+ print STDERR "Internal error: Unknown schedule block type " . $schedule_database{"\U$thorn\E BLOCK_$block TYPE"} . "\n";
+ return ("", "");
+ $CST_errors++;
+ }
+
+ $buffer .= "\"" . $schedule_database{"\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";
+ if($language ne "")
+ {
+ $buffer .= $indent . "\"" . $language . "\"" . ",\n";
+ }
- return 0;
+ $buffer .= $indent . scalar(@mem_groups) . ", /* Number of STORAGE groups */\n";
+ $buffer .= $indent . scalar(@comm_groups) . ", /* Number of COMM groups */\n";
+ $buffer .= $indent . scalar(@trigger_groups) . ", /* Number of TRIGGERS groups */\n";
+ $buffer .= $indent . scalar(@before_list) . ", /* Number of BEFORE routines */\n";
+ $buffer .= $indent . scalar(@after_list) . ", /* Number of AFTER routines */\n";
+ $buffer .= $indent . scalar(@while_list) . " /* Number of WHILE variables */";
+
+ foreach $item (@mem_groups, @comm_groups, @trigger_groups, @before_list, @after_list, @while_list)
+ {
+ $buffer .= ",\n" . $indent . "\"" . $item . "\"" ;
+ }
+
+ $buffer .= ");\n\n";
+
+ return ($buffer, $prototype);
+}
+
+#/*@@
+# @routine ScheduleStatement
+# @date Fri Sep 17 17:38:30 1999
+# @author Tom Goodale
+# @desc
+# Creates the code for a given schedule statement
+# @enddesc
+# @calls
+# @calledby
+# @history
+#
+# @endhistory
+#
+#@@*/
+sub ScheduleStatement
+{
+ local($thorn, $implementation, $statement, $n_interface_database, @rest) = @_;
+ local(%interface_database);
+ local(%schedule_database);
+
+ local($buffer, $prototype);
+ local(@groups);
+ local($group);
+
+ # 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];
+
+ # Extract the groups.
+ @groups = &ScheduleSelectGroups($thorn, $implementation,
+ $schedule_database{"\U$thorn\E STATEMENT_$statement GROUPS"},
+ %interface_database);
+
+ if($schedule_database{"\U$thorn\E STATEMENT_$statement TYPE"} eq "STOR")
+ {
+ $function = "CCTK_ScheduleGroupStorage(";
+ }
+ elsif($schedule_database{"\U$thorn\E STATEMENT_$statement TYPE"} eq "COMM")
+ {
+ $function = "CCTK_ScheduleGroupComm(";
}
-
-EOT
+ else
+ {
+ print STDERR "Unknown statement type '" .$schedule_database{"\U$thorn\E STATEMENT_$statement TYPE"} ."'\n";
+ $CST_errors++;
+ return ("", "");
+ }
+
+ $prototype = "";
+
+ foreach $group (@groups)
+ {
+ $buffer .= " $function " . "\"" . $group . "\"" . ");\n"
+ }
+
+ return ($buffer, $prototype);
+}
+
+#/*@@
+# @routine ScheduleSelectGroups
+# @date Fri Sep 17 17:38:53 1999
+# @author Tom Goodale
+# @desc
+# Parses a list of variable groups and selects valid ones.
+# @enddesc
+# @calls
+# @calledby
+# @history
+#
+# @endhistory
+#
+#@@*/
+sub ScheduleSelectGroups
+{
+ local($thorn, $implementation, $group_list, %interface_database) = @_;
+ local(@groups);
+ local(@temp_list);
+ local($group);
+ local($other_imp, $other_thorn, $foundit, $block);
+
+ @temp_list = split(/[,\s\n]+/, $group_list);
- close OUT;
+ foreach $group (@temp_list)
+ {
+ next if($group =~ m:^\s*$:);
- open (OUT, ">make.code.defn") || die "Cannot open make.code.defn";
+ $other_imp = "";
- $files = "";
- foreach $file (split(" ",$rfr),split(" ",$startup),split(" ",$wrapper)) {
- if($file)
+ if($group =~ m/(.+)::(.+)/)
{
- $files = "$files ".$file.".c";
+ $other_imp=$1;
+ $group = $2;
+
+ if(($1 !~ m:^\s*$thorn\s*$:i) && ($1 !~ m:^\s*$implementation\s*$:i))
+ {
+ # 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)
+ {
+ $block = "PUBLIC";
+ }
+ elsif($interface_database{"IMPLEMENTATION \U$implementation\E FRIENDS"} =~ m:\b$other_imp\b:i)
+ {
+ $block = "PROTECTED";
+ }
+ else
+ {
+ print STDERR "Schedule error: Thorn $thorn - group $group doesn't exist.\n";
+ $CST_errors++;
+ next;
+ }
+
+ $interface_database{"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)
+ {
+ push(@groups, "$other_imp\::$group");
+ next;
+ }
+ else
+ {
+ print STDERR "Schedule error: Thorn $thorn - group $group doesn't exist.\n";
+ $CST_errors++;
+ next;
+ }
+ }
+ }
+
+ if($interface_database{"\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)
+ {
+ push(@groups, "$implementation\::$group");
+ }
+ elsif($interface_database{"\U$thorn\E PUBLIC GROUPS"} =~ m:\b$group\b:i)
+ {
+ push(@groups, "$implementation\::$group");
+ }
+ elsif($other_imp eq "")
+ {
+ $foundit = 0;
+ # Check ancestors and friends
+ foreach $other_imp (split(" ", $interface_database{"IMPLEMENTATION \U$implementation\E ANCESTORS"}))
+ {
+ $interface_database{"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)
+ {
+ push(@groups, "$other_imp\::$group");
+ $foundit = 1;
+ last;
+ }
+ }
+ if(! $foundit)
+ {
+ foreach $other_imp (split(" ", $interface_database{"IMPLEMENTATION \U$implementation\E FRIENDS"}))
+ {
+ $interface_database{"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)
+ {
+ push(@groups, "$other_imp\::$group");
+ $foundit = 1;
+ last;
+ }
+ }
+ }
+ if(! $foundit)
+ {
+ print STDERR "Schedule error: Thorn $thorn - group $group doesn't exist.\n";
+ $CST_errors++;
+ }
+ }
+ else
+ {
+ print STDERR "Schedule error: Thorn $thorn - group $group doesn't exist.\n";
+ $CST_errors++;
}
}
- print OUT "SRCS = BindingsSchedule.c Cactus_RegisterSTARTUP.c Cactus_RegisterRFR.c $files\n";
+ return @groups;
+}
+
+#/*@@
+# @routine ScheduleSelectRoutines
+# @date Fri Sep 17 17:39:29 1999
+# @author Tom Goodale
+# @desc
+# Parses a list of schedule routines/groups.
+# FIXME - should validate
+# @enddesc
+# @calls
+# @calledby
+# @history
+#
+# @endhistory
+#
+#@@*/
+sub ScheduleSelectRoutines
+{
+ local($thorn, $implementation, $routine_list, %schedule_database) = @_;
+ local(@routines);
+ local(@temp_list);
+ local($routine);
- close OUT;
+ @temp_list = split(/[,\s\n]+/, $routine_list);
+
+ foreach $routine (@temp_list)
+ {
+ next if($routine =~ m:^\s*$:);
+
+ push(@routines, $routine);
+
+ }
+
+ return @routines;
+}
+
+#/*@@
+# @routine ScheduleSelectVars
+# @date Fri Sep 17 17:39:58 1999
+# @author Tom Goodale
+# @desc
+# Parses a list of variables
+# FIXME - should validate
+# @enddesc
+# @calls
+# @calledby
+# @history
+#
+# @endhistory
+#
+#@@*/
+sub ScheduleSelectVars
+{
+ local($thorn, $implementation, $var_list, %interface_database) = @_;
+ local(@vars);
+ local(@temp_list);
+ local($var);
+
+ @temp_list = split(/[,\s\n]+/, $var_list);
+
+ foreach $var (@temp_list)
+ {
+ next if($var =~ m:^\s*$:);
+
+ push(@vars, $var);
+ }
- chdir $start_dir;
+ return @vars;
}
1;
diff --git a/lib/sbin/GridFuncStuff.pl b/lib/sbin/GridFuncStuff.pl
index a784d3a6..75f721c7 100644
--- a/lib/sbin/GridFuncStuff.pl
+++ b/lib/sbin/GridFuncStuff.pl
@@ -51,30 +51,34 @@ sub CreateVariableBindings
@data = &CreateThornArgumentHeaderFile($thorn, %interface_database);
- open(OUT, ">$thorn"."_arguments.h");
+ $dataout = "";
+# open(OUT, ">$thorn"."_arguments.h");
foreach $line (@data)
{
- print OUT "$line\n";
+ $dataout .= "$line\n";
}
- close OUT;
+ &WriteFile("$thorn\_arguments.h",$dataout);
+# close OUT;
}
- open(OUT, ">cctk_arguments.h");
+# open(OUT, ">cctk_arguments.h");
+ $dataout = "";
foreach $thorn (split(" ",$interface_database{"THORNS"}))
{
- print OUT "#ifdef THORN_IS_$thorn\n";
- print OUT "#include \"$thorn"."_arguments.h\"\n";
- print OUT "#define CCTK_FARGUMENTS \U$thorn"."_FARGUMENTS\n";
- print OUT "#define DECLARE_CCTK_FARGUMENTS DECLARE_\U$thorn"."_FARGUMENTS\n";
- print OUT "#define CCTK_CARGUMENTS \U$thorn"."_CARGUMENTS\n";
- print OUT "#define DECLARE_CCTK_CARGUMENTS DECLARE_\U$thorn"."_CARGUMENTS\n";
- print OUT "#endif\n\n";
+ $dataout .= "#ifdef THORN_IS_$thorn\n";
+ $dataout .= "#include \"$thorn"."_arguments.h\"\n";
+ $dataout .= "#define CCTK_FARGUMENTS \U$thorn"."_FARGUMENTS\n";
+ $dataout .= "#define DECLARE_CCTK_FARGUMENTS DECLARE_\U$thorn"."_FARGUMENTS\n";
+ $dataout .= "#define CCTK_CARGUMENTS \U$thorn"."_CARGUMENTS\n";
+ $dataout .= "#define DECLARE_CCTK_CARGUMENTS DECLARE_\U$thorn"."_CARGUMENTS\n";
+ $dataout .= "#endif\n\n";
}
- close OUT;
+ &WriteFile("cctk_arguments.h",$dataout);
+# close OUT;
chdir "..";
@@ -84,76 +88,85 @@ sub CreateVariableBindings
}
chdir "Variables";
- open (OUT, ">BindingsVariables.c") || die "Cannot open BindingsVariables.c";
+# open (OUT, ">BindingsVariables.c") || die "Cannot open BindingsVariables.c";
$filelist = "BindingsVariables.c";
+ $dataout = "";
+
foreach $thorn (split(" ",$interface_database{"THORNS"}))
{
- print OUT "int CactusBindingsVariables_$thorn"."_Initialise(void);\n";
+ $dataout .= "int CactusBindingsVariables_$thorn"."_Initialise(void);\n";
}
- print OUT "\n";
+ $dataout .= "\n";
- print OUT "int CCTKi_BindingsVariablesInitialise(void)\n{\n";
+ $dataout .= "int CCTKi_BindingsVariablesInitialise(void)\n{\n";
foreach $thorn (split(" ",$interface_database{"THORNS"}))
{
- print OUT " CactusBindingsVariables_$thorn"."_Initialise();\n";
+ $dataout .= " CactusBindingsVariables_$thorn"."_Initialise();\n";
}
- print OUT " return 0;\n}\n\n";
+ $dataout .= " return 0;\n}\n\n";
+
+ &WriteFile("BindingsVariables.c",$dataout);
- close OUT;
+# close OUT;
foreach $thorn (split(" ",$interface_database{"THORNS"}))
{
- open(OUT, ">$thorn.c") || die "Cannot create $thorn.c";
+ $dataout = "";
+
+# open(OUT, ">$thorn.c") || die "Cannot create $thorn.c";
- print OUT "\#include \"cctk_Groups.h\"\n";
- print OUT "\#include \"cctk_FortranWrappers.h\"\n";
+ $dataout .= "\#include \"cctk_Groups.h\"\n";
+ $dataout .= "\#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);";
+ $dataout .= "int CCTKi_BindingsFortranWrapper$thorn(void *GH, void *fpointer);";
- print OUT "int CactusBindingsVariables_$thorn"."_Initialise(void)\n{\n";
+ $dataout .= "int CactusBindingsVariables_$thorn"."_Initialise(void)\n{\n";
foreach $block ("PUBLIC", "PROTECTED", "PRIVATE")
{
@data = &CreateThornGroupInitialisers($thorn, $block, %interface_database);
foreach $line (@data)
{
- print OUT "$line\n";
+ $dataout .= "$line\n";
}
}
- print OUT " CCTK_RegisterFortranWrapper(\"$thorn\", CCTKi_BindingsFortranWrapper$thorn);\n\n";
+ $dataout .= " CCTK_RegisterFortranWrapper(\"$thorn\", CCTKi_BindingsFortranWrapper$thorn);\n\n";
- print OUT " return 0;\n};\n";
- close OUT;
+ $dataout .= " return 0;\n};\n";
+
+ &WriteFile("$thorn.c",$dataout);
+# close OUT;
$filelist .= " $thorn.c";
}
foreach $thorn (split(" ",$interface_database{"THORNS"}))
{
- open(OUT, ">$thorn\_FortranWrapper.c") || die "Cannot create $thorn\_FortranWrapper.c";
-
+# open(OUT, ">$thorn\_FortranWrapper.c") || die "Cannot create $thorn\_FortranWrapper.c";
+ $dataout = "";
+
@data = &CreateThornFortranWrapper($thorn);
foreach $line (@data)
{
- print OUT "$line\n";
+ $dataout .= "$line\n";
}
- close OUT;
+ &WriteFile("$thorn\_FortranWrapper.c",$dataout);
+# close OUT;
$filelist .= " $thorn\_FortranWrapper.c";
}
- open (OUT, ">make.code.defn") || die "Cannot open make.code.defn";
-
- print OUT "SRCS = $filelist\n";
-
- close OUT;
+# open (OUT, ">make.code.defn") || die "Cannot open make.code.defn";
+ $dataout = "SRCS = $filelist\n";
+ &WriteFile("make.code.defn",$dataout);
+# close OUT;
chdir $start_dir;
}
diff --git a/lib/sbin/Runtest.pl b/lib/sbin/Runtest.pl
index 6692b9db..7d83cc08 100644
--- a/lib/sbin/Runtest.pl
+++ b/lib/sbin/Runtest.pl
@@ -233,7 +233,7 @@ sub runtest {
printf "Issuing $cmd\n";
$retcode = 0;
open (CMD, "$cmd |");
- open (LOG, "> ${sep}$tp.log");
+ open (LOG, "> $tp.log");
while (<CMD>) {
print LOG;
diff --git a/lib/sbin/output_config.pl b/lib/sbin/output_config.pl
index b0d70b9a..ed1193e0 100644
--- a/lib/sbin/output_config.pl
+++ b/lib/sbin/output_config.pl
@@ -12,14 +12,16 @@ sub OutputFile
{
local($directory, $file, @data) = @_;
- open(OUT, ">$directory/$file") || die "Can't open $file in $directory\n";
+# open(OUT, ">$directory/$file") || die "Can't open $file in $directory\n";
+ $dataout = "";
foreach $line (@data)
{
- print OUT "$line\n";
+ $dataout .= "$line\n";
}
- close OUT;
+ &WriteFile("$directory/$file",$dataout);
+# close OUT;
}