From 91d9f35c351b54547d7cab6d69c1ccc554d22d17 Mon Sep 17 00:00:00 2001 From: allen Date: Wed, 20 Oct 1999 12:46:22 +0000 Subject: 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 --- lib/sbin/BuildHeaders.pl | 88 ++--- lib/sbin/CSTUtils.pl | 39 ++ lib/sbin/CreateImplementationBindings.pl | 14 +- lib/sbin/CreateParameterBindings.pl | 316 ++++++++------- lib/sbin/CreateScheduleBindings.pl | 634 ++++++++++++++++++++++++++++--- lib/sbin/GridFuncStuff.pl | 87 +++-- lib/sbin/Runtest.pl | 2 +- lib/sbin/output_config.pl | 8 +- 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 (
) { - open(HEADER,"<$cctk_home/arrangements/$arrangement/$thorn/src/$inc_file1"); - while (
) - { - 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 (
) { - open(HEADER,"<$cctk_home/arrangements/$arrangement/$thorn/src/$inc_file1"); - while (
) - { - 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 () + { + $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 <make.code.defn"); +# print 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 < -#include -#include -#include "config.h" -#include "cctk_Misc.h" -#include "cctk_WarnLevel.h" +# print 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 < 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 \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 < - - 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 () { 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; } -- cgit v1.2.3