#!/usr/bin/perl -w
#
#    $Id: ProcessSpec 204 2005-05-14 13:17:35Z ajw $
#    $URL: http://svn.cp15.org/NFS/tags/v106/!Sunfish/ProcessSpec $
#
#    Process an XDR spec and produce a set of C header and source files to
#    implement the RPC calls in the spec
#
#
#    Copyright (C) 2003 Alex Waugh
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


my @states;
my $state = "none";
my @names;
my $name = "";
my %types;
my %typessize;
my $nextunnamed = 1;
my @unnamed;
my $spectype = shift @ARGV;
my $firstcase;

open(PROCS,">$spectype-process1.h") or die $^E;
open(UNIONS,">$spectype-process2.h") or die $^E;
open(STRUCTS,">$spectype-structs.h") or die $^E;
open(CALLS,">$spectype-calls.c") or die $^E;
open(CALLSH,">$spectype-calls.h") or die $^E;

my $header = "/* Automatically generated */\n\n";

print PROCS   $header;
print UNIONS  $header;
print STRUCTS $header;
print STRUCTS "#ifndef ${spectype}_structs_h\n";
print STRUCTS "#define ${spectype}_structs_h\n\n";
print STRUCTS "#include \"primitives.h\"\n\n";
print CALLS   $header;
print CALLS   "#include \"$spectype-calls.h\"\n\n";
print CALLSH  $header;
print CALLSH  "#ifndef ${spectype}_calls_h\n";
print CALLSH  "#define ${spectype}_calls_h\n\n";
print CALLSH  "#include \"rpc.h\"\n";
print CALLSH  "#include \"$spectype-structs.h\"\n";
print CALLSH  "#include \"$spectype-process1.h\"\n";
print CALLSH  "#include \"$spectype-process2.h\"\n\n";

$types{"unsigned int"} = "int";
$types{"uint32"} = "int";
$types{"uint64"} = "uint64_t";
$types{"unsigned"} = "int";
$types{"int"} = "int";
$types{"void"} = "void";
$types{"bool"} = "enum";
$typessize{"void"} = 0;
$typessize{"int"} = 0;
$typessize{"unsigned"} = 0;
$typessize{"bool"} = "bool";

$structbase = "##structbase.";

$line = 0;

