callbackgen

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

# We need keywords, but haven't completely built yet, so can't use the blib
# Thus we pull in Language.pm directly
require "../Language.pm";
package main;

$VERSION = '3.314';

# xs_manual=>1,   -> The .xs file makes the handler itself

my %Cbs =
    (attribute	=> {which=>'Parser', args => [text=>'string']},
     comment	=> {which=>'Parser', args => [text=>'string']},
     endparse	=> {which=>'Parser', args => [text=>'string']},
     keyword	=> {which=>'Parser', args => [text=>'string']},
     number	=> {which=>'Parser', args => [text=>'string']},
     operator	=> {which=>'Parser', args => [text=>'string']},
     preproc	=> {which=>'Parser', args => [text=>'string']},
     string	=> {which=>'Parser', args => [text=>'string']},
     symbol	=> {which=>'Parser', args => [text=>'string']},
     sysfunc	=> {which=>'Parser', args => [text=>'string']},
     #
     class      => {which=>'SigParser', args => [kwd=>'string', name=>'string', virt=>'string']},
     contassign => {which=>'SigParser', args => [kwd=>'string', lhs=>'string', rhs=>'string']},
     covergroup => {which=>'SigParser', args => [kwd=>'string', name=>'string']},
     defparam   => {which=>'SigParser', args => [kwd=>'string', lhs=>'string', rhs=>'string']},
     endcell	=> {which=>'SigParser', args => [kwd=>'string']},
     endclass	=> {which=>'SigParser', args => [kwd=>'string']},
     endgroup	=> {which=>'SigParser', args => [kwd=>'string']},
     endinterface=>{which=>'SigParser', args => [kwd=>'string']},
     endmodport => {which=>'SigParser', args => [kwd=>'string']},
     endmodule	=> {which=>'SigParser', args => [kwd=>'string']},
     endpackage	=> {which=>'SigParser', args => [kwd=>'string']},
     endprogram	=> {which=>'SigParser', args => [kwd=>'string']},
     endtaskfunc=> {which=>'SigParser', args => [kwd=>'string']},
     function	=> {which=>'SigParser', args => [kwd=>'string', name=>'string', data_type=>'string']},
     import	=> {which=>'SigParser', args => [package=>'string', id=>'string']},
     instant	=> {which=>'SigParser', args => [mod=>'string', cell=>'string', range=>'string']},
     interface	=> {which=>'SigParser', args => [kwd=>'string', name=>'string']},
     modport    => {which=>'SigParser', args => [kwd=>'string', name=>'string']},
     module	=> {which=>'SigParser', args => [kwd=>'string', name=>'string', ignore3=>'undef', celldefine=>'bool'],},
     package	=> {which=>'SigParser', args => [kwd=>'string', name=>'string']},
     parampin	=> {which=>'SigParser', args => [name=>'string', conn=>'string', index=>'int']},
     pin	=> {which=>'SigParser', args => [name=>'string', conn=>'string', index=>'int']},
     port	=> {which=>'SigParser', args => [name=>'string', objof=>'string', direction=>'string',
						 data_type=>'string', array=>'string', index=>'int']},
     program	=> {which=>'SigParser', args => [kwd=>'string', name=>'string'],},
     var	=> {which=>'SigParser', args => [kwd=>'string',	 name=>'string', objof=>'string', net=>'string',
						 data_type=>'string', array=>'string', value=>'string'],},
     task	=> {which=>'SigParser', args => [kwd=>'string', name=>'string']},
    );

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

our $Opt_Debug;

autoflush STDOUT 1;
autoflush STDERR 1;
Getopt::Long::config ("no_auto_abbrev");
if (! GetOptions (
	  # Local options
	  "help"	=> \&usage,
	  "version"	=> sub { print "Version $VERSION\n"; exit(0); },
	  "<>"		=> sub { die "%Error: Unknown parameter: $_[0]\n"; },
    )) {
    die "%Error: Bad usage, try 'callbackgen --help'\n";
}

process();

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

sub usage {
    print "Version $VERSION\n";
    pod2usage(-verbose=>2, -exitval=>2, -output=>\*STDOUT);
    exit (1);
}

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

sub process {
    filter("Parser.xs",0);
    filter("VParse.h",0);
    filter("Parser_callbackgen.cpp",1);
}

