New parameter stuff.

Now a non-active thorn's extensions to parameters shouldn't be valid,
range checking is now done, even for strings, which must conform to
a regular expression.

Tom


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

6 files changed, 335 insertions, 8 deletions

diff --git a/lib/sbin/CST b/lib/sbin/CST
index a9a9b896..2afdf098 100644
--- a/lib/sbin/CST
+++ b/lib/sbin/CST
@@ -6,7 +6,7 @@
 #  @desc 
 #  Parses the the configuration files for thorns.
 #  @enddesc 
-#  @version $Header: /mnt/data2/cvs2svn/cvs-repositories/Cactus/lib/sbin/CST,v 1.25 1999-07-30 15:56:42 allen Exp $
+#  @version $Header: /mnt/data2/cvs2svn/cvs-repositories/Cactus/lib/sbin/CST,v 1.26 1999-08-26 15:34:16 goodale Exp $
 #@@*/
 
 # Global parameter to track the number of errors from the CST
@@ -115,6 +115,8 @@ if ($CST_debug)
 }
 %parameter_database = &CheckImpParamConsistency(scalar(keys %interface_database), %interface_database, %parameter_database);
 
+#$debug_parameters = 1;
+
 if($debug_parameters)
 {
   &print_parameter_database(%parameter_database);
diff --git a/lib/sbin/CreateImplementationBindings.pl b/lib/sbin/CreateImplementationBindings.pl
index 77b61709..93d62d07 100644
--- a/lib/sbin/CreateImplementationBindings.pl
+++ b/lib/sbin/CreateImplementationBindings.pl
@@ -42,6 +42,8 @@ sub CreateImplementationBindings
   @data = ();
 
   push(@data, "#include <stdio.h>\n");
+  push(@data, "/* FIXME - remove when ActiveThorns does not need this */\n");
+  push(@data, "#include \"SKBinTree.h\"\n\n");
   push(@data, "#include \"cctk_ActiveThorns.h\"\n\n");
 
   push(@data, "int CCTKi_BindingsImplementationsInitialise(void)\n{\n");
diff --git a/lib/sbin/CreateParameterBindings.pl b/lib/sbin/CreateParameterBindings.pl
index f2cb57fe..e034ed93 100644
--- a/lib/sbin/CreateParameterBindings.pl
+++ b/lib/sbin/CreateParameterBindings.pl
@@ -226,7 +226,19 @@ EOT
   {
     print OUT "  $routine"."Initialise();\n";
   }
+
+  foreach $thorn (split(" ",$interface_database{"THORNS"}))
+  {
+    print OUT "  CCTKi_BindingsCreate$thorn"."Parameters();\n\n";
+  }
+
+  foreach $thorn (split(" ",$interface_database{"THORNS"}))
+  {
+    print OUT "  CCTKi_Bindings$thorn"."ParameterExtensions();\n\n";
+  }
+
   print OUT <<EOT;
+
   return 0;
 }
  
@@ -407,9 +419,11 @@ EOT
   
   close OUT;
 
+  $newfilelist = NewParamStuff($n_param_database, @rest);
+
   open (OUT, ">make.code.defn") || die "Cannot open make.code.defn";
 
-  print OUT "SRCS = BindingsParameters.c $files\n";
+  print OUT "SRCS = BindingsParameters.c $files $newfilelist\n";
 
   close OUT;
 
@@ -565,6 +579,253 @@ EOT
   close OUT;
 
   chdir $start_dir;