while (<>) {
  $line++;
  #print "$state - $_";
  if ($state =~ /(struct)|(union)|(linklist)/) {
    if (/\}\;*/) {
      if ($state eq "union") {
        print STRUCTS "} u;\n};\n";
        print UNIONS "}} while (0)\n\n";
      } elsif ($state eq "linklist") {
        print STRUCTS "};\n";
        print PROCS "ptr = &((*ptr)->next);\\\n";
        print PROCS "}\\\n";
        print PROCS "} while (opted);\\\n";
        print PROCS "*ptr = NULL;\\\n";
        $structbase = "##structbase.";
      } else {
        print STRUCTS "};\n";
      }
      print PROCS "} while (0)\n#endif\n\n";
      $state = "none";
    } elsif (/\}.+\;/) {
      die "struct/union instance: $_";
    } elsif (/case (\w*)\:/) {
      print UNIONS "break;\\\n" if (!$firstcase);
      print UNIONS "case $1:\\\n";
      print UNIONS "process_union_body_${name}_$1(input,${structbase}u);\\\n";
      print PROCS "} while (0)\n#endif\n" if (!$firstcase);
      print PROCS "#ifndef process_union_body_${name}_$1\n";
      print PROCS "#define process_union_body_${name}_$1(input,structbase) do {\\\n";
      $firstcase = 0;
    } elsif (/default\:/) {
      print UNIONS "break;\\\n" if (!$firstcase);
      print UNIONS "default:\\\n";
      print UNIONS "process_union_body_${name}_default(input,${structbase}u);\\\n";
      print PROCS "} while (0)\n#endif\n" if (!$firstcase);
      print PROCS "#ifndef process_union_body_${name}_default\n";
      print PROCS "#define process_union_body_${name}_default(input,structbase) do {\\\n";
      $firstcase = 0;
    } elsif (/\s*void\;/) {
      # do nothing
    } elsif (/(.*)opaque +(\w*)\<(\w*)\>\;/) {
      my $ws = $1;
      my $opaquename = $2;
      my $maxsize = $3;
      $maxsize = "OPAQUE_MAX" if ($maxsize =~ /^$/);
      print STRUCTS "${ws}struct opaque $opaquename;\n";
      print PROCS "process_opaque(input,${structbase}$opaquename,$maxsize);\\\n";
    } elsif (/(.*)unsigned int (\w*)\<(\w*)\>\;/) {
      my $ws = $1;
      my $opaquename = $2;
      my $maxsize = $3;
      $maxsize = "OPAQUE_MAX" if ($maxsize =~ /^$/);
      print STRUCTS "${ws}struct opaqueint $opaquename;\n";
      print PROCS "process_opaqueint(input,${structbase}$opaquename,$maxsize);\\\n";
    } elsif (/(\s*)(\w+(\s+\w+)*)\s+(\*?)(\w+)\;$/) {
      my $ws = $1;
      my $elementtype = $2;
      my $ptr = $4;
      my $element = $5;
      my $type = $types{$elementtype};
      my $typesize = $typessize{$elementtype};
      while ($type ne "int" and exists $types{$type}) {
        $type = $types{$type};
      }
      die "Unknown type \"$elementtype\"\n" unless defined $type;
      die "next ptr not named next (line $line)\n" if ($elementtype eq $name and $element ne "next");
      if ($type eq "linklist" and $element eq "next") {
        print STRUCTS "${ws}struct $elementtype $ptr$element;\n";
      } elsif ($type eq "struct" or $type eq "union" or $type eq "linklist") {
        print STRUCTS "${ws}struct $elementtype $ptr$element;\n";
        print PROCS "process_${type}_$elementtype(input, ${structbase}$element, $typesize);\\\n";
      } elsif (($type eq "opaque") || ($type eq "string")) {
        print STRUCTS "${ws}struct opaque $element;\n";
        print PROCS "process_${type}(input, ${structbase}$element, $typesize);\\\n";
      } elsif (($type eq "fixed_opaque") || ($type eq "fixed_string")) {
        print STRUCTS "${ws}char $element\[$typesize\];\n";
        print PROCS "process_${type}(input, ${structbase}$element, $typesize);\\\n";
      } else {
        if ($type eq "enum") {
          print STRUCTS "${ws}enum $elementtype $element;\n";
          print PROCS "process_enum(input,${structbase}$element, $elementtype);\\\n";
        } else {
          print STRUCTS "${ws}$elementtype $element;\n";
          print PROCS "process_$type(input,${structbase}$element, 0);\\\n";
        }
      }
    } elsif (/\/\*.*\*\//) {
      print STRUCTS;
    } elsif (/^\s*$/) {
      print STRUCTS;
    } else {
      die "Unknown struct field (line $line): $_\n";
    }
  } elsif ($state eq "enum") {
    print STRUCTS;
    $state = "none" if (/\}\;/);
  } elsif ($state eq "comment") {
    print STRUCTS;
    $state = "none" if (/\*\//);
  } elsif ($state eq "none") {

    if (/^\s*enum *(\w*)/) {
      print STRUCTS;
      $name = $1;
      $types{$name} = $state = "enum";
      $typessize{$name} = $name;
    } elsif (/^\s*union *(\w*) *switch *\( *(\w*) *(\w*)\)/) {
      $name = $1;
      $types{$name} = $state = "union";
      $typessize{$name} = 0;
      print STRUCTS "struct ${name} {\n";
      print STRUCTS "enum " if ($2 ne "unsigned");
      print STRUCTS "$2 $3;\n";
      print STRUCTS "union {\n";
      $firstcase = 1;
      print UNIONS "#define process_union_${name}(input,structbase, maxsize) do {\\\n";
      if ($2 eq "unsigned") {
        print UNIONS "process_int(input,${structbase}$3, 0);\\\n";
      } else {
        print UNIONS "process_enum(input,${structbase}$3, $2);\\\n";
      }
      print UNIONS "switch (${structbase}$3) {\\\n";
    } elsif (/^\s*struct *\*(\w*) /) {
      # Linked list
      $name = $1;
      $types{$name} = $state = "linklist";
      $typessize{$name} = 0;
      print STRUCTS "struct ${name} {\n";
      print STRUCTS "int opted;\n";
      print PROCS "#ifndef process_linklist_${name}\n";
      print PROCS "#define process_linklist_${name}(input, structbase, maxsize) do {\\\n";
      print PROCS "struct $name **ptr = &##structbase;\\\n";
      print PROCS "int opted;\\\n";
      print PROCS "do {\\\n";
      print PROCS "process_int(input, opted, 0);\\\n";
      print PROCS "if (opted) {\\\n";
      print PROCS "*ptr = llmalloc(sizeof(struct $name));\\\n";
      print PROCS "if (*ptr == NULL) goto buffer_overflow;\\\n";
      $structbase = "(*ptr)->";
    } elsif (/^\s*struct *(\w*) /) {
      print STRUCTS;
      $name = $1;
      $types{$name} = $state = "struct";
      $typessize{$name} = 0;
      print PROCS "#ifndef process_struct_${name}\n";
      print PROCS "#define process_struct_${name}(input,structbase, maxsize) do {\\\n";
    } elsif (/^\s*\#((define)|(ifndef)|(if)|(ifdef)|(endif)|(pragma))/) {
      print STRUCTS;
    } elsif (/^\s*typedef (.*) (\S+)\[(\w*)\]\;/) {
      #print STRUCTS "typedef char $2\[$3\];" if ($1 eq "opaque");
      #print STRUCTS;
      $types{$2} = "fixed_$1";
      $typessize{$2} = $3;
    } elsif (/^\s*typedef (.*) (\S+)\<(\w*)\>\;/) {
      my $size = $3;
      $size = "OPAQUE_MAX" if ($size eq "");
      $types{$2} = $1;
      $typessize{$2} = $size;
    } elsif (/^\s*typedef (.*) (\S+)\;/) {
      print STRUCTS;
      $types{$2} = $1;
      $typessize{$2} = 0;
    } elsif (/^\s*const (\w+) *= *(\w+)\;/) {
      print STRUCTS "#ifndef $1\n";
      print STRUCTS "#define $1 $2\n";
      print STRUCTS "#endif\n";
    } elsif (/^\s*(\w*) (\w*)\((\w*)\) = (\w*)\;/) {
      my $res = $1;
      my $procname = $2;
      my $args = $3;
      my $procno = $4;
      my $prog;
      die "type $args not defined\n" if (!defined $types{$args});
      die "type $res not defined\n" if (!defined $types{$res});
      my $proto = "\nos_error *$procname(";
      my $calltype = "TXBLOCKING";
      if (!($args =~ /^void$/)) {
        if (($types{$args} =~ /(struct)|(union)|(linklist)/)) {
          $proto .= "struct $args";
        } else {
          $proto .= "$types{$args}";
        }
        $proto .= " *args, ";
      }
      if (!($res =~ /^void$/)) {
        if (($types{$res} =~ /(struct)|(union)|(linklist)/)) {
          $proto .= "struct $res";
        } elsif (($types{$res} =~ /enum/)) {
          $proto .= "enum $res";
        } else {
          $proto .= "$types{$res}";
        }
        $proto .= " *res, ";
      }
      $proto .= "struct conn_info *conn";
      if ($procname =~ m/(WRITE)|(READ)$/) {
        $proto .= ", enum callctl calltype";
        $calltype = "calltype";
      } elsif ($procname =~ m/UMNT/) {
        $calltype = "TXNONBLOCKING";
      }
      $proto .= ")";
      if ($procname =~ m/^NFS/) {
        $prog = "NFS_RPC_PROGRAM";
        $vers = "NFS_RPC_VERSION";
      } elsif ($procname =~ m/^(MNT)|(MOUNT)/) {
        $prog = "MOUNT_RPC_PROGRAM";
        $vers = "MOUNT_RPC_VERSION";
      } elsif ($procname =~ m/^PCNFSD/) {
        $prog = "PCNFSD_RPC_PROGRAM";
        $vers = "PCNFSD_RPC_VERSION";
      } elsif ($procname =~ m/^PMAP/) {
        $prog = "PMAP_RPC_PROGRAM";
        $vers = "PMAP_RPC_VERSION";
      } else {
        die "Unknown prefix";
      }
      print CALLSH "$proto;\n";
      print CALLS  "$proto\n";
      print CALLS "{\n\tos_error *err;\n\n";
      print CALLS "\trpc_prepare_call($prog, $vers, $procno, conn);\n";
      print CALLS "\tprocess_$types{$args}";
      print CALLS "_$args" if (($types{$args} =~ /(struct)|(union)|(linklist)/));
      print CALLS "(OUTPUT, (*args), $typessize{$args});\n";
      print CALLS "\terr = rpc_do_call(conn, $calltype);\n";
      print CALLS "\trpc_resetfifo();\n" if ($procname =~ m/UMNT/);
      print CALLS "\tif (err) return err;\n";
      print CALLS "\tprocess_$types{$res}";
      print CALLS "_${res}" if (($types{$res} =~ /(struct)|(union)|(linklist)/));
      print CALLS "(INPUT, (*res), $typessize{$res});\n";
      print CALLS "\treturn NULL;\n";
      print CALLS "buffer_overflow:\n";
      print CALLS "\treturn rpc_buffer_overflow();\n}\n";
    } elsif (/\/\*.*\*\//) {
      print STRUCTS;
    } elsif (/\/\*/) {
      print STRUCTS;
      $state = "comment";
    } elsif (/^\s*$/) {
      print STRUCTS;
    } else {
      die "Unknown input: $_\n";
    }
  } else {
    die "Unknown state\n";
  }
}

print CALLSH  "#endif\n\n";
print STRUCTS "#endif\n\n";

