#!/usr/bin/perl

#
# Read a set of .doc files generated by CUPL,
# outputting equivalent Perl code generators.
#

#
# The Perl code generators have to deal with the
# complicated case where there are multiple drivers 
# for the same signal (OC and tri-state drivers).
#
# Suppose:
#   f = e1;
#   f.oe = e2;
#
# What is done is that these are converted to an
# open collector model:
#   f = 'b'0;
#   f.oe = !e1&e2;
# and all the relevant "oe" formulae are saved up
# to be output at the end.
#
# The interface is a call to &ocassign, with the
# lhs and rhs of:
#   !f = !e1&e2;
# That is
#   &ocassign("f", "!(e1)&(e2)");
#
# For ocassign to work, the signal must also be on
# the list of known OC signals:
#   $oc{"f"} = 1;
#

foreach $f (@ARGV) {
  open(INPUT, $f) || die "$f: $!";
  %pad = ();
  while (<INPUT>) {
    last if /^--- --/;
  }
  while (<INPUT>) {
    next unless /^\s+([!]*)\s+(\S+)\s+(\S+)\s+[NV]/;
    $neg{$2} = $1;
    $pad{$2} = $3;
  }
  open(INPUT, $f) || die "$f: $!";
  $name = $f; $name =~ s/.doc$//;
  $name =~ s/.*[\\\/]//;
  $name = "dec$name" if $name =~ /^23/;
  $name = "sn$name" if $name =~ /^74/;
  $name =~ y/A-Z/a-z/;
  %code = ();
  print "sub $name {\n";
  while (<INPUT>) {
    last if /^====/;
  }
  while (<INPUT>) {
    last if /^====/;
  }
  while (<INPUT>) {
    s/\r//g;
    last if /^====/;
    if (/^(\S+)\s*=>/) {
      $lh = $1;
      $negate = ""; $negate = "!" if $lh =~ s/^!//;
      $suffix = "";
      $suffix = $1 if $lh =~ s/(\..*)//;
      if (!defined $pad{$lh}) {
#       warn "No symbol $lh\n";
        $first = 1;
        undef $lh;
        next;
      }
      # Determine if the pad needs negation.
      $code = "";
      $first = 1;
    } elsif (/^\r*$/) {
      # Remember the assembled expression for the pad.
      next unless defined $lh;
      chop $code; chop $code; # Remove last "\n"
      $code = "!($code)" if $negate ne $neg{$lh};
      $lh = "\$pad\{$pad{$lh}\}" unless $pad{$lh} >= 200;
      $code{"$lh$suffix"} = $code if defined $lh;
      $code = "";
      undef $lh;
    } else {
      next unless defined $lh;
      s/\s+//g;
      # Replace identifiers with '$pad{n}' where 'n' is the 
      # corresponding pad number.
      s/\b(\d+)\b/'b'$1/;
      foreach $id (keys %pad) {
        next if $pad{$id} >= 200;
        s/\b$id\b/$neg{$id}\$pad\{$pad{$id}\}/g;
      }
      $code .= "   " unless $first;
      $code .= "$_\\n";
      $first = 0;
    }
  }
  foreach $lh (sort keys %code) {
    next if $lh =~ /[.]oe$/;
    if (defined $code{"${lh}.oe"}) {
      print "  \$oc{$lh} = 1 if defined $lh;\n";
      print "  &ocassign($lh, \"!($code{$lh})&($code{\"$lh.oe\"})\") if defined $lh;\n";
    } else {
      $code = "";
      $code = " if defined $lh" if $lh =~ /pad/;
      print "  &qcode(\"$lh = $code{$lh};\\n\")$code;\n";
    }
  }
  print "}\n\$hidden{\"$name\"} = 0;\n\n"
}
print "1;\n";
