#!/usr/bin/perl -w
#
# $Id: makemod,v 1.9 2001/03/26 22:03:12 stevek Exp $
#
# Generate a kernel module source file from module.def and skeleton files
#

require 5.004;
use strict;

my %keywords = (
   # name          type      req  output                 values
   'CATEGORY' => [ 'SCALAR', 0,   'STRING',              undef ],
   'DEFINE'   => [ 'ARRAY',  0,   'DEF()',               undef ],
   'IDSTRING' => [ 'SCALAR', 1,   'STRING',              undef ],
   'INCLUDE'  => [ 'ARRAY',  0,   'INC()',               undef ],
   'INIT'     => [ 'SCALAR', 1,   'FUNC',                undef ],
   'MODULE'   => [ 'SCALAR', 1,   'WORD',                undef ],
   'OPTION'   => [ 'ARRAY',  0,   'DEF(MODULE_OPTION_)', { 'UNLOADABLE' =>
                                                              'SHUTDOWN' } ],
   'SHUTDOWN' => [ 'SCALAR', 1,   'FUNC',                undef ],
   'VERSION'  => [ 'SCALAR', 1,   'INTEGER',             undef ]
);

my %freebsd_keywords = (
   'DEPENDS'   => [ 'ARRAY',  0,
                    'REP(wiii,MODULE_DEPEND(%MODULE%,%1,%2,%3,%4);)', undef ]
);

my %linux_keywords = (
);

my %solaris_keywords = (
   'DEPENDS'   => [ 'ARRAY',  0,   'WORD',                undef ]
);

my %spaces = (
   'freebsd' => \%freebsd_keywords,
   'linux'   => \%linux_keywords,
   'solaris' => \%solaris_keywords
);

my $datetime = localtime;

my %defs = (
   'DATE'     => $datetime,
   'PROGNAME' => 'makemod'
);


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

   print STDERR <<EOF;
Usage: makemod <template>

$msg
EOF

   exit 1;
}


# Check parameters
my $nargs = @ARGV;
usage 'Need to only specify template' if $nargs != 1;

my $template = shift @ARGV;
usage 'Invalid template \'' . $template . '\'' unless -f $template;


# Process module definition file
open( DEF, "<module.def") || die "module.def: $!";
my $line = 0;
my $space;
while( <DEF> ) {
   $line++;
   next if /^#|^\s*$/;

   # Look for space keys
   if( /^\[\s*(.*)\s*\]\s*$/ ) {
      $space = lc($1);
      (print STDERR "Invalid space $1 at line $line\n"), exit 1
         unless exists $spaces{$space};
      next;
   }

   next unless !$space || $space eq $^O;

   (print STDERR "Invalid definition at line $line\n"), exit 1
      unless /^\s*(\w+)\s+(("[^"]+")|\w+)$/;

   my( $key, $value) = (uc($1), $2);
   $value =~ s/"//g;

   (print STDERR "Invalid keyword '$key' at line $line\n"), exit 1
      unless exists $keywords{$key} ||
             (exists $spaces{$space} && exists $spaces{$space}->{$key});

   my @entry;
   if( exists $keywords{$key} ) { @entry = @{$keywords{$key}}; }
   else                         { @entry = @{$spaces{$space}->{$key}}; }
   if( defined $entry[3] ) {
      # Make sure we have an acceptable value
      my $keyvalue;
      my %values = %{$entry[3]};
      foreach( keys %values ) {
         $keyvalue = $_, last if uc($_) eq uc($value);
      }
      (print STDERR "Invalid value for keyword '$key' at line $line\n"), exit 1
         unless defined $keyvalue;

      my $toggle = $values{$keyvalue};
      die "Invalid toggle keyword '$toggle' in keyword table"
         if defined $toggle && !exists $keywords{$toggle};
      $keywords{$toggle}->[1] = ($keywords{$toggle}->[1])?0:1;
   }

   # Validate integer types
   (print STDERR "Non-integer value encountered for keyword '$key' at line $line\n"), exit 1
      if $entry[2] eq 'INTEGER' && $value !~ /^\d+$/;

   # Store prototypes if entry is a function
   $defs{'PROTOTYPES'} .= 'extern int ' . $value . '( void );' . "\n"
      if $entry[2] eq 'FUNC';

   # Store values
   if( $entry[0] eq 'ARRAY' ) {
      ($defs{$key} = (),
       $defs{'KEYWORDS'} .= "#define MAKEMOD_KEYWORD_$key\n")
         if !exists $defs{$key};
      push(@{$defs{$key}}, $value);
      next;
   }
   if( $entry[0] eq 'SCALAR' ) {
      (print STDERR "Duplicate keyword '$key' at line $line\n"), exit 1
         if exists $defs{$key};
      $defs{'KEYWORDS'} .= "#define MAKEMOD_KEYWORD_$key\n";
      $defs{$key} = $value, next 
   }

   die "Internal error, invalid type in keyword table";
}
close( DEF );


# Check for required values set
foreach( keys %keywords ) {
   my @entry = @{$keywords{$_}};
   (print STDERR "Missing required keyword '$_' in module.def\n"), exit 1
      if $entry[1] && !exists $defs{$_};
   $defs{$_} = undef if !exists $defs{$_};
}


# Validate template
open( TEMPLATE, "<$template" ) || die "$template: $!";
$line = 0;
while( <TEMPLATE> ) {
   $line++;

   my @keys = /\[\[([^\]]*)\]\]/g;
   next unless @keys;

   foreach( @keys ) {
      (print STDERR "Missing value for keyword '$_' at line $line of template\n"), exit 1
         unless exists $defs{uc($_)} ||
                (exists $keywords{uc($_)} && !$keywords{uc($_)}->[1]) ||
                (exists $spaces{$^O}->{uc($_)} && !$spaces{$^O}->{uc($_)}->[1]);
   }
}


