diff options
-rw-r--r-- | lib/sbin/CreateFunctionBindings.pl | 37 | ||||
-rw-r--r-- | lib/sbin/CreateParameterBindings.pl | 193 | ||||
-rw-r--r-- | lib/sbin/GridFuncStuff.pl | 2 | ||||
-rw-r--r-- | lib/sbin/create_c_stuff.pl | 66 |
4 files changed, 88 insertions, 210 deletions
diff --git a/lib/sbin/CreateFunctionBindings.pl b/lib/sbin/CreateFunctionBindings.pl index a784d0c5..81783003 100644 --- a/lib/sbin/CreateFunctionBindings.pl +++ b/lib/sbin/CreateFunctionBindings.pl @@ -752,44 +752,17 @@ sub DummyThornFunctions push(@data, $line); # Make sure we use all arguments to avoid warnings - $line = " CCTK_INT cctk_dummy_int;\n"; + $line = " const void *cctk_dummy_pointer;\n"; push(@data, $line); - $line = " CCTK_REAL cctk_dummy_real;\n"; - push(@data, $line); - $line = " void *cctk_dummy_pointer;\n"; - push(@data, $line); - $line = " cctk_dummy_int=0;\n"; - push(@data, $line); - $line = " cctk_dummy_int+=0;\n"; - push(@data, $line); - $line = " cctk_dummy_real=0;\n"; - push(@data, $line); - $line = " cctk_dummy_real+=0;\n"; - push(@data, $line); - $line = " cctk_dummy_pointer=NULL;\n"; - push(@data, $line); - $line = " cctk_dummy_pointer=(CCTK_REAL *)cctk_dummy_pointer;\n"; + $line = " cctk_dummy_pointer = cctk_dummy_pointer;\n"; push(@data, $line); foreach $arg (split(",",$function_db->{"$function CARGS"})) { $arg =~ m:(.*\s+\**)([^\s*\*]+)\s*:; - $type=$1; +# $type=$1; $name=$2; - if ($type =~ /[^\*]*\*\s*/ && $type !~ "const") - { - $line = " cctk_dummy_pointer=(void *)$name;\n"; - push(@data, $line); - } - elsif ($type =~ /int/i) - { - $line = " cctk_dummy_int=$name;\n"; - push(@data, $line); - } - elsif ($type =~ /real/i) - { - $line = " cctk_dummy_real=$name;\n"; - push(@data, $line); - } + $line = " cctk_dummy_pointer = \&$name;\n"; + push(@data, $line); } $line = " CCTK_Warn(1,__LINE__,__FILE__,\"Bindings\",\n"; push(@data, $line); diff --git a/lib/sbin/CreateParameterBindings.pl b/lib/sbin/CreateParameterBindings.pl index e371d83d..bb7dbe58 100644 --- a/lib/sbin/CreateParameterBindings.pl +++ b/lib/sbin/CreateParameterBindings.pl @@ -2,9 +2,9 @@ # @file CreateParameterBindings.pl # @date Sun Jul 25 00:52:36 1999 # @author Tom Goodale -# @desc +# @desc # Parameter binding stuff -# @enddesc +# @enddesc # @version $Header$ #@@*/ @@ -12,14 +12,14 @@ # @routine CreateParameterBindings # @date Thu Jan 28 15:27:16 1999 # @author Tom Goodale -# @desc +# @desc # Create the bindings used for the parameters. -# @enddesc -# @calls -# @calledby -# @history +# @enddesc +# @calls +# @calledby +# @history # -# @endhistory +# @endhistory # #@@*/ @@ -109,7 +109,7 @@ sub CreateParameterBindings $dataout = ""; foreach $line (@data) { - $dataout .= "$line\n"; + $dataout .= "$line\n"; } &WriteFile("\U$implementation\E". "_restricted.c",\$dataout); @@ -119,17 +119,17 @@ sub CreateParameterBindings $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 = ""; foreach $line (@data) { - $dataout .= "$line\n"; + $dataout .= "$line\n"; } $dataout .= "\n\n"; &WriteFile("ParameterCRestricted\U$implementation\E".".h",\$dataout); @@ -155,7 +155,7 @@ sub CreateParameterBindings $dataout = ""; foreach $line (@data) { - $dataout .= "$line\n"; + $dataout .= "$line\n"; } $dataout .= "\n\n"; &WriteFile("\U$thorn\E"."_private.c",\$dataout); @@ -165,19 +165,19 @@ sub CreateParameterBindings $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 = ""; foreach $line (@data) { - $dataout .= "$line\n"; + $dataout .= "$line\n"; } $dataout .= "\n\n"; &WriteFile("ParameterCPrivate\U$thorn\E".".h",\$dataout); @@ -228,7 +228,7 @@ sub CreateParameterBindings $dataout .= "}\n\n"; &WriteFile("BindingsParameters.c",\$dataout); - + $newfilelist = NewParamStuff($rhparameter_db, $rhinterface_db); $dataout = ""; @@ -259,144 +259,101 @@ sub CreateParameterBindings if($header_files{"GLOBAL"}) { - $dataout .= "#include \"". $header_files{"GLOBAL"} ."\"\n"; + $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"; + 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"})) { - $friend_implementation = $rhinterface_db->{"\U$friend\E IMPLEMENTS"}; - $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 = $rhparameter_db->{"\U$friend_thorn $parameter\E type"}; - $type_string = &get_c_type_string($type); + $type_string = &get_c_type_string($type); - $line = " ".$type_string ." " .$parameter . " = RESTRICTED_\U$friend\E_STRUCT.$parameter;"; + $line = "const $type_string $parameter = RESTRICTED_\U$friend\E_STRUCT.$parameter;"; - push(@data, $line); + push(@data, $line); } } - $dataout .= "#define DECLARE_CCTK_PARAMETERS \\\n"; - - $dataout .= "void *cctk_pdummy_pointer;\\ - CCTK_INT cctk_pdummy_int;\\ - CCTK_REAL cctk_pdummy_real;\\\n"; + $dataout .= "\n"; + $dataout .= "#define DECLARE_CCTK_PARAMETERS \\\n"; - $decl = "DECLARE_GLOBAL_PARAMETER_STRUCT_PARAMS"; if($header_files{"GLOBAL"}) { - $dataout .= "$decl \\\n"; + $dataout .= " DECLARE_GLOBAL_PARAMETER_STRUCT_PARAMS \\\n"; } - - $decl = "DECLARE_RESTRICTED_\U$implementation\E_STRUCT_PARAMS"; + if($header_files{"\U$implementation\E RESTRICTED"}) { - $dataout .= "$decl \\\n"; + $dataout .= " DECLARE_RESTRICTED_\U$implementation\E_STRUCT_PARAMS \\\n"; } - $decl = "DECLARE_PRIVATE_\U$thorn\E_STRUCT_PARAMS"; if($header_files{"\U$thorn\E PRIVATE"}) { - $dataout .= "$decl \\\n"; + $dataout .= " DECLARE_PRIVATE_\U$thorn\E_STRUCT_PARAMS \\\n"; } foreach $line (@data) { - $dataout .= $line . "\\\n"; + $dataout .= " $line \\\n"; } - $dataout .= "\n"; + $dataout .= " const void *cctk_pdummy_pointer;\n\n"; $dataout .= "#define USE_CCTK_PARAMETERS \\\n"; - $dataout .= "cctk_pdummy_int=0;\\ - cctk_pdummy_int+=0;\\ - cctk_pdummy_real=0;\\ - cctk_pdummy_real+=0;\\ - cctk_pdummy_pointer=NULL;\\ - cctk_pdummy_pointer=(CCTK_REAL *)cctk_pdummy_pointer;\\\n"; - - $decl = "USE_GLOBAL_PARAMETER_STRUCT_PARAMS"; + if($header_files{"GLOBAL"}) { - $dataout .= "$decl \\\n"; + $dataout .= " USE_GLOBAL_PARAMETER_STRUCT_PARAMS \\\n"; } - - $decl = "USE_RESTRICTED_\U$implementation\E_STRUCT_PARAMS"; + if($header_files{"\U$implementation\E RESTRICTED"}) { - $dataout .= "$decl \\\n"; + $dataout .= " USE_RESTRICTED_\U$implementation\E_STRUCT_PARAMS \\\n"; } - $decl = "USE_PRIVATE_\U$thorn\E_STRUCT_PARAMS"; if($header_files{"\U$thorn\E PRIVATE"}) { - $dataout .= "$decl \\\n"; + $dataout .= " USE_PRIVATE_\U$thorn\E_STRUCT_PARAMS \\\n"; } - - @data = (); foreach $friend (split(" ",$rhparameter_db->{"\U$thorn\E SHARES implementations"})) { - $friend_implementation = $rhinterface_db->{"\U$friend\E IMPLEMENTS"}; $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"}; - if ($type =~ /REAL/) - { - $type_parameter = "cctk_pdummy_real"; - } - elsif ($type =~ /INT/) - { - $type_parameter = "cctk_pdummy_int"; - } - elsif ($type =~ /BOOLEAN/) - { - $type_parameter = "cctk_pdummy_int"; - } - else - { - $type_parameter = "cctk_pdummy_pointer"; - } - $line = "$type_parameter = $parameter;"; - push(@data, $line); + $dataout .= " cctk_pdummy_pointer = \&$parameter; \\\n"; } } - foreach $line (@data) - { - $dataout .= $line . "\\\n"; - } - $dataout .= "\n"; + $dataout .= " cctk_pdummy_pointer = cctk_pdummy_pointer;\n\n"; $dataout .= "#endif\n"; &WriteFile("\U$thorn\E"."_CParameters.h",\$dataout); - } + } # Write this one to a temporary file and read it back in # Can probably do this better @@ -468,7 +425,7 @@ sub NewParamStuff my(%routines); my($structure, %structures); my(%header_files); - my($block); + my($block); my($filelist); my(@creationdata); my(@extensiondata); @@ -492,25 +449,25 @@ sub NewParamStuff if((keys %these_parameters > 0)) { - if($block eq "GLOBAL") - { - push(@data, "#include \"ParameterCGlobal.h\""); - } - elsif($block eq "RESTRICTED") - { - push(@data, "#include \"ParameterCRestricted\U$imp\E.h\""); - } - elsif($block eq "PRIVATE") - { - push(@data, "#include \"ParameterCPrivate\U$thorn\E.h\""); - } - else - { - die "Internal error"; - } - -# print "Generating $block parameters for $thorn, providing $imp\n"; - push(@creationdata,&CreateParameterRegistrationStuff($block, $thorn, $imp, $rhparameter_db, %these_parameters)); + if($block eq "GLOBAL") + { + push(@data, "#include \"ParameterCGlobal.h\""); + } + elsif($block eq "RESTRICTED") + { + push(@data, "#include \"ParameterCRestricted\U$imp\E.h\""); + } + elsif($block eq "PRIVATE") + { + push(@data, "#include \"ParameterCPrivate\U$thorn\E.h\""); + } + else + { + die "Internal error"; + } + +# print "Generating $block parameters for $thorn, providing $imp\n"; + push(@creationdata,&CreateParameterRegistrationStuff($block, $thorn, $imp, $rhparameter_db, %these_parameters)); } } @@ -598,15 +555,15 @@ sub CreateParameterRegistrationStuff # print "This param is $parameter\n"; $type = $rhparameter_db->{"\U$thorn $parameter\E type"}; - + # print "Type is $type\n"; - + $n_ranges = $rhparameter_db->{"\U$thorn $parameter\E ranges"}; - + # print "N_ranges is $n_ranges\n"; - + $quoted_default = $rhparameter_db->{"\U$thorn $parameter\E default"}; - + # $quoted_default =~ s:\"::g; The database now strips all unescaped quotes. # Set steerable details @@ -638,7 +595,7 @@ sub CreateParameterRegistrationStuff " \"" . $quoted_default . "\", /* The default value */\n" . " &($structure.$parameter), /* The actual data pointer */\n". " $n_ranges /* How many allowed ranges it has */"; - + for($range=1; $range <= $n_ranges; $range++) { $quoted_range = $rhparameter_db->{"\U$thorn $parameter\E range $range range"}; @@ -646,7 +603,7 @@ sub CreateParameterRegistrationStuff if($range_description !~ m:\":) { - $range_description = "\"$range_description\""; + $range_description = "\"$range_description\""; } $range_description =~ s:,$::; @@ -679,7 +636,7 @@ sub CreateParameterExtensionStuff my(@data); my($line); my($structure, $type, $n_ranges, $range, $quoted_range, $range_description); - + # print "Extending $block from $thorn\n"; foreach $parameter (split(" ",$rhparameter_db->{"\U$thorn\E SHARES \U$block\E variables"})) @@ -693,7 +650,7 @@ sub CreateParameterExtensionStuff if($range_description !~ m:\":) { - $range_description = "\"$range_description\""; + $range_description = "\"$range_description\""; } #$quoted_range =~ s:\":\\\":g; diff --git a/lib/sbin/GridFuncStuff.pl b/lib/sbin/GridFuncStuff.pl index 02d0c285..99babd5f 100644 --- a/lib/sbin/GridFuncStuff.pl +++ b/lib/sbin/GridFuncStuff.pl @@ -556,7 +556,7 @@ sub CreateCArgumentUses $suffix .= "_p"; } - push(@declarations, "cctk_dummy_pointer =$argument$suffix;"); + push(@declarations, "cctk_dummy_pointer = \&$argument$suffix;"); } } diff --git a/lib/sbin/create_c_stuff.pl b/lib/sbin/create_c_stuff.pl index aae35679..88e13b86 100644 --- a/lib/sbin/create_c_stuff.pl +++ b/lib/sbin/create_c_stuff.pl @@ -196,7 +196,7 @@ sub CreateCStructureParameterHeader # Create the structure - push(@data,("#ifdef __cplusplus", "extern \"C\"", "{", "#endif")); + push(@data,("#ifdef __cplusplus", "extern \"C\"", "{", "#endif", "")); push(@data,( "extern struct ", "{")); foreach $parameter (&order_params($rhparameters, $rhparameter_db)) @@ -209,80 +209,28 @@ sub CreateCStructureParameterHeader push(@data, $line); - $line = $type_string ." " .$parameter . " = $structure.$parameter;"; + $line = " const $type_string $parameter = $structure.$parameter; \\"; push(@definition, $line); - $line = ""; - if ($type_string =~ /CCTK_REAL16/) - { - $line = "cctk_pdummy_real16=$parameter;"; - } - elsif ($type_string =~ /CCTK_REAL8/) - { - $line = "cctk_pdummy_real8=$parameter;"; - } - elsif ($type_string =~ /CCTK_REAL4/) - { - $line = "cctk_pdummy_real4=$parameter;"; - } - elsif ($type_string =~ /CCTK_REAL/) - { - $line = "cctk_pdummy_real=$parameter;"; - } - elsif ($type_string =~ /CCTK_INT8/) - { - $line = "cctk_pdummy_int8=$parameter;"; - } - elsif ($type_string =~ /CCTK_INT4/) - { - $line = "cctk_pdummy_int4=$parameter;"; - } - elsif ($type_string =~ /CCTK_INT2/) - { - $line = "cctk_pdummy_int2=$parameter;"; - } - elsif ($type_string =~ /CCTK_INT/) - { - $line = "cctk_pdummy_int=$parameter;"; - } - else - { - $line = "cctk_pdummy_pointer=(void *)$parameter;"; - } + $line = " cctk_pdummy_pointer = \&$parameter; \\"; push(@use, $line); - } - # Some compilers don't like an empty structure. if((keys %$rhparameters) == 0) { push(@data, " int dummy_parameter;"); } - push(@data, "} $structure;"); + push(@data, "} $structure;", ""); - push(@data, ""); - push(@data,("#ifdef __cplusplus", "}", "#endif")); - - - push(@data, "#define DECLARE_$structure"."_PARAMS \\"); - - foreach $line (@definition) - { - push(@data, " const $line \\"); - } + push(@data,("#ifdef __cplusplus", "}", "#endif", "")); + push(@data, "#define DECLARE_$structure"."_PARAMS \\", @definition); push(@data, ""); - - push(@data, "#define USE_$structure"."_PARAMS \\"); - - foreach $line (@use) - { - push(@data, " $line \\"); - } + push(@data, "#define USE_$structure"."_PARAMS \\", @use); return @data; } |