verilator/src/astgen

#!/usr/bin/perl -w
# See copyright, etc in below POD section.
######################################################################

#require 5.006_001;
use Getopt::Long;
use IO::File;
use Pod::Usage;
use strict;
use vars qw ($Debug @Types %Classes %Children %ClassRefs %Stages);

#======================================================================
# main

$Debug = 0;
my $opt_classes;
my $opt_report;
my @Opt_Cpt;
my @Opt_I;
Getopt::Long::config ("pass_through", "no_auto_abbrev");
if (! GetOptions (
	  "help"	=> \&usage,
	  "debug"	=> sub { $Debug = 1; },
	  "classes!"	=> \$opt_classes,
	  "report!"	=> \$opt_report,
	  "<>"		=> \&parameter,
    )) {
    usage();
}

read_types("$Opt_I[0]/V3Ast.h");
read_types("$Opt_I[0]/V3AstNodes.h");
read_stages("$Opt_I[0]/Verilator.cpp");
read_refs(glob("$Opt_I[0]/*.y"), glob("$Opt_I[0]/*.h"), glob("$Opt_I[0]/*.cpp"));
if ($opt_report) {
    write_report(undef);
}
if ($opt_classes) {
    write_report("V3Ast__gen_report.txt");
    write_classes("V3Ast__gen_classes.h");
    write_visitor("V3Ast__gen_visitor.h");
    write_intf("V3Ast__gen_interface.h");
    write_impl("V3Ast__gen_impl.h");
    write_types("V3Ast__gen_types.h");
}
foreach my $cpt (@Opt_Cpt) {
    Cpt::process(in_filename=>"$Opt_I[0]/${cpt}.cpp", out_filename=>"${cpt}__gen.cpp");
}

#----------------------------------------------------------------------

sub usage {
    pod2usage(-verbose=>2, -exitval=>2, -output=>\*STDOUT);
    exit (1);
}

sub parameter {
    my $param = shift;
    if ($param =~ /^-+I(\S+)/) {
	push @Opt_I, $1;
    } elsif ($param =~ s/\.cpp$//) {
	push @Opt_Cpt, $param;
    } else {
	die "%Error: Unknown parameter: $param,";
    }
}

#######################################################################

sub read_types {
    my $filename = shift;

    my $fh = IO::File->new($filename) or die "%Error: $! $filename,";
    while (defined (my $line = $fh->getline())) {
	$line =~ s/\/\/.*$//;
	next if $line =~ /^\s*$/;
	if ($line =~ /^\s*(class|struct)\s*(\S+)/) {
	    my $class = $2;
	    my $inh = "";
	    $inh = $1 if ($line =~ /:\s*public\s+(\S+)/);
	    print "class $class : $inh\n" if $Debug;
	    $inh = "" if $class eq "AstNode";
	    if ($inh =~ /Ast/ || $class eq "AstNode") {
		$class =~ s/^Ast//;
		$inh =~ s/^Ast//;
		$Classes{$class} = $inh;
		$Children{$inh}{$class} = 1;
	    }
	}
    }
}

sub read_stages {
    my $filename = shift;

    my $fh = IO::File->new($filename) or die "%Error: $! $filename,";
    my $n = 0;
    while (defined (my $line = $fh->getline())) {
	$line =~ s/\/\/.*$//;
	next if $line =~ /^\s*$/;
	if ($line =~ /^\s*([A-Za-z0-9]+)::/) {
	    my $stage = $1.".cpp";
	    if (!defined ($Stages{$stage})) {
		$Stages{$stage} = $n++;
	    }
	}
    }
}

sub read_refs {
    my @filenames = @_;

    foreach my $filename (@filenames) {
	(my $basename = $filename) =~ s!.*/!!;
	my $fh = IO::File->new($filename) or die "%Error: $! $filename,";
	while (defined (my $line = $fh->getline())) {
	    $line =~ s/\/\/.*$//;
	    while ($line =~ /\bnew\s*(Ast[A-Za-z0-9_]+)/g) {
		$ClassRefs{$1}{newed}{$basename} = 1;
	    }
	    while ($line =~ /\b(Ast[A-Za-z0-9_]+)/g) {
		$ClassRefs{$1}{used}{$basename} = 1;
	    }
	}
    }
    #use Data::Dumper;print Dumper(\%ClassRefs);
}

