#!/usr/bin/perl -w
#
# $Id: makecompset,v 1.14 2001/03/19 23:45:00 stevek Exp $
#
# Generate a component set source file
#

require 5.004;
use strict;
use BinFile;
use BinFile::AutoDetect;
use Build::Component;

# Debugging parameters
my %debug = (
   'Dump Symbols' => 0
);


# Component sets (in order of initialization)
compset 'Mutexes',             '^_gswtk_mtx_(\S+)',  \&mtx_generate;
compset 'Condition Variables', '^_gswtk_cond_(\S+)', \&cond_generate;
compset 'Basic Lists',         '^_gswtk_bl_(\S+)',   \&bl_generate;
compset 'Memory Zones',        '^_gswtk_mz_(\S+)',   \&mz_generate;
compset 'Components',          '^_gswtk_comp_(\S+)', \&comp_generate;


########################################
# Component set generation subroutines #
########################################


# Mutexes
sub mtx_generate (@) {
   my($mode,$group,$rval,$set,$name,$sym) = @_;
   my $pattern = $set->pattern;
   $name =~ /$pattern/;

   if( $mode & COMP_GEN_INIT ) {
      print '   GSWTK_OS_MUTEX_INITIALIZE('.$1.','.$rval.');'."\n";
   }
   if( $mode & COMP_GEN_TEARDOWN ) {
      print '   GSWTK_OS_MUTEX_TEARDOWN('.$1.','.$rval.');'."\n"
   }
   0;
}

# Condition Variables
sub cond_generate (@) {
   my($mode,$group,$rval,$set,$name,$sym) = @_;
   my $pattern = $set->pattern;
   $name =~ /$pattern/;

   if( $mode & COMP_GEN_INIT ) {
      print '   GSWTK_OS_COND_INITIALIZE('.$1.','.$rval.');'."\n";
   }
   if( $mode & COMP_GEN_TEARDOWN ) {
      print '   GSWTK_OS_COND_TEARDOWN('.$1.','.$rval.');'."\n"
   }
   0;
}

# Basic Lists
sub bl_generate (@) {
   my($mode,$group,$rval,$set,$name,$sym) = @_;
   my $pattern = $set->pattern;
   $name =~ /$pattern/;

   if( $mode & COMP_GEN_INIT ) {
      print '   GSWTK_BASICLIST_INITIALIZE('.$1.','.$rval.');'."\n";
   }
   if( $mode & COMP_GEN_TEARDOWN ) {
      print '   GSWTK_BASICLIST_TEARDOWN('.$1.','.$rval.');'."\n"
   }
   0;
}

# Memory zones
my $initmz = 0;
my $teardownmz = 0;

sub mz_generate (@) {
   my($mode,$group,$rval,$set,$name,$sym) = @_;
   my $pattern = $set->pattern;
   $name =~ /$pattern/;

   if( $mode & COMP_GEN_INIT ) {
      print '   gswk_component_initialize_by_name("memory");'."\n"
         unless $initmz++;
      print '   GSWTK_MEM_ZONE_INITIALIZE('.$group,', '.$1.','.$rval.');'."\n";
   }
   if( $mode & COMP_GEN_TEARDOWN ) {
      # We just teardown the whole group of memory zones
      print '   GSWTK_MEM_ZONE_TEARDOWN('.$group.','.$rval.');'."\n"
         unless $teardownmz++;
   }
   0;
}

# Components
my $teardowncomp = 0;
my $seenbase = 0;

sub comp_generate (@) {
   my($mode,$group,$rval,$set,$name,$sym) = @_;
   my $pattern = $set->pattern;
   $name =~ /$pattern/;

   if( $1 eq 'component' ) {
      $seenbase = 1 if !$seenbase;
   }
   else {
      # Defer all child components until base is seen
      return 1 unless $mode & COMP_GEN_FORCE;
   }

   if( $mode & COMP_GEN_INIT ) {
      print <<EOF;
   GSWTK_REGISTER_COMPONENT($group,$1,$rval);
   if( $rval == EALREADY ) $rval = 0;
EOF
   }
   if( $mode & COMP_GEN_TEARDOWN ) {
      # We just teardown the whole group of components
      print '   GSWTK_TEARDOWN_COMPONENT('.$group.','.$rval.');'."\n"
         unless $teardowncomp++;
   }
   0;
}



#########
# Usage #
#########
sub usage {
   my( $msg ) = @_;

   print STDERR <<EOF;
Usage: makecompset <prefix> <basedir> <dir1> [<dir2> .. <dirn>]

$msg
EOF

   exit 1;
}


####################
# Check parameters #
####################
my $nargs = @ARGV;
usage 'Need to specify the symbol prefix and base directory' if $nargs < 2;

my $symprefix = shift @ARGV;
my $basedir = shift @ARGV;
usage 'Need to specify a valid base directory' unless -r "$basedir/configuration";
usage 'Need to specify at least one component directory' if $nargs < 2;

###############################
# Determine component objects #
###############################
my @files;
foreach( @ARGV ) {
   print STDERR "Warning: no generated components in '$_'\n"
      unless -f "$basedir/$_/.component.mak";
   open( COMPMAK, "$basedir/$_/.component.mak" ) || next;
   while( <COMPMAK> ) {
      next unless /COMPOBJS\s*\+=\s*(\S+)/;
      push @files, $basedir.'/'.$1;
   }
   close( COMPMAK );
}

##################################
# Load symbol tables for objects #
##################################
my @objects;
foreach( @files ) {
   push( @objects, new BinFile::AutoDetect( $_, BINFILE_LOADSYMS ) );
}

############################################
# Search objects for component set symbols #
############################################
my $obj;
foreach $obj ( @objects ) {
   my $set;
   foreach $set ( &COMP_SETS ) {
      foreach( $obj->search($set->pattern) ) {
         $set->addsymbol($_);
      }
   }
}

##################################
# Warn of missing set references #
##################################
my $setname;
foreach $setname ( sort &COMP_NAMES ) {
   my $set = getcompset($setname);
   my @syms = $set->unknown_names;
   my $pattern = $set->pattern;
   print "Missing references to $setname:\n" if @syms;
   foreach( @syms ) {
      /$pattern/;
      print "   $1\n";
   }
}

#######################
# Display set members #
#######################
foreach $setname ( sort &COMP_NAMES ) {
   my $set = getcompset($setname);
   my @syms = $set->known_symbols;
   my $pattern = $set->pattern;
   print "$setname:\n" if @syms;
   foreach( sort { $a->name cmp $b->name } @syms ) {
      my $name = $_->name;
      $_->dump, next if $debug{'Dump Symbols'};
      $name =~ /$pattern/;
      print "   $1\n";
   }
}

#################################
# Generate component set source #
#################################
open( SETSRC, ">_gsw_compset.c" ) || die $!;
select( SETSRC );
print <<EOF;
/*
 * Automatically generated by makecompset.
 * Do not modify.
 */

#include "configuration.h"
#define GSWTK_INCL_ALL
#include <gswtk/gswtk.h>

EOF
generatesets $symprefix;
close( SETSRC );

