[Amforth] Ref Card Generation -- working hack

[Mark R. <cab...@gm...>]

So here is a working hack to make a refcard with both the avr8/works and
common/words directory. Since I don't even sort of speak Perl I'll leave
any real fixes to someone who does. However, I made a few notes pointing
out the things that were the issue before.
There is still the issue of files that don't have the 3 lines at the top of
stack effects, category and description. It is easy to see which files need
to be fixed so they can be scanned correctly. The ones in the unclassified
group at the end can be a little tougher to find. I had to search for <.db
"-1"> to find that one in num-constants.asm. Those did fail pretty
gracefully though.

tl;dnr
This works in a hackish sort of way. Still work to do but closer now.

========= START make-refcard-rst ===================

#!/usr/bin/perl
use strict;

# local hashes
my %XT;
my %VOC;
my %ASM;
my %USEDBY;
my %DESCRIPTION;
my %DSTACK;
my %RSTACK;
my %CSTACK;
my %CATEGORY;
my %TYPEOF;

my $version="6.9";

my $texdir="../doc/source/TG";

my $asmdir="../common/words";
my $devasmdir="../avr8/words";

sub readASM {
  my ($filename) = @_;
  open(ASM, $filename) or die ("$filename: $!\n");
  my @ASM = <ASM>;
  close(ASM);
  my $ASM = "";
  my ($lbl, $state, $voc, $xt, $dstack, $rstack, $cstack, $category,
$typeof);
  my ($line1, $line2, $line3, $description) = ("","","", "");

  # Added to try and remove the prevline issues
  # before fixing correctly.
  $line1 = $ASM[0]; # stack--effects
  $line2 = $ASM[1]; # category
  $line3 = $ASM[2]; # description

  # From this point on all prevline vars are now:
  # prevline3 is now $line1
  # prevline2 is now $line2
  # prevline1 is now $line3
  # This change is just to clarify that the first three
  # lines have to be the info we are looking for. It was
  # how it worked before but more loosly bound.

  foreach my $line (@ASM) {
    chomp($line);
    #
    next if $line=~/\.if/;
    $line =~ s/_VE_HEAD/VE_HEAD/;
    $ASM .= $line;

    if($line=~/^VE_(.*):/) {
      # start a new definition
      $ASM = "";
      $lbl = "XT_$1";
      $state = "new_header_found";
      $voc   = "(unnamed)";
      $category = "unclassified";
      $dstack = "( -- )";
      $dstack = "($1)" if $line1=~/\([S]?:?([^\)]+)/;
      $rstack = "";
      $rstack = "(R: $1)" if $line1=~/R:\s+([^)]+)\)/;
      $cstack = "";
      $cstack = "(C: $1)" if $line1=~/C:\s+([^)]+)\)/;
      $description = $1 if $line3=~/^;(.*)/;
      if( $line2=~/;(.+)$/) {
        $category = $1;
      }
      next;
    }

    if($line=~/^;VE_(.*):/) {
      # start a new definition
      $ASM = "";
      $lbl = "XT_$1";
      $state = "new_header_found";
      $voc   = "(hidden)";
      $dstack = $line1;
      $dstack = "( -- )";
      $dstack = "($1)" if $line1=~/\([S]?:?([^\)]+)/;
      $rstack = "";
      $rstack = "R($1)" if $line1=~/R:\s+(.+)\)/;
      $cstack = "";
      $cstack = "(C: $1)" if $line1=~/C:\s+(.+)\)/;
      $description = $1 if $line3=~/^;(.*)/;
      if( $line2=~/;(.+)$/) {
        $category = $1;
      }
      $category = "internal/hidden";
      next;
    }
    if($state =~ /new_header_found/ && $line=~/.dw\s*(.*)/) {
      $state = "new_voc_header";
      next;
    }
    if ($state =~ /new_voc_header/ && $line=~/.db\s*(.*)/) {
      my @voc = split/,/, $1;
      my $i=0;
      $voc = "";
      foreach my $v (@voc) {
        # next if $i++ == 0;
        print "[$v]";
        $voc .= chr(hex($1)) if $v=~/\$([\da-fA-F]+)/;
        $voc .= $1 if $v=~/"(\S+)"/;
      }
      $state = "vocabulary entry found";
      next;
    }
    if($line=~/^XT_(.*)/){
      $state = "xt_found";
      next;
    }
    if($state=~/xt_found/ && $line=~/.dw\s+(\w+)/) {
      $xt = $1;
      $state = "header_complete";
      next;
    }
    if($state =~ /header_complete/) {
      $DSTACK{$lbl} = $dstack;
      $RSTACK{$lbl} = $rstack;
      $CSTACK{$lbl} = $cstack;

      $XT{$lbl} = $xt;
      $VOC{$lbl} = $voc;
      $DESCRIPTION{$lbl} = $description;
      push @{$CATEGORY{$category}}, $lbl;
      $state = "parsing_body";
      next;
    }

    if($state =~ /parsing_body/) {
      $ASM{$lbl} = $ASM if $ASM=~/\w/;
    }
  }
}

sub _head {
  my ($title) = @_;
  my ($r);
  open(I, "refcard-head.rst") or die "refcard header not found";
  while(<I>) {
    s/\*VERSION\*/$version/g;
    $r .= $_
  }
  close(I);
  return $r;
}

sub _foot {
}

sub printLaTeX {
  my ($title) = @_;
  open(LATEX, ">$texdir/refcard.rst") or die "$!\n";;
  print LATEX _head($title);
  foreach my $category (sort keys %CATEGORY) {
    next if $category=~/^\s*$/;
    next if $category=~/internal/;

    print "$category\n";
    my $cattxt = $category;
    $cattxt =~s/\s+(.*)/$1/;
    print LATEX "\n$cattxt\n". "-" x length($cattxt) . "\n\n";
    foreach my $lbl (sort @{$CATEGORY{$category}}) {
      my $xt  = $XT{$lbl};
      my $voc = $VOC{$lbl};
      my $shortlbl = substr($lbl, 3);
      my $descr = $DESCRIPTION{$lbl};

      my $dstack = $DSTACK{$lbl};
      my $rstack = $RSTACK{$lbl};
      my $cstack = $CSTACK{$lbl};
      my $verbdelim = "|";
      $verbdelim = "/" if $dstack=~/$verbdelim/;
      # print LATEX ".. _ $lbl:\n";
      #$voc =~ s/\\/\\textbackslash/g;
      #$voc =~ s/\#/\\#/g;
      # $voc =~ s/]/{]}/g;
      ##voc =~ s/\[/{[}/g;
      $voc =~ s/\$/\\\$/g;
      #$voc =~ s/_/\\_/g;
      $voc =~ s/"/''/g; # '"
      #$voc =~ s/\+/\\\+/g;
      #$voc =~ s/-/\\-/g;
      #$voc =~ s/\*/\\\*/g;
      $voc =~ s/\\/\\\\/g;
      #$descr =~ s/_/\\_/g;
      print LATEX "* :command:`$voc`\n";
      print LATEX "  $dstack\n";
      print LATEX "  $rstack\n" unless $rstack =~ /^\s*$/;
      print LATEX "  $cstack\n" unless $cstack =~ /^\s*$/;
      print LATEX " $descr\n\n";

    }
    print LATEX "\n\n";
  }
  print LATEX _foot();
}

opendir(CWD, $asmdir);
foreach (reverse sort readdir(CWD)) {
  next unless -f "$asmdir/$_";
  next unless /(.*).asm$/;
  my $basename = "$asmdir/$_";
  print "$basename\n";
  readASM($basename);
}

# Adding the second dir to be searched then keeps the
# sorted lists altogether for the webpage

  opendir(CWD, $devasmdir);
foreach (reverse sort readdir(CWD)) {
  next unless -f "$devasmdir/$_";
  next unless /(.*).asm$/;
  my $basename = "$devasmdir/$_";
  print "$basename\n";
  readASM($basename);
}
print "\n";
printLaTeX($version);
print "\n";

========= END make-refcard-rst =====================