diff options
author | allen <allen@17b73243-c579-4c4c-a9d2-2d5706c11dac> | 1999-10-20 12:46:22 +0000 |
---|---|---|
committer | allen <allen@17b73243-c579-4c4c-a9d2-2d5706c11dac> | 1999-10-20 12:46:22 +0000 |
commit | 91d9f35c351b54547d7cab6d69c1ccc554d22d17 (patch) | |
tree | 27eb648bc7abc83a8c687c390e60fbf56c8c58f6 /lib/sbin/CreateScheduleBindings.pl | |
parent | 019f6271792eba1d1d4d9c385bd545638d8d3cc4 (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
Diffstat (limited to 'lib/sbin/CreateScheduleBindings.pl')
-rw-r--r-- | lib/sbin/CreateScheduleBindings.pl | 634 |
1 files changed, 582 insertions, 52 deletions
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; |