#!/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.423';
# 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, -noperldoc=>1);
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-2017 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: