File Coverage

blib/lib/SystemC/Vregs/File.pm

Criterion	Covered	Total	%
statement	79	130	60.7
branch	19	56	33.9
condition	1	9	11.1
subroutine	12	17	70.5
pod	6	10	60.0
total	117	222	52.7

# See copyright, etc in below POD section.
######################################################################

package SystemC::Vregs::File;
use File::Basename;
use vars qw($VERSION);
use base qw(SystemC::Vregs::Language);

use SystemC::Vregs::Number;
use SystemC::Vregs::Language;
use strict;
use Carp;

$VERSION = '1.470';

######################################################################
######################################################################
# Files

sub open {
    my $class = shift;
    # General routine for opening output file and starting header

    my %params = @_;
    $params{language} or croak "%Error: No language=> specified,";

    my $self = $class->SUPER::new(verbose=>1,
				  # noheader=>0,
				  %params);

    my ($name,$path,$suffix) = fileparse($self->{filename},'\..*');
    my $template_filename = $path.$name."__template".$suffix;
    print "Check Template File $template_filename\n" if $SystemC::Vregs::Debug;
    if (-r $template_filename) {
	#$self->{template}->read (filename=>$template_filename);
    }

    if (!$self->{noheader}) {
	$self->print("// -*- C++ -*-\n") if ($self->{CPP});
	$self->print("\n") if ($self->{XML});
	$self->comment("DO NOT EDIT -- Generated automatically by vregs\n");
	if ($self->{C} || $self->{CPP}) {
	    $self->comment_pre("\\file\n");
	    $self->comment_pre("\\brief Register Information: Generated automatically by vregs\n");
	} else {
	    $self->comment("DESC"."RIPTION: Register Information: Generated automatically by vregs\n");
	}
	$self->comment_pre("\n");
    }

    if ($self->{rules}) {
	$self->{rules}->filehandle($self);
	foreach my $rfile ($self->{rules}->filenames()) {
	    $rfile = basename($rfile,"^");
	    $self->comment_pre("See SystemC::Vregs::Rules file: $rfile\n");
	}
	$self->comment_pre("\n");
    }

    $self->{rules}->execute_rule ('any_file_before', 'any_file', $self) if $self->{rules};

    return $self;
}

sub close {
    my $self = shift;
    # General routine for closing output file

    $self->close_prep();

    $self->{rules}->execute_rule ('any_file_after', 'any_file', $self) if $self->{rules};

    if (!$self->{noheader}) {
	$self->print("\n");
	$self->comment ("DO NOT EDIT -- Generated automatically by vregs\n");
    }

    $self->SUPER::close();
}

sub private_not_public {
    my $self = shift;
    my $private = shift;
    my $pack = shift;
    # Print public: or private: depending on desired state

    my $enabled = (defined $pack->{rules}{protect_rdwr_only}
		   ? $pack->{rules}{protect_rdwr_only}
		   : $pack->{protect_rdwr_only});
    $private = 0 if !$enabled;
    if ($self->{CPP}) {
	if ($private && !$self->{private}) {
	    $self->print ("protected:\n");
	}
	if (!$private && $self->{private}) {
	    $self->print ("public:\n");
	}
    }
    $self->set_private($private);
}

sub set_private {
    my $self = shift;
    my $private = shift;
    $self->{private} = $private;
}

sub fn {
    my $self = shift;
    my $clname = shift;
    my $suffix = shift;
    my $proto = shift;
    # Declare a function with C++ semantics, mangle into C if necessary
    if ($self->{CPP}) {
	$self->print ("    $proto ",@_);
    } else {
	my $const = ($proto =~ s/const\s*$//) ? "const ":"";

	$proto =~ m/\s*(\S+)\s*\(/;
	my $fname = lcfirst "${clname}_$1";
	$fname .= "_".$suffix if $suffix;
	if ($self->{private}) {
	    $self->{func_private}{$fname} = $self->{private};
	    $fname .= "_private";
	}
	$proto =~ s/\s+(\S+)\s*\(/ ${fname}(/;

        $proto =~ s/\(/(${const}${clname}* thisp,/;
        $proto =~ s/,\s*\)/)/;
	$self->print ("$proto ",@_);
    }
}

sub call_str {
    my $self = shift;
    my $clname = shift;
    my $suffix = shift;
    my $call = shift;
    # Call a function with C++ semantics, mangle into C if necessary
    # return as *string*
    if ($self->{CPP}) {
	return join('',"$call",@_);
    } else {
	$call =~ m/\s*(\S+)\s*\(/;
	my $fname = lcfirst "${clname}_$1";
	$fname .= "_".$suffix if $suffix;
	$fname .= "_private" if $self->{func_private}{$fname};
	$call =~ s/(\S+)\s*\(/${fname}(/;
        $call =~ s/\(/(thisp,/ or croak "%Error: No args in func call '$call',";
        $call =~ s/,\s*\)/)/;
	return join('',$call,@_);
    }
}

######################################################################
# Tabify all output

sub print {
    my $self = shift;
    # Override default SystemC::Vregs::Language::print to tabify all output
    $self->push_text($self->tabify(@_));
}

sub print_at_close {
    my $self = shift;
    # Override default SystemC::Vregs::Language::print to tabify all output
    $self->push_close_text($self->tabify(@_));
}

sub printf_tabify {
    my $self = shift;
    my $line = sprintf(shift,@_);
    $self->print($self->tabify($line));
}

sub tabify {
    my $self = shift;
    my $line = join('',@_);
    # Convert any space-tabs to just tabs
    my $out='';
    my $col=0;
    my $spaces=0;
    $line =~ s/\t        /\t\t/g;
    for (my $i=0; $i
	my $c = substr($line,$i,1);
	if ($c eq "\n") {
	    $out .= $c;
	    $col = 0;
	    $spaces = 0;
	} elsif ($c eq "\t") {
	    my $wantcol = int(($col+$spaces+8)/8)*8;
	    while ($wantcol > $col) {
		$col = int(($col+8)/8)*8;
		$out .= "\t";
	    }
	    $spaces = 0;
	} elsif ($c eq " ") {
	    $spaces++;
	} else {
	    if ($spaces) { $out .= ' 'x$spaces; $col+=$spaces; $spaces=0; }
	    $out .= $c;
	    $col++;
	}
    }
    return $out;
}

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