sub filter {
    my $filename = shift;
    my $make_xs = shift;

    my $fh = IO::File->new("<$filename");
    my @lines;
    if (!$fh) {
	if ($make_xs) {
	    @lines = ("// CALLBACKGEN_XS\n");
	} else {
	    die "%Error: $! $filename\n";
	}
    } else {
	@lines = $fh->getlines;
	$fh->close;
    }
    my @orig = @lines;

    my $strip;
    my @out;
    foreach my $line (@lines) {
	if ($line =~ /CALLBACKGEN_GENERATED_BEGIN/) {
	    $strip = 1;
	} else {
	    if (!$strip) {
		push @out, $line;
	    }

	    if ($line =~ /CALLBACKGEN_GENERATED_END/) {
		$strip = 0;
	    }
	    elsif ($line =~ /CALLBACKGEN_H_MEMBERS/) {
		push @out, "    // CALLBACKGEN_GENERATED_BEGIN - GENERATED AUTOMATICALLY by callbackgen\n";
		push @out, _h_use_cb();
		push @out, "    // CALLBACKGEN_GENERATED_END - GENERATED AUTOMATICALLY by callbackgen\n";
	    }
	    elsif ($line =~ /CALLBACKGEN_CB_USE/) {
		push @out, "    // CALLBACKGEN_GENERATED_BEGIN - GENERATED AUTOMATICALLY by callbackgen\n";
		push @out, _c_use_cb();
		push @out, "    // CALLBACKGEN_GENERATED_END - GENERATED AUTOMATICALLY by callbackgen\n";
	    }
	    elsif ($line =~ /CALLBACKGEN_H_VIRTUAL(_0)?/) {
		my $zero = (($1||"") eq "_0") ? " = 0":"";
		push @out, "    // CALLBACKGEN_GENERATED_BEGIN - GENERATED AUTOMATICALLY by callbackgen\n";
		my $last_which = "";
		foreach my $cb (sort {$Cbs{$a}{which} cmp $Cbs{$b}{which} || $a cmp $b} keys %Cbs) {
		    my $which = $Cbs{$cb}{which};
		    if ($last_which ne $which) {
			push @out, "    // Verilog::$which Callback methods\n";
			$last_which = $which;
		    }
		    push @out, "    virtual void "._func($cb)."("._arglist($cb).")".$zero.";\n";
		}
		push @out, "    // CALLBACKGEN_GENERATED_END - GENERATED AUTOMATICALLY by callbackgen\n";
	    }
	    elsif ($line =~ /CALLBACKGEN_XS/) {
		push @out, "// CALLBACKGEN_GENERATED_BEGIN - GENERATED AUTOMATICALLY by callbackgen\n";
		foreach my $cb (sort {$Cbs{$a}{which} cmp $Cbs{$b}{which} || $a cmp $b} keys %Cbs) {
		    next if $Cbs{$cb}{xs_manual};
		    push @out, _xs($cb);
		}
		push @out, _xs_use_cb();
		push @out, "// CALLBACKGEN_GENERATED_END - GENERATED AUTOMATICALLY by callbackgen\n";
	    }
	    elsif ($line =~ /CALLBACKGEN_KEYWORDS/) {
		push @out, "    // CALLBACKGEN_GENERATED_BEGIN - GENERATED AUTOMATICALLY by callbackgen\n";
		push @out, _h_keywords();
		push @out, "    // CALLBACKGEN_GENERATED_END - GENERATED AUTOMATICALLY by callbackgen\n";
	    }
	    elsif ($line =~ /CALLBACKGEN/) {
		die "%Error: callbackgen: Unknown pragma: $line";
	    }
	}
    }
    @lines = @out;

    if (join('',@lines) ne join('',@orig)
	|| $make_xs) {  # Generated file, so touch to apppease make
	print "callbackgen edited $filename\n";
	$fh = IO::File->new(">$filename") or die "%Error: $! writing $filename\n";
	$fh->write(join('',@lines));
	$fh->close;
    }
}

sub _func {
    my $cb = shift;
    return $cb."Cb";
}

sub _arglist {
    my $cb = shift;
    my $args = "VFileLine* fl";
    my $n=0;
    for (my $i=0; $i<=$#{$Cbs{$cb}{args}}; $i+=2) {
	my ($arg,$type) = ($Cbs{$cb}{args}[$i],$Cbs{$cb}{args}[$i+1]);
	$args .= "\n\t" if (($n++%5)==4);
	if ($type eq 'string') {
	    $args .= ", const string\& $arg";
	} elsif ($type eq 'bool' || $type eq 'int') {
	    $args .= ", $type $arg";
	} elsif ($type eq 'undef') {
	    $args .= ", bool";
	} else {
	    die "%Error: callbackgen: Unknown type: $arg=>$type\n";
	}
    }
    return $args;
}

