Parse information in thorns' configuration.ccl files.

So far only the "REQUIRES THORNS: <list of thorns>" attribute is evaluated
and checked that (1) all required thorns are in the ThornList to be compiled
and (2) activated at runtime.


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

1 files changed, 74 insertions, 49 deletions

diff --git a/lib/sbin/CreateImplementationBindings.pl b/lib/sbin/CreateImplementationBindings.pl
index 254bffc9..474e0858 100644
--- a/lib/sbin/CreateImplementationBindings.pl
+++ b/lib/sbin/CreateImplementationBindings.pl
@@ -2,17 +2,16 @@
 #  @file      CreateImplementationBindings.pl
 #  @date      Sun Jul  4 17:09:54 1999
 #  @author    Tom Goodale
-#  @desc 
-#  
-#  @enddesc 
+#  @desc
+#
+#  @enddesc
 #@@*/
 
 sub CreateImplementationBindings
 {
-  my($bindings_dir, $rhparameter_db, $rhinterface_db) = @_;
-  my($start_dir);
-  my($thorn);
-  my(@data);
+  my($bindings_dir, $rhparameter_db, $rhinterface_db, $configuration_db) = @_;
+  my($i, $start_dir, $thorn);
+  my(@data, @thorns, @ancestors, @friends, @requires_thorns);
 
   if(! $build_dir)
   {
@@ -37,19 +36,14 @@ sub CreateImplementationBindings
     mkdir('include', 0755) || die 'Unable to create include directory';
   }
 
-  @data = ();
-  foreach $thorn (sort split(' ', $rhinterface_db->{'THORNS'}))
-  {
-    push(@data, "int CCTKi_BindingsThorn_$thorn(void);") 
-  }
+  @thorns = sort split(' ', $rhinterface_db->{'THORNS'});
+  @data = map { "void CCTKi_BindingsThorn_$_(void);" } @thorns;
+  push(@data, '');
 
   push(@data, 'int CCTKi_BindingsImplementationsInitialise(void);');
   push(@data, 'int CCTKi_BindingsImplementationsInitialise(void)');
   push(@data, '{');
-  foreach $thorn (sort split(' ', $rhinterface_db->{'THORNS'}))
-  {
-    push(@data, "  CCTKi_BindingsThorn_$thorn();") 
-  }
+  push(@data, map { "  CCTKi_BindingsThorn_$_();" } @thorns);
   push(@data, '  return 0;');
   push(@data, '}');
   push(@data, "\n");  # workaround for perl 5.004_04 to add a trailing newline
@@ -64,17 +58,20 @@ sub CreateImplementationBindings
   {
     mkdir("$build_dir", 0755) || die "Unable to create $build_dir";
   }
-  
+
   chdir "$build_dir";
 
-  foreach $thorn (sort split(' ', $rhinterface_db->{'THORNS'}))
+  foreach $thorn (@thorns)
   {
     if(! -d "$thorn")
     {
       mkdir("$thorn", 0755) || die "Unable to create $build_dir/$thorn";
     }
-  
+
     $myimp = $rhinterface_db->{"\U$thorn\E IMPLEMENTS"};
+    @ancestors = map { "    \"$_\"," } split (' ', $rhinterface_db->{"IMPLEMENTATION \U$myimp\E ANCESTORS"});
+    @friends = map { "    \"$_\"," } split (' ', $rhinterface_db->{"\U$thorn\E FRIEND"});
+    @requires_thorns = map { "    \"$_\"," } split (' ', $configuration_db->{"\U$thorn\E REQUIRES THORNS"});
 
     @data = ();
     push(@data, '#include <stdio.h>');
@@ -82,52 +79,80 @@ sub CreateImplementationBindings
     push(@data, '#include "cctki_ActiveThorns.h"');
     push(@data, '');
 
-    push(@data, "int CCTKi_BindingsThorn_${thorn}(void);");
-    push(@data, "int CCTKi_BindingsThorn_${thorn}(void)");
+    push(@data, "void CCTKi_BindingsThorn_${thorn}(void);");
+    push(@data, "void CCTKi_BindingsThorn_${thorn}(void)");
     push(@data, '{');
-    push(@data, '  int retval;');
     push(@data, "  const char *name[] = {\"$thorn\", 0};");
     push(@data, "  const char *implementation[] = {\"$myimp\", 0};");
-    push(@data, '  const char *ancestors[] =');
-    push(@data, '  {');
-    foreach $ancestor (split(" ",$rhinterface_db->{"IMPLEMENTATION \U$myimp\E ANCESTORS"}))
+    $i = 3;
+    if (@ancestors)
     {
-      push(@data, "    \"$ancestor\",");
+      push(@data, '  const char *ancestors[] =');
+      push(@data, '  {');
+      push(@data, @ancestors);
+      push(@data, '    0,');
+      push(@data, '  };');
+      push(@data, '');
+      $i++;
     }
-    push(@data, '    0,');
-    push(@data, '  };');
-    push(@data, '');
 
-    # Just pass the ones this thorn has declared itself to be friends with.
-    push(@data, '  const char *friends[] =');
-    push(@data, '  {');
-    foreach $friend (split(" ",$rhinterface_db->{"\U$thorn\E FRIEND"}))
+    if (@friends)
     {
-      push(@data, "    \"$friend\",");
+      # Just pass the ones this thorn has declared itself to be friends with.
+      push(@data, '  const char *friends[] =');
+      push(@data, '  {');
+      push(@data, @friends);
+      push(@data, '    0,');
+      push(@data, '  };');
+      push(@data, '');
+      $i++;
     }
-    push(@data, '    0,');
-    push(@data, '  };');
-    push(@data, '');
 
-    push(@data, '  /* Should be able to do below with a constant initialiser but sr8000 compiler complains');
+    if (@requires_thorns)
+    {
+      push(@data, '  const char *requires_thorns[] =');
+      push(@data, '  {');
+      push(@data, @requires_thorns);
+      push(@data, '    0,');
+      push(@data, '  };');
+      push(@data, '');
+      $i++;
+    }
+
+    push(@data, '  /*');
+    push(@data, '   * Should be able to do below with a constant initializer');
+    push(@data, '   * but sr8000 compiler doesn\'t like it.');
     push(@data, '   * So have to laboriously assign values to each member of array.');
     push(@data, '   */');
-    push(@data, '  struct iAttributeList attributes[5];');
+    push(@data, "  struct iAttributeList attributes[$i];");
     push(@data, '');
     push(@data, '  attributes[0].attribute                = "name";');
     push(@data, '  attributes[0].AttributeData.StringList = name;');
     push(@data, '  attributes[1].attribute                = "implementation";');
     push(@data, '  attributes[1].AttributeData.StringList = implementation;');
-    push(@data, '  attributes[2].attribute                = "ancestors";');
-    push(@data, '  attributes[2].AttributeData.StringList = ancestors;');
-    push(@data, '  attributes[3].attribute                = "friends";');
-    push(@data, '  attributes[3].AttributeData.StringList = friends;');
-    push(@data, '  attributes[4].attribute                = 0;');
-    push(@data, '  attributes[4].AttributeData.StringList = 0;');
-    push(@data, '');
-    push(@data, '  retval = CCTKi_RegisterThorn(attributes);');
+    $i = 2;
+    if (@ancestors)
+    {
+      push(@data, "  attributes[$i].attribute                = \"ancestors\";");
+      push(@data, "  attributes[$i].AttributeData.StringList = ancestors;");
+      $i++;
+    }
+    if (@friends)
+    {
+      push(@data, "  attributes[$i].attribute                = \"friends\";");
+      push(@data, "  attributes[$i].AttributeData.StringList = friends;");
+      $i++;
+    }
+    if (@requires_thorns)
+    {
+      push(@data, "  attributes[$i].attribute                = \"requires thorns\";");
+      push(@data, "  attributes[$i].AttributeData.StringList = requires_thorns;");
+      $i++;
+    }
+    push(@data, "  attributes[$i].attribute                = 0;");
+    push(@data, "  attributes[$i].AttributeData.StringList = 0;");
     push(@data, '');
-    push(@data, '  return retval;');
+    push(@data, '  CCTKi_RegisterThorn(attributes);');
     push(@data, '}');
     push(@data, "\n");  # workaround for perl 5.004_04 to add a trailing newline
 
@@ -137,7 +162,7 @@ sub CreateImplementationBindings
     $dataout = 'SRCS = cctk_ThornBindings.c';
     &WriteFile("$thorn/make.code.defn",\$dataout);
   }
-    
+
   chdir($start_dir);
 }