# Process template and generate module source file
open( SRC, ">_gsw_module.c") || die "_gsw_module.c: $!";
seek( TEMPLATE, 0, 0 );
while( <TEMPLATE> ) {
   my @keys = /\[\[([^\]]*)\]\]/g;
   (print SRC), next unless @keys;

   my $index;
   foreach $index ( 0 .. $#keys ) {
      my $key = uc($keys[$index]);
      next if $index && uc($keys[$index-1]) eq $key;

      s/\[\[$key\]\]/$defs{$key}/, next
         unless exists $keywords{$key} || exists $spaces{$^O}->{$key};

      my @entry;
      if( exists $keywords{$key} ) { @entry = @{$keywords{$key}}; }
      else                         { @entry = @{$spaces{$^O}->{$key}}; }

      sub writekey {
         my( $key, $output, $value ) = @_;
         ($output eq 'STRING') &&
            do { return '"' . $value . '"' };

         ($output eq 'WORD' || $output eq 'INTEGER') &&
            do { return $value };

         ($output eq 'FUNC') &&
            do { return $value . '()' };

         ($output =~ /INC\(([^\)]*)\)/) &&
            do { return '#include "' . $1 . $value . '"' };

         ($output =~ /DEF\(([^\)]*)\)/) &&
            do { return '#define ' . $1 . uc($value) };

         ($output =~ /REP\(([iw]+),(.*)\)$/) &&
            do {
               my $nrequired = length($1);
               my @parts = split(/\,/,$value);
               (print STDERR "Value for keyword '%key' must have $nrequired ".
                             " parameter".(($nrequired>1)?'s':'')), exit 1
                  unless length($1) == @parts;

               my @subs;
               foreach( 0 .. ($nrequired-1) ) {
                  my $type = substr($1,$_,1);
                  ($type eq 'i') &&
                     do {
                        (print STDERR "Parameter #".($_+1)." must be an integer"), exit 1
                           unless $parts[$_] == ($parts[$_] + 0);
                        push(@subs, $parts[$_]);
                        next;
                     };
                  ($type eq 'w') &&
                     do {
                        push(@subs, $parts[$_]);
                        next;
                     };
               }

               my $outstring = $2;
               foreach( 1 .. $nrequired ) {
                  $outstring =~ s/\%$_/$subs[$_-1]/xeg;
               }

               while( my( $savekey, $saveval ) = each %defs ) {
                  $outstring =~ s/\%$savekey\%/$saveval/xeg;
               }

               return $outstring;
            };

         die "Invalid output in keyword table for '$key'";
      }

      if( $entry[0] eq 'ARRAY' ) {
         my @lines;
         foreach( @{$defs{$key}} ) {
            push( @lines, writekey $key, $entry[2], $_ )
         }

         my $lines;
         if($entry[2] eq 'STRING') { $lines = join(',', @lines); }
         if($entry[2] eq 'WORD')   { $lines = join(',', @lines); }
         else                      { $lines = join("\n", @lines); }

         s/\[\[$key\]\]/$lines/g;
      }
      else {
         my $replace = writekey $key, $entry[2], $defs{$key};
         s/\[\[$key\]\]/$replace/g;
      }
   }
   print SRC;
}
close( SRC );
close( TEMPLATE );

# Write out .module.mak file
open( MODMAK, ">.module.mak" ) || die ".module.mak: $!";
print MODMAK <<EOF;
KMOD = $defs{'MODULE'}
EOF
close( MODMAK );