sub _xs {
    my $cb = shift;
    my @out;
    push @out, "// GENERATED AUTOMATICALLY by callbackgen\n";
    push @out, "void VParserXs::"._func($cb)."("._arglist($cb).") {\n";
    my $enable = "callbackMasterEna()";
    $enable .= " && m_useCb_${cb}";
    $enable .= " && $Cbs{$cb}{enable}" if $Cbs{$cb}{enable};
    push @out, "    if ($enable) {\n";
    push @out, "        cbFileline(fl);\n";
    my $callargs="";
    my $n=1;
    for (my $i=0; $i<=$#{$Cbs{$cb}{args}}; $i+=2) {
	my ($arg,$type) = ($Cbs{$cb}{args}[$i],$Cbs{$cb}{args}[$i+1]);
	if ($type eq 'string') {
	    push @out, "        static string hold${n}; hold${n} = $arg;\n";
	    $callargs .= ", hold${n}.c_str()";
	} elsif ($type eq 'bool') {
	    push @out, "        static string hold${n}; hold${n} = $arg ? \"1\":\"0\";\n";
	    $callargs .= ", hold${n}.c_str()";
	} elsif ($type eq 'int') {
	    push @out, "        static string hold${n}; static char num".$n."[30]; sprintf(num${n},\"%d\",$arg); hold${n}=num${n};\n";
	    $callargs .= ", hold${n}.c_str()";
	} elsif ($type eq 'undef') {
	    $callargs .= ", NULL";
	} else {
	    die "%Error: callbackgen: Unknown type: $arg=>$type\n";
	}

	$n++;
    }
    my $narg = $n-1;
    push @out, "        call(NULL, $narg, \"$cb\"$callargs);\n";
    push @out, "    }\n";
    push @out, "}\n";
    return @out;
}

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

sub _h_use_cb {
    my @out;
    push @out, "    struct {  // Bit packed to help the cache\n";
    foreach my $cb (sort {$a cmp $b} keys %Cbs) {
	push @out, "        bool m_useCb_${cb}:1;\n";
    }
    push @out, "    };\n";
    return @out;
}

sub _c_use_cb {
    my @out;
    push @out, "    void set_cb_use() {\n";
    foreach my $cb (sort {$a cmp $b} keys %Cbs) {
	push @out, "       m_useCb_${cb} = true;\n";
    }
    push @out, "   }\n";
    return @out;
}

sub _xs_use_cb {
    my @out;
    push @out, "// GENERATED AUTOMATICALLY by callbackgen\n";
    # Trailing Ena so it doesn't look like it is a callback itself
    push @out, "void VParserXs::useCbEna(const char* name, bool flag) {\n";
    push @out, "    if (0) ;\n";
    foreach my $cb (sort {$a cmp $b} keys %Cbs) {
	push @out, "    else if (0==strcmp(name,\"${cb}\")) m_useCb_${cb} = flag;\n";
    }
    push @out, "}\n";
    return @out;
}

sub _h_keywords {
    my @out;

    (keys %Verilog::Language::Keyword) or die "%Error: Keyword loading failed,";

    push @out, "    static bool isKeyword(const char* kwd, int leng) {\n";
    # If this gets slow, we can use a perfect hashing function and a table to compare
    push @out, "\tstatic set<string> s_map;\n";
    push @out, "\tif (s_map.empty()) {\n";
    my $i=0;
    push @out, "\t    const char* kwds[] = {";
    foreach my $kwd (sort keys %Verilog::Language::Keyword) {
	next if $kwd !~ /^[a-zA-Z_]/;
	push @out, "\n\t\t" if ($i++%7)==0;
	push @out, "\"$kwd\",";
    }
    push @out, "\"\"};\n";
    push @out, "\t    for (const char** k=kwds; **k; k++) s_map.insert(*k);\n";
    push @out, "\t}\n";
    push @out, "\tstring str(kwd,leng);\n";
    push @out, "\treturn s_map.end() != s_map.find(str);\n";
    push @out, "    }\n";
    return @out;
}

#######################################################################
__END__

=pod

=head1 NAME

callbackgen - Create callback functions for Verilog-Perl internals

=head1 SYNOPSIS

  make

  This will invoke callbackgen

=head1 DESCRIPTION

Callbackgen is an internal utility used in building Verilog::Parser.

=head1 EXTENSIONS

=over 4

=item //CALLBACKGEN_H_VIRTUAL

Creates "virtual callbackCb(...);"

=item //CALLBACKGEN_H_VIRTUAL_0

Creates "virtual callbackCb(...) = 0;"

=item //CALLBACKGEN_XS

Creates XS code for accepting the callback.

=back

=head1 ARGUMENTS

=over 4

=item --help

Displays this message and program version and exits.

=item --debug

Enable debug.

=item --version

Print the version number and exit.

=back

=head1 DISTRIBUTION

This is part of the L<http://www.veripool.org/> free Verilog EDA software
tool suite.  The latest version is available from CPAN and from
L<http://www.veripool.org/>.

Copyright 2008-2012 by Wilson Snyder.  This package 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: "./callbackgen "
### End: