CST only writes files which have changed (still a couple more writes

to replace).

Also a bug fix for Build Headers for when the file to be included is
in the include directory of the thorn.


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

1 files changed, 582 insertions, 52 deletions

diff --git a/lib/sbin/CreateScheduleBindings.pl b/lib/sbin/CreateScheduleBindings.pl
index c2a06e6f..bb477f3b 100644
--- a/lib/sbin/CreateScheduleBindings.pl
+++ b/lib/sbin/CreateScheduleBindings.pl
@@ -1,19 +1,19 @@
 #/*@@
 #  @file      CreateScheduleBindings.pl
-#  @date      Sun Jul 25 00:53:43 1999
+#  @date      Thu Sep 16 23:30:21 1999
 #  @author    Tom Goodale
 #  @desc 
-#  Schedule bindings stuff
+#  New schedule stuff.  Should be renamed !!!
 #  @enddesc 
+#  @version $Header$
 #@@*/
 
-
 #/*@@
 #  @routine    CreateScheduleBindings
-#  @date       Thu Jan 28 15:27:16 1999
+#  @date       Fri Sep 17 14:16:23 1999
 #  @author     Tom Goodale
 #  @desc 
-#  Create the bindings used for the scheduler.
+#  Creates the schedule bindings.
 #  @enddesc 
 #  @calls     
 #  @calledby   
@@ -24,97 +24,627 @@
 #@@*/
 sub CreateScheduleBindings
 {
-  local($bindings_dir,$n_thorns,@rest) = @_;
-  local(%thorns);
+  local($bindings_dir, $n_interface_database, @rest) = @_;
   local(%interface_database);
-  local($wrapper, $rfr, $startup, %schedule_data);
-
-  %thorns = @rest[0..2*$n_thorns-1];
-  %interface_database = @rest[2*$n_thorns..$#rest];
+  local(%schedule_database);
+  local($start_dir);
+  local($thorn);
+  local($file_list);
 
+  # Extract the interface and schedule databases from the arguments.
+  %interface_database = @rest[0..2*$n_interface_database-1];
+  %schedule_database = @rest[2*$n_interface_database..$#rest];
+  
   if(! -d $bindings_dir)
   {
     mkdir("$bindings_dir", 0755) || die "Unable to create $bindings_dir";
   }
   $start_dir = `pwd`;
+
   chdir $bindings_dir;
 
   if(! -d "Schedule")
   {
     mkdir("Schedule", 0755) || die "Unable to create Schedule directory";
   }
-  chdir "Schedule";
 
-  # Parse the schedule.ccl files
-  if ($CST_debug)
+  if(! -d "include")
   {
-    print "DEBUG: Parsing schedule.ccl files\n";
+    mkdir("include", 0755) || die "Unable to create include directory";
   }
-  ($wrapper,$rfr,$startup, %schedule_data) = &create_schedule_code($bindings_dir,$n_thorns,%thorns,%interface_database);
 
-  @rfr_files = split(" ",$rfr);
+  chdir "Schedule";
+
+  $file_list = "";
 
-  # Write the contents of BindingsScheduleRegisterRFR.c
-  if ($CST_debug)
+  foreach $thorn (sort split(" ", $interface_database{"THORNS"}))
   {
-    print "DEBUG: Creating RFR registration files\n";
+    $buffer = &ScheduleCreateFile($thorn, scalar(keys %interface_database), 
+				  %interface_database, %schedule_database);
+
+#    open(OUT, ">Schedule$thorn.c") || die "Unable to open Schedule$thorn.c";
+    
+    &WriteFile("Schedule$thorn.c",$buffer);
+
+#    close OUT;
+
+    $file_list .= " Schedule$thorn.c";
   }
-  &create_RegisterRFR($bindings_dir,scalar(@rfr_files), @rfr_files, %schedule_data); 
 
-  # Write the contents of BindingsScheduleRegisterSTARTUP.c
+  $buffer = ScheduleCreateBindings(scalar(keys %interface_database), 
+				  %interface_database, %schedule_database);
+
+
+#  open(OUT, ">BindingsSchedule.c") || die "Unable to open BindingsSchedule.c";
+
+  &WriteFile("BindingsSchedule.c",$buffer);
+
+#  close OUT;
+
+  $file_list .= " BindingsSchedule.c";
+
+#  open(OUT, ">make.code.defn") || die "Unable to open make.code.defn";
+
+  &WriteFile("make.code.defn","SRCS = $file_list\n");
+
+#  close OUT;
+  
+  chdir "$start_dir";
+}  
+
+#/*@@
+#  @routine    ScheduleCreateFile
+#  @date       Fri Sep 17 17:34:26 1999
+#  @author     Tom Goodale
+#  @desc 
+#  Creates a string containing all the data which should go into a schedule file.
+#  @enddesc 
+#  @calls     
+#  @calledby   
+#  @history 
+#
+#  @endhistory 
+#
+#@@*/
+sub ScheduleCreateFile
+{
+  local($thorn, $n_interface_database, @rest) = @_;
+  local(%interface_database);
+  local(%schedule_database);
+
+  local($implementation);
+  local($buffer, $prototypes);
+  local($block, $block_buffer, $block_prototype);
+  local($statement, $statement_buffer, $statement_prototype);
+  local($indent, $language, $function);
+  local(@mem_groups);
+  local(@comm_groups);
+  local(@trigger_groups);
+  local(@before_list);
+  local(@after_list);
+  local(@while_list);
+  local($outfile);
+  local($outbuf);
+
+  # Extract the interface, and schedule databases from the arguments.
+  %interface_database = @rest[0..2*$n_interface_database-1];
+  %schedule_database = @rest[2*$n_interface_database..$#rest];
   
-  if ($CST_debug)
+  $implementation = $interface_database{"\U$thorn\E IMPLEMENTS"};
+  
+  $buffer = $schedule_database{"\U$thorn\E FILE"};
+  
+  # Process each schedule block
+  for($block = 0 ; $block < $schedule_database{"\U$thorn\E N_BLOCKS"}; $block++)
+  {
+    ($block_buffer, $block_prototype) = &ScheduleBlock($thorn, $implementation, $block,
+						       $n_interface_database, 
+						       @rest);
+    $buffer =~ s:\@BLOCK\@$block:$block_buffer:;
+    $prototypes .= "$block_prototype";
+  }
+
+  # Process each schedule statement
+  for($statement = 0 ; $statement < $schedule_database{"\U$thorn\E N_STATEMENTS"}; $statement++)
   {
-    print "DEBUG: Creating STARTUP registration files\n";
+    ($statement_buffer, $statement_prototype) = &ScheduleStatement($thorn, $implementation, $statement, 
+								   $n_interface_database,
+								   @rest);
+    $buffer =~ s:\@STATEMENT\@$statement:$statement_buffer:;
+    $prototypes .= "$statement_prototype";
   }
-  &create_RegisterSTARTUP($bindings_dir,split(" ",$startup)); 
+    
+  # Actually create the string
+
+  # Header stuff
+  $outbuf = "";
+  $outbuf .=  "\#define THORN_IS_$thorn\n";
+  $outbuf .=  "\n";
+  $outbuf .=  "\#include <stdarg.h>\n";
+  $outbuf .=  "\n";
+  $outbuf .=  "\#include \"cctk.h\"\n";
+  $outbuf .=  "\#include \"cctk_parameters.h\"\n";
+  $outbuf .=  "\#include \"cctk_schedule.h\"\n";
+  $outbuf .=  "\#include \"cctk_Flesh.h\"\n";
+  $outbuf .=  "\#include \"cctk_Comm.h\"\n";
+  $outbuf .=  "\n";
+  $outbuf .=  "/* Prototypes for functions to be registered. */\n";
+  $outbuf .=  "$prototypes\n";
+  $outbuf .=  "\n";
+  $outbuf .=  "/*\@\@\n";
+  $outbuf .=  "  \@routine    CCTKi_BindingsSchedule_$thorn\n";
+  $outbuf .=  "  \@date       \n";
+  $outbuf .=  "  \@author     \n";
+  $outbuf .=  "  \@desc \n";
+  $outbuf .=  "  Creates the schedule bindings for thorn $thorn\n";
+  $outbuf .=  "  \@enddesc \n";
+  $outbuf .=  "  \@calls     \n";
+  $outbuf .=  "  \@calledby   \n";
+  $outbuf .=  "  \@history \n";
+  $outbuf .=  "\n";
+  $outbuf .=  "  \@endhistory\n"; 
+  $outbuf .=  "\n";
+  $outbuf .=  "\@\@*/\n";
+  $outbuf .=  "void CCTKi_BindingsSchedule_$thorn(void)\n";
+  $outbuf .=  "{\n";
+  $outbuf .=  "  DECLARE_CCTK_PARAMETERS\n";
+  $outbuf .=  "$buffer\n";
+  $outbuf .=  "}\n";
+  $outbuf .=  "\n";
+
+  return $outbuf;
+
+}
+
+#/*@@
+#  @routine    ScheduleCreateBindings
+#  @date       Fri Sep 17 18:17:13 1999
+#  @author     Tom Goodale
+#  @desc 
+#  Creates a string containing all the data which should go into the master 
+#  schedule bindings file.
+#  @enddesc 
+#  @calls     
+#  @calledby   
+#  @history 
+#
+#  @endhistory 
+#
+#@@*/
+sub ScheduleCreateBindings
+{
+  local($n_interface_database, @rest) = @_;
+  local(%interface_database);
+  local(%schedule_database);
+
+  local($outbuf);
+
+  # Extract the interface, and schedule databases from the arguments.
+  %interface_database = @rest[0..2*$n_interface_database-1];
+  %schedule_database = @rest[2*$n_interface_database..$#rest];
 
-  open (OUT, ">BindingsSchedule.c") || die "Cannot open BindingsSchedule.c";
+  
+  $outbuf = "";
+  $outbuf .=  "\#include \"SKBinTree.h\"\n";
+  $outbuf .=  "\#include \"cctk_ActiveThorns.h\"\n";
+  $outbuf =   "\n";
+  $outbuf .=  "/* Prototypes for functions to be registered. */";
 
-  print OUT  <<EOT;
-#include <stdio.h>
- 
-  int CCTKi_BindingsScheduleInitialise(void)
+  foreach $thorn (sort split(" ", $interface_database{"THORNS"}))
   {
-    return 0;
+    $outbuf .= "void CCTKi_BindingsSchedule_$thorn(void);\n";
   }
 
-  int CCTKi_BindingsScheduleRegister(const char *type, void *data)
+  $outbuf .=  "/*\@\@\n";
+  $outbuf .=  "  \@routine    CCTKi_BindingsScheduleInitialise\n";
+  $outbuf .=  "  \@date       \n";
+  $outbuf .=  "  \@author     \n";
+  $outbuf .=  "  \@desc \n";
+  $outbuf .=  "  Calls all the thorn schedule bindings file if the thorns are active.\n";
+  $outbuf .=  "  \@enddesc \n";
+  $outbuf .=  "  \@calls     \n";
+  $outbuf .=  "  \@calledby   \n";
+  $outbuf .=  "  \@history \n";
+  $outbuf .=  "\n";
+  $outbuf .=  "  \@endhistory\n"; 
+  $outbuf .=  "\n";
+  $outbuf .=  "\@\@*/\n";
+  $outbuf .=  "int CCTKi_BindingsScheduleInitialise(void)\n";
+  $outbuf .=  "{\n";
+  foreach $thorn (sort split(" ", $interface_database{"THORNS"}))
   {
-    
-    if (CCTK_Equals(type,"STARTUP"))
+    $outbuf .= "  if(CCTK_IsThornActive(\"$thorn\"))\n";
+    $outbuf .= "  {\n";
+    $outbuf .= "    CCTKi_BindingsSchedule_$thorn();\n";
+    $outbuf .= "  }\n";
+  }
+  $outbuf .=  "  return 0;\n";
+  $outbuf .=  "}\n";
+  $outbuf .=  "\n";
+
+  return $outbuf;
+}
+#/*@@
+#  @routine    ScheduleBlock
+#  @date       Fri Sep 17 17:37:59 1999
+#  @author     Tom Goodale
+#  @desc 
+#  Creates the code for a given schedule block
+#  @enddesc 
+#  @calls     
+#  @calledby   
+#  @history 
+#
+#  @endhistory 
+#
+#@@*/
+sub ScheduleBlock
+{
+  local($thorn, $implementation, $block, $n_interface_database, @rest) = @_;
+  local(%interface_database);
+  local(%schedule_database);
+
+  local($buffer, $prototype);
+  local($indent, $language, $function);
+  local(@mem_groups);
+  local(@comm_groups);
+  local(@trigger_groups);
+  local(@before_list);
+  local(@after_list);
+  local(@while_list);
+
+
+  # Extract the interface, and schedule databases from the arguments.
+  %interface_database = @rest[0..2*$n_interface_database-1];
+  %schedule_database = @rest[2*$n_interface_database..$#rest];
+
+  # Extract group and routine information from the databases
+  @mem_groups = &ScheduleSelectGroups($thorn, $implementation, 
+				      $schedule_database{"\U$thorn\E BLOCK_$block STOR"},
+				      %interface_database);
+
+  @comm_groups = &ScheduleSelectGroups($thorn, $implementation, 
+				       $schedule_database{"\U$thorn\E BLOCK_$block COMM"},
+				       %interface_database);
+
+  @trigger_groups = &ScheduleSelectGroups($thorn, $implementation, 
+					  $schedule_database{"\U$thorn\E BLOCK_$block TRIG"},
+					  %interface_database);
+		
+
+  @before_list = &ScheduleSelectRoutines($thorn, $implementation, 
+					 $schedule_database{"\U$thorn\E BLOCK_$block BEFORE"},
+					 %schedule_database);
+
+  @after_list = &ScheduleSelectRoutines($thorn, $implementation, 
+					$schedule_database{"\U$thorn\E BLOCK_$block AFTER"},
+					%schedule_database);
+
+  @while_list = &ScheduleSelectVars($thorn, $implementation, 
+				    $schedule_database{"\U$thorn\E BLOCK_$block WHILE"},
+				    %interface_database);
+
+
+  # Start writing out the data 
+  if($schedule_database{"\U$thorn\E BLOCK_$block TYPE"} eq "GROUP")
+  {
+    $prototype = "";
+    $buffer = "  CCTK_ScheduleGroup(";
+    $indent = "                     ";
+    $language = "";
+  }
+  elsif($schedule_database{"\U$thorn\E BLOCK_$block TYPE"} eq "FUNCTION")
+  {
+    if($schedule_database{"\U$thorn\E BLOCK_$block LANG"} =~ m:^\s*C\s*$:i )
     {
-      Cactus_RegisterSTARTUP();
-    } 
-    else if (CCTK_Equals(type,"RFRINIT")) 
+      $language = "C";
+      $function = $schedule_database{"\U$thorn\E BLOCK_$block NAME"};
+    }
+    elsif($schedule_database{"\U$thorn\E BLOCK_$block LANG"} =~ m:^\s*(F|F77|FORTRAN|F90)\s*$:i )
     {
-      Cactus_RegisterRFR(data);
-    } else {
-      printf ("Unknown type in CCTKi_BindingsScheduleRegister");
+      $language = "Fortran";
+      $function = "FORTRAN_NAME(".$schedule_database{"\U$thorn\E BLOCK_$block NAME"} .")";
     }
+    else
+    {
+      print STDERR "Unknown language " .$schedule_database{"\U$thorn\E BLOCK_$block LANG"} ."\n";
+      $CST_errors++;
+      return ("", "");
+    }
+    $prototype = "extern int $function(void); /* Note that this is a cheat, we just need a function pointer. */\n";
+    $buffer = "  CCTK_ScheduleFunction($function,\n";
+    $indent = "                        ";
+    $buffer .= "$indent";
+  }
+  else
+  {
+    print STDERR "Internal error: Unknown schedule block type " . $schedule_database{"\U$thorn\E BLOCK_$block TYPE"} . "\n";
+    return ("", "");
+    $CST_errors++;
+  }
+  
+  $buffer .= "\"" . $schedule_database{"\U$thorn\E BLOCK_$block NAME"} . "\"" . ",\n";
+  $buffer .= $indent . "\"" . $thorn . "\"" . ",\n";
+  $buffer .= $indent . "\"" . $implementation . "\"" . ",\n";
+  $buffer .= $indent . "\"" . $schedule_database{"\U$thorn\E BLOCK_$block DESCRIPTION"} . "\"" . ",\n";
+  $buffer .= $indent . "\"" . $schedule_database{"\U$thorn\E BLOCK_$block WHERE"} . "\"" . ",\n";
+  if($language ne "")
+  {
+    $buffer .= $indent . "\"" . $language . "\"" . ",\n";
+  }
 
-    return 0;
+  $buffer .= $indent . scalar(@mem_groups) . ",                       /* Number of STORAGE groups */\n";
+  $buffer .= $indent . scalar(@comm_groups) . ",                       /* Number of COMM groups */\n";
+  $buffer .= $indent . scalar(@trigger_groups) . ",                       /* Number of TRIGGERS groups */\n";
+  $buffer .= $indent . scalar(@before_list) . ",                       /* Number of BEFORE routines */\n";
+  $buffer .= $indent . scalar(@after_list) . ",                       /* Number of AFTER routines */\n";
+  $buffer .= $indent . scalar(@while_list) . "                        /* Number of WHILE variables */";
+  
+  foreach $item (@mem_groups, @comm_groups, @trigger_groups, @before_list, @after_list, @while_list)
+  {
+    $buffer .= ",\n" . $indent . "\"" . $item . "\"" ;
+  }
+
+  $buffer .= ");\n\n";
+
+  return ($buffer, $prototype);
+}
+
+#/*@@
+#  @routine    ScheduleStatement
+#  @date       Fri Sep 17 17:38:30 1999
+#  @author     Tom Goodale
+#  @desc 
+#  Creates the code for a given schedule statement
+#  @enddesc 
+#  @calls     
+#  @calledby   
+#  @history 
+#
+#  @endhistory 
+#
+#@@*/
+sub ScheduleStatement
+{
+  local($thorn, $implementation, $statement, $n_interface_database, @rest) = @_;
+  local(%interface_database);
+  local(%schedule_database);
+
+  local($buffer, $prototype);
+  local(@groups);
+  local($group);
+
+  # Extract the interface and schedule databases from the arguments.
+  %interface_database = @rest[0..2*$n_interface_database-1];
+  %schedule_database = @rest[2*$n_interface_database..$#rest];
+
+  # Extract the groups.
+  @groups = &ScheduleSelectGroups($thorn, $implementation, 
+				  $schedule_database{"\U$thorn\E STATEMENT_$statement GROUPS"},
+				  %interface_database);
+
+  if($schedule_database{"\U$thorn\E STATEMENT_$statement TYPE"} eq "STOR")
+  {
+    $function = "CCTK_ScheduleGroupStorage(";
+  }
+  elsif($schedule_database{"\U$thorn\E STATEMENT_$statement TYPE"} eq "COMM")
+  {
+    $function = "CCTK_ScheduleGroupComm(";
   }
- 
-EOT
+  else
+  {
+    print STDERR "Unknown statement type '" .$schedule_database{"\U$thorn\E STATEMENT_$statement TYPE"} ."'\n";
+    $CST_errors++;
+    return ("", "");
+  }
+
+  $prototype = "";
+
+  foreach $group (@groups)
+  {
+    $buffer .= "  $function " . "\"" . $group . "\"" . ");\n"
+  }
+
+  return ($buffer, $prototype);
+}
+
+#/*@@
+#  @routine    ScheduleSelectGroups
+#  @date       Fri Sep 17 17:38:53 1999
+#  @author     Tom Goodale
+#  @desc 
+#  Parses a list of variable groups and selects valid ones.
+#  @enddesc 
+#  @calls     
+#  @calledby   
+#  @history 
+#
+#  @endhistory 
+#
+#@@*/
+sub ScheduleSelectGroups
+{
+  local($thorn, $implementation, $group_list, %interface_database) = @_;
+  local(@groups);
+  local(@temp_list);
+  local($group);
+  local($other_imp, $other_thorn, $foundit, $block);
+
+  @temp_list = split(/[,\s\n]+/, $group_list);
 
-  close OUT;
+  foreach $group (@temp_list)
+  {
+    next if($group =~ m:^\s*$:);
 
-  open (OUT, ">make.code.defn") || die "Cannot open make.code.defn";
+    $other_imp = "";
 
-  $files = "";
-  foreach $file (split(" ",$rfr),split(" ",$startup),split(" ",$wrapper)) {
-    if($file)
+    if($group =~ m/(.+)::(.+)/)
     {
-      $files = "$files ".$file.".c";
+      $other_imp=$1;
+      $group = $2;
+
+      if(($1 !~ m:^\s*$thorn\s*$:i) && ($1 !~ m:^\s*$implementation\s*$:i))
+      {
+	# The name has been given completely specified but it isn't this thorn.
+      
+	if($interface_database{"IMPLEMENTATION \U$implementation\E ANCESTORS"} =~ m:\b$other_imp\b:i)
+	{
+	  $block = "PUBLIC";
+	}
+	elsif($interface_database{"IMPLEMENTATION \U$implementation\E FRIENDS"} =~ m:\b$other_imp\b:i)
+	{
+	  $block = "PROTECTED";
+	}
+	else
+	{
+	  print STDERR "Schedule error: Thorn $thorn - group $group doesn't exist.\n";
+	  $CST_errors++;
+	  next;
+	}
+
+	$interface_database{"IMPLEMENTATION \U$other_imp\E THORNS"} =~ m:(\w+):;
+	$other_thorn = $1;
+      
+	if($interface_database{"\U$other_thorn\E $block GROUPS"} =~ m:\b$group\b:i)
+	{
+	  push(@groups, "$other_imp\::$group");
+	  next;
+	}
+	else
+	{
+	  print STDERR "Schedule error: Thorn $thorn - group $group doesn't exist.\n";
+	  $CST_errors++;
+	  next;
+	}	
+      }
+    }
+
+    if($interface_database{"\U$thorn\E PRIVATE GROUPS"} =~ m:\b$group\b:i)
+    {
+      push(@groups, "$thorn\::$group");
+    }
+    elsif($interface_database{"\U$thorn\E PROTECTED GROUPS"} =~ m:\b$group\b:i)
+    {
+      push(@groups, "$implementation\::$group");
+    }
+    elsif($interface_database{"\U$thorn\E PUBLIC GROUPS"} =~ m:\b$group\b:i)
+    {
+      push(@groups, "$implementation\::$group");
+    }
+    elsif($other_imp eq "")
+    {
+      $foundit = 0;
+      # Check ancestors and friends
+      foreach $other_imp (split(" ", $interface_database{"IMPLEMENTATION \U$implementation\E ANCESTORS"}))
+      {
+	$interface_database{"IMPLEMENTATION \U$other_imp\E THORNS"} =~ m:(\w+):;
+	$other_thorn = $1;
+
+	if($interface_database{"\U$other_thorn\E PUBLIC GROUPS"} =~ m:\b$group\b:i)
+	{
+	  push(@groups, "$other_imp\::$group");
+	  $foundit = 1;
+	  last;
+	}
+      }
+      if(! $foundit)
+      {
+	foreach $other_imp (split(" ", $interface_database{"IMPLEMENTATION \U$implementation\E FRIENDS"}))
+	{
+	  $interface_database{"IMPLEMENTATION \U$other_imp\E THORNS"} =~ m:(\w+):;
+	  $other_thorn = $1;
+
+	  if($interface_database{"\U$other_thorn\E PROTECTED GROUPS"} =~ m:\b$group\b:i)
+	  {
+	    push(@groups, "$other_imp\::$group");
+	    $foundit = 1;
+	    last;
+	  }
+	}
+      }
+      if(! $foundit)
+      {
+	print STDERR "Schedule error: Thorn $thorn - group $group doesn't exist.\n";
+	$CST_errors++;
+      }
+    }
+    else
+    {
+      print STDERR "Schedule error: Thorn $thorn - group $group doesn't exist.\n";
+      $CST_errors++;
     }
   }
 
-  print OUT "SRCS = BindingsSchedule.c Cactus_RegisterSTARTUP.c Cactus_RegisterRFR.c $files\n";
+  return @groups;
+}
+
+#/*@@
+#  @routine    ScheduleSelectRoutines
+#  @date       Fri Sep 17 17:39:29 1999
+#  @author     Tom Goodale
+#  @desc 
+#  Parses a list of schedule routines/groups.
+#  FIXME - should validate
+#  @enddesc 
+#  @calls     
+#  @calledby   
+#  @history 
+#
+#  @endhistory 
+#
+#@@*/
+sub ScheduleSelectRoutines
+{
+  local($thorn, $implementation, $routine_list, %schedule_database) = @_;
+  local(@routines);
+  local(@temp_list);
+  local($routine);
 
-  close OUT;
+  @temp_list = split(/[,\s\n]+/, $routine_list);
+
+  foreach $routine (@temp_list)
+  {
+    next if($routine =~ m:^\s*$:);
+
+    push(@routines, $routine);
+
+  }
+
+  return @routines;
+}
+
+#/*@@
+#  @routine    ScheduleSelectVars
+#  @date       Fri Sep 17 17:39:58 1999
+#  @author     Tom Goodale
+#  @desc 
+#  Parses a list of variables
+#  FIXME - should validate
+#  @enddesc 
+#  @calls     
+#  @calledby   
+#  @history 
+#
+#  @endhistory 
+#
+#@@*/
+sub ScheduleSelectVars
+{
+  local($thorn, $implementation, $var_list, %interface_database) = @_;
+  local(@vars);
+  local(@temp_list);
+  local($var);
+
+  @temp_list = split(/[,\s\n]+/, $var_list);
+
+  foreach $var (@temp_list)
+  {
+    next if($var =~ m:^\s*$:);
+
+    push(@vars, $var);
+  }
 
-  chdir $start_dir;
+  return @vars;
 }
 
 1;