language.pm

Verilog Parser in Perl

    return ($Gateprim{$symbol});
}

######################################################################
#### String utilities

sub strip_comments {
    return $_[0] if $_[0] !~ m!/!s;  # Fast path
    my $text = shift;
    # Spec says that // has no special meaning inside /**/
    my $quote; my $olcmt; my $cmt;
    my $out = "";
    while ($text =~ m!(.*?)(//|/\*|\*/|\n|\"|$)!sg) {
	$out .= $1 if !$olcmt && !$cmt;
	my $t = $2;
	if ($2 eq '"') {
	    $out .= $t;
	    $quote = ! $quote;
	} elsif (!$quote && !$olcmt && $t eq '/*') {
	    $cmt = 1;
	} elsif (!$quote && !$cmt && $t eq '//') {
	    $olcmt = 1;
	} elsif ($cmt && $t eq '*/') {
	    $cmt = 0;
	} elsif ($t eq "\n") {
	    $olcmt = 0;
	    $out .= $t;
	} else {
	    $out .= $t if !$olcmt && !$cmt;
	}
    }
    return $out;
}

######################################################################
#### Numeric utilities

sub number_bits {
    my $number = shift;
    if ($number =~ /^\s*([0-9]+)\s*\'/i) {
	return $1;
    }
    return undef;
}

sub number_signed {
    my $number = shift;
    if ($number =~ /\'\s*s/i) {
	return 1;
    }
    return undef;
}

sub number_value {
    my $number = shift;
    $number =~ s/[_ ]//g;
    if ($number =~ /\'s?h([0-9a-f]+)$/i) {
	return (hex ($1));
    }
    elsif ($number =~ /\'s?o([0-9a-f]+)$/i) {
	return (oct ($1));
    }
    elsif ($number =~ /\'s?b([0-1]+)$/i) {
	my $val = 0;
	$number = $1;
	foreach my $bit (split(//, $number)) {
	    $val = ($val<<1) | ($bit=='1'?1:0);
	}
	return ($val);
    }
    elsif ($number =~ /\'s?d?([0-9]+)$/i
	   || $number =~ /^(-?[0-9]+)$/i) {
	return ($1);
    }
    return undef;
}

sub number_bigint {
    my $number = shift;
    $number =~ s/[_ ]//g;
    if ($number =~ /\'s?h([0-9a-f]+)$/i) {
	return (Math::BigInt->new("0x".$1));
    }
    elsif ($number =~ /\'s?o([0-9a-f]+)$/i) {
	my $digits = $1;
	my $vec = Math::BigInt->new();
	my $len = length($digits);
	my $bit = 0;
	for (my $index=$len-1; $index>=0; $index--, $bit+=3) {
	    my $digit = substr($digits,$index,1);
	    my $val = Math::BigInt->new($digit);
	    $val = $val->blsft($bit,2);
	    $vec->bior($val);
	}
	return ($vec);
    }
    elsif ($number =~ /\'s?b([0-1]+)$/i) {
	return (Math::BigInt->new("0b".$1));
    }
    elsif ($number =~ /\'s?d?0*([0-9]+)$/i
	   || $number =~ /^0*([0-9]+)$/i) {
	return (Math::BigInt->new($1));
    }
    return undef;
}

sub number_bitvector {
    my $number = shift;
    $number =~ s/[_ ]//g;
    my $bits = number_bits($number) || 32;
    if ($number =~ /\'s?h([0-9a-f]+)$/i) {
	return (Bit::Vector->new_Hex($bits,$1));
    }
    elsif ($number =~ /\'s?o([0-9a-f]+)$/i) {
	my $digits = $1;
	my $vec = Bit::Vector->new($bits);
	my $len = length($digits);
	my $bit = 0;
	for (my $index=$len-1; $index>=0; $index--, $bit+=3) {
	    my $digit = substr($digits,$index,1);
	    $vec->Bit_On($bit+2) if ($digit & 4);
	    $vec->Bit_On($bit+1) if ($digit & 2);
	    $vec->Bit_On($bit+0) if ($digit & 1);
	}
	return ($vec);
    }
    elsif ($number =~ /\'s?b([0-1]+)$/i) {
	return (Bit::Vector->new_Bin($bits,$1));
    }
    elsif ($number =~ /\'s?d?([0-9]+)$/i
	   || $number =~ /^([0-9]+)$/i) {
	return (Bit::Vector->new_Dec($bits,$1));
    }
    return undef;
}

######################################################################
#### Signal utilities

sub split_bus {
    my $bus = shift;
    if ($bus !~ /\[/) {
	# Fast case: No bussing
	return $bus;
    } elsif ($bus =~ /^([^\[]+\[)([0-9]+):([0-9]+)(\][^\]]*)$/) {
	# Middle speed case: Simple max:min
	my $bit;
	my @vec = ();
	if ($2 >= $3) {
	    for ($bit = $2; $bit >= $3; $bit --) {
		push @vec, $1 . $bit . $4;
	    }
	} else {
	    for ($bit = $2; $bit <= $3; $bit ++) {
		push @vec, $1 . $bit . $4;
	    }
	}
	return @vec;
    } else {
	# Complex case: x:y:z,p,...	etc
	# Do full parsing
	my @pretext = ();	# [brnum]
	my @expanded = ();	# [brnum][bitoccurance]
	my $inbra = 0;
	my $brnum = 0;
	my ($beg,$end,$step);
	foreach (split (/([:\]\[,])/, $bus)) {
	    if (/^\[/) {
		$inbra = 1;
		$pretext[$brnum] .= $_;
	    }
	    if (!$inbra) {
		# Not in bracket, just remember text
		$pretext[$brnum] .= $_;
		next;
	    }
	    if (/[\],]/) {
		if (defined $beg) {
		    # End of bus piece
		    #print "Got seg $beg $end $step\n";
		    my $bit;
		    if ($beg >= $end) {
			for ($bit = $beg; $bit >= $end; $bit -= $step) {
			    push @{$expanded[$brnum]}, $bit;
			}
		    } else {
			for ($bit = $beg; $bit <= $end; $bit += $step) {
			    push @{$expanded[$brnum]}, $bit;
			}
		    }
		}
		$beg = undef;
		# Now what?
		if (/^\]/) {
		    $inbra = 0;
		    $brnum++;
		    $pretext[$brnum] .= $_;
		}
		elsif (/,/) {
		    $inbra = 1;
		}
	    } elsif (/:/) {
		$inbra++;
	    }
	    else {
		if ($inbra == 1) {	# Begin value
		    $beg = $end = number_value ($_);	# [2'b11:2'b00] is legal
		    $step = 1;
		} elsif ($inbra == 2) {	# End value
		    $end = number_value ($_);		# [2'b11:2'b00] is legal
		} elsif ($inbra == 3) {	# Middle value
		    $step = number_value ($_);		# [2'b11:2'b00] is legal
		}
		# Else ignore extra colons
	    }
	}

	# Determine max size of any bracket expansion array
	my $br;
	my $max_size = $#{$expanded[0]};
	for ($br=1; $br<$brnum; $br++) {
	    my $len = $#{$expanded[$br]};
	    if ($len < 0) {
		push @{$expanded[$br]}, "";
		$len = 0;
	    }
	    $max_size = $len if $max_size < $len;
	}

	my $i;
	my @vec = ();
	for ($i=0; $i<=$max_size; $i++) {
	    $bus = "";
	    for ($br=0; $br<$brnum; $br++) {
		#print "i $i  br $br >", $pretext[$br],"<\n";
		$bus .= $pretext[$br] . $expanded[$br][$i % (1+$#{$expanded[$br]})];
	    }
	    $bus .= $pretext[$br];	# Trailing stuff
	    push @vec, $bus;
	}
	return @vec;
    }
}

sub split_bus_nocomma {
    # Faster version of split_bus
    my $bus = shift;
    if ($bus !~ /:/) {
	# Fast case: No bussing
	return $bus;
    } elsif ($bus =~ /^([^\[]+\[)([0-9]+):([0-9]+)(\][^\]]*)$/) {
	# Middle speed case: Simple max:min
	my $bit;
	my @vec = ();
	if ($2 >= $3) {
	    for ($bit = $2; $bit >= $3; $bit --) {
		push @vec, $1 . $bit . $4;
	    }
	} else {
	    for ($bit = $2; $bit <= $3; $bit ++) {
		push @vec, $1 . $bit . $4;
	    }
	}
	return @vec;
    } else {
	# Complex case: x:y	etc
	# Do full parsing
	my @pretext = ();	# [brnum]
	my @expanded = ();	# [brnum][bitoccurance]
	my $inbra = 0;
	my $brnum = 0;
	my ($beg,$end);
	foreach (split (/([:\]\[])/, $bus)) {
	    if (/^\[/) {
		$inbra = 1;
		$pretext[$brnum] .= $_;
	    }
	    if (!$inbra) {
		# Not in bracket, just remember text
		$pretext[$brnum] .= $_;
		next;
	    }
	    if (/[\]]/) {
		if (defined $beg) {
		    # End of bus piece
		    #print "Got seg $beg $end\n";
		    my $bit;
		    if ($beg >= $end) {
			for ($bit = $beg; $bit >= $end; $bit--) {
			    push @{$expanded[$brnum]}, $bit;
			}
		    } else {
			for ($bit = $beg; $bit <= $end; $bit++) {
			    push @{$expanded[$brnum]}, $bit;
			}
		    }
		}
		$beg = undef;
		# Now what?
		if (/^\]/) {
		    $inbra = 0;
		    $brnum++;
		    $pretext[$brnum] .= $_;
		}
	    } elsif (/:/) {
		$inbra++;
	    }
	    else {
		if ($inbra == 1) {	# Begin value
		    $beg = $end = $_;
		} elsif ($inbra == 2) {	# End value
		    $end = $_;
		}
		# Else ignore extra colons
	    }
	}

	# Determine max size of any bracket expansion array
	my $br;
	my $max_size = $#{$expanded[0]};
	for ($br=1; $br<$brnum; $br++) {
	    my $len = $#{$expanded[$br]};
	    if ($len < 0) {
		push @{$expanded[$br]}, "";
		$len = 0;
	    }
	    $max_size = $len if $max_size < $len;
	}

	my $i;
	my @vec = ();
	for ($i=0; $i<=$max_size; $i++) {
	    $bus = "";
	    for ($br=0; $br<$brnum; $br++) {
		#print "i $i  br $br >", $pretext[$br],"<\n";
		$bus .= $pretext[$br] . $expanded[$br][$i % (1+$#{$expanded[$br]})];
	    }
	    $bus .= $pretext[$br];	# Trailing stuff
	    push @vec, $bus;
	}
	return @vec;
    }
}

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