Okay, I got a little bit of a chance to play with this tonight. I wanted to
hack out the $prevline variables and forcibly replace them with the actual
beginning lines from the file. This then shows all the asm files in
common/words that have issues that need to be dealt with. It's at best a
hack before really fixing the script, but I wanted to see if that was how
those prevlines were working. I'll attach the hacked up make-refcard-rst
below. Once it is in place it can be run after which building the htdocs
with make htdocs will create the new refcard.html file. As you can see
there are a number of errors. Looking at the common/asm files shows them to
be ones with non-conformant comment lines at the top. The files with the 3
comment lines at the top, even if they have the ".if cpu_" stuff in them
now generate correctly though. I'll try to make more progress during the
week, but bear in mind that I've never looked at a Perl script before a day
or two ago. :P

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

#!/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;

# current version. There should be a version variable
# stored somewhere in the source tree that could be pulled
# by any of the build tools. TODO.
my $version="6.9";

# relative location of refcard.rst output file for building
my $texdir="../doc/source/TG";

# location of the core words
# currently the core .asm files are parsed incorrectly
# due to adding various platforms. The platform ones work.
# TODO: add platform specific output to refcard.
#my $asmdir="../avr8/words";
my $asmdir="../common/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 ($prevline1, $prevline2, $prevline3, $description) = ("","","", "");

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

    # From this point on all prevline vars are now:
    # prevline3 is now $line1
    # prevline2 is now $line2
    # prevline1 is now $line3

    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;
   }
#    print "***\n$prevline3\n$prevline2\n$prevline1\n$line\n***\n";
#    print "$prevline3 : $category\n";
#    die;
   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;
}
        $prevline3 = $prevline2;
        $prevline2 = $prevline1;
        $prevline1 = $line;

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);
}
print "\n";
printLaTeX($version);
print "\n";

make-refcard-rst ================================================== FINISH

While it may be a butchery at the moment, I think it does show a way
forward. Stripping out all the excess dancing in readASM should make it
easier to add additional directories to scan then figure out how to
display. In all fairness, if there were multiple refcards, one for the core
and one for any platforms, a user would only need to look at the two they
cared about. In that case, they whole thing could be done without smashing
everything together and making the refcard gigantic. Just something to
think about.

All the best,
Mark

_______________________________________________
Amforth-devel mailing list for http://amforth.sf.net/
Amforth-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/amforth-devel

Reply via email to