path: root/lib/sbin/config_parser.pl

#! /usr/bin/perl -s
#/*@@
#  @file      config_parser.pl
#  @date      Sep 1998
#  @author    Tom Goodale
#  @desc 
#  Parses the the configuration files for thorns.
#  @enddesc 
#  @version $Id$
#@@*/

##########################################################################
# Parse the command line

$activethorns = shift(@ARGV);

if (! $activethorns) 
{
    printf "Usage: config_parser [-top=<TOP>] [-config_dir=<config directory>] [-cctk_home=<CCTK home dir>] -bindings_dir=<CCTK bindings directory> ActiveThornList";
    exit;
}


if(! $top)
{
  $top = `pwd`;
}

if(! $config_dir)
{
  $config_dir = "$top/config-data";
}

# Set up the CCTK home directory
if(! $cctk_home)
{
  $cctk_home = $ENV{'CCTK_HOME'} || "$ENV{HOME}/CCTK";
  $cctk_home =~ s:/$::g;
}

if(! $bindings_dir)
{
  $bindings_dir = "$top/bindings";
}


########################################################################
# Require certain packages


$sbin_dir = "$cctk_home/lib/sbin";

if (!-e "$sbin_dir/parameter_parser.pl" ) 
{
  die "Unable to find CCTK sbin directory - tried $sbin_dir\n";
}

require "$sbin_dir/parameter_parser.pl";
require "$sbin_dir/interface_parser.pl";
require "$sbin_dir/schedule_parser.pl";
require "$sbin_dir/create_c_stuff.pl";
require "$sbin_dir/create_fortran_stuff.pl";
require "$sbin_dir/GridFuncStuff.pl";
require "$sbin_dir/output_config.pl";


#######################################################################
#
#                     Main Program
#
######################################################################

# Find out which thorns we have and the location of the ccl files.
%thorns = &CreateThornList($cctk_home, $activethorns);

# Parse the interface.ccl files
%interface_database = &create_interface_database(%thorns);


if($debug_interface)
{
  &print_interface_database(%interface_database);
}

# Parse the parameter.ccl files
%parameter_database = &create_parameter_database(%thorns);

if($debug_parameters)
{
  &print_parameter_database(%parameter_database);
}


# Create all the bindings
&CreateBindings($bindings_dir, scalar(keys %parameter_database), %parameter_database, %interface_database);

# Finally (must be last), create the make.thornlist file.
@make_thornlist = &CreateMakeThornlist(%thorns);

&OutputFile($config_dir, "make.thornlist", @make_thornlist);

exit;


#############################################################################
#
#                      Subroutines
#
#############################################################################

#/*@@
#  @routine    CreateThornList
#  @date       Thu Jan 28 15:18:45 1999
#  @author     Tom Goodale
#  @desc 
#  Parses the ActiveThorns file and extracts the thorn names.
#  @enddesc 
#  @calls     
#  @calledby   
#  @history 
#
#  @endhistory 
#
#@@*/

sub CreateThornList
{
  local($cctk_home, $activethorns) = @_;
  local(%thornlist);
  local($thorn, $toolkit, $thorn_name);

  open(ACTIVE, "<$activethorns") || die "Cannot open ActiveThorns file $activethorns !";

  # Put a reference to the main cctk sources in.
  $thornlist{"Cactus"} = "$cctk_home/src";

#  print "cctk_home is $cctk_home\n";

  # Loop through the lines of the file.
  while(<ACTIVE>)
  {
    #Ignore comments.
    s/\#(.*)$//g;

    s/\n//g;		# Different from chop...

    #Ignore blank lines
    next if (m:^\s*$:);

    foreach $thorn (split(' '))
    {
      $thorn =~ m:(.*)[/\\](.*):;

      $toolkit = $1;
      $thorn_name = $2;
      # No longer strip thorn_ off the beginning of a thorn name.
      #      $thorn_name =~ s/thorn_//;
      
      if( -r "$cctk_home/toolkits/$thorn/param.ccl" &&
	  -r "$cctk_home/toolkits/$thorn/interface.ccl" &&
	  -r "$cctk_home/toolkits/$thorn/schedule.ccl")
      {
	if( $thornlist{"$thorn_name"} )
	{
	  print "Ignoring duplicate thorn $thorn_name\n";
	}
	else
	{
	  $thornlist{"$thorn_name"} = "$cctk_home/toolkits/$thorn";
	}
      }
      else
      {
	print "Ignoring $thorn - missing ccl file(s)\n";
	next;
      }
    }
  }
  close ACTIVE;

  return %thornlist;
}



