#!/afs/athena/contrib/perl5/p -w

use strict;
use FileHandle;

use vars qw( $P );
# $P = '_P';

# Remove comments.  Can't just s@\Q/*\E.*\Q*/\E@@gs, that's too hungry.
sub uncomment ($) {
  local($_) = @_;
  my ($stash) = '';

  while (m<\Q/*\E>) {
    $stash .= $`;
    if ($' =~ m<\Q*/\E>) {
      $_ = $';
    } else {
      warn "Last comment is un-terminated.\n";
      $_ = '';
    }
  }
  $stash . $_;
}

# Remove special CPP lines (ie, anything starting with #).
sub uncpp ($) {
  local($_) = @_;
  s/^\#.*$//gm;
  $_;
}

# Gobble a paren (possibly containing nested paren sets)
sub eat_parens ($) {
  local($_) = @_;
  my ($level, $body) = (1, '');

  while ($level) {
    /[()]/ || (warn("Un-balanced parens."), return ($body . $_, ''));
    $body .= $` . $&;
    $level += (($& eq '(') ? 1 : -1);
    $_ = $';
  }
  chop $body;
  ($body, $_);
}

# Write prototypes.
sub mkproto {
  local($_) = @_;
  while (m/^(\S.*)\s*\(/m) {
    $_ = $';
    my ($func) = $1;
    my ($last) = ($` =~ m/\n([^\n]*\n)$/s);
    if ($func !~ /\s/) {
      $last =~ s/.*;//g;   $last =~ s/^\s+//;
      $func = ($last . $func) if $last;
    }

    my ($paren);
    ($paren, $_) = eat_parens($_);

    if (!/^\s*;/ && !($func =~ /static/)) {
      my ($body) = $P ? "$func $P(($paren));" : "$func ($paren);";
      $body =~ s/\s+/ /g;
      print "$body\n";
    }
  }
}

print <<"EndOfPrefix" if $P;
#ifdef __STDC__
#define   $P(argl)   argl
#else
#define   $P(argl)
#endif /* __STDC__ */

EndOfPrefix

if (@ARGV) {
  foreach $_ (@ARGV) {
    my ($fh) = (new FileHandle $_) || next;
    print "/* $_ */\n";
    mkproto uncpp uncomment(join('', <$fh>));
  }
} else {
  mkproto uncpp uncomment(join('', <>));
}

print <<"EndOfPostfix" if $P;

#undef $P
EndOfPostfix