diff options
| -rw-r--r-- | lib/sbin/CST | 100 | ||||
| -rw-r--r-- | lib/sbin/create_c_stuff.pl | 110 | ||||
| -rw-r--r-- | lib/sbin/schedule_parser.pl | 94 |
3 files changed, 277 insertions, 27 deletions
diff --git a/lib/sbin/CST b/lib/sbin/CST index b986947e..383aaa0b 100644 --- a/lib/sbin/CST +++ b/lib/sbin/CST @@ -62,6 +62,7 @@ require "$sbin_dir/create_c_stuff.pl"; require "$sbin_dir/create_fortran_stuff.pl"; require "$sbin_dir/GridFuncStuff.pl"; require "$sbin_dir/output_config.pl"; +require "$sbin_dir/Orderer.pl"; ####################################################################### @@ -551,6 +552,7 @@ EOT print OUT "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"; } print OUT <<EOT; @@ -615,14 +617,94 @@ EOT int CCTK_BindingsParameterGet(const char *identifier, void **value) { - return -1; + int retval = 1; + int temp_retval; + char *implementation = NULL; + char *param_name = NULL; + + CCTK_SplitString(&implementation, ¶m_name, identifier, "::"); + + if(!implementation) + { + retval = CCTK_BindingsParametersPublicGet(identifier, value); + } + else + { +EOT + + foreach $routine (keys %routines, "CCTK_BindingsParametersPublic") + { + + print OUT <<EOT; + + if(CCTK_Equals(implementation, \"$routines{$routine}\")) + { +EOT + print OUT " temp_retval = $routine"."Get(param_name, value);"; + + print OUT <<EOT; + + if(!temp_retval) + { + retval = 0; + } + } +EOT + } + + print OUT <<EOT; + } + + free(implementation); + free(param_name); + return retval; } int CCTK_BindingsParameterHelp(const char *identifier, const char *format, FILE *file) { - return -1; -} + int retval = 1; + int temp_retval; + char *implementation = NULL; + char *param_name = NULL; + + CCTK_SplitString(&implementation, ¶m_name, identifier, "::"); + + if(!implementation) + { + retval = CCTK_BindingsParametersPublicHelp(identifier, format, file); + } + else + { +EOT + + foreach $routine (keys %routines, "CCTK_BindingsParametersPublic") + { + + print OUT <<EOT; + + if(CCTK_Equals(implementation, \"$routines{$routine}\")) + { +EOT + print OUT " temp_retval = $routine"."Help(param_name, format, file);"; + + print OUT <<EOT; + if(!temp_retval) + { + retval = 0; + } + } +EOT + } + + print OUT <<EOT; + } + + free(implementation); + free(param_name); + return retval; +} + EOT close OUT; @@ -795,7 +877,7 @@ EOT #/*@@ -# @routine CreateParameterBindings +# @routine CreateScheduleBindings # @date Thu Jan 28 15:27:16 1999 # @author Tom Goodale # @desc @@ -811,6 +893,9 @@ EOT sub CreateScheduleBindings { local($bindings_dir,$n_thorns,@rest) = @_; + local(%thorns); + local(%interface_database); + local($wrapper, $rfr, $startup, %schedule_data); %thorns = @rest[0..2*$n_thorns-1]; %interface_database = @rest[2*$n_thorns..$#rest]; @@ -829,11 +914,12 @@ sub CreateScheduleBindings chdir "Schedule"; # Parse the schedule.ccl files - ($wrapper,$rfr,$startup) = &create_schedule_code($bindings_dir,$n_thorns,%thorns,%interface_database); - + ($wrapper,$rfr,$startup, %schedule_data) = &create_schedule_code($bindings_dir,$n_thorns,%thorns,%interface_database); + + @rfr_files = split(" ",$rfr); # Write the contents of BindingsScheduleRegisterRFR.c - &create_RegisterRFR($bindings_dir,split(" ",$rfr)); + &create_RegisterRFR($bindings_dir,scalar(@rfr_files), @rfr_files, %schedule_data); # Write the contents of BindingsScheduleRegisterSTARTUP.c &create_RegisterSTARTUP($bindings_dir,split(" ",$startup)); diff --git a/lib/sbin/create_c_stuff.pl b/lib/sbin/create_c_stuff.pl index 27311f86..e4ad29c4 100644 --- a/lib/sbin/create_c_stuff.pl +++ b/lib/sbin/create_c_stuff.pl @@ -51,6 +51,7 @@ sub CreateParameterBindingFile $line = "\#include \"CParameterStructNames.h\""; push(@data, $line); $line = "\#include \"Misc.h\""; + $line = "\#include \"ParameterBindings.h\""; push(@data, $line); push(@data, ""); @@ -117,6 +118,45 @@ sub CreateParameterBindingFile push(@data, ""); + # Getting subroutine + + push(@data, ("int $prefix"."Get(const char *param, void **value)", "{")); + push(@data, (" int retval;", " retval = 1;", "")); + + + foreach $parameter (keys %parameters) + { + push(@data, &get_parameter_code($structure,$parameters{$parameter}, + $parameter, %parameter_database)); + push(@data, ""); + + } + + push(@data, " return retval;"); + + push(@data, "}"); + + push(@data, ""); + + # Help subroutine + + push(@data, ("int $prefix"."Help(const char *param, const char *format, FILE *file)", "{")); + push(@data, (" int retval;", " retval = 1;", "")); + + + foreach $parameter (keys %parameters) + { + push(@data, &help_parameter_code($structure,$parameters{$parameter}, + $parameter, %parameter_database)); + push(@data, ""); + + } + + push(@data, " return retval;"); + + push(@data, "}"); + + push(@data, ""); return @data; } @@ -433,5 +473,75 @@ sub order_params return (@float_params, @string_params, @int_params); } + +sub get_parameter_code +{ + local($structure, $implementation,$parameter, %parameter_database) = @_; + local($type, $type_string); + local($line, @lines); + local($range); + local($quoted_range); + + $type = $parameter_database{"\U$implementation $parameter\E type"}; + + push(@lines,(" if(CCTK_Equals(param, \"$parameter\"))", " {")); + + if( $type eq "KEYWORD") + { + $line = " *value = $structure.$parameter;\n" ; + $line .= " retval = PARAMETER_KEYWORD;" ; + } + elsif( $type eq "STRING") + { + $line = " *value = $structure.$parameter;\n" ; + $line .= " retval = PARAMETER_STRING;" ; + } + elsif( $type eq "SENTENCE") + { + $line = " *value = $structure.$parameter;\n" ; + $line .= " retval = PARAMETER_SENTENCE;" ; + } + elsif($type eq "INTEGER") + { + $line = " *value = \&($structure.$parameter);\n" ; + $line .= " retval = PARAMETER_INTEGER;" ; + } + elsif($type eq "REAL") + { + $line = " *value = \&($structure.$parameter);\n" ; + $line .= " retval = PARAMETER_REAL;" ; + } + elsif($type eq "LOGICAL") + { + $line = " *value = \&($structure.$parameter);\n" ; + $line .= " retval = PARAMETER_LOGICAL;" ; + } + else + { + print "Unknown parameter type $type\n"; + } + + push(@lines, ($line, " }")); + + return @lines; +} + +sub help_parameter_code +{ + local($structure, $implementation,$parameter, %parameter_database) = @_; + local($type, $type_string); + local($line, @lines); + local($range); + local($quoted_range); + + $type = $parameter_database{"\U$implementation $parameter\E type"}; + + push(@lines,(" if(CCTK_Equals(param, \"$parameter\"))", " {")); + + push(@lines, " printf(\"Help asked for parameter: $implementation\::$parameter.\\n\");"); + push(@lines, ($line, " }")); + + return @lines; +} 1; diff --git a/lib/sbin/schedule_parser.pl b/lib/sbin/schedule_parser.pl index 4a9123f6..7027324c 100644 --- a/lib/sbin/schedule_parser.pl +++ b/lib/sbin/schedule_parser.pl @@ -77,6 +77,18 @@ sub create_schedule_code %schedule_ordering = @schedule_data; + $schedule_ordering{":THORNS:"} = join(" ", keys %thorns); + + $schedule_ordering{":ROUTINES:"} = ""; + + foreach $thorn (keys %thorns) + { + foreach $routine (split(" ", $schedule_ordering{"\U$thorn"})) + { + $schedule_ordering{":ROUTINES:"} .= "$routine "; + } + } + return ($wrapper_files,$rfr_files,$startup_files, %schedule_ordering); } @@ -131,23 +143,59 @@ sub write_startup_header { sub create_RegisterRFR { - local ($dir,@rfr_routines) = @_; - local ($rfr_calls,$file,$outfile); + local ($dir,$n_rfrfiles, @rest) = @_; + local ($rfr_calls, $rfr_order_calls, $rfr_order_prototypes, $outfile); + local(@sorted_routines); + local($routine); + local($order, %order); + + if($n_rfrfiles == 0) + { + @rfr_files = (); + %schedule_data = @rest; + } + else + { + @rfr_files = @rest[0..$n_rfrfiles-1]; + %schedule_data = @rest[$n_rfrfiles..$#rest]; + } $outfile = "$dir/Schedule/Cactus_RegisterRFR.c"; open (OUT, ">$outfile") || die "Cannot open $outfile"; $rfr_calls = ""; - foreach $file (@rfr_routines) { + $rfr_order_calls = ""; + $rfr_order_prototypes = ""; + + # Sort the rfr routines + @sorted_routines = &OrderList("Scheduling error", ":ROUTINES:", %schedule_data); + $order = 1; + + foreach $routine (@sorted_routines) + { + if($routine) + { + $rfr_order_prototypes .= "void $routine(cGH *);\n"; + $rfr_order_calls .= " rfrRegisterOrderNumber($routine, $order);\n"; + $order++; + } + } + + foreach $file (@rfr_files) + { $rfr_calls = "$rfr_calls ".$file."(data);\n"; } print OUT <<EOT; - Cactus_RegisterRFR(void *data) - { - $rfr_calls - } +#include "flesh.h" + +$rfr_order_prototypes +void Cactus_RegisterRFR(void *data) +{ +$rfr_order_calls +$rfr_calls +} EOT return; @@ -202,36 +250,41 @@ sub parse_schedule_ccl local($thorn,$implementation,$type,@data) = @_; local($proto,$out,$line,$line_number,@compile_files); local(%schedule_ordering); + local($routine); # Parse the data from the thorns schedule.ccl file for ($line_number=0; $line_number<@data; $line_number++) { $line = @data[$line_number]; + @options = (); + # Parse the entire schedule block if ($line =~ m/\s*schedule\s*(.*)\s*at\s*(.*)/i) { - ($wrapper_file,$proto_block,$out_block) = &parse_schedule_block($thorn,$implementation,$type,@data); + $routine = $1; + @options = split(" ", $2); + + ($wrapper_file,$proto_block,$out_block, $routine) = &parse_schedule_block($thorn,$implementation,$type,@data); + $proto .= "$proto_block"; $out .= "$out_block"; $compile_files .= " $wrapper_file"; - $routine = $1; - if($2) + if(@options) { $schedule_ordering{"\U$thorn"} .= " $routine"; - @options = split(" ", $2); for($option = 0; $option < $#options; $option++) { if($options[$option] =~ m:\bBEFORE\b:i) { - $schedule_ordering{"\U%thorn BEFORE"} .= " $options[$option+1]"; + $schedule_ordering{"\U$routine BEFORE"} .= " $options[$option+1]"; $option++; } elsif($options[$option] =~ m:\bAFTER\b:i) { - $schedule_ordering{"\U%thorn \U$routine AFTER"} .= " $options[$option+1]"; + $schedule_ordering{"\U$routine AFTER"} .= " $options[$option+1]"; $option++; } } @@ -337,7 +390,7 @@ sub find_schedule_block else { print STDERR "No description listed for routine '$routine' registered at '$rfr_entry'\n"; - $desc = "Please write a description of what this routine does."; + $desc = "\"Please write a description of what this routine does.\""; } return ($routine,$rfr_entry,$desc,@block); } @@ -377,12 +430,12 @@ sub parse_schedule_block # At the moment can schedule at RFR entry points of at STARTUP if ($type eq "startup" && $when =~ /\s*STARTUP\s*/i) { - ($wrapper_file, $proto, $out) = &parse_schedule_at_STARTUP($thorn,$implementation,$routine,$desc,@block); + ($wrapper_file, $proto, $out, $routine) = &parse_schedule_at_STARTUP($thorn,$implementation,$routine,$desc,@block); } elsif ($type eq "rfr" && $when !~ /\s*STARTUP\s*/i) { - ($wrapper_file,$proto,$out) = &parse_schedule_at_RFR($thorn,$implementation,$routine,$when,$desc,@block); + ($wrapper_file,$proto,$out, $routine) = &parse_schedule_at_RFR($thorn,$implementation,$routine,$when,$desc,@block); } - return ($wrapper_file,$proto,$out); + return ($wrapper_file,$proto,$out, $routine); } @@ -393,7 +446,7 @@ sub parse_schedule_at_STARTUP { $out .= " $routine();\n"; - return ("", "", $out); + return ("", "", $out, $routine); } @@ -413,7 +466,6 @@ sub parse_schedule_at_RFR { $line = @block[$i]; if ($line =~ m/\s*LANG\s*:\s*FORTRAN\s*$/i) { - $out .= " rfrRegisterFunction(GH->rfr_top,GH,".$routine."_wrapper,$when,$desc);\n"; $got_it++; # Write the rfr called fortran wrapper routine @@ -432,6 +484,8 @@ sub parse_schedule_at_RFR { { print "Error in LANG in schedule.ccl $got_it\n"; } + + $out .= " rfrRegisterFunction(GH->rfr_top,GH,$routine,$when,$desc);\n"; # Look for Storage for ($i=0; $i<@block; $i++) @@ -501,7 +555,7 @@ sub parse_schedule_at_RFR { } } - return ($wrapper_file,$proto,$out); + return ($wrapper_file,$proto,$out, $routine); } |