#/*@@
#  @routine    get_public_parameters
#  @date       Thu Jan 28 15:21:52 1999
#  @author     Tom Goodale
#  @desc 
#  Gets a list of all public parameters and the throns they are in.
#  @enddesc 
#  @calls     
#  @calledby   
#  @history 
#
#  @endhistory 
#
#@@*/

sub get_public_parameters
{
  local(%parameter_database) = @_;
  local(%public_parameters);
  local($param);

  foreach $param (split(/ /,$parameter_database{"PUBLIC PARAMETERS"}))
  {
    if($param =~ m/(.*)::(.*)/)
    {
      $public_parameters{"$2"} = $1;
    }
  }

  return %public_parameters;
}

    

#/*@@
#  @routine    CreateMakeThornlist
#  @date       Thu Jan 28 15:22:31 1999
#  @author     Tom Goodale
#  @desc 
#  Creates the lines which should be palced in the make.thornlist file.
#  @enddesc 
#  @calls     
#  @calledby   
#  @history 
#
#  @endhistory 
#
#@@*/

sub CreateMakeThornlist
{
  local(%thorns) = @_;
  local($thorn);
  local($thornlist);

  $thornlist = "THORNS =";
  foreach $thorn (keys %thorns)
  {
    # Ignore the main sources - they are dealt with separately
    next if ($thorn =~ m:Cactus:);

    $thorns{$thorn} =~ m:(.*)/(.*)/(.*):;

    # Onlu place toolkit_name/thorn_name in the file.
    $thornlist .= " $2/$3";
  }

  return ("$thornlist", "");
}
  
#/*@@
#  @routine    CreateBindings
#  @date       Thu Jan 28 15:24:53 1999
#  @author     Tom Goodale
#  @desc 
#  All the perl generated stuff is finally placed into the bindings 'thorn'.
#  @enddesc 
#  @calls     
#  @calledby   
#  @history 
#
#  @endhistory 
#
#@@*/

