Changed CCTK_DECLARE_ARGUMENTS and CCTK_DECLARE_PARAMETERS macros so that

local variables/parameters are now used in their declarations block
without requiring separate USE_CCTK_* macros).

This closes PR Cactus/1657: CST doesn't ignore braces "{" instring literals.


git-svn-id: http://svn.cactuscode.org/flesh/trunk@3677 17b73243-c579-4c4c-a9d2-2d5706c11dac

5 files changed, 49 insertions, 99 deletions

diff --git a/lib/make/force-rebuild b/lib/make/force-rebuild
index e89f64f1..198a8ff0 100644
--- a/lib/make/force-rebuild
+++ b/lib/make/force-rebuild
@@ -5,7 +5,7 @@
 #   @desc 
 #   Timestamp file for forcing rebuilds of configurations
 #   @enddesc 
-#   @version $Id: force-rebuild,v 1.12 2004-04-01 09:03:38 schnetter Exp $
+#   @version $Id: force-rebuild,v 1.13 2004-04-24 15:44:50 tradke Exp $
 # @@*/
 
 6 March 2003: minor changes to CreateFunctionBindings.pl 
@@ -23,3 +23,6 @@
 19 Januar 2004: Compile Cactus and CactusBindings first so that other thorns
                 can access Fortran modules therein
 01 April 2004: Re-enable the consistency check for inheriting
+23 April 2004: Changed DECLARE_CCTK_* macros to use declared
+               parameters/variables in place (without requiring separate
+               USE_CCTK_* macros)
diff --git a/lib/sbin/CreateParameterBindings.pl b/lib/sbin/CreateParameterBindings.pl
index bf82225b..d8fe411b 100644
--- a/lib/sbin/CreateParameterBindings.pl
+++ b/lib/sbin/CreateParameterBindings.pl
@@ -183,10 +183,8 @@ sub CreateParameterBindings
       push(@data, "#include \"" . $header_files{"\U$implementation\E RESTRICTED"} . "\"");
     }
 
-    if($header_files{"\U$thorn\E PRIVATE"})
-    {
-      push(@data, "#include \"" . $header_files{"\U$thorn\E PRIVATE"} . "\"");
-    }
+    push(@data, "#include \"" . $header_files{"\U$thorn\E PRIVATE"} . "\"")
+      if($header_files{"\U$thorn\E PRIVATE"});
 
     foreach $friend (split(' ',$rhparameter_db->{"\U$thorn\E SHARES implementations"}))
     {
@@ -194,27 +192,15 @@ sub CreateParameterBindings
     }
     push(@data, '');
 
-    @use = ();
     push(@data, '#define DECLARE_CCTK_PARAMETERS \\');
-    push(@use, '#define USE_CCTK_PARAMETERS \\');
-    if($header_files{'GLOBAL'})
-    {
-      push(@data, '  DECLARE_GLOBAL_PARAMETER_STRUCT_PARAMS \\');
-      push(@use, '  USE_GLOBAL_PARAMETER_STRUCT_PARAMS \\');
-    }
-
-    if($header_files{"\U$implementation\E RESTRICTED"})
-    {
-      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"})
-    {
-      push(@data, "  DECLARE_PRIVATE_\U$thorn\E_STRUCT_PARAMS \\");
-      push(@use, "  USE_PRIVATE_\U$thorn\E_STRUCT_PARAMS \\");
-    }
+    push(@data, '  DECLARE_GLOBAL_PARAMETER_STRUCT_PARAMS \\')
+      if($header_files{'GLOBAL'});
+    push(@data, "  DECLARE_RESTRICTED_\U$implementation\E_STRUCT_PARAMS \\")
+      if($header_files{"\U$implementation\E RESTRICTED"});
+    push(@data, "  DECLARE_PRIVATE_\U$thorn\E_STRUCT_PARAMS \\")
+      if($header_files{"\U$thorn\E PRIVATE"});
 
+    @use = ();
     foreach $friend (split(' ',$rhparameter_db->{"\U$thorn\E SHARES implementations"}))
     {
       $rhinterface_db->{"IMPLEMENTATION \U$friend\E THORNS"} =~ m:([^ ]*):;
@@ -236,13 +222,17 @@ sub CreateParameterBindings
         }
 
         push(@data, "  $type_string$varprefix const $parameter = RESTRICTED_\U$friend\E_STRUCT.$realname; \\");
-        push(@use, "  (void) ($parameter + 0); \\");
+        push(@use, "    RESTRICTED_FRIENDS_STRUCT_use = \&$parameter, \\");
       }
     }
 
