diff options
| -rw-r--r-- | lib/sbin/CST | 47 | ||||
| -rw-r--r-- | lib/sbin/CSTUtils.pl | 92 | ||||
| -rw-r--r-- | lib/sbin/GridFuncStuff.pl | 53 | ||||
| -rw-r--r-- | lib/sbin/NewCreateScheduleBindings.pl | 12 | ||||
| -rw-r--r-- | lib/sbin/ScheduleParser.pl | 35 | ||||
| -rw-r--r-- | lib/sbin/interface_parser.pl | 48 | ||||
| -rw-r--r-- | lib/sbin/parameter_parser.pl | 128 | ||||
| -rw-r--r-- | src/include/cctk_GroupsOnGH.h | 5 | ||||
| -rw-r--r-- | src/main/CactusDefaultInitialise.c | 15 | ||||
| -rw-r--r-- | src/main/CallStartupFunctions.c | 3 | ||||
| -rw-r--r-- | src/main/GroupsOnGH.c | 148 | ||||
| -rw-r--r-- | src/main/InitialiseCactus.c | 31 | ||||
| -rw-r--r-- | src/main/InitialiseDataStructures.c | 2 | ||||
| -rw-r--r-- | src/main/ScheduleInterface.c | 211 | ||||
| -rw-r--r-- | src/main/make.code.defn | 4 | ||||
| -rw-r--r-- | src/main/rfrInterface.c | 292 | ||||
| -rw-r--r-- | src/make.code.defn | 2 |
17 files changed, 709 insertions, 419 deletions
diff --git a/lib/sbin/CST b/lib/sbin/CST index 79a03dfe..7adb7415 100644 --- a/lib/sbin/CST +++ b/lib/sbin/CST @@ -6,7 +6,7 @@ # @desc # Parses the the configuration files for thorns. # @enddesc -# @version $Header: /mnt/data2/cvs2svn/cvs-repositories/Cactus/lib/sbin/CST,v 1.29 1999-09-15 08:56:07 allen Exp $ +# @version $Header: /mnt/data2/cvs2svn/cvs-repositories/Cactus/lib/sbin/CST,v 1.30 1999-09-19 14:16:43 goodale Exp $ #@@*/ # Global parameter to track the number of errors from the CST @@ -63,7 +63,8 @@ if (!-e "$sbin_dir/parameter_parser.pl" ) require "$sbin_dir/parameter_parser.pl"; require "$sbin_dir/interface_parser.pl"; -require "$sbin_dir/schedule_parser.pl"; +#require "$sbin_dir/schedule_parser.pl"; +require "$sbin_dir/ScheduleParser.pl"; require "$sbin_dir/create_c_stuff.pl"; require "$sbin_dir/create_fortran_stuff.pl"; require "$sbin_dir/GridFuncStuff.pl"; @@ -73,7 +74,8 @@ require "$sbin_dir/ImpParamConsistency.pl"; require "$sbin_dir/CSTUtils.pl"; require "$sbin_dir/CreateParameterBindings.pl"; require "$sbin_dir/CreateImplementationBindings.pl"; -require "$sbin_dir/CreateScheduleBindings.pl"; +require "$sbin_dir/NewCreateScheduleBindings.pl"; +#require "$sbin_dir/CreateScheduleBindings.pl"; require "$sbin_dir/BuildHeaders.pl"; ####################################################################### @@ -90,6 +92,7 @@ print "Reading ThornList...\n"; print "Parsing interface files...\n"; %interface_database = &create_interface_database(%thorns); +#$debug_interface = 1; if($debug_interface) { &print_interface_database(%interface_database); @@ -99,6 +102,10 @@ if($debug_interface) print "Parsing parameter files...\n"; %parameter_database = &create_parameter_database(%thorns); +# Parse the schedule.ccl files +print "Parsing schedule files...\n"; +%schedule_database = &create_schedule_database(%thorns); + print "Checking consistency...\n"; %parameter_database = &CheckImpParamConsistency(scalar(keys %interface_database), %interface_database, %parameter_database); @@ -107,9 +114,22 @@ if($debug_parameters) &print_parameter_database(%parameter_database); } +#$debug_interface = 1; +if($debug_interface) +{ + &print_interface_database(%interface_database); +} + +#$debug_schedule = 1; +if($debug_schedule) +{ + &print_schedule_database(%schedule_database); +} + # Create all the bindings print "Creating Thorn-Flesh bindings...\n"; -&CreateBindings($bindings_dir, scalar(keys %parameter_database), %parameter_database, %interface_database); +&CreateBindings($bindings_dir, scalar(keys %parameter_database), scalar(keys %interface_database), + %parameter_database, %interface_database, %schedule_database); # Create header file of active thorns for the code @activethornsheader = &CreateActiveThornsHeader(%thorns); @@ -461,11 +481,17 @@ sub CreateDefineThisThornHeader sub CreateBindings { - local($bindings_dir, $n_param_database, @rest) = @_; + local($bindings_dir, $n_param_database, $n_interface_database, @rest) = @_; local(%parameter_database); local(%interface_database); + local(%schedule_database); local($start_dir); + # Extract the parameter,interface, and schedule databases from the arguments. + %parameter_database = @rest[0..2*$n_param_database-1]; + %interface_database = @rest[2*$n_param_database..2*($n_param_database+$n_interface_database)-1]; + %schedule_database = @rest[2*($n_param_database+$n_interface_database)..$#rest]; + # Extract the parameter and interface databases from the arguments. %parameter_database = @rest[0..2*$n_param_database-1]; %interface_database = @rest[2*$n_param_database..$#rest]; @@ -480,10 +506,15 @@ sub CreateBindings $start_dir = `pwd`; # Create the bindings for the subsystems. - &CreateImplementationBindings($bindings_dir, $n_param_database, @rest); - &CreateParameterBindings($bindings_dir, $n_param_database, @rest); + print " Creating implementation bindings...\n"; + &CreateImplementationBindings($bindings_dir, $n_param_database, %parameter_database, %interface_database); + print " Creating parameter bindings...\n"; + &CreateParameterBindings($bindings_dir, $n_param_database, %parameter_database, %interface_database); + print " Creating variable bindings...\n"; &CreateVariableBindings($bindings_dir, %interface_database); - &CreateScheduleBindings($bindings_dir, scalar(keys %thorns), %thorns,%interface_database); + print " Creating schedule bindings...\n"; + &CreateScheduleBindings($bindings_dir, scalar(keys %interface_database), + %interface_database, %schedule_database); # Place an appropriate make.code.defn in the bindings directory. chdir $bindings_dir; diff --git a/lib/sbin/CSTUtils.pl b/lib/sbin/CSTUtils.pl index 743186ad..e56a85e0 100644 --- a/lib/sbin/CSTUtils.pl +++ b/lib/sbin/CSTUtils.pl @@ -43,5 +43,97 @@ sub CST_error } + +#/*@@ +# @routine read_file +# @date Wed Sep 16 11:54:38 1998 +# @author Tom Goodale +# @desc +# Reads a file deleting comments and blank lines. +# @enddesc +# @calls +# @calledby +# @history +# @hdate Fri Sep 10 10:25:47 1999 @hauthor Tom Goodale +# @hdesc Allows a \ to escape the end of a line. +# @endhistory +#@@*/ + +sub read_file +{ + local($file) = @_; + local(@indata); + local($line); + + open(IN, "<$file") || die("Can't open $file\n"); + + $line = ""; + + while(<IN>) + { + $_ =~ s/\#.*//; + + next if(m/^\s+$/); + + &chompme($_); + + # Add to the currently processed line. + $line .= $_; + + # Check the line for line-continuation + if(m:[^\\]\\$:) + { + $line =~ s:\\$::; + } + else + { + push(@indata, $line); + $line = ""; + } + } + + # Make sure to dump out the last line, even if it ends in a \ + if($line ne "") + { + push(@indata, $line); + } + close IN; + + return @indata; +} + + +#/*@@ +# @routine chompme +# @date Mon 26th April 1999 +# @author Gabrielle Allen +# @desc +# Implements a version of the perl5 chomp function, +# returning the string passed in with the last character +# removed unless it is a newline +# @enddesc +# @calls +# @calledby +# @history +# +# @endhistory +#@@*/ + +sub chompme +{ + local($in) = @_; + + $lastchar = chop($in); + if ($lastchar == "\n") + { + return $_; + } + else + { + return $in; + } +} + + 1; diff --git a/lib/sbin/GridFuncStuff.pl b/lib/sbin/GridFuncStuff.pl index dce01078..a784d3a6 100644 --- a/lib/sbin/GridFuncStuff.pl +++ b/lib/sbin/GridFuncStuff.pl @@ -111,8 +111,10 @@ sub CreateVariableBindings open(OUT, ">$thorn.c") || die "Cannot create $thorn.c"; print OUT "\#include \"cctk_Groups.h\"\n"; + print OUT "\#include \"cctk_FortranWrappers.h\"\n"; # print OUT "#include \"cctk_Flesh.h\"\n"; # print OUT "#include \"StoreVariableData.h\"\n\n"; + print OUT "int CCTKi_BindingsFortranWrapper$thorn(void *GH, void *fpointer);"; print OUT "int CactusBindingsVariables_$thorn"."_Initialise(void)\n{\n"; foreach $block ("PUBLIC", "PROTECTED", "PRIVATE") @@ -124,6 +126,7 @@ sub CreateVariableBindings print OUT "$line\n"; } } + print OUT " CCTK_RegisterFortranWrapper(\"$thorn\", CCTKi_BindingsFortranWrapper$thorn);\n\n"; print OUT " return 0;\n};\n"; close OUT; @@ -131,6 +134,21 @@ sub CreateVariableBindings $filelist .= " $thorn.c"; } + foreach $thorn (split(" ",$interface_database{"THORNS"})) + { + open(OUT, ">$thorn\_FortranWrapper.c") || die "Cannot create $thorn\_FortranWrapper.c"; + + @data = &CreateThornFortranWrapper($thorn); + + foreach $line (@data) + { + print OUT "$line\n"; + } + + close OUT; + $filelist .= " $thorn\_FortranWrapper.c"; + } + open (OUT, ">make.code.defn") || die "Cannot open make.code.defn"; print OUT "SRCS = $filelist\n"; @@ -886,7 +904,7 @@ sub CreateThornArgumentHeaderFile # $print_data = 1; if ($print_data) { - foreach $arg (keys data) + foreach $arg (keys %data) { print "$thorn data: $arg : $data{\"$arg\"}\n"; } @@ -1189,4 +1207,37 @@ sub CreateThornGroupInitialisers } +sub CreateThornFortranWrapper +{ + local($thorn) = @_; + local(@data); + + push(@data, "#define THORN_IS_$thorn"); + push(@data, "#include \"cctk.h\""); + push(@data, "#include \"cctk_Flesh.h\""); + push(@data, "#include \"cctk_Groups.h\""); + push(@data, "#include \"cctk_Comm.h\""); + push(@data, "#include \"cctk_arguments.h\""); + push(@data, ""); + + push(@data, "int CCTKi_BindingsFortranWrapper$thorn(cGH *GH, void *fpointer)"); + push(@data, "{"); + push(@data, " void (*function)(\U$thorn\E_C2F_PROTO);"); + push(@data, ""); + push(@data, " DECLARE_\U$thorn\E_C2F"); + push(@data, " INITIALISE_\U$thorn\E_C2F"); + push(@data, ""); + + push(@data, " function = (void (*)(\U$thorn\E_C2F_PROTO))fpointer;"); + push(@data, ""); + push(@data, " function(PASS_\U$thorn\E_C2F(GH));"); + push(@data, ""); + push(@data, " return 0;"); + push(@data, ""); + + push(@data, "}"); + + return (@data); +} + 1; diff --git a/lib/sbin/NewCreateScheduleBindings.pl b/lib/sbin/NewCreateScheduleBindings.pl index 5d66a7d2..88c8fe4f 100644 --- a/lib/sbin/NewCreateScheduleBindings.pl +++ b/lib/sbin/NewCreateScheduleBindings.pl @@ -22,20 +22,18 @@ # @endhistory # #@@*/ -sub NewCreateScheduleBindings +sub CreateScheduleBindings { - local($bindings_dir, $n_param_database, $n_interface_database, @rest) = @_; - local(%parameter_database); + local($bindings_dir, $n_interface_database, @rest) = @_; local(%interface_database); local(%schedule_database); local($start_dir); local($thorn); local($file_list); - # Extract the parameter,interface, and schedule databases from the arguments. - %parameter_database = @rest[0..2*$n_param_database-1]; - %interface_database = @rest[2*$n_param_database..2*($n_param_database+$n_interface_database)-1]; - %schedule_database = @rest[2*($n_param_database+$n_interface_database)..$#rest]; + # Extract the interface and schedule databases from the arguments. + %interface_database = @rest[0..2*$n_interface_database-1]; + %schedule_database = @rest[2*$n_interface_database..$#rest]; if(! -d $bindings_dir) { diff --git a/lib/sbin/ScheduleParser.pl b/lib/sbin/ScheduleParser.pl index 665dd38b..106111f4 100644 --- a/lib/sbin/ScheduleParser.pl +++ b/lib/sbin/ScheduleParser.pl @@ -39,6 +39,8 @@ sub create_schedule_database # Get the schedule stuff from it @new_schedule_data = &parse_schedule_ccl($thorn, @indata); + + &PrintScheduleStatistics($thorn, @new_schedule_data); # Add the schedule stuff to the master schedule database push (@schedule_data, @new_schedule_data); @@ -155,7 +157,8 @@ sub ParseScheduleBlock local(@comm_groups) = (); local(@trigger_groups) = (); local($keyword) = ""; - local(@current_sched_list); + local(@current_sched_list) = (); + local($where) = ""; #Parse the first line of the schedule block @@ -194,7 +197,7 @@ sub ParseScheduleBlock if($fields[$field] =~ m:^AT$:i) { $field+=2; - if($keyword ne "") + if($where ne "") { print STDERR "Error parsing schedule block line '$data[$line_number]'\n"; print STDERR "Attempt to schedule same block at/in two places.\n"; @@ -215,7 +218,7 @@ sub ParseScheduleBlock elsif($fields[$field] =~ m:^IN$:i) { $field+=2; - if($keyword ne "") + if($where ne "") { print STDERR "Error parsing schedule block line '$data[$line_number]'\n"; print STDERR "Attempt to schedule same block at/in two places.\n"; @@ -308,18 +311,21 @@ sub ParseScheduleBlock push(@while_list, $fields[$field]); } $field++; + $keyword = ""; } elsif(($keyword eq "") && ($field == $#fields) && ($fields[$field] =~ m:\s*\{\s*:)) { # This bit matches a { at the end of a line # I don't like it, but it seems to be already in use 8-( $line_number--; + $keyword = ""; last; } else { print STDERR "Error parsing schedule block line '$data[$line_number]'\n"; $CST_errors++; + $keyword = ""; $field++; } } @@ -452,4 +458,27 @@ sub print_schedule_database } } +#/*@@ +# @routine PrintScheduleStatistics +# @date Sun Sep 19 13:07:08 1999 +# @author Tom Goodale +# @desc +# Prints out statistics about a thorn's schedule.ccl +# @enddesc +# @calls +# @calledby +# @history +# +# @endhistory +# +#@@*/ +sub PrintScheduleStatistics +{ + local($thorn, %schedule_database) = @_; + + print " " . $schedule_database{"\U$thorn\E N_BLOCKS"} . " schedule blocks.\n"; + + return; +} + 1; diff --git a/lib/sbin/interface_parser.pl b/lib/sbin/interface_parser.pl index 0bf4da6f..bccbceb6 100644 --- a/lib/sbin/interface_parser.pl +++ b/lib/sbin/interface_parser.pl @@ -24,7 +24,7 @@ sub create_interface_database # Loop through each thorn's interface file. foreach $thorn (keys %thorns) { - + print " $thorn\n"; # Get the arrangement name for the thorn $thorns{$thorn} =~ m:.*/arrangements/([^/]*)/[^/]*:; $arrangement = $1; @@ -34,6 +34,8 @@ sub create_interface_database # Get the interface data from it @new_interface_data = &parse_interface_ccl($arrangement,$thorn, @indata); + + &PrintInterfaceStatistics($thorn, @new_interface_data); # Add the interface to the master interface database push (@interface_data, @new_interface_data); @@ -750,4 +752,48 @@ sub print_interface_database } } +#/*@@ +# @routine PrintInterfaceStatistics +# @date Sun Sep 19 13:03:23 1999 +# @author Tom Goodale +# @desc +# Prints out some statistics about a thorn's interface.ccl +# @enddesc +# @calls +# @calledby +# @history +# +# @endhistory +# +#@@*/ +sub PrintInterfaceStatistics +{ + local($thorn, %interface_database) = @_; + local($block); + local($sep); + + print " Implements: " . $interface_database{"\U$thorn IMPLEMENTS"} . "\n"; + + if($interface_database{"\U$thorn INHERITS"} ne "") + { + print " Inherits: " . $interface_database{"\U$thorn INHERITS"} . ""; + } + + if($interface_database{"\U$thorn FRIEND"} ne "") + { + print " Friend of: " . $interface_database{"\U$thorn FRIEND"} . ""; + } + + $sep = " "; + foreach $block ("Public", "Protected", "Private") + { + print $sep . scalar(split(" ", $interface_database{"\U$thorn $block\E GROUPS"})) . " $block"; + $sep = ", "; + } + + print " variable groups\n"; + + return; +} + 1; diff --git a/lib/sbin/parameter_parser.pl b/lib/sbin/parameter_parser.pl index a288fda7..12996a36 100644 --- a/lib/sbin/parameter_parser.pl +++ b/lib/sbin/parameter_parser.pl @@ -30,12 +30,15 @@ sub create_parameter_database # Loop through each implementation's parameter file. foreach $thorn (keys %thorns) { + print " $thorn\n"; # Read the data @indata = &read_file("$thorns{$thorn}/param.ccl"); # Get the parameters from it @new_parameter_data = &parse_param_ccl($thorn, @indata); - + + &PrintParameterStatistics($thorn, @new_parameter_data); + # Add the parameters to the master parameter database push (@parameter_data, @new_parameter_data); @@ -84,97 +87,6 @@ sub cross_index_parameters - -#/*@@ -# @routine read_file -# @date Wed Sep 16 11:54:38 1998 -# @author Tom Goodale -# @desc -# Reads a file deleting comments and blank lines. -# @enddesc -# @calls -# @calledby -# @history -# @hdate Fri Sep 10 10:25:47 1999 @hauthor Tom Goodale -# @hdesc Allows a \ to escape the end of a line. -# @endhistory -#@@*/ - -sub read_file -{ - local($file) = @_; - local(@indata); - local($line); - - open(IN, "<$file") || die("Can't open $file\n"); - - $line = ""; - - while(<IN>) - { - $_ =~ s/\#.*//; - - next if(m/^\s+$/); - - &chompme($_); - - # Add to the currently processed line. - $line .= $_; - - # Check the line for line-continuation - if(m:[^\\]\\$:) - { - $line =~ s:\\$::; - } - else - { - push(@indata, $line); - $line = ""; - } - } - - # Make sure to dump out the last line, even if it ends in a \ - if($line ne "") - { - push(@indata, $line); - } - close IN; - - return @indata; -} - - -#/*@@ -# @routine chompme -# @date Mon 26th April 1999 -# @author Gabrielle Allen -# @desc -# Implements a version of the perl5 chomp function, -# returning the string passed in with the last character -# removed unless it is a newline -# @enddesc -# @calls -# @calledby -# @history -# -# @endhistory -#@@*/ - -sub chompme -{ - local($in) = @_; - - $lastchar = chop($in); - if ($lastchar == "\n") - { - return $_; - } - else - { - return $in; - } -} - #/*@@ # @routine parse_param_ccl # @date Wed Sep 16 11:55:33 1998 @@ -387,6 +299,38 @@ sub print_parameter_database } +#/*@@ +# @routine PrintParameterStatistics +# @date Sun Sep 19 13:04:18 1999 +# @author Tom Goodale +# @desc +# Prints out some statistics about a thorn's param.ccl +# @enddesc +# @calls +# @calledby +# @history +# +# @endhistory +# +#@@*/ +sub PrintParameterStatistics +{ + local($thorn, %parameter_database) = @_; + local($block); + local($sep); + + $sep = " "; + foreach $block ("Global", "Restricted", "Private") + { + print $sep . scalar(split(" ", $parameter_database{"\U$thorn $block\E variables"})) . " $block"; + $sep = ", "; + } + + print " parameters\n"; + + return; +} + 1; diff --git a/src/include/cctk_GroupsOnGH.h b/src/include/cctk_GroupsOnGH.h index fadd7c0b..603365e4 100644 --- a/src/include/cctk_GroupsOnGH.h +++ b/src/include/cctk_GroupsOnGH.h @@ -23,6 +23,11 @@ void *CCTK_VarDataPtrI(cGH *GH, int timelevel, int varindex); void *CCTK_VarDataPtrB(cGH *GH, int timelevel, int varindex, char *fullvarname); +int CCTK_DisableGroupStorageI(void *GH, int group); +int CCTK_DisableGroupCommI(void *GH, int group); +int CCTK_EnableGroupStorageI(void *GH, int group); +int CCTK_EnableGroupCommI(void *GH, int group); + #ifdef __cplusplus } #endif diff --git a/src/main/CactusDefaultInitialise.c b/src/main/CactusDefaultInitialise.c index 854e3697..410f3b11 100644 --- a/src/main/CactusDefaultInitialise.c +++ b/src/main/CactusDefaultInitialise.c @@ -115,21 +115,8 @@ int CactusInitialiseGH(cGH *GH) GH->rfr_top = NULL; - rfrInitTree(&(GH->rfr_top), - CCTKi_rfrStorageOn, - CCTKi_rfrStorageOff, - CCTKi_rfrCommunicationOn, - CCTKi_rfrCommunicationOff, - CCTKi_rfrTriggerable, - CCTKi_rfrTriggerSaysGo, - CCTKi_rfrTriggerAction, - CCTKi_rfrCallFunc); - /* Do the rfr initialisation on this GH */ - CCTKi_BindingsScheduleRegister("RFRINIT", (void *)GH); - - /* Report the rfr tree */ - CCTKi_rfrPrintTree(GH,GH->rfr_top); + CCTK_ScheduleGHInit((void *)GH); /* Initialise all the extensions. */ CCTKi_InitGHExtensions(GH); diff --git a/src/main/CallStartupFunctions.c b/src/main/CallStartupFunctions.c index 7db2e5ee..4d921fa3 100644 --- a/src/main/CallStartupFunctions.c +++ b/src/main/CallStartupFunctions.c @@ -10,6 +10,7 @@ #include <stdio.h> #include "cctk_Flesh.h" +#include "cctk_schedule.h" static char *rcsid = "$Id$"; @@ -32,7 +33,7 @@ int dummy(tFleshConfig *); int CallStartupFunctions(tFleshConfig *ConfigData) { - CCTKi_BindingsScheduleRegister("STARTUP", NULL); + CCTK_ScheduleTraverse("CCTK_STARTUP", NULL); return 0; } diff --git a/src/main/GroupsOnGH.c b/src/main/GroupsOnGH.c index aefa2a6c..caae5cba 100644 --- a/src/main/GroupsOnGH.c +++ b/src/main/GroupsOnGH.c @@ -17,6 +17,7 @@ #include "cctk_Groups.h" #include "cctk_WarnLevel.h" #include "cctk_GroupsOnGH.h" +#include "cctk_Comm.h" /*#define DEBUG_GROUPS*/ @@ -195,3 +196,150 @@ void *CCTK_VarDataPtrB(cGH *GH, int timelevel, int varindex, char *fullvarname) } } + /*@@ + @routine CCTK_EnableGroupCommI + @date Sat Feb 13 17:06:30 1999 + @author Tom Goodale + @desc + Enables communication for a group based upon its name. + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ +int CCTK_EnableGroupCommI(void *GH, int group) +{ + int retcode; + char *group_name; + + group_name = CCTK_GroupName(group); + if(group_name) + { +#ifdef DEBUG + printf("Turning on comm in %s for group %s (%d)\n",__FILE__group_name,group); +#endif + retcode = CCTK_EnableGroupComm(GH, group_name); + + free(group_name); + } + else + { + retcode = 0; + } + + return retcode; +} + + /*@@ + @routine CCTK_EnableGroupStorageI + @date Sat Feb 13 17:06:30 1999 + @author Tom Goodale + @desc + Enables storage for a group based upon its name. + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ +int CCTK_EnableGroupStorageI(void *GH, int group) +{ + int retcode; + char *group_name; + + group_name = CCTK_GroupName(group); + if(group_name) + { +#ifdef DEBUG + printf("Turning on storage in %s for group %s (%d)\n",__FILE__group_name,group); +#endif + retcode = CCTK_EnableGroupStorage(GH, group_name); + + free(group_name); + } + else + { + retcode = 0; + } + + return retcode; +} + + /*@@ + @routine CCTK_DisableGroupCommI + @date Sat Feb 13 17:06:30 1999 + @author Tom Goodale + @desc + Routine to switch communication off for a group based upon its index + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ +int CCTK_DisableGroupCommI(void *GH, int group) +{ + int retcode; + char *group_name; + + group_name = CCTK_GroupName(group); + if(group_name) + { +#ifdef DEBUG + printf("Turning off comm in %s for group %s (%d)\n",__FILE__,group_name,group); +#endif + retcode = CCTK_DisableGroupComm(GH, group_name); + + free(group_name); + } + else + { + retcode = 0; + } + + return retcode; +} + + /*@@ + @routine CCTK_DisableGroupStorageI + @date Sat Feb 13 17:06:30 1999 + @author Tom Goodale + @desc + Routine to switch storage off for a group based upon its index + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ +int CCTK_DisableGroupStorageI(void *GH, int group) +{ + int retcode; + char *group_name; + + group_name = CCTK_GroupName(group); + if(group_name) + { +#ifdef DEBUG + printf("Turning off storage in %s for group %s (%d)\n",__FILE__,group_name,group); +#endif + retcode = CCTK_DisableGroupStorage(GH, group_name); + + free(group_name); + } + else + { + retcode = 0; + } + + return retcode; +} diff --git a/src/main/InitialiseCactus.c b/src/main/InitialiseCactus.c index e5767288..b90211be 100644 --- a/src/main/InitialiseCactus.c +++ b/src/main/InitialiseCactus.c @@ -9,7 +9,9 @@ #include <stdio.h> +#include "cctk.h" #include "cctk_Flesh.h" +#include "cctki_schedule.h" int ProcessCommandLine(int *inargc, char ***inargv, tFleshConfig *ConfigData); int ProcessEnvironment(int *argc, char ***argv,tFleshConfig *ConfigData); @@ -65,12 +67,41 @@ int InitialiseCactus(int *argc, char ***argv, tFleshConfig *ConfigData) ProcessParameterDatabase(ConfigData); + InitialiseScheduler(ConfigData); + CallStartupFunctions(ConfigData); return 0; } + /*@@ + @routine InitialiseScheduler + @date Fri Sep 17 19:34:55 1999 + @author Tom Goodale + @desc + Initialise all scheduled items + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ +int InitialiseScheduler(tFleshConfig *ConfigData) +{ + int retcode; + + CCTKi_BindingsScheduleInitialise(); + retcode = CCTKi_ScheduleSortAllGroups(); + + CCTK_PRINTSEPARATOR + CCTK_SchedulePrint(NULL); + CCTK_PRINTSEPARATOR + + return retcode; +} diff --git a/src/main/InitialiseDataStructures.c b/src/main/InitialiseDataStructures.c index c153cc4b..449d427d 100644 --- a/src/main/InitialiseDataStructures.c +++ b/src/main/InitialiseDataStructures.c @@ -52,7 +52,7 @@ int InitialiseDataStructures(tFleshConfig *ConfigData) CCTKi_BindingsImplementationsInitialise(); /* CCTKi_BindingsParametersInitialise();*/ CCTKi_BindingsVariablesInitialise(); - CCTKi_BindingsScheduleInitialise(); + /*CCTKi_BindingsScheduleInitialise();*/ CCTKi_ActivateThorn("Cactus"); diff --git a/src/main/ScheduleInterface.c b/src/main/ScheduleInterface.c index 8d410c98..5001450f 100644 --- a/src/main/ScheduleInterface.c +++ b/src/main/ScheduleInterface.c @@ -1,4 +1,3 @@ -#define DEBUG /*@@ @file ScheduleInterface.c @date Thu Sep 16 14:06:21 1999 @@ -70,7 +69,9 @@ typedef struct { cGH *GH; t_schedpoint schedpoint; - + + int whiling; + } t_sched_data; @@ -180,9 +181,8 @@ int CCTK_ScheduleFunction(void *function, } else { -#ifdef DEBUG - fprintf(stderr, "Failed to schedule %s at %s!!!\n", name, where); -#endif + fprintf(stderr, "Internal error: Failed to schedule %s at %s!!!\n", name, where); + exit(2); retcode = -1; } @@ -429,32 +429,33 @@ int CCTK_SchedulePrint(const char *where) data.GH = NULL; data.schedpoint = schedpoint_misc; + data.whiling = 0; if(!where) { - printf ("Startup routines\n"); + printf (" Startup routines\n"); SchedulePrint("CCTK_STARTUP"); printf("\n"); - printf ("Parameter checking routines\n"); + printf (" Parameter checking routines\n"); SchedulePrint("CCTK_PARAMCHECK"); printf("\n"); - printf("Initialisation\n"); + printf(" Initialisation\n"); SchedulePrint("CCTK_INITIAL"); SchedulePrint("CCTK_POSTINITIAL"); SchedulePrint("CCTK_POSTSTEP"); printf("\n"); - printf ("do loop over timesteps\n"); + printf (" do loop over timesteps\n"); SchedulePrint("CCTK_PRESTEP"); SchedulePrint("CCTK_EVOL"); SchedulePrint("CCTK_BOUND"); - printf (" t = t+dt\n"); + printf (" t = t+dt\n"); SchedulePrint("CCTK_POSTSTEP"); - printf (" if (analysis)\n"); + printf (" if (analysis)\n"); indent_level +=2; SchedulePrint("CCTK_ANALYSIS"); indent_level -=2; - printf (" endif\n"); - printf ("enddo\n"); + printf (" endif\n"); + printf (" enddo\n"); } else { @@ -707,28 +708,113 @@ static int SchedulePrint(const char *where) ********************************************************************/ + /*@@ + @routine CCTKi_SchedulePrintEntry + @date Sun Sep 19 13:31:23 1999 + @author Tom Goodale + @desc + Routine called on entry to a group when traversing for printing. + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ static int CCTKi_SchedulePrintEntry(t_attribute *attribute, t_sched_data *data) { - indent_level++; + indent_level += 2; return 1; } + /*@@ + @routine CCTKi_SchedulePrintEntry + @date Sun Sep 19 13:31:23 1999 + @author Tom Goodale + @desc + Routine called on exit to a group when traversing for printing. + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ static int CCTKi_SchedulePrintExit(t_attribute *attribute, t_sched_data *data) { - indent_level--; + indent_level -=2; return 1; } + /*@@ + @routine CCTKi_SchedulePrintEntry + @date Sun Sep 19 13:31:23 1999 + @author Tom Goodale + @desc + Routine called for while ofo a group when traversing for printing. + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ static int CCTKi_SchedulePrintWhile(int n_whiles, char **whiles, t_attribute *attribute, t_sched_data *data) { - return 0; + int i; + + if(!data->whiling) + { + for(i=0; i < indent_level+2; i++) printf(" "); + + printf("while ("); + + for(i = 0; i < n_whiles; i++) + { + if(i > 0) + { + printf(" && "); + } + + printf("%s", whiles[i]); + } + + printf(")\n"); + } + else + { + for(i=0; i < indent_level; i++) printf(" "); + + printf("end while\n"); + } + + data->whiling = !data->whiling; + + return data->whiling; } + /*@@ + @routine CCTKi_SchedulePrintFunction + @date Sun Sep 19 13:36:25 1999 + @author Tom Goodale + @desc + Function which actually prints out data about a group or a function. + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ static int CCTKi_SchedulePrintFunction(void *function, t_attribute *attribute, t_sched_data *data) @@ -747,6 +833,20 @@ static int CCTKi_SchedulePrintFunction(void *function, ********************************************************************/ + /*@@ + @routine CCTKi_ScheduleCallEntry + @date Sun Sep 19 13:24:06 1999 + @author Tom Goodale + @desc + Routine called when a schedule group is entered. + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ static int CCTKi_ScheduleCallEntry(t_attribute *attribute, t_sched_data *data) { @@ -761,6 +861,7 @@ static int CCTKi_ScheduleCallEntry(t_attribute *attribute, if(data->schedpoint == schedpoint_analysis) { + /* In analysis, so check triggers */ for (i = 0; i < attribute->n_trigger_groups ; i++) { index = CCTK_FirstVarIndexI(attribute->trigger_groups[i]); @@ -778,17 +879,20 @@ static int CCTKi_ScheduleCallEntry(t_attribute *attribute, if(go) { + /* Switch on storage for groups */ for(i = 0; i < attribute->n_mem_groups; i++) { attribute->StorageOnEntry[i] = CCTK_EnableGroupStorageI(data->GH,attribute->mem_groups[i]); } + /* Switch on communication for groups. */ for(i = 0; i < attribute->n_comm_groups; i++) { attribute->CommOnEntry[i] = CCTK_EnableGroupCommI(data->GH,attribute->comm_groups[i]); } } + /* Remember if we have switched on storage and comm or not. */ attribute->done_entry = go; } else @@ -799,6 +903,20 @@ static int CCTKi_ScheduleCallEntry(t_attribute *attribute, return go; } + /*@@ + @routine CCTKi_ScheduleCallExit + @date Sun Sep 19 13:25:24 1999 + @author Tom Goodale + @desc + Routine called on exit from a schedule group. + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ static int CCTKi_ScheduleCallExit(t_attribute *attribute, t_sched_data *data) { @@ -806,11 +924,13 @@ static int CCTKi_ScheduleCallExit(t_attribute *attribute, int index; int last; + /* Only do this if the entry routine did stuff. */ if(attribute && attribute->done_entry) { if(data->schedpoint == schedpoint_analysis) { + /* In analysis, so do any trigger actions. */ for (i = 0; i < attribute->n_trigger_groups ; i++) { index = CCTK_FirstVarIndexI(attribute->trigger_groups[i]); @@ -822,12 +942,13 @@ static int CCTKi_ScheduleCallExit(t_attribute *attribute, } } - + /* Switch off storage if it was switched on in entry. */ for(i = 0; i < attribute->n_mem_groups; i++) { if(!attribute->StorageOnEntry[i]) CCTK_DisableGroupStorageI(data->GH,attribute->mem_groups[i]); } + /* Switch off communication if it was done in entry. */ for(i = 0; i < attribute->n_comm_groups; i++) { if(!attribute->CommOnEntry[i]) CCTK_DisableGroupCommI(data->GH,attribute->comm_groups[i]); @@ -837,14 +958,53 @@ static int CCTKi_ScheduleCallExit(t_attribute *attribute, return 1; } + /*@@ + @routine CCTKi_ScheduleCallWhile + @date Sun Sep 19 13:27:53 1999 + @author Tom Goodale + @desc + Routine called to check variables to see if a group or function should be executed. + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ static int CCTKi_ScheduleCallWhile(int n_whiles, char **whiles, t_attribute *attribute, t_sched_data *data) { - return 0; + int i; + int retcode; + + retcode = 1; + + /* FIXME - should do a lot of validation either here or on registration */ + for(i = 0; i < n_whiles; i++) + { + retcode = retcode && *((int *)CCTK_VarDataPtr(data->GH, 0, whiles[i])); + } + + return retcode; } + /*@@ + @routine CCTKi_ScheduleCallFunction + @date Sun Sep 19 13:29:14 1999 + @author Tom Goodale + @desc + The routine which actually calls a function. + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ static int CCTKi_ScheduleCallFunction(void *function, t_attribute *attribute, t_sched_data *data) @@ -873,6 +1033,21 @@ static int CCTKi_ScheduleCallFunction(void *function, *************** Specialised Startup Routines ******************** ********************************************************************/ + /*@@ + @routine CCTKi_ScheduleStartupFunction + @date Sun Sep 19 13:30:00 1999 + @author Tom Goodale + @desc + Startup routines take no arguments, so use this calling function instead + of the one generally used. + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ static int CCTKi_ScheduleStartupFunction(void *function, t_attribute *attribute, t_sched_data *data) diff --git a/src/main/make.code.defn b/src/main/make.code.defn index efdda784..a45a32da 100644 --- a/src/main/make.code.defn +++ b/src/main/make.code.defn @@ -29,6 +29,8 @@ GHExtensions.c\ WarnLevel.c\ ActiveThorns.c\ Parameters.c\ -Subsystems.c +Subsystems.c\ +ScheduleInterface.c\ +FortranWrappers.c diff --git a/src/main/rfrInterface.c b/src/main/rfrInterface.c index 1c8a05a0..0e57f8f2 100644 --- a/src/main/rfrInterface.c +++ b/src/main/rfrInterface.c @@ -47,281 +47,31 @@ int CCTK_rfrTraverse(cGH *GH, int rfrpoint) return 0; } +#include "cctk_schedule.h" - /*@@ - @routine rfrPrintTree - @date 14 Mar 1999 - @author Gabrielle Allen - @desc - Prints the order of the RFR calling tree - @enddesc - @calls - @history - @endhistory - - @var - @vdesc - @vtype - @vio - @vcomment - @endvar - - @returntype int - @returndesc - 0 = routine did not print rfr tree - 1 = routine did print rfr tree - @endreturndesc - - @version $Header$ -@@*/ - -int CCTKi_rfrPrintTree(cGH *GH,void *rfr_top) -{ - DECLARE_CCTK_PARAMETERS - - static int showed_tree = 0; - - /* Return if the users doesn't want to see the tree */ - if (!cctk_show_rfr_tree || cctk_brief_output) return 0; - - if (!showed_tree) - { - - showed_tree = 1; - - CCTK_PRINTSEPARATOR - printf ("Evolution tree from the RFR\n"); - - rfrPrintDescs(rfr_top,GH,CCTK_BASEGRID,"CCTK_BASEGRID",""); - rfrPrintDescs(rfr_top,GH,CCTK_INITIAL, "CCTK_INITIAL",""); - rfrPrintDescs(rfr_top,GH,CCTK_POSTINITIAL, "CCTK_POSTINITIAL",""); - rfrPrintDescs(rfr_top,GH,CCTK_POSTSTEP,"CCTK_POSTSTEP",""); - printf ("\n do loop over timesteps\n"); - rfrPrintDescs(rfr_top,GH,CCTK_PRESTEP,"CCTK_PRESTEP"," "); - rfrPrintDescs(rfr_top,GH,CCTK_EVOL,"CCTK_EVOL"," "); - rfrPrintDescs(rfr_top,GH,CCTK_BOUND,"CCTK_BOUND"," "); - - printf (" t = t+dt\n"); - rfrPrintDescs(rfr_top,GH,CCTK_POSTSTEP,"CCTK_POSTSTEP"," "); - - printf (" if (analysis)\n"); - rfrPrintDescs(rfr_top,GH,CCTK_ANALYSIS,"CCTK_ANALYSIS"," "); - printf (" endif\n"); - printf (" enddo\n"); - CCTK_PRINTSEPARATOR - - } - - return 1; - -} - - /*@@ - @routine CCTKi_rfrStorageOn - @date Sat Feb 13 17:06:30 1999 - @author Tom Goodale - @desc - Routine called by the rfr to switch storage on for a group - @enddesc - @calls - @calledby - @history - - @endhistory - -@@*/ -int CCTKi_rfrStorageOn(void *GH, int group) -{ - int retcode; - char *group_name; - - group_name = CCTK_GroupName(group); - - if(group_name) - { -#ifdef RFRDEBUG - printf("Turning on storage in rfrInterface.c for group %s (%d)\n",group_name,group); -#endif - retcode = CCTK_EnableGroupStorage(GH, group_name); - free(group_name); - } - else - { - retcode = 0; - } - - return retcode; -} - - /*@@ - @routine CCTKi_rfrStorageOff - @date Sat Feb 13 17:06:30 1999 - @author Tom Goodale - @desc - Routine called by the rfr to switch storage off for a group - @enddesc - @calls - @calledby - @history - - @endhistory +#define SCHEDULE(x) case CCTK_ ## x : CCTK_ScheduleTraverse("CCTK_" #x, data); break -@@*/ -int CCTKi_rfrStorageOff(void *GH, int group) +void rfrTraverse(void *rfr_top, void *data, int when) { - int retcode; - char *group_name; - - group_name = CCTK_GroupName(group); - if(group_name) + switch(when) { -#ifdef RFRDEBUG - printf("Turning off storage in rfrInterface.c for group %s (%d)\n",group_name,group); -#endif - retcode = CCTK_DisableGroupStorage(GH, group_name); - - free(group_name); + SCHEDULE(PARAMCHECK); + SCHEDULE(BASEGRID); + SCHEDULE(RECOVER); + SCHEDULE(INITIAL); + SCHEDULE(POSTINITIAL); + SCHEDULE(CPINITIAL); + SCHEDULE(PRESTEP); + SCHEDULE(POSTSTEP); + SCHEDULE(EVOL); + SCHEDULE(BOUND); + SCHEDULE(CHECKPOINT); + SCHEDULE(ANALYSIS); + SCHEDULE(TERMINATE); + SCHEDULE(CONVERGENCE); + default : + CCTK_WARN(0, "Unknown scheduling point"); } - else - { - retcode = 0; - } - - return retcode; -} - /*@@ - @routine CCTKi_rfrCommunicationOn - @date Sat Feb 13 17:06:30 1999 - @author Tom Goodale - @desc - Routine called by the rfr to switch communication on for a group - @enddesc - @calls - @calledby - @history - - @endhistory - -@@*/ -int CCTKi_rfrCommunicationOn(void *GH, int group) -{ - int retcode; - char *group_name; - - group_name = CCTK_GroupName(group); - if(group_name) - { -#ifdef RFRDEBUG - printf("Turning on comm in rfrInterface.c for group %s (%d)\n",group_name,group); -#endif - retcode = CCTK_EnableGroupComm(GH, group_name); - - free(group_name); - } - else - { - retcode = 0; - } - - return retcode; -} - - /*@@ - @routine CCTKi_rfrCommunicationOff - @date Sat Feb 13 17:06:30 1999 - @author Tom Goodale - @desc - Routine called by the rfr to switch communication off for a group - @enddesc - @calls - @calledby - @history - - @endhistory - -@@*/ -int CCTKi_rfrCommunicationOff(void *GH, int group) -{ - int retcode; - char *group_name; - - group_name = CCTK_GroupName(group); - if(group_name) - { -#ifdef RFRDEBUG - printf("Turning off comm in rfrInterface.c for group %s (%d)\n",group_name,group); -#endif - retcode = CCTK_DisableGroupComm(GH, group_name); - - free(group_name); - } - else - { - retcode = 0; - } - - return retcode; -} - - /*@@ - @routine CCTKi_rfrTriggerable - @date Sat March 6 1999 - @author Gabrielle Allen - @desc - Returns true if this rfr entry point should be triggerable - for some event, otherwise returns false in which case none - of the triggers stuff is done. - @enddesc - @calls - @calledby - @history - - @endhistory - @var entrypoint - @vdesc describes the entrypoint of the RFR - @vtype int - @vio in - @vcomment RFR entrypoint macros are in src/include/rfr_constants.h - @endvar -@@*/ - -int CCTKi_rfrTriggerable(int entrypoint) -{ - if (entrypoint == CCTK_ANALYSIS) - { - return 1; - } - else - return 0; -} - - - - /*@@ - @routine CCTKi_rfrCallFunc - @date Sat Feb 13 17:08:39 1999 - @author Tom Goodale - @desc - Routine called by the rfr to call a function. - @enddesc - @calls - @calledby - @history - - @endhistory - -@@*/ -int CCTKi_rfrCallFunc(void *GH, int language, void *function) -{ - - void (*calledfunc)(void *); - - calledfunc = (void (*)(void *))function; - - /* Call the function. */ - - calledfunc(GH); - - return 0; + return; } diff --git a/src/make.code.defn b/src/make.code.defn index b268651e..795936d5 100644 --- a/src/make.code.defn +++ b/src/make.code.defn @@ -1,2 +1,2 @@ SRCS = -SUBDIRS = IO comm rfr util main +SUBDIRS = IO comm util main schedule |