sub CreateBindings
{
  local($bindings_dir, $n_param_database, @rest) = @_;
  local(%parameter_database);
  local(%interface_database);
  local($start_dir);

  # Extract the parameter and interface databases from the arguments.
  %parameter_database = @rest[0..2*$n_param_database-1];
  %interface_database = @rest[2*$n_param_database..$#rest];

  # Create the bindings directory if it doesn't exist.
  if(! -d $bindings_dir)
  {
    mkdir("$bindings_dir", 0755) || die "Unable to create $bindings_dir";
  }

  # Remember where we started.
  $start_dir = `pwd`;

  # Create the bindings for the subsystems.
  &CreateParameterBindings($bindings_dir, $n_param_database, @rest);
  &CreateVariableBindings($bindings_dir, %interface_database);
  &CreateScheduleBindings($bindings_dir);

  # Place an appropriate make.code.defn in the bindings directory.
  chdir $bindings_dir;

  open (OUT, ">make.code.defn") || die "Cannot open make.code.defn";

  print OUT "SRCS = \n";
  print OUT "SUBDIRS = Parameters Variables Schedule\n";

  close OUT;
    
  # Go back to where we started.
  chdir $start_dir;
  
}

#/*@@
#  @routine    CreateParameterBindings
#  @date       Thu Jan 28 15:27:16 1999
#  @author     Tom Goodale
#  @desc 
#  Create the bindings used for the parameters.
#  @enddesc 
#  @calls     
#  @calledby   
#  @history 
#
#  @endhistory 
#
#@@*/

sub CreateParameterBindings
{
  local($bindings_dir, $n_param_database, @rest) = @_;
  local(%parameter_database);
  local(%interface_database);
  local($start_dir);
  local($line);
  local(%these_parameters);
  local($implementation, $thorn);
  local($files);
  local(%routines);
  local($structure, %structures);

  %parameter_database = @rest[0..(2*$n_param_database)-1];
  %interface_database = @rest[2*$n_param_database..$#rest];

  if(! -d $bindings_dir)
  {
    mkdir("$bindings_dir", 0755) || die "Unable to create $bindings_dir";
  }
  $start_dir = `pwd`;

  chdir $bindings_dir;

  if(! -d "Parameters")
  {
    mkdir("Parameters", 0755) || die "Unable to create Parameters directory";
  }

  if(! -d "include")
  {
    mkdir("include", 0755) || die "Unable to create include directory";
  }

  chdir "Parameters";


  # Generate all public parameters
  %these_parameters = &get_public_parameters(%parameter_database);

  @data = &CreateParameterBindingFile("CCTK_BindingsParametersPublic", "PUBLIC_PARAMETER_STRUCT", scalar(keys %these_parameters), %these_parameters, %parameter_database);

  open (OUT, ">Public.c") || die "Cannot open Public.c";

  foreach $line (@data)
  {
    print OUT "$line\n";
  }

  close OUT;

  $files = "Public.c";
  $structures{"PUBLIC_PARAMETER_STRUCT"} = "cctk_params_public";

  # Generate the public data header file

  chdir "..";
  chdir "include";

  @data = &CreateCStructureParameterHeader("CCTK_BindingsParametersPublic", "PUBLIC_PARAMETER_STRUCT", scalar(keys %these_parameters), %these_parameters, %parameter_database);

  open (OUT, ">ParameterCPublic.h") || die "Cannot open ParameterCPublic.h";

  foreach $line (@data)
  {
    print OUT "$line\n";
  }

  close OUT;

  chdir "..";
  chdir "Parameters";

  # Generate all protected parameters
  foreach $implementation (split(" ",$interface_database{"IMPLEMENTATIONS"}))
  {
    $interface_database{"IMPLEMENTATION \U$implementation\E THORNS"} =~ m:([^ ]+):;

    $thorn = $1;

    %these_parameters = &GetThornParameterList($thorn, "PROTECTED", %parameter_database);

    if((keys %these_parameters > 0))
    {
      @data = &CreateParameterBindingFile("CCTK_BindingsParameters$implementation"."_protected", "PROTECTED_\U$implementation\E_STRUCT", scalar(keys %these_parameters), %these_parameters, %parameter_database);

      open (OUT, ">\U$implementation\E". "_protected.c") || die "Cannot open \U$implementation\E"."_protected.c";
      
      foreach $line (@data)
      {
	print OUT "$line\n";
      }
    
      close OUT;

      $files .= " \U$implementation\E". "_protected.c";
      $routines{"CCTK_BindingsParameters$implementation"."_protected"} = "$implementation";
      $structures{"PROTECTED_\U$implementation\E_STRUCT"} = "cctk_params_$implementation"."_protected";

      # Generate the data header file
      
      chdir "..";
      chdir "include";

      @data = &CreateCStructureParameterHeader("CCTK_BindingsParameters$implementation"."_protected", "PROTECTED_\U$implementation\E_STRUCT", scalar(keys %these_parameters), %these_parameters, %parameter_database);
      
      open (OUT, ">ParameterCProtected\U$implementation\E".".h") || die "Cannot open ParameterCProtected\U$implementation\E".".h";

      foreach $line (@data)
      {
	print OUT "$line\n";
      }

      close OUT;

      chdir "..";
      chdir "Parameters";

    }
  }

  # Generate all private parameters
  foreach $thorn (split(" ",$interface_database{"THORNS"}))
  {
    %these_parameters = &GetThornParameterList($thorn, "PRIVATE", %parameter_database);

    if((keys %these_parameters > 0))
    {
      @data = &CreateParameterBindingFile("CCTK_BindingsParameters$thorn"."_private", "PRIVATE_\U$thorn\E_STRUCT", scalar(keys %these_parameters), %these_parameters, %parameter_database);

      open (OUT, ">\U$thorn\E"."_private.c") || die "Cannot open \U$thorn\E"."_private.c";

      foreach $line (@data)
      {
	print OUT "$line\n";
      }
    
      close OUT;

      $files .= " \U$thorn\E". "_private.c";
      $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", scalar(keys %these_parameters), %these_parameters, %parameter_database);

      $structures{"PRIVATE_\U$thorn\E_STRUCT"} = "cctk_params_$thorn"."_private";
      
      open (OUT, ">ParameterCPrivate\U$thorn\E".".h") || die "Cannot open ParameterCPrivate\U$thorn\E".".h";

      foreach $line (@data)
      {
	print OUT "$line\n";
      }

      close OUT;

      chdir "..";
      chdir "Parameters";

    }
  }

  open (OUT, ">Bindings.c") || die "Cannot open Bindings.c";

  print OUT  <<EOT;
#include <stdio.h>
#include "config.h"
#include "Misc.h"

EOT

  foreach $routine ((keys %routines), "CCTK_BindingsParametersPublic")
  {
    print OUT "int $routine"."Initialise(void);\n";
    print OUT "int $routine"."Set(const char *param, const char *value);\n";
    print OUT "int $routine"."Get(const char *param, void **data);\n";
  }
 
print OUT <<EOT;

int CCTK_BindingsParametersInitialise(void)
{

EOT

  foreach $routine (keys %routines)
  {
    print OUT "  $routine"."Initialise();\n";
  }
  print OUT <<EOT;
  return 0;
}
 
int CCTK_BindingsParameterSet(const char *identifier, const char *value)
{
  int retval = 1;
  int temp_retval;
  char *implementation = NULL;
  char *param_name = NULL;

  CCTK_SplitString(&implementation, &param_name, identifier, "::");

  if(!implementation)
  {
    retval = CCTK_BindingsParametersPublicSet(identifier, value);
  }
  else
  { 
EOT

  foreach $routine (keys %routines)
  {

    print OUT <<EOT;

    if(CCTK_Equals(implementation, \"$routines{$routine}\"))
    {
EOT
      print OUT "      temp_retval =  $routine"."Set(param_name, value);";

    print OUT <<EOT;
 
      if(!temp_retval) 
      {
        retval = 0;
      }
    }
EOT
  }
 
  print OUT <<EOT;
  }
 
  free(implementation);
  free(param_name);
  return retval;
}
 
int CCTK_BindingsParameterGet(const char *identifier, void **value)
{   
  return -1;
}
 
EOT
  
  close OUT;

  open (OUT, ">make.code.defn") || die "Cannot open make.code.defn";

  print OUT "SRCS = Bindings.c $files\n";

  close OUT;

  # Create the appropriate thorn parameter headers

  chdir "..";
  chdir "include";

  foreach $thorn (split(" ",$interface_database{"THORNS"}))
  {

    @data = &CreateFortranThornParameterBindings($thorn, $n_param_database, @rest);

    open(OUT, ">\U$thorn\E"."_FParameters.h") || die "Cannot open \U$thorn\E"."_FParameters.h";

    foreach $line (@data)
    {
      print OUT "$line\n";
    }

    close OUT;

    open(OUT, ">\U$thorn\E"."_CParameters.h") || die "Cannot open \U$thorn\E"."_CParameters.h";

    $implementation = $interface_database{"\U$thorn\E IMPLEMENTS"};

    print OUT <<EOT;
 
\#ifndef _\U$thorn\E_PARAMETERS_H_
 
\#define _\U$thorn\E_PARAMETERS_H_

EOT

  $header =  "ParameterCPublic.h";
  if( -r $header)
  {
    print OUT "#include \"$header\"\n";
  }
 
  $header =  "ParameterCProtected\U$implementation\E.h";
  if( -r $header)
  {
    print OUT "#include \"$header\"\n";
  }

  $header =  "ParameterCPrivate\U$thorn\E.h";
  if( -r $header)
  {
    print OUT "#include \"$header\"\n";
  }
 
  print OUT "\n";

    @data = ();
    foreach $friend (split(" ",$parameter_database{"\U$thorn\E FRIEND implementations"}))
    {
      $friend_implementation = $interface_database{"\U$friend\E IMPLEMENTS"};

      print OUT "#include \"ParameterCProtected\U$friend\E.h\"\n";

      $interface_database{"IMPLEMENTATION \U$friend\E THORNS"} =~ m:([^ ]*):;
 
      $friend_thorn = $1;

      foreach $parameter (split(" ",$parameter_database{"\U$thorn FRIEND $friend\E variables"}))
      {
	$type = $parameter_database{"\U$friend_thorn $parameter\E type"};

	$type_string = &get_c_type_string($type);

	$line = "  ".$type_string ." " .$parameter . " = PROTECTED_\U$friend\E_STRUCT.$parameter;";

	push(@data, $line);

      }
    }

    print OUT "#define DECLARE_PARAMETERS \\\n";

    $header =  "ParameterCPublic.h";
    $decl =  "DECLARE_PUBLIC_PARAMETER_STRUCT_PARAMS";
    if( -r $header)
    {
      print OUT "$decl \\\n";
    }
 
    $header =  "ParameterCProtected\U$implementation\E.h";
    $decl = "DECLARE_PROTECTED_\U$implementation\E_STRUCT_PARAMS";
    if( -r $header)
    {
      print OUT "$decl \\\n";
    }

    $header =  "ParameterCPrivate\U$thorn\E.h";
    $decl = "DECLARE_PRIVATE_\U$thorn\E_STRUCT_PARAMS";
    if( -r $header)
    {
      print OUT "$decl \\\n";
    }

    foreach $line (@data)
    {
      print OUT $line . "\\\n";
    }

    print OUT "\n";

    print OUT "#endif\n";

    close OUT;
  }   

  open(OUT, "| perl $cctk_home/lib/sbin/c_file_processor.pl $top/config-data > CParameterStructNames.h") || die "Cannot create CParameterStructNames.h by running c_file_procesor.pl";
  foreach $structure (keys %structures)
  {
    print OUT "#define $structure FORTRAN_NAME($structures{$structure})\n";
  }

  print OUT "\n";

  close OUT;
    
  open(OUT, ">CParameters.h") || die "Cannot open CParameters.h";

  print OUT "#include \"CParameterStructNames.h\"\n\n";

  foreach $thorn (split(" ",$interface_database{"THORNS"}))
  {
    print OUT "#ifdef THORN_IS_$thorn\n";
    print OUT "#include \"\U$thorn\E"."_CParameters.h\"\n";
    print OUT "#endif\n\n";
  }

  close OUT;

  open(OUT, ">FParameters.h") || die "Cannot open FParameters.h";

  foreach $thorn (split(" ",$interface_database{"THORNS"}))
  {
    print OUT "#ifdef THORN_IS_$thorn\n";
    print OUT "#include \"\U$thorn\E"."_FParameters.h\"\n";
    print OUT "#endif\n\n";
  }

  close OUT;

  open(OUT, ">declare_parameters.h") || die "Cannot open declare_parameters.h";

  print OUT "#ifdef CCODE\n";
  print OUT "#include \"CParameters.h\"\n";
  print OUT "#endif\n\n";


  print OUT "#ifdef FCODE\n";
  print OUT "#include \"FParameters.h\"\n";
  print OUT "#endif\n\n";

  close OUT;

  chdir $start_dir;
}


#/*@@
#  @routine    CreateParameterBindings
#  @date       Thu Jan 28 15:27:16 1999
#  @author     Tom Goodale
#  @desc 
#  Create the bindings used for the scheduler.
#  @enddesc 
#  @calls     
#  @calledby   
#  @history 
#
#  @endhistory 
#
#@@*/
sub CreateScheduleBindings
{
  local($bindings_dir,$schedule_code) = @_;

  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 
  ($wrapper,$rfr,$startup) = &create_schedule_code($bindings_dir,%thorns);
  

  # Write the contents of BindingsScheduleRegisterRFR.c
  &create_RegisterRFR($bindings_dir,split(" ",$rfr)); 

  # Write the contents of BindingsScheduleRegisterSTARTUP.c
  &create_RegisterSTARTUP($bindings_dir,split(" ",$startup)); 

  open (OUT, ">Bindings.c") || die "Cannot open Bindings.c";

  print OUT  <<EOT;
 
  int CCTK_BindingsScheduleInitialise(void)
  {
    return 0;
  }

  int CCTK_BindingsScheduleRegister(const char *type, void *data)
  {
    
    if (CCTK_Equals(type,"STARTUP"))
    {
      Cactus_RegisterSTARTUP();
    } 
    else if (CCTK_Equals(type,"RFRINIT")) 
    {
      Cactus_RegisterRFR(data);
    } else {
      printf ("Unknown type in CCTK_BindingsScheduleRegister");
    }

    return 0;
  }
 
EOT

  close OUT;

  open (OUT, ">make.code.defn") || die "Cannot open make.code.defn";

  $files = "";
  foreach $file (split(" ",$rfr),split(" ",$startup),split(" ",$wrapper)) {
    if($file)
    {
      $files = "$files ".$file.".c";
    }
  }

  print OUT "SRCS = Bindings.c Cactus_RegisterSTARTUP.c Cactus_RegisterRFR.c $files\n";

  close OUT;

  chdir $start_dir;
}