+
+
+}
+
+sub NewParamStuff
+{
+  local($n_param_database, @rest) = @_;
+  local(%parameter_database);
+  local(%interface_database);
+  local($line);
+  local(%these_parameters);
+  local($implementation, $thorn);
+  local($files);
+  local(%routines);
+  local($structure, %structures);
+  local(%header_files);
+  local($thorn, $block); 
+  local($filelist);
+  local(@creationdata);
+  local(@extensiondata);
+  local(@data);
+
+  %parameter_database = @rest[0..(2*$n_param_database)-1];
+  %interface_database = @rest[2*$n_param_database..$#rest];
+
+
+  foreach $thorn (split(" ",$interface_database{"THORNS"}))
+  {
+    $imp = $interface_database{"\U$thorn\E IMPLEMENTS"};
+
+    push(@data, "#include <stdarg.h>");
+    push(@data, "");
+    push(@data, "#include \"config.h\"");
+    push(@data, "#include \"ParameterBindings.h\"");
+
+    push(@data, "#include \"CParameterStructNames.h\"");
+
+    foreach $block ("GLOBAL", "RESTRICTED", "PRIVATE")
+    {
+      %these_parameters = &GetThornParameterList($thorn, $block, %parameter_database);
+
+      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, scalar(keys %these_parameters), %these_parameters, %parameter_database));
+      }
+    }
+
+
+    # Now the parameter extensions
+#    print $parameter_database{"\U$thorn\E SHARES implementations"} . "\n";
+
+    foreach $block (split(" ",$parameter_database{"\U$thorn\E SHARES implementations"}))
+    {
+
+      push(@data, "#include \"ParameterCRestricted\U$block\E.h\"");
+
+#      print "Generating $block extension from $thorn\n";
+      push(@extensiondata,&CreateParameterExtensionStuff($block, $thorn, %parameter_database));
+
+    }
+
+    push(@data, "");
+    push(@data, "int CCTKi_BindingsCreate$thorn"."Parameters(void)");
+    push(@data, "{");
+
+    push(@data, @creationdata);
+
+    push(@data, "}");
+
+    push(@data, "");
+    push(@data, "int CCTKi_Bindings$thorn"."ParameterExtensions(void)");
+    push(@data, "{");
+
+    push(@data, @extensiondata);
+
+    push(@data, "}");
+
+    open (OUT, ">Create$thorn"."Parameters.c");
+
+    foreach $line (@data)
+    {
+      print OUT "$line\n";
+    }
+    
+    close OUT;
+
+    @data=();
+    @creationdata=();
+    @extensiondata=();
+
+    $filelist .= " Create$thorn"."Parameters.c";
+  }
+
+  return $filelist;
+}
+
+sub CreateParameterRegistrationStuff
+{
+  local($block, $thorn, $imp, $n_params, @rest) = @_;
+  local(%these_parameters);
+  local(%parameter_database);
+  local(@data);
+  local($line);
+  local($structure, $type, $n_ranges);
+
+  %these_parameters = @rest[0..(2*$n_params)-1];
+  %parameter_database = @rest[2*$n_params..$#rest];
+
+  if($block eq "GLOBAL")
+  {
+    $structure="GLOBAL_PARAMETER_STRUCT";
+  }
+  elsif($block eq "RESTRICTED")
+  {
+    $structure="RESTRICTED_\U$imp\E_STRUCT";
+  }
+  elsif($block eq "PRIVATE")
+  {
+    $structure = "PRIVATE_\U$thorn\E_STRUCT";
+  }
+  else
+  {
+    die "Internal error";
+  }
+
+#  print "Thorn is $thorn\n";
+#  print "Structure is $structure\n";
+
+  foreach $parameter (sort keys %these_parameters)
+  {
+
+#    print "This param is $parameter\n";
+
+    $type = $parameter_database{"\U$thorn $parameter\E type"};
+    
+#    print "Type is $type\n";
+    
+    $n_ranges = $parameter_database{"\U$thorn $parameter\E ranges"};
+    
+#    print "N_ranges is $n_ranges\n";
+    
+    $quoted_default = $parameter_database{"\U$thorn $parameter\E default"};
+    
+    $quoted_default =~ s:\"::g;
+
+    $line="  ParameterCreate(\"$parameter\", /* The parameter name */\n".
+          "                  \"$thorn\",     /* The thorn          */\n". 
+          "                  \"$type\"       /* The parameter type */,\n".
+          "                  \"$block\",     /* The scoping block  */\n".
+          "                  0,              /* Is it steerable ?  */\n".
+          "                  " . $parameter_database{"\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 */";
+    
+    for($range=1; $range <= $n_ranges; $range++)
+    {
+      $quoted_range = $parameter_database{"\U$thorn $parameter\E range $range range"};
+      $range_description = $parameter_database{"\U$thorn $parameter\E range $range description"};
+
+      if($range_description !~ m:\":)
+      {
+	$range_description = "\"$range_description\"";
+      }
+
+      $range_description =~ s:,$::;
+
+      #$quoted_range =~ s:\":\\\":g;
+      $quoted_range =~ s:\"::g;
+      $quoted_range =~ s:^\s*::;
+      $quoted_range =~ s:\s*$::;
+
+      $line .= ",\n                  \"".$quoted_range."\", $range_description";
+
+    }
+
+    $line .=");\n";
+
+    push(@data, $line);
+  }
+
+
+  return @data;
+}
+
+sub CreateParameterExtensionStuff
+{
+  local($block, $thorn, %parameter_database) = @_;
+  local(@data);
+  local($line);
+  local($structure, $type, $n_ranges, $range, $quoted_range, $range_description);
+ 
+#  print "Extending $block from $thorn\n";
+
+  foreach $parameter (split(" ",$parameter_database{"\U$thorn\E SHARES \U$block\E variables"}))
+  {
+    $n_ranges = $parameter_database{"\U$thorn $parameter\E ranges"};
+
+    for($range=1; $range <= $n_ranges; $range++)
+    {
+      $quoted_range = $parameter_database{"\U$thorn $parameter\E range $range range"};
+      $range_description = $parameter_database{"\U$thorn $parameter\E range $range description"};
+
+      if($range_description !~ m:\":)
+      {
+	$range_description = "\"$range_description\"";
+      }
+
+      #$quoted_range =~ s:\":\\\":g;
+      $quoted_range =~ s:\"::g;
+      $quoted_range =~ s:^\s*::;
+      $quoted_range =~ s:\s*$::;
+
+      push(@data, "  ParameterAddRange(\"$block\",");
+      push(@data, "                    \"$parameter\",");
+      push(@data, "                    \"$thorn\",");
+      push(@data, "                    \"$quoted_range\",");
+      push(@data, "                    $range_description);");
+      push(@data, "");
+
+
+#      print "Adding \"$quoted_range\" to $parameter\n";
+
+
+    }
+
+  }
+
+  return @data;
 }
 
 1;
diff --git a/lib/sbin/create_c_stuff.pl b/lib/sbin/create_c_stuff.pl
index 6508146a..d986c6d9 100644
--- a/lib/sbin/create_c_stuff.pl
+++ b/lib/sbin/create_c_stuff.pl
@@ -92,6 +92,11 @@ sub CreateParameterBindingFile
     
     push(@data, "");
 
+    push(@data, &create_parameter_code($structure,$parameters{$parameter}, 
+				       $parameter, %parameter_database));
+    
+    push(@data, "");
+
   }
 
   push(@data, "  return 0;");
@@ -218,11 +223,6 @@ sub set_parameter_code
     }
     $line .= ");";
   }
-  elsif( $type eq "KEYWORD")
-  {
-    $line = "    retval = CCTK_SetKeyword(\&($structure.$parameter), value);" ;
-
-  }
   elsif( $type eq "STRING" || $type eq "SENTENCE")
   {
     $line = "    retval = CCTK_SetString(\&($structure.$parameter),value);" ;
@@ -576,5 +576,63 @@ sub help_parameter_code
     
   return @lines;
 }
+
+
+sub create_parameter_code
+{
+  local($structure, $implementation,$parameter, %parameter_database) = @_;
+  local($type, $type_string);
+  local($line, @lines);
+  local($default);
+  local($temp_default);
+
+  $default = $parameter_database{"\U$implementation $parameter\E default"};
+  $type = $parameter_database{"\U$implementation $parameter\E type"};
+
+  $type_string = &get_c_type_string($type);
+
+  if($type_string eq "char *")
+  {
+    $line = "  $structure" .".$parameter = malloc(" 
+      . (length($default)-1). "\*sizeof(char));";
+    push(@lines, $line);
+
+    $line = "  if($structure.$parameter)";
+    push(@lines, $line);
+
+    $line = "    strcpy($structure.$parameter, $default);";
+    push(@lines, $line);
+  }
+  elsif($type eq "LOGICAL")
+  {
+    # Logicals need to be done specially.
+
+    # Strip out any quote marks, and spaces at start and end.
+    $temp_default = $default;
+    $temp_default =~ s:\"::g;
+    $temp_default =~ s:\s*$:: ;
+    $temp_default =~ s:^\s*:: ;
+
+    $line = "  CCTK_SetLogical(\&($structure.$parameter),\"$temp_default\");";
+    push(@lines, $line);
+  }
+  else
+  {
+    $line = "  $structure.$parameter = $default;";
+    push(@lines, $line);
+  }
+
+      $line = "ParameterCreate($parameter, $implementation,
+                    \"foobar\",\"" . $parameter_database{"\U$implementation $parameter\E type"}."\"
+                    const char *scope,
+                    int        steerable,
+                    const char *description,
+                    const char *defval,
+                    void       *data)";
+
+
+  return @lines;
+}
   
 1;