#----------------------------------------------------------------------

sub open_file {
    my $filename = shift;
    my $fh = IO::File->new($filename,"w") or die "%Error: $! $filename,";
    print $fh '// Generated by astgen // -*- mode: C++; c-file-style: "cc-mode" -*-'."\n";
    return $fh;
}

#----------------------------------------------------------------------

sub subclasses_of {
    my $type = shift;

    my @cllist;
    for (my $subclass = $::Classes{$type}; $subclass; ) {
	push @cllist, $subclass;
	$subclass = $::Classes{$subclass};
    }

    return (reverse @cllist);
}

sub children_of {
    my $type = shift;

    my @cllist;
    my @todo;
    push @todo, $type;
    while (my $subclass = shift @todo) {
	foreach my $child (sort keys %{$::Children{$subclass}}) {
	    push @todo, $child;
	    push @cllist, $child;
	}
    }

    return (@cllist);
}

#----------------------------------------------------------------------

sub write_report {
    my $filename = shift;
    my $fh = defined($filename) ? open_file($filename) : \*STDOUT;

    $fh->print("Processing stages (approximate, based on order in Verilator.cpp):\n");
    foreach my $class (sort {$Stages{$a} <=> $Stages{$b}} keys %Stages) {
	$fh->print("\t$class\n");
    }

    $fh->print("\nProcessing stages (approximate, based on order in Verilator.cpp):\n");
    foreach my $type (sort (keys %Classes)) {
	printf $fh "  class %-20s\n", "Ast${type}";
	$fh->print("\tparent:\t");
	foreach my $subclass (subclasses_of($type)) {
	    next if $subclass eq 'Node';
	    printf $fh "Ast%-12s ",$subclass;
	}
	printf $fh "\n";
	$fh->print("\tchilds:\t");
	foreach my $subclass (children_of($type)) {
	    next if $subclass eq 'Node';
	    printf $fh "Ast%-12s ",$subclass;
	}
	printf $fh "\n";
	if (my $refs = $ClassRefs{"Ast${type}"}) {
	    $fh->print("\tnewed:\t");
	    foreach my $stage (sort {($Stages{$a}||-1) <=> ($Stages{$b}||-1)}
			       keys %{$refs->{newed}}) {
		$fh->print($stage."  ");
	    }
	    $fh->print("\n");
	    $fh->print("\tused:\t");
	    foreach my $stage (sort {($Stages{$a}||-1) <=> ($Stages{$b}||-1)}
			       keys %{$refs->{used}}) {
		$fh->print($stage."  ");
	    }
	    $fh->print("\n");
	}
	$fh->print("\n");
    }
}

sub write_classes {
    my $fh = open_file(@_);
    printf $fh "class AstNode;\n";
    foreach my $type (sort (keys %Classes)) {
	printf $fh "class %-20s // ", "Ast${type};";
	foreach my $subclass (subclasses_of($type)) {
	    printf $fh "Ast%-12s ",$subclass;
	}
	printf $fh "\n";
    }
    $fh->close();
}

sub write_visitor {
    my $fh = open_file(@_);
    foreach my $type (sort (keys %Classes)) {
	my $base = $Classes{$type};
	if ($base) {
	    printf $fh "    virtual void visit(Ast${type}* nodep) { visit((Ast${base}*)(nodep)); }\n";
	} else {
	    printf $fh "    virtual void visit(Ast${type}*) = 0;\n";
	}
    }
    $fh->close();
}

sub write_intf {
    my $fh = open_file(@_);

    print $fh "\n";
    print $fh "    // These for use by VN_IS macro only\n";
    foreach my $type (sort (keys %Classes)) {
        print $fh "    static bool privateIs",$type,"(const AstNode* nodep);\n";
    }

    print $fh "\n";
    print $fh "    // These for use by VN_CAST macro only\n";
    foreach my $type (sort (keys %Classes)) {
        print $fh "    static Ast",$type,"* privateCast",$type,"(AstNode* nodep);\n";
    }
    foreach my $type (sort (keys %Classes)) {
        print $fh "    static const Ast",$type,"* privateConstCast",$type,"(const AstNode* nodep);\n";
    }

    $fh->close();
}

