diff options
author | tradke <tradke@17b73243-c579-4c4c-a9d2-2d5706c11dac> | 2002-03-27 15:34:19 +0000 |
---|---|---|
committer | tradke <tradke@17b73243-c579-4c4c-a9d2-2d5706c11dac> | 2002-03-27 15:34:19 +0000 |
commit | 489ed36e225fbadf3618d9e338d158750347fa9f (patch) | |
tree | 606b59cd9a8da7b83da483f23d54a9fb8a21e53e /lib/sbin/CreateParameterBindings.pl | |
parent | 358c188550d74a47d1fb817de7d9add766720f04 (diff) |
Reworked treatment of CCTK_DECLARE macros. Now the C file preprocessor
will put everything up to the closing bracket for a routine into a new block.
Also, the USE_CCTK macro is now appended directly to the CCTK_DECLARE macro.
There is no need anymore to use CCTK_NO_AUTOUSE_MACRO.
Also changed the way how parameters and arguments are used within the USE_CCTK
macros: now it's done by "(void) (parameter = 0);" which is better than
assigning the address of it to some dummy pointer.
This fixes problems where one had to parse for a possible return statement
at the end of the routine.
This fix closes PR Cactus/949.
Also did some perl code optimization and added grdoc headers for files
generated by the CST.
git-svn-id: http://svn.cactuscode.org/flesh/trunk@2676 17b73243-c579-4c4c-a9d2-2d5706c11dac
Diffstat (limited to 'lib/sbin/CreateParameterBindings.pl')
-rw-r--r-- | lib/sbin/CreateParameterBindings.pl | 518 |
1 files changed, 206 insertions, 312 deletions
diff --git a/lib/sbin/CreateParameterBindings.pl b/lib/sbin/CreateParameterBindings.pl index f0405528..e2f7819b 100644 --- a/lib/sbin/CreateParameterBindings.pl +++ b/lib/sbin/CreateParameterBindings.pl @@ -3,9 +3,9 @@ # @date Sun Jul 25 00:52:36 1999 # @author Tom Goodale # @desc -# Parameter binding stuff +# Parameter binding stuff # @enddesc -# @version $Header$ +# @version $Header$ #@@*/ #/*@@ @@ -15,12 +15,6 @@ # @desc # Create the bindings used for the parameters. # @enddesc -# @calls -# @calledby -# @history -# -# @endhistory -# #@@*/ sub CreateParameterBindings @@ -44,377 +38,275 @@ sub CreateParameterBindings chdir $bindings_dir; - if(! -d "Parameters") + if(! -d 'Parameters') { - mkdir("Parameters", 0755) || die "Unable to create Parameters directory"; + mkdir('Parameters', 0755) || die 'Unable to create Parameters directory'; } - if(! -d "include") + if(! -d 'include') { - mkdir("include", 0755) || die "Unable to create include directory"; + mkdir('include', 0755) || die 'Unable to create include directory'; } - chdir "Parameters"; - - # Generate all global parameters %these_parameters = &get_global_parameters($rhparameter_db); - @data = &CreateParameterBindingFile("CCTK_BindingsParametersGlobal", "GLOBAL_PARAMETER_STRUCT", \%these_parameters, $rhparameter_db); + $dataout = &CreateParameterBindingFile('CCTK_BindingsParametersGlobal', 'GLOBAL_PARAMETER_STRUCT', \%these_parameters, $rhparameter_db); - $dataout = ""; - foreach $line (@data) - { - $dataout .= "$line\n"; - } - &WriteFile("Global.c",\$dataout); + &WriteFile('Parameters/Global.c',\$dataout); - $files = "Global.c"; - $structures{"GLOBAL_PARAMETER_STRUCT"} = "cctk_params_global"; + $files = 'Global.c'; + $structures{'GLOBAL_PARAMETER_STRUCT'} = 'cctk_params_global'; # Generate the global data header file - chdir ".."; - chdir "include"; + $dataout = &CreateCStructureParameterHeader('CCTK_BindingsParametersGlobal', 'GLOBAL_PARAMETER_STRUCT', \%these_parameters, $rhparameter_db); - @data = &CreateCStructureParameterHeader("CCTK_BindingsParametersGlobal", "GLOBAL_PARAMETER_STRUCT", \%these_parameters, $rhparameter_db); - - $dataout = ""; - foreach $line (@data) - { - $dataout .= "$line\n"; - } - $dataout .= "\n\n"; + &WriteFile('include/ParameterCGlobal.h',\$dataout); - &WriteFile("ParameterCGlobal.h",\$dataout); - - $header_files{"GLOBAL"} = "ParameterCGlobal.h"; - - chdir ".."; - chdir "Parameters"; + $header_files{'GLOBAL'} = 'ParameterCGlobal.h'; # Generate all restricted parameters - foreach $implementation (split(" ",$rhinterface_db->{"IMPLEMENTATIONS"})) + foreach $implementation (split(' ',$rhinterface_db->{'IMPLEMENTATIONS'})) { $rhinterface_db->{"IMPLEMENTATION \U$implementation\E THORNS"} =~ m:([^ ]+):; $thorn = $1; - %these_parameters = &GetThornParameterList($thorn, "RESTRICTED", $rhparameter_db); + %these_parameters = &GetThornParameterList($thorn, 'RESTRICTED', $rhparameter_db); if((keys %these_parameters > 0)) { - @data = &CreateParameterBindingFile("CCTK_BindingsParameters$implementation"."_restricted", "RESTRICTED_\U$implementation\E_STRUCT", \%these_parameters, $rhparameter_db); + $dataout = &CreateParameterBindingFile("CCTK_BindingsParameters${implementation}_restricted", "RESTRICTED_\U$implementation\E_STRUCT", \%these_parameters, $rhparameter_db); - $dataout = ""; - foreach $line (@data) - { - $dataout .= "$line\n"; - } - &WriteFile("\U$implementation\E". "_restricted.c",\$dataout); + &WriteFile("Parameters/\U$implementation\E_restricted.c",\$dataout); - $files .= " \U$implementation\E". "_restricted.c"; - $routines{"CCTK_BindingsParameters$implementation"."_restricted"} = "$implementation"; - $structures{"RESTRICTED_\U$implementation\E_STRUCT"} = "$implementation"."rest"; + $files .= " \U$implementation\E_restricted.c"; + $routines{"CCTK_BindingsParameters${implementation}_restricted"} = "$implementation"; + $structures{"RESTRICTED_\U$implementation\E_STRUCT"} = "${implementation}rest"; # Generate the data header file - chdir ".."; - chdir "include"; - - @data = &CreateCStructureParameterHeader("CCTK_BindingsParameters$implementation"."_restricted", "RESTRICTED_\U$implementation\E_STRUCT", \%these_parameters, $rhparameter_db); - + $dataout = &CreateCStructureParameterHeader("CCTK_BindingsParameters${implementation}_restricted", "RESTRICTED_\U$implementation\E_STRUCT", \%these_parameters, $rhparameter_db); - $dataout = ""; - foreach $line (@data) - { - $dataout .= "$line\n"; - } - $dataout .= "\n\n"; - &WriteFile("ParameterCRestricted\U$implementation\E".".h",\$dataout); - - $header_files{"\U$implementation\E RESTRICTED"} = "ParameterCRestricted\U$implementation\E".".h"; - - chdir ".."; - chdir "Parameters"; + &WriteFile("include/ParameterCRestricted\U$implementation\E.h",\$dataout); + $header_files{"\U$implementation\E RESTRICTED"} = "ParameterCRestricted\U$implementation\E.h"; } } # Generate all private parameters - foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) + foreach $thorn (split(' ',$rhinterface_db->{'THORNS'})) { - %these_parameters = &GetThornParameterList($thorn, "PRIVATE", $rhparameter_db); + %these_parameters = &GetThornParameterList($thorn, 'PRIVATE', $rhparameter_db); if((keys %these_parameters > 0)) { - @data = &CreateParameterBindingFile("CCTK_BindingsParameters$thorn"."_private", "PRIVATE_\U$thorn\E_STRUCT", \%these_parameters, $rhparameter_db); + $dataout = &CreateParameterBindingFile("CCTK_BindingsParameters${thorn}_private", "PRIVATE_\U$thorn\E_STRUCT", \%these_parameters, $rhparameter_db); + &WriteFile("Parameters/\U$thorn\E_private.c",\$dataout); - $dataout = ""; - foreach $line (@data) - { - $dataout .= "$line\n"; - } - $dataout .= "\n\n"; - &WriteFile("\U$thorn\E"."_private.c",\$dataout); - - - $files .= " \U$thorn\E". "_private.c"; - $routines{"CCTK_BindingsParameters$thorn"."_private"} = "$thorn"; + $files .= " \U$thorn\E_private.c"; + $routines{"CCTK_BindingsParameters${thorn}_private"} = "$thorn"; # Generate the data header file - chdir ".."; - chdir "include"; - - @data = &CreateCStructureParameterHeader("CCTK_BindingsParameters$thorn"."_private", "PRIVATE_\U$thorn\E_STRUCT", \%these_parameters, $rhparameter_db); - - $structures{"PRIVATE_\U$thorn\E_STRUCT"} = "$thorn"."priv"; + $dataout = &CreateCStructureParameterHeader("CCTK_BindingsParameters${thorn}_private", "PRIVATE_\U$thorn\E_STRUCT", \%these_parameters, $rhparameter_db); + $structures{"PRIVATE_\U$thorn\E_STRUCT"} = "${thorn}priv"; - $dataout = ""; - foreach $line (@data) - { - $dataout .= "$line\n"; - } - $dataout .= "\n\n"; - &WriteFile("ParameterCPrivate\U$thorn\E".".h",\$dataout); - - - $header_files{"\U$thorn\E PRIVATE"} = "ParameterCPrivate\U$thorn\E".".h"; - - chdir ".."; - chdir "Parameters"; + &WriteFile("include/ParameterCPrivate\U$thorn\E.h",\$dataout); + $header_files{"\U$thorn\E PRIVATE"} = "ParameterCPrivate\U$thorn\E.h"; } } - $dataout = ""; - $dataout .= "\#include <stdio.h>\n"; - $dataout .= "\#include <stdlib.h>\n"; - $dataout .= "\#include <string.h>\n"; - $dataout .= "\#include \"cctk_Config.h\"\n"; - $dataout .= "\#include \"cctk_Misc.h\"\n"; - $dataout .= "\#include \"cctk_WarnLevel.h\"\n"; + @thorns = split(' ',$rhinterface_db->{'THORNS'}); + @data = (); + push(@data, map ('extern int CCTKi_BindingsCreate' . $_ . 'Parameters(void);', @thorns)); + push(@data, ''); + push(@data, map ('extern int CCTKi_Bindings' . $_ . 'ParameterExtensions(void);', @thorns)); + push(@data, ''); + push(@data, ''); - foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) - { - $dataout .= "extern int CCTKi_BindingsCreate$thorn"."Parameters(void);\n\n"; - } - - foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) - { - $dataout .= "extern int CCTKi_Bindings$thorn"."ParameterExtensions(void);\n\n"; - } + push(@data, 'int CCTKi_BindingsParametersInitialise(void);'); + push(@data, 'int CCTKi_BindingsParametersInitialise(void)'); + push(@data, '{'); - $dataout .= "int CCTKi_BindingsParametersInitialise(void);\n\n"; - $dataout .= "int CCTKi_BindingsParametersInitialise(void)\n"; - $dataout .= "\{\n\n"; - - foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) - { - $dataout .= " CCTKi_BindingsCreate$thorn"."Parameters();\n\n"; - } - - foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) - { - $dataout .= " CCTKi_Bindings$thorn"."ParameterExtensions();\n\n"; - } + push(@data, map (' CCTKi_BindingsCreate' . $_ . 'Parameters();', @thorns)); + push(@data, ''); + push(@data, map (' CCTKi_Bindings' . $_ . 'ParameterExtensions();', @thorns)); + push(@data, ''); - $dataout .= "return 0;\n"; - $dataout .= "}\n\n"; + push(@data, ' return 0;'); + push(@data, '}'); + push(@data, "\n"); # workaround for perl 5.004_04 to add a trailing newline - &WriteFile("BindingsParameters.c",\$dataout); + $dataout = join ("\n", @data); + &WriteFile('Parameters/BindingsParameters.c',\$dataout); $newfilelist = NewParamStuff($rhparameter_db, $rhinterface_db); - $dataout = ""; - $dataout .= "SRCS = BindingsParameters.c $files $newfilelist\n"; - &WriteFile("make.code.defn",\$dataout); + $dataout = "SRCS = BindingsParameters.c $files $newfilelist"; + &WriteFile('Parameters/make.code.defn',\$dataout); # Create the appropriate thorn parameter headers - chdir ".."; - chdir "include"; - - foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) + foreach $thorn (split(' ',$rhinterface_db->{'THORNS'})) { + $dataout = &CreateFortranThornParameterBindings($thorn, $rhparameter_db, $rhinterface_db); + &WriteFile("include/\U$thorn\E_FParameters.h",\$dataout); - @data = &CreateFortranThornParameterBindings($thorn, $rhparameter_db, $rhinterface_db); - - $dataout = ""; - foreach $line (@data) - { - $dataout .= "$line\n"; - } - &WriteFile("\U$thorn\E"."_FParameters.h",\$dataout); - - $dataout = ""; $implementation = $rhinterface_db->{"\U$thorn\E IMPLEMENTS"}; - $dataout .= "\#ifndef _\U$thorn\E_PARAMETERS_H_\n\n"; - $dataout .= "\#define _\U$thorn\E_PARAMETERS_H_\n\n"; - - if($header_files{"GLOBAL"}) - { - $dataout .= "#include \"". $header_files{"GLOBAL"} ."\"\n"; - } - - if($header_files{"\U$implementation\E RESTRICTED"}) - { - $dataout .= "#include \"". $header_files{"\U$implementation\E RESTRICTED"}."\"\n"; - } - - if($header_files{"\U$thorn\E PRIVATE"}) - { - $dataout .= "#include \"".$header_files{"\U$thorn\E PRIVATE"}."\"\n"; - } - - $dataout .= "\n"; @data = (); - foreach $friend (split(" ",$rhparameter_db->{"\U$thorn\E SHARES implementations"})) + push(@data, '/*@@'); + push(@data, " \@header \U$thorn\E_CParameters.h"); + push(@data, ' @author Automatically generated by CreateParameterBindings.pl'); + push(@data, ' @desc'); + push(@data, " Declares parameters of thorn $thorn"); + push(@data, ' @enddesc'); + push(@data, ' @@*/'); + push(@data, ''); + push(@data, ''); + + push(@data, "#ifndef _\U$thorn\E_PARAMETERS_H_"); + push(@data, "#define _\U$thorn\E_PARAMETERS_H_ 1"); + push(@data, ''); + + if($header_files{'GLOBAL'}) { - $dataout .= "#include \"ParameterCRestricted\U$friend\E.h\"\n"; - - $rhinterface_db->{"IMPLEMENTATION \U$friend\E THORNS"} =~ m:([^ ]*):; - - $friend_thorn = $1; - - foreach $parameter (split(" ",$rhparameter_db->{"\U$thorn SHARES $friend\E variables"})) - { - $type = $rhparameter_db->{"\U$friend_thorn $parameter\E type"}; - - $type_string = &get_c_type_string($type); - - $line = "const $type_string $parameter = RESTRICTED_\U$friend\E_STRUCT.$parameter;"; - - push(@data, $line); - - } - } - - $dataout .= "\n"; - - $dataout .= "#define DECLARE_CCTK_PARAMETERS \\\n"; - - if($header_files{"GLOBAL"}) - { - $dataout .= " DECLARE_GLOBAL_PARAMETER_STRUCT_PARAMS \\\n"; + push(@data, "#include \"$header_files{'GLOBAL'}\""); } if($header_files{"\U$implementation\E RESTRICTED"}) { - $dataout .= " DECLARE_RESTRICTED_\U$implementation\E_STRUCT_PARAMS \\\n"; + push(@data, "#include \"" . $header_files{"\U$implementation\E RESTRICTED"} . "\""); } if($header_files{"\U$thorn\E PRIVATE"}) { - $dataout .= " DECLARE_PRIVATE_\U$thorn\E_STRUCT_PARAMS \\\n"; + push(@data, "#include \"" . $header_files{"\U$thorn\E PRIVATE"} . "\""); } - foreach $line (@data) + foreach $friend (split(' ',$rhparameter_db->{"\U$thorn\E SHARES implementations"})) { - $dataout .= " $line \\\n"; + push(@data, "#include \"ParameterCRestricted\U$friend\E.h\""); } + push(@data, ''); - $dataout .= " const void *cctk_pdummy_pointer;\n\n"; - - $dataout .= "#define USE_CCTK_PARAMETERS \\\n"; - - if($header_files{"GLOBAL"}) + @use = (); + push(@data, '#define DECLARE_CCTK_PARAMETERS \\'); + push(@use, '#define USE_CCTK_PARAMETERS \\'); + if($header_files{'GLOBAL'}) { - $dataout .= " USE_GLOBAL_PARAMETER_STRUCT_PARAMS \\\n"; + push(@data, ' DECLARE_GLOBAL_PARAMETER_STRUCT_PARAMS \\'); + push(@use, ' USE_GLOBAL_PARAMETER_STRUCT_PARAMS \\'); } if($header_files{"\U$implementation\E RESTRICTED"}) { - $dataout .= " USE_RESTRICTED_\U$implementation\E_STRUCT_PARAMS \\\n"; + push(@data, " DECLARE_RESTRICTED_\U$implementation\E_STRUCT_PARAMS \\"); + push(@use, " USE_RESTRICTED_\U$implementation\E_STRUCT_PARAMS \\"); } if($header_files{"\U$thorn\E PRIVATE"}) { - $dataout .= " USE_PRIVATE_\U$thorn\E_STRUCT_PARAMS \\\n"; + push(@data, " DECLARE_PRIVATE_\U$thorn\E_STRUCT_PARAMS \\"); + push(@use, " USE_PRIVATE_\U$thorn\E_STRUCT_PARAMS \\"); } - foreach $friend (split(" ",$rhparameter_db->{"\U$thorn\E SHARES implementations"})) + foreach $friend (split(' ',$rhparameter_db->{"\U$thorn\E SHARES implementations"})) { $rhinterface_db->{"IMPLEMENTATION \U$friend\E THORNS"} =~ m:([^ ]*):; - foreach $parameter (split(" ",$rhparameter_db->{"\U$thorn SHARES $friend\E variables"})) + $friend_thorn = $1; + + foreach $parameter (split(' ',$rhparameter_db->{"\U$thorn SHARES $friend\E variables"})) { - $dataout .= " cctk_pdummy_pointer = \&$parameter; \\\n"; + $type = $rhparameter_db->{"\U$friend_thorn $parameter\E type"}; + $type_string = &get_c_type_string($type); + + push(@data, " const $type_string$parameter = RESTRICTED_\U$friend\E_STRUCT.$parameter; \\"); + push(@use, " (void) ($parameter + 0); \\"); } } - $dataout .= " cctk_pdummy_pointer = cctk_pdummy_pointer;\n\n"; - - $dataout .= "#endif\n"; - &WriteFile("\U$thorn\E"."_CParameters.h",\$dataout); + push(@data, ' USE_CCTK_PARAMETERS'); + push(@data, ''); + push(@data, @use); + push(@data, ''); + push(@data, "#endif /* _\U$thorn\E_PARAMETERS_H_ */"); + push(@data, "\n"); # workaround for perl 5.004_04 to add a trailing newline + $dataout = join ("\n", @data); + &WriteFile("include/\U$thorn\E_CParameters.h",\$dataout); } # Write this one to a temporary file and read it back in # Can probably do this better - open(OUT, "| perl $cctk_home/lib/sbin/c_file_processor.pl $top/config-data > CParameterStructNames_temp.h") || die "Cannot create CParameterStructNames.h by running c_file_processor.pl"; + open(OUT, "| perl $cctk_home/lib/sbin/c_file_processor.pl $top/config-data > include/CParameterStructNames_temp.h") || die 'Cannot create CParameterStructNames.h by running c_file_processor.pl'; foreach $structure (keys %structures) { print OUT "#define $structure CCTK_FORTRAN_COMMON_NAME($structures{$structure})\n"; } - print OUT "\n"; close OUT; - open(IN,"<CParameterStructNames_temp.h"); - $dataout = ""; - while (<IN>) - { - $dataout .= $_; - } + open(IN,'< include/CParameterStructNames_temp.h'); + $dataout = join ('', <IN>); close IN; - &WriteFile("CParameterStructNames.h",\$dataout); + &WriteFile('include/CParameterStructNames.h',\$dataout); - $dataout = ""; - $dataout .= "#include \"CParameterStructNames.h\"\n\n"; - foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) + @data = (); + push(@data, '#include "CParameterStructNames.h"'); + push(@data, ''); + foreach $thorn (split(' ',$rhinterface_db->{'THORNS'})) { - $dataout .= "\#ifdef THORN\_IS\_$thorn\n"; - $dataout .= "\#include \"\U$thorn\E"."\_CParameters.h\"\n"; - $dataout .= "\#endif\n\n"; + push(@data, "#ifdef THORN\_IS\_$thorn"); + push(@data, "#include \"\U$thorn\E_CParameters.h\""); + push(@data, '#endif'); + push(@data, "\n"); # workaround for perl 5.004_04 to add a trailing newline } - &WriteFile("CParameters.h",\$dataout); + $dataout = join ("\n", @data); + &WriteFile('include/CParameters.h',\$dataout); - $dataout = ""; - foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) + @data = (); + foreach $thorn (split(' ',$rhinterface_db->{'THORNS'})) { - $dataout .= "\#ifdef THORN_IS\_$thorn\n"; - $dataout .= "\#include \"\U$thorn\E"."\_FParameters.h\"\n"; - $dataout .= "\#endif\n\n"; + push(@data, "#ifdef THORN\_IS\_$thorn"); + push(@data, "#include \"\U$thorn\E_FParameters.h\""); + push(@data, '#endif'); + push(@data, "\n"); # workaround for perl 5.004_04 to add a trailing newline } - &WriteFile("FParameters.h",\$dataout); - - $dataout = "/* get the CCTK datatype definitions */\n"; - $dataout .= "#include \"cctk_Types.h\"\n\n"; - $dataout .= "#ifdef CCODE\n"; - $dataout .= "#include \"CParameters.h\"\n"; - $dataout .= "#endif\n\n"; - $dataout .= "#ifdef FCODE\n"; - $dataout .= "#include \"FParameters.h\"\n"; - $dataout .= "#endif\n\n"; - &WriteFile("cctk_Parameters.h",\$dataout); + $dataout = join ("\n", @data); + &WriteFile('include/FParameters.h',\$dataout); + @data = (); + push(@data, '/* get the CCTK datatype definitions */'); + push(@data, '#include "cctk_Types.h"'); + push(@data, ''); + push(@data, '#ifdef CCODE'); + push(@data, '#include "CParameters.h"'); + push(@data, '#elif FCODE'); + push(@data, '#include "FParameters.h"'); + push(@data, '#endif'); + push(@data, "\n"); # workaround for perl 5.004_04 to add a trailing newline - chdir $start_dir; + $dataout = join ("\n", @data); + &WriteFile('include/cctk_Parameters.h',\$dataout); + chdir $start_dir; } + sub NewParamStuff { my($rhparameter_db, $rhinterface_db) = @_; @@ -431,39 +323,48 @@ sub NewParamStuff my(@extensiondata); my(@data); - foreach $thorn (split(" ",$rhinterface_db->{"THORNS"})) + foreach $thorn (split(' ',$rhinterface_db->{'THORNS'})) { $imp = $rhinterface_db->{"\U$thorn\E IMPLEMENTS"}; - push(@data, "#include <stdarg.h>"); - push(@data, ""); - push(@data, "#include \"cctk_Config.h\""); - push(@data, "#include \"cctk_Constants.h\""); - push(@data, "#include \"ParameterBindings.h\""); - - push(@data, "#include \"CParameterStructNames.h\""); - - foreach $block ("GLOBAL", "RESTRICTED", "PRIVATE") + push(@data, '/*@@'); + push(@data, " \@file Create${thorn}Parameters.c"); + push(@data, ' @author Automatically generated by CreateParameterBindings.pl'); + push(@data, ' @desc'); + push(@data, ' Creates/extends parameters for this thorn'); + push(@data, ' @enddesc'); + push(@data, ' @@*/'); + push(@data, ''); + push(@data, ''); + + push(@data, '#include <stdarg.h>'); + push(@data, ''); + push(@data, '#include "cctk_Config.h"'); + push(@data, '#include "cctk_Constants.h"'); + push(@data, '#include "ParameterBindings.h"'); + push(@data, '#include "CParameterStructNames.h"'); + + foreach $block ('GLOBAL', 'RESTRICTED', 'PRIVATE') { %these_parameters = &GetThornParameterList($thorn, $block, $rhparameter_db); if((keys %these_parameters > 0)) { - if($block eq "GLOBAL") + if($block eq 'GLOBAL') { - push(@data, "#include \"ParameterCGlobal.h\""); + push(@data, '#include "ParameterCGlobal.h"'); } - elsif($block eq "RESTRICTED") + elsif($block eq 'RESTRICTED') { push(@data, "#include \"ParameterCRestricted\U$imp\E.h\""); } - elsif($block eq "PRIVATE") + elsif($block eq 'PRIVATE') { push(@data, "#include \"ParameterCPrivate\U$thorn\E.h\""); } else { - die "Internal error"; + die 'Internal error'; } # print "Generating $block parameters for $thorn, providing $imp\n"; @@ -475,7 +376,7 @@ sub NewParamStuff # Now the parameter extensions # print $rhparameter_db->{"\U$thorn\E SHARES implementations"} . "\n"; - foreach $block (split(" ",$rhparameter_db->{"\U$thorn\E SHARES implementations"})) + foreach $block (split(' ',$rhparameter_db->{"\U$thorn\E SHARES implementations"})) { push(@data, "#include \"ParameterCRestricted\U$block\E.h\""); @@ -485,43 +386,41 @@ sub NewParamStuff } - push(@data, ""); - push(@data, "int CCTKi_BindingsCreate$thorn"."Parameters(void);\n"); - push(@data, "int CCTKi_BindingsCreate$thorn"."Parameters(void)"); - push(@data, "{"); + push(@data, ''); + push(@data, "int CCTKi_BindingsCreate${thorn}Parameters(void);"); + push(@data, "int CCTKi_BindingsCreate${thorn}Parameters(void)"); + push(@data, '{'); push(@data, @creationdata); - push(@data, " return 0;"); - push(@data, "}"); + push(@data, ' return 0;'); + push(@data, '}'); - push(@data, ""); - push(@data, "int CCTKi_Bindings$thorn"."ParameterExtensions(void);\n"); - push(@data, "int CCTKi_Bindings$thorn"."ParameterExtensions(void)"); - push(@data, "{"); + push(@data, ''); + push(@data, "int CCTKi_Bindings${thorn}ParameterExtensions(void);"); + push(@data, "int CCTKi_Bindings${thorn}ParameterExtensions(void)"); + push(@data, '{'); push(@data, @extensiondata); - push(@data, " return 0;"); - push(@data, "}"); + push(@data, ' return 0;'); + push(@data, '}'); + push(@data, "\n"); # workaround for perl 5.004_04 to add a trailing newline - $dataout = ""; - foreach $line (@data) - { - $dataout .= "$line\n"; - } - &WriteFile("Create$thorn"."Parameters.c",\$dataout); + $dataout = join ("\n", @data); + &WriteFile("Parameters/Create${thorn}Parameters.c",\$dataout); @data=(); @creationdata=(); @extensiondata=(); - $filelist .= " Create$thorn"."Parameters.c"; + $filelist .= " Create${thorn}Parameters.c"; } return $filelist; } + sub CreateParameterRegistrationStuff { my($block, $thorn, $imp, $rhparameter_db, %these_parameters) = @_; @@ -529,21 +428,21 @@ sub CreateParameterRegistrationStuff my($line); my($structure, $type, $n_ranges); - if($block eq "GLOBAL") + if($block eq 'GLOBAL') { - $structure="GLOBAL_PARAMETER_STRUCT"; + $structure='GLOBAL_PARAMETER_STRUCT'; } - elsif($block eq "RESTRICTED") + elsif($block eq 'RESTRICTED') { $structure="RESTRICTED_\U$imp\E_STRUCT"; } - elsif($block eq "PRIVATE") + elsif($block eq 'PRIVATE') { $structure = "PRIVATE_\U$thorn\E_STRUCT"; } else { - die "Internal error"; + die 'Internal error'; } # print "Thorn is $thorn\n"; @@ -570,31 +469,31 @@ sub CreateParameterRegistrationStuff $steerable = $rhparameter_db->{"\U$thorn $parameter\E steerable"}; if ($steerable =~ /never/i || $steerable =~/^$/) { - $steerable_type = "CCTK_STEERABLE_NEVER"; + $steerable_type = 'CCTK_STEERABLE_NEVER'; } elsif ($steerable =~ /always/i) { - $steerable_type = "CCTK_STEERABLE_ALWAYS"; + $steerable_type = 'CCTK_STEERABLE_ALWAYS'; } elsif ($steerable =~ /recover/i) { - $steerable_type = "CCTK_STEERABLE_RECOVER"; + $steerable_type = 'CCTK_STEERABLE_RECOVER'; } else { $message = "Illegal steerable type ($steerable) for parameter $parameter in $thorn"; - &CST_error(0,$message,"",__LINE__,__FILE__); + &CST_error(0,$message,'',__LINE__,__FILE__); } - $line=" CCTKi_ParameterCreate(\"$parameter\", /* The parameter name */\n". - " \"$thorn\", /* The thorn */\n". - " \"$type\", /* The parameter type*/\n". - " \"$block\", /* The scoping block */\n". - " $steerable_type, /* Is it steerable ? */\n". - " " . $rhparameter_db->{"\U$thorn $parameter\E description"} . ", /* The description */\n" . - " \"" . $quoted_default . "\", /* The default value */\n" . - " &($structure.$parameter), /* The actual data pointer */\n". - " $n_ranges /* How many allowed ranges it has */"; + $line=" CCTKi_ParameterCreate(\"$parameter\",\n" . + " \"$thorn\",\n" . + " \"$type\",\n" . + " \"$block\",\n" . + " $steerable_type,\n" . + " " . $rhparameter_db->{"\U$thorn $parameter\E description"} . ",\n" . + " \"" . $quoted_default . "\",\n" . + " &($structure.$parameter),\n" . + " $n_ranges"; for($range=1; $range <= $n_ranges; $range++) { @@ -617,19 +516,18 @@ sub CreateParameterRegistrationStuff # as the beginning of an escape sequence in C strings $quoted_range =~ s:\\:\\\\:g; - $line .= ",\n \"".$quoted_range."\", $range_description"; - + $line .= ",\n \"".$quoted_range."\",$range_description"; } - $line .=");\n"; + $line .= ");\n"; push(@data, $line); } - return @data; } + sub CreateParameterExtensionStuff { my($block, $thorn, $rhparameter_db) = @_; @@ -639,7 +537,7 @@ sub CreateParameterExtensionStuff # print "Extending $block from $thorn\n"; - foreach $parameter (split(" ",$rhparameter_db->{"\U$thorn\E SHARES \U$block\E variables"})) + foreach $parameter (split(' ',$rhparameter_db->{"\U$thorn\E SHARES \U$block\E variables"})) { $n_ranges = $rhparameter_db->{"\U$thorn $parameter\E ranges"}; @@ -662,15 +560,11 @@ sub CreateParameterExtensionStuff push(@data, " \"$parameter\","); push(@data, " \"$thorn\","); push(@data, " \"$quoted_range\","); - push(@data, " $range_description);"); + push(@data, " $range_description);"); push(@data, ""); - # print "Adding \"$quoted_range\" to $parameter\n"; - - } - } return @data; |