+
diff --git a/lib/sbin/parameter_parser.pl b/lib/sbin/parameter_parser.pl
index e1691214..14a62dcc 100644
--- a/lib/sbin/parameter_parser.pl
+++ b/lib/sbin/parameter_parser.pl
@@ -359,7 +359,7 @@ sub print_parameter_database
   
   foreach $field ( sort keys %parameter_database )
   {
-    print "$field has value $parameter_database{$field}";
+    print "$field has value $parameter_database{$field}\n";
   }
 }
 
diff --git a/lib/sbin/schedule_parser.pl b/lib/sbin/schedule_parser.pl
index c2335ee0..529b5ecb 100644
--- a/lib/sbin/schedule_parser.pl
+++ b/lib/sbin/schedule_parser.pl
@@ -106,6 +106,8 @@ sub write_rfr_header {
   $header .= "#include \"cctk.h\"\n";
   $header .= "#include \"cctk_Flesh.h\"\n";
   $header .= "#include \"cctk_Comm.h\"\n";
+  $header .= "/* FIXME - remove when ActiveThorns does not need this */\n";
+  $header .= "#include \"SKBinTree.h\"\n\n";
   $header .= "#include \"cctk_ActiveThorns.h\"\n";
   $header .= "#include \"cctk_Groups.h\"\n";
   $header .= "#include \"cctk_GroupsOnGH.h\"\n";
@@ -134,6 +136,8 @@ sub write_startup_header {
   print OUTSTART "#include <stdio.h>\n";
   print OUTSTART "#include \"cctk.h\"\n";
   print OUTSTART "#include \"cctk_Flesh.h\"\n";
+  print OUTSTART "/* FIXME - remove when ActiveThorns does not need this */\n";
+  print OUTSTART "#include \"SKBinTree.h\"\n\n";
   print OUTSTART "#include \"cctk_ActiveThorns.h\"\n";
   print OUTSTART "#include \"rfrConstants.h\"\n";
   print OUTSTART "#include \"cctk_parameters.h\"\n";