sub write_impl {
    my $fh = open_file(@_);

    print $fh "\n";
    print $fh "    // These for use by VN_IS macro only\n";
    foreach my $type (sort (keys %Classes)) {
	if (children_of($type)) {
            print $fh "inline bool AstNode::privateIs",$type,"(const AstNode* nodep) { return (bool)(dynamic_cast<const Ast",$type,"*>(nodep)); }\n";
	} else {
            print $fh "inline bool AstNode::privateIs",$type,"(const AstNode* nodep) { return nodep && nodep->type() == AstType::at",$type,"; }\n";
	}
    }

    foreach my $type (sort (keys %Classes)) {
        print $fh "inline Ast",$type,"* AstNode::privateCast",$type,"(AstNode* nodep) { return dynamic_cast<Ast",$type,"*>(nodep); }\n";
    }
    foreach my $type (sort (keys %Classes)) {
        print $fh "inline const Ast",$type,"* AstNode::privateConstCast",$type,"(const AstNode* nodep) { return dynamic_cast<const Ast",$type,"*>(nodep); }\n";
    }

    $fh->close();
}

sub write_types {
    my $fh = open_file(@_);

    printf $fh "    enum en {\n";
    # Add "at" prefix to avoid conflicting with FOPEN and other macros in include files
    foreach my $type (sort (keys %Classes)) {
	next if $type =~ /^Node/;
	print $fh "\tat",$type,",\n";
    }
    printf $fh "\t_ENUM_END\n";
    printf $fh "    };\n";
    printf $fh "    const char* ascii() const {\n";
    printf $fh "	const char* const names[] = {\n";
    foreach my $type (sort (keys %Classes)) {
	next if $type =~ /^Node/;
	print $fh "\t\"", uc $type, "\",\n";
    }
    printf $fh "\t\"_ENUM_END\"\n";
    printf $fh "	};\n";
    printf $fh "	return names[m_e];\n";
    printf $fh "    };\n";
    $fh->close();
}

#######################################################################

package Cpt;

sub error {
    my $self = shift;
    my $txt = join('', @_);
    die "%Error: $self->{in_filename}:$self->{in_linenum}: $txt\n";
}

sub print {
    my $self = shift;
    my $txt = join('', @_);
    push @{$self->{out_lines}}, $txt;
}

sub output_func {
    my $self = shift;
    my $func = shift;
    push  @{$self->{out_lines}}, $func;
}

sub _output_line {
    my $self = shift;
    $self->print("#line ",$self->{out_linenum}+2," \"$self->{out_filename}\"\n");
}

sub process {
    my $self = {
	in_filename => undef,
	out_filename => undef,
	out_lines => [],
	out_linenum => 1,
	@_,
    };
    bless $self, __PACKAGE__;

    my $ln = 1;
    my $didln;

    # Read the file and parse into list of functions that generate output
    my $fhi = IO::File->new($self->{in_filename}) or die "%Error: $! $self->{in_filename},";
    while (defined(my $line = $fhi->getline)) {
	if (!$didln) {
	    $self->print("#line $. \"$self->{in_filename}\"\n");
	    $didln = 1;
	}
	if ($line =~ /^\s+(TREE.*)$/) {
	    my $func = $1;
	    $self->{in_linenum} = $.;
	    $self->print("//$line");
	    $self->output_func(sub{my $self=shift; $self->_output_line(); });
	    $self->tree_line ($func);
	    $didln = 0;
	}
	elsif ($line !~ /^\s*\/[\/\*]\s*TREE/
	       && $line =~ /\s+TREE/) {
	    $self->error("Unknown astgen line: $line");
	}
	else {
	    $self->print($line);
	}
    }
    $fhi->close;

    # Put out the resultant file, if the list has a reference to a
    # function, then call that func to generate output
    my $fho = ::open_file($self->{out_filename});
    my @togen = @{$self->{out_lines}};
    foreach my $line (@togen) {
	if (ref $line) {
	    $self->{out_lines} = [];
	    &$line($self);
	} else {
	    $self->{out_lines} = [$line];
	}
	foreach my $out (@{$self->{out_lines}}) {
	    $self->{out_linenum}++ while ($out =~ /\n/smg);
	    print $fho $out;
	}
    }
    $fho->close;
}

