File Coverage

blib/lib/Verilog/Parser.pm

Criterion	Covered	Total	%
statement	105	125	84.0
branch	20	38	52.6
condition	7	13	53.8
subroutine	24	28	85.7
pod	14	20	70.0
total	170	224	75.8

# Verilog - Verilog Perl Interface
# See copyright, etc in below POD section.
######################################################################

package Verilog::Parser;
use Carp;
use Verilog::Getopt;
use Verilog::Language;
use Verilog::Std;

require DynaLoader;
use base qw(DynaLoader);

use strict;
use vars qw($VERSION $Debug);

$VERSION = '3.478';

#$Debug sets the default value for debug.  You're better off with the object method though.

our @_Callback_Names = qw(
  attribute
  endparse
  keyword
  number
  operator
  preproc
  string
  symbol
  );

######################################################################
#### Configuration Section

bootstrap Verilog::Parser;

#In Parser.xs:
# sub _new (class, sigparser)
# sub _open (class)
# sub _debug (class, level)
# sub _prologe (class, flag)
# sub _callback_master_enable
# sub _use_cb (class, name, flag)
# sub parse (class)
# sub eof (class)
# sub filename (class, [setit])
# sub lineno (class, [setit])
# sub unreadback (class, [setit])
# sub unreadbackCat (class, add)

######################################################################
#### Constructors

sub new {
    my $class = shift;  $class = ref $class if ref $class;
    my $self = {_sigparser=>0,
		symbol_table=>[],	# .xs will init further for us
		use_vars => 1,
		use_unreadback => 1,   # Backward compatibility
		use_protected => 1,   # Backward compatibility
		use_pinselects => 0,   # Backward compatibility
		use_std => undef,	# Undef = silent
		#use_cb_{callback-name} => 0/1
		#
		#_debug		# Don't set, use debug() accessor to change level
		@_};

    bless $self, $class;
    # Sets $self->{_cthis}
    $self->_new($self,
		# Options go here
		$self->{symbol_table},
		$self->{_sigparser},
		$self->{use_unreadback},
		$self->{use_protected},
		$self->{use_pinselects},  # Undocumented as for use in SigParser only
		);

    $self->{use_cb_contassign} = $self->{use_vars} if !exists $self->{use_cb_contassign};
    $self->{use_cb_defparam} = $self->{use_vars} if !exists $self->{use_cb_defparam};
    $self->{use_cb_pin}    = $self->{use_vars} if !exists $self->{use_cb_pin};
    $self->{use_cb_port}   = $self->{use_vars} if !exists $self->{use_cb_port};
    $self->{use_cb_var}    = $self->{use_vars} if !exists $self->{use_cb_var};

    foreach my $key (keys %{$self}) {
	if ($key =~ /^use_cb_(.*)/) {
	    $self->_use_cb($1, $self->{$key});
	}
    }

    $self->language(Verilog::Language::language_standard());
    $self->debug($Debug) if $Debug;
    return $self;
}

sub DESTROY {
    my $self = shift;
    $self->_DESTROY;
}

######################################################################
####  Accessors

sub callback_names {
    my @out = sort @_Callback_Names;
    return @out;
}

sub debug {
    my $self = shift;
    my $level = shift;
    if (defined $level) {
	$self->{_debug} = $level;
	$self->_debug($level);
    }
    return $self->{_debug};
}

sub fileline {
    my $self = shift;
    return ($self->filename||"").":".($self->lineno||"");
}

sub line { return lineno(@_); }  # Old, now undocumented

#######################################################################
#### Methods

sub reset {
    my $self = shift;
    $self->std;
}

sub std {
    my $self = shift;
    my $quiet = !defined $self->{use_std} && $self->{_sigparser};
    if (!$self->{symbol_table}[2]->{std}  # Not in the symbol table yet
	&& ($self->{use_std} || $quiet)
	) {
	print "Including std::\n" if $self->{_debug};
	my $olddbg = $self->debug;
	if ($quiet) {
	    print "Disabling debug during std:: loading\n" if $self->{_debug};
	    $self->debug(0);
	    $self->_callback_master_enable(0); # //verilog-perl callbacks off
	}
	$self->eof;  #Flush user code before callback disable
	$self->parse(Verilog::Std::std);
	$self->eof;
	if ($quiet) {
	    $self->_callback_master_enable(1); # //verilog-perl callbacks on
	    $self->debug($olddbg);
	}
    }
}

sub parse_file {
    # Read a file and parse
    @_ == 2 or croak 'usage: $parser->parse_file($filename)';
    my $self = shift;
    my $filename = shift;

    my $fh = new IO::File;
    $fh->open($filename) or croak "%Error: $! $filename";
    $self->reset();
    $self->filename($filename);
    $self->lineno(1);
    while (defined(my $line = $fh->getline())) {
	$self->parse($line);
    }
    $self->eof;
    $fh->close;
    return $self;
}

sub parse_preproc_file {
    # Read a preprocess file and parse
    @_ == 2 or croak 'usage: $parser->parse_file(Verilog::Preproc_object_ref)';
    my $self = shift;
    my $pp = shift;

    ref($pp) or croak "%Error: not passed a Verilog::Preproc object";
    $self->reset();

    # Chunk size of ~32K determined experimentally with t/49_largeish.t
    while (defined(my $text = $pp->getall(31*1024))) {
	$self->parse($text);
    }
    $self->eof;
    return $self;
}

######################################################################
#### Called by the parser

sub error {
    my ($self,$text,$token)=@_;
    my $fileline = $self->filename.":".$self->lineno;
    croak("%Error: $fileline: $text\n"
	  ."Stopped");
}

sub attribute {
    # Default Internal callback
    my $self = shift;	# Parser invoked
    my $token = shift;	# What token was parsed
    $self->unreadbackCat($token);
}

sub comment {
    # Default Internal callback
    my $self = shift;	# Parser invoked
    my $token = shift;	# What token was parsed
    $self->unreadbackCat($token);
}

sub string {
    # Default Internal callback
    my $self = shift;	# Parser invoked
    my $token = shift;	# What token was parsed
    $self->unreadbackCat($token);
}

sub keyword {
    # Default Internal callback
    my $self = shift;	# Parser invoked
    my $token = shift;	# What token was parsed
    $self->unreadbackCat($token);
}

sub symbol {
    # Default Internal callback
    my $self = shift;	# Parser invoked
    my $token = shift;	# What token was parsed
    $self->unreadbackCat($token);
}

sub operator {
    # Default Internal callback
    my $self = shift;	# Parser invoked
    my $token = shift;	# What token was parsed
    $self->unreadbackCat($token);
}

sub preproc {
    # Default Internal callback
    my $self = shift;	# Parser invoked
    my $token = shift;	# What token was parsed
    if (Verilog::Language::is_keyword($token)) {
	$self->keyword($token); # Do this for backward compatibility with Version 2.*
    } else {
	$self->symbol($token); # Do this for backward compatibility with Version 2.*
    }
}
sub number {
    # Default Internal callback
    my $self = shift;	# Parser invoked
    my $token = shift;	# What token was parsed
    $self->unreadbackCat($token);
}

sub sysfunc {
    # Default Internal callback - note the default action
    my $self = shift;	# Parser invoked
    my $token = shift;	# What token was parsed
    $self->symbol($token); # Do this for backward compatibility with Version 2.*
}

sub endparse {
    # Default Internal callback
    my $self = shift;	# Parser invoked
    my $token = shift;	# What token was parsed
    $self->unreadbackCat($token);
}

######################################################################
#### Package return
1;
__END__