-    push(@data, '  USE_CCTK_PARAMETERS');
-    push(@data, '');
-    push(@data, @use);
+    if(@use)
+    {
+      push(@data, '  const void *RESTRICTED_FRIENDS_STRUCT_use = ( \\');
+      push(@data, @use);
+      push(@data,  '    RESTRICTED_FRIENDS_STRUCT_use = &RESTRICTED_FRIENDS_STRUCT_use \\');
+      push(@data,  '  );');
+    }
     push(@data, '');
     push(@data, "#endif  /* _\U$thorn\E_PARAMETERS_H_ */");
     push(@data, "\n");  # workaround for perl 5.004_04 to add a trailing newline
diff --git a/lib/sbin/GridFuncStuff.pl b/lib/sbin/GridFuncStuff.pl
index 82d2e729..5ca0631d 100644
--- a/lib/sbin/GridFuncStuff.pl
+++ b/lib/sbin/GridFuncStuff.pl
@@ -97,7 +97,7 @@ sub CreateVariableBindings
 
   push(@data, '#define CCTK_ARGUMENTS CCTK_CARGUMENTS');
   push(@data, '#define _CCTK_ARGUMENTS _CCTK_CARGUMENTS');
-  push(@data, '#define DECLARE_CCTK_ARGUMENTS DECLARE_CCTK_CARGUMENTS USE_CCTK_CARGUMENTS');
+  push(@data, '#define DECLARE_CCTK_ARGUMENTS DECLARE_CCTK_CARGUMENTS');
   push(@data, '#endif');
   push(@data, '');
   push(@data, '#ifdef FCODE');
@@ -115,7 +115,6 @@ sub CreateVariableBindings
     push(@data, "#define DECLARE_CCTK_FARGUMENTS DECLARE_\U$thorn" . '_FARGUMENTS');
     push(@data, "#define CCTK_CARGUMENTS \U$thorn" . '_CARGUMENTS');
     push(@data, "#define DECLARE_CCTK_CARGUMENTS DECLARE_\U$thorn" . '_CARGUMENTS');
-    push(@data, "#define USE_CCTK_CARGUMENTS USE_\U$thorn" . '_CARGUMENTS');
     push(@data, '#endif');
   }
   push(@data, "\n");  # workaround for perl 5.004_04 to add a trailing newline
@@ -527,7 +526,7 @@ sub CreateCArgumentDeclarations
 
     for($level = 0; $level < $ntimelevels; $level++)
     {
-      push(@declarations, "CCTK_$type *$varname = (CCTK_$type *) CCTKi_VarDataPtr(cctkGH, $level, $implementation, $var);");
+      push(@declarations, "CCTK_$type *$varname = ($varname = (CCTK_$type *) \&$varname, (CCTK_$type *) CCTKi_VarDataPtr(cctkGH, $level, $implementation, $var));");
 
       # Modify the name for the time level
       $varname .= '_p';
@@ -551,41 +550,6 @@ sub CreateCArgumentDeclarations
 
 }
 
-#/*@@
-#  @routine    CreateCArgumentUses
-#  @date       Nov 5 1999
-#  @author     Gabrielle Allen
-#  @desc
-#  Creates the requisite argument list declarations for C.
-#  @enddesc
-#@@*/
-sub CreateCArgumentUses
-{
-  my(%arguments) = @_;
-  my($varname, $suffix, $imp);
-  my(@declarations) = ();
-
-  # Now deal with the rest of the arguments
-  foreach $varname (sort keys %arguments)
-  {
-    next if ($arguments{$varname} =~ m:STORAGESIZE|GROUPLENGTH:);
-
-    $arguments{$varname} =~ m\^([^! ]+) ?([^!]*)?!([^!]*)::([^!]*)!([^!]*)\;
-
-    $ntimelevels = $5;
-
-    for($level = 0; $level < $ntimelevels; $level++)
-    {
-      push(@declarations, "(void) ($varname + 0);");
-
-      # Modify the name for the time level
-      $varname .= '_p';
-    }
-  }
-
-  return @declarations;
-}
-
 
 #/*@@
 #  @routine    CreateFortranArgumentList
@@ -896,12 +860,6 @@ sub CreateThornArgumentHeaderFile
     push(@returndata, join (" \\\n", @data));
     push(@returndata, '');
 
-    # Create code to use each C argument variable
-    push(@returndata, "#define USE_${thorn}_${block}_CARGUMENTS \\");
-    @data = &CreateCArgumentUses(%data);
-    push(@returndata, join (" \\\n", @data));
-    push(@returndata, '');
-
     # Create the C argument variable number statics
     push(@returndata, "#define DECLARE_${thorn}_${block}_C2F \\");
     @data = &CreateCArgumentStatics(%data);
@@ -935,7 +893,6 @@ sub CreateThornArgumentHeaderFile
   $fortran_arguments = "#define ${thorn}_FARGUMENTS _CCTK_FARGUMENTS";
   $fortran_declarations = "#define DECLARE_${thorn}_FARGUMENTS _DECLARE_CCTK_FARGUMENTS";
   $c_declarations = "#define \UDECLARE_${thorn}_CARGUMENTS _DECLARE_CCTK_CARGUMENTS";
-  $c_use_arguments = "#define \UUSE_${thorn}_CARGUMENTS _USE_CCTK_CARGUMENTS";
   $c_argument_prototypes = "#define \U${thorn}_C2F_PROTO _CCTK_C2F_PROTO";
   $c_argument_lists = "#define PASS_\U${thorn}_C2F(GH) _PASS_CCTK_C2F(GH)";
   $c_declare_statics = "#define DECLARE_\U${thorn}_C2F _DECLARE_CCTK_C2F";
@@ -947,7 +904,6 @@ sub CreateThornArgumentHeaderFile
       $fortran_arguments .= ", ${thorn}_${block}_FARGUMENTS";
       $fortran_declarations .= " DECLARE_${thorn}_${block}_FARGUMENTS";
       $c_declarations .= " DECLARE_${thorn}_${block}_CARGUMENTS";
-      $c_use_arguments .= " USE_${thorn}_${block}_CARGUMENTS";
       $c_argument_prototypes .= ", ${thorn}_${block}_C2F_PROTO";
       $c_argument_lists .= ", PASS_${thorn}_${block}_C2F(GH)";
       $c_declare_statics .= " DECLARE_${thorn}_${block}_C2F";
@@ -968,8 +924,6 @@ sub CreateThornArgumentHeaderFile
   push(@returndata, '#ifdef CCODE');
   push(@returndata, $c_declarations);
   push(@returndata, '');
-  push(@returndata, $c_use_arguments);
-  push(@returndata, '');
   push(@returndata, $c_argument_prototypes);
   push(@returndata, '');
   push(@returndata, $c_argument_lists);
diff --git a/lib/sbin/c_file_processor.pl b/lib/sbin/c_file_processor.pl
index e7c74819..7f447710 100644
--- a/lib/sbin/c_file_processor.pl
+++ b/lib/sbin/c_file_processor.pl
@@ -28,9 +28,9 @@ if (! -e "$fortran_name_file" )
 
 require "$fortran_name_file";
 
-$closing_brackets  = '';
 $routine  = '';
-$n_arg_braces = -3;
+$n_arg_left_braces = $n_arg_right_braces = 0;
+$do_fix_fnames = 0;
 
 # parse the file up to a ";\n"
 $/ = ";\n";
@@ -46,37 +46,38 @@ while (<>)
     #  it is not checked if some code follows after the closing '*/')
     if ($mline !~ m/^\s*\/\// && $mline !~ m/^\s*\/\*.*\*\/\s*$/)
     {
-      # check if the DECLARE macros are found on a line
-      if ($mline =~ s/(DECLARE_CCTK_(PARAMETERS|ARGUMENTS))(\s*;)?/$1 {/g)
-      {
-        $closing_brackets = "} /* closing bracket for $1 block */ " . $closing_brackets;
-        $n_arg_braces = -1;
-      }
+      # Remove a ; from after the DECLARE_CCTK_* macros
+      $mline =~ s/(DECLARE_CCTK_(PARAMETERS|ARGUMENTS))(\s*;)?/$1/;
 
       # Remove a ; from after the fileversion macro
       # such a semicolon could lead to warning messages.
       $mline =~ s/^\s*(CCTK_FILEVERSION\s*\([^)]*\))(\s*;)?/$1/;
       $mline =~ s/^\s*((ONE|TWO|THREE|FOUR|FIVE)_FORTSTRING_(CREATE|PTR)\s*\([^)]*\))(\s*;)?/$1/;
 
-      # start counting braces if there has been a DECLARE macro
-      if ($closing_brackets)
-      {
-        $n_arg_braces-- while ($mline =~ m/(})/g);
-        $n_arg_braces++ while ($mline =~ m/({)/g);
-      }
+      # start counting braces
+      $n_arg_left_braces++  while ($mline =~ m/({)/g);
+      $n_arg_right_braces++ while ($mline =~ m/(})/g);
 
-      $mline = "$closing_brackets$mline" if ($n_arg_braces == -1);
+      # check if we have to fix names of fortran wrappers
+      $do_fix_fnames = 1 if ($mline =~ /(CCTK_FNAME|CCTK_FORTRAN_COMMON_NAME)/);
     }
 
     $routine .= $mline . "\n";
 
-    if ($n_arg_braces == -1)
+    if ($n_arg_left_braces > 0 && $n_arg_left_braces - $n_arg_right_braces == 0)
     {
-      $closing_brackets = '';
-      $n_arg_braces = -2;
+      $n_arg_left_braces = $n_arg_right_braces = 0;
 
       # call the fortran namefix routine/reset routine
-      fixfnames ($routine);
+      if ($do_fix_fnames)
+      {
+        fixfnames ($routine);
+        $do_fix_fnames = 0;
+      }
+      else
+      {
+        print $routine;
+      }
       $routine = '';
     }
   }
diff --git a/lib/sbin/create_c_stuff.pl b/lib/sbin/create_c_stuff.pl
index 499f8767..1952a188 100644
--- a/lib/sbin/create_c_stuff.pl
+++ b/lib/sbin/create_c_stuff.pl
@@ -172,7 +172,7 @@ sub GetThornParameterList
 sub CreateCStructureParameterHeader
 {
   my($prefix, $structure, $rhparameters, $rhparameter_db) = @_;
-  my($line,@data);
+  my($line,@data,@use);
   my(%parameters);
   my($type, $type_string);
   my(@definition);
@@ -187,6 +187,7 @@ sub CreateCStructureParameterHeader
   push(@data, 'extern struct');
   push(@data, '{');
 
+  push(@use, "  const void *${structure}_use = ( \\");
   foreach $parameter (&order_params($rhparameters, $rhparameter_db))
   {
     my $type = $rhparameter_db->{"\U$rhparameters->{$parameter} $parameter\E type"};
@@ -207,8 +208,10 @@ sub CreateCStructureParameterHeader
 
     push(@data, "  $type_string $realname$suffix;");
     push(@definition, "  $type_string$varprefix const $parameter = $structure.$realname; \\");
-    push(@use, "  (void) ($parameter + 0); \\");
+    push(@use, "    ${structure}_use = \&$parameter, \\");
   }
+  push(@use, "    &${structure}_use \\");
+  push(@use, '  );');
 
   # Some compilers don't like an empty structure.
   if((keys %$rhparameters) == 0)
@@ -226,9 +229,8 @@ sub CreateCStructureParameterHeader
 
   push(@data, "#define DECLARE_${structure}_PARAMS \\");
   push(@data, @definition);
-  push(@data, '');
-  push(@data, "#define USE_${structure}_PARAMS \\");
   push(@data, @use);
+
   push(@data, "\n");   # workaround for perl 5.004_04 to add a trailing newline
 
   return join ("\n", @data);