sub tree_line {
    my $self = shift;
    my $func = shift;

    $func =~ s!\s*//.*$!!;
    $func =~ s!\s*;\s*$!!;

    # doflag "S" indicates an op specifying short-circuiting for a type.
    if ($func =~ /TREEOP(1?)([VCS]?)\s*\(\s*  \"([^\"]*)\"  \s*,\s* \"([^\"]*)\"  \s*\)/sx) {
	my $order = $1; my $doflag = $2; my $from = $3; my $to = $4;
	#$self->print("// $from $to\n");
	if (!$self->{did_out_tree}) {
	    $self->{did_out_tree} = 1;
	    $self->output_func(sub{ my $self=shift;
				    $self->tree_match();
				    $self->tree_base();
				});
	}
	$from =~ /Ast([a-zA-Z0-9]+)\s*\{(.*)\}\s*$/
	    or $self->error("Can't parse from function: $func");
	my $type = $1;
	my $subnodes = $2;
	(::subclasses_of($type)) or $self->error("Unknown AstNode type: $type: in $func");

	my $mif;
	if ($doflag eq '') { $mif = "m_doNConst"; }
	elsif ($doflag eq 'V') { $mif = "m_doV"; }
	elsif ($doflag eq 'C') { $mif = ""; }
	elsif ($doflag eq 'S') { $mif = "m_doNConst"; } # Not just for m_doGenerate
	else { die; }
	$subnodes =~ s/,,/__ESCAPEDCOMMA__/g;
	foreach my $subnode (split /\s*,\s*/, $subnodes) {
	    $subnode =~ s/__ESCAPEDCOMMA__/,/g;
	    next if $subnode =~ /^\$([a-z0-9]+)$/gi;   # "$lhs" is just a comment that this op has a lhs
	    $mif .= " && " if $mif;
	    my $subnodeif = $subnode;
            $subnodeif =~ s/\$([a-zA-Z0-9]+)\.cast([A-Z][A-Za-z0-9]+)$/VN_IS(nodep->$1(),$2)/g;
	    $subnodeif =~ s/\$([a-zA-Z0-9]+)\.([a-zA-Z0-9]+)$/nodep->$1()->$2()/g;
	    $subnodeif = add_nodep($subnodeif);
	    $mif .= $subnodeif;
	}

	my $exec_func = treeop_exec_func($self, $to);
        while ($exec_func =~ s/([-()a-zA-Z0-9_>]+)->cast([A-Z][A-Za-z0-9]+)\(\)/VN_CAST($1,$2)/) {}

	$self->{treeop}{$type} ||= [];
	my $n = $#{$self->{treeop}{$type}} + 1;
	my $typefunc = {
	    order => $order,
	    comment => $func,
	    match_func => "match_${type}_${n}",
	    match_if => $mif,
	    exec_func => $exec_func,
	    uinfo_level => ($to =~ /^!/ ? 0:7),
	    short_circuit => ($doflag eq 'S'),
	};

	($typefunc->{uinfo} = $func) =~ s/[ \t\"\{\}]+/ /g;
	push @{$self->{treeop}{$type}}, $typefunc;
    }
    elsif ($func =~ /TREE_SKIP_VISIT\s*\(\s*  \"([^\"]*)\"  \s*\)/sx) {
	my $type = $1;
	$self->{tree_skip_visit}{$type} = 1;
	$::Classes{$type} or $self->error("Unknown node type: $type");
    }
    else {
	$self->error("Unknown astgen op: $func");
    }
}

sub add_nodep {
    my $str = shift;
    $str =~ s/\$([a-zA-Z0-9]+)/nodep->$1()/g;
    return $str;
}

our %_Exec_Syms;
our $_Exec_Nsyms;
sub _exec_syms_recurse {
    my $aref = shift;
    foreach my $sym (@{$aref}) {
	if (ref $sym) { _exec_syms_recurse($sym); }
	elsif ($sym =~ /^\$.*/) {
	    if (!defined $_Exec_Syms{$sym}) {
		$_Exec_Syms{$sym} = "arg".(++$_Exec_Nsyms)."p";
	    }
	}
    }
}

sub _exec_new_recurse {
    my $aref = shift;
    my $out = "new ".$aref->[0]."(nodep->fileline()";
    my $first = 1;
    foreach my $sym (@{$aref}) {
	if ($first) { $first=0; next; }
	$out .= ", ";
	if (ref $sym) { $out.=_exec_new_recurse($sym); }
	elsif ($sym =~ /^\$.*/) {
	    $out .= $_Exec_Syms{$sym};
	} else {
	    $out .= $sym;
	}
    }
    return $out.")";
}

sub treeop_exec_func {
    my $self = shift;
    my $func = shift;
    my $out = "";
    $func =~ s/^!//;
    if ($func =~ /^\s*[a-zA-Z0-9]+\s*\(/) {  # Function call
	(my $outl = $func) =~ s/\$([a-zA-Z0-9]+)/nodep->$1()/g;
	$out .= $outl.";";
    }
    elsif ($func    =~ /^\s*Ast([a-zA-Z0-9]+) \s*\{\s* (.*) \s* \}$/x) {

	my $nargs = 0;
	my %argnums;  # Number for each argument name

	my $aref = undef;	# Recursive array with structure to form
	my @astack;
	my $forming = "";
	my $argtext = $func . "\000";   # EOF character
	#print "FF $func\n" if $Debug;
	while ($argtext =~ s/^(.)//) {
	    my $tok = $1;
	    #print "TOK: $tok $forming\n" if $tok !~ /[a-zA-Z0-9]/;

	    if ($tok eq "\000") {
	    } elsif ($tok =~ /\s+/) {
	    } elsif ($tok eq "{") {
		my $newref = [$forming];
		push @{$aref}, $newref;
		push @astack, $aref if $aref;
		$aref = $newref;
		$forming = "";
	    } elsif ($tok eq "}") {
		push @{$aref}, $forming if $forming;
		$aref = pop @astack;
		$aref or $self->error("Too many } in execution function: $func\n");
		$forming = "";
	    } elsif ($tok eq ",") {
		push @{$aref}, $forming if $forming;
		$forming = "";
	    } else {
		$forming .= $tok;
	    }
	}
	($aref && ref $aref->[0] && !$aref->[1]) or $self->error("Badly formed execution function: $func\n");
	$aref = $aref->[0];
	#use Data::Dumper; print Dumper($aref),"\n";

	# Assign numbers to each $ symbol
	%_Exec_Syms = ();
	$_Exec_Nsyms = 0;
	_exec_syms_recurse($aref);

	foreach my $sym (sort {$_Exec_Syms{$a} cmp $_Exec_Syms{$b}} (keys %_Exec_Syms)) {
	    my $argnp = $_Exec_Syms{$sym};
	    my $arg = add_nodep($sym);
	    $out .= "AstNode* ${argnp} = ${arg}->unlinkFrBack();\n";
	}

	$out .= "AstNode* newp = " . _exec_new_recurse($aref).";\n";
	$out .= "nodep->replaceWith(newp);";
	$out .= "nodep->deleteTree(); VL_DANGLING(nodep);";
	#print "FF $out\n" if $Debug;
    } elsif ($func eq "NEVER") {
	$out .= "nodep->v3fatalSrc(\"Executing transform that was NEVERed\");";
    } elsif ($func eq "DONE") {
    } else {
	$self->error("Unknown execution function format: $func\n");
    }
    return $out;
}

sub tree_match {
    my $self = shift;
    $self->print ("    // TREEOP functions, each return true if they matched & transformed\n");
    #use Data::Dumper; print Dumper($self);
    foreach my $base (sort (keys %{$self->{treeop}})) {
	foreach my $typefunc (@{$self->{treeop}{$base}}) {
	    $self->print("    // Generated by astgen\n");
	    $self->print("    bool $typefunc->{match_func}(Ast${base}* nodep) {\n",
			 "\t// $typefunc->{comment}\n",);
	    $self->print(	"\tif ($typefunc->{match_if}) {\n");
	    $self->print(	"\t    UINFO($typefunc->{uinfo_level},(void*)(nodep)<<\" $typefunc->{uinfo}\\n\");\n");
	    $self->print(	"\t    $typefunc->{exec_func}\n");
	    $self->print(	"\t    return true;\n");
	    $self->print(	"\t}\n");
	    $self->print(	"\treturn false;\n");
	    $self->print("    }\n",);
	}
    }
}

sub tree_base {
    my $self = shift;
    $self->print ("    // TREEOP visitors, call each base type's match\n");
    $self->print ("    // Bottom class up, as more simple transforms are generally better\n");
    foreach my $type (sort (keys %::Classes)) {
	my $base = $::Classes{$type};
	my @out_for_type_sc;
	my @out_for_type;
	foreach my $base (::subclasses_of($type), $type) {
	    foreach my $typefunc (@{$self->{treeop}{$base}}) {
		my @lines = ("	if ($typefunc->{match_func}(nodep)) return;\n",);
		if ($typefunc->{short_circuit}) {	# short-circuit match fn
		    push @out_for_type_sc, @lines;
		} else {				# Standard match fn
		    if ($typefunc->{order}) {
			unshift @out_for_type, @lines;   # TREEOP1's go in front of others
		    } else {
			push @out_for_type, @lines;
		    }
		}
	    }
	}

	# We need to deal with two cases. For short circuited functions we
	# evaluate the LHS, then apply the short-circuit matches, then
	# evaluate the RHS and possibly THS (ternary operators may
	# short-circuit) and apply all the other matches.

	# For types without short-circuits, we just use iterateChildren, which
	# saves one comparison.
	if ($out_for_type_sc[0]) {	# Short-circuited types
	    $self->print("    // Generated by astgen with short-circuiting\n",
			 "    virtual void visit(Ast${type}* nodep) {\n",
                         "      iterateAndNextNull(nodep->lhsp());\n",
			 @out_for_type_sc);
            $self->print("      iterateAndNextNull(nodep->rhsp());\n",
                         "      AstNodeTriop *tnp = VN_CAST(nodep, NodeTriop);\n",
                         "      if (tnp && tnp->thsp()) iterateAndNextNull(tnp->thsp());\n",
			 @out_for_type,
			 "    }\n") if ($out_for_type[0]);
	} elsif ($out_for_type[0]) {	# Other types with something to print
	    my $skip = $self->{tree_skip_visit}{$type};
	    my $gen = $skip ? "Gen" : "";
	    $self->print("    // Generated by astgen\n",
			 "    virtual void visit$gen(Ast${type}* nodep) {\n",
			 ($skip?"":
                          "     iterateChildren(nodep);\n"),
			 @out_for_type,
			 "    }\n");
	}
    }
}

#######################################################################
package main;
__END__

=pod

=head1 NAME

astgen - Generate V3Ast headers to reduce C++ code duplication

=head1 SYNOPSIS

  astgen

=head1 DESCRIPTION

Generates several files for Verilator compilations.

=head1 ARGUMENTS

=over 4

=item --help

Displays this message and program version and exits.

=item --classes

Makes class declaration files.

=item --report

Makes a report report.

=back

=head1 DISTRIBUTION

Copyright 2002-2018 by Wilson Snyder.  Verilator is free software; you can
redistribute it and/or modify it under the terms of either the GNU Lesser
General Public License Version 3 or the Perl Artistic License Version 2.0.

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.

=head1 AUTHORS

Wilson Snyder <wsnyder@wsnyder.org>

=head1 SEE ALSO

=cut

######################################################################
### Local Variables:
### compile-command: "./astgen -I. --report"
### End: