#!/usr/bin/perl -w
# #!/bin/perl -w
# SystemC$B$N%m%0$+$i(BVCD$B%U%!%$%k$r@8@.$9$k%D!<%k(B
#   File  : sysclog2vcd.pl 
#   $B:n@.F|(B: 2009/3/20
#   $B:n@.(B  : bambooflow

### $B%G%U%)%k%H%Q%i%a!<%?(B ###################################

# $B=PNO(BVCD$B%U%!%$%kL>(B(default)
my $out_filename          = "sysclog.vcd";
# $B0l;~%U%!%$%k(B
my $tmp_filename          = "__tmp_varlog_vcd__";
my $tmp_header_filename   = "__tmp_header_vcd__";

# $B%?%$%`%9%1!<%k(B(default)
my $default_timescale_str = "1ps";

# var$BL>$NJ8;zNsD9$5(B
my $unique_var_len        = 4;


### $BFbItJ];}MQ%0%m!<%P%kJQ?t(B #############################

# $B%O%C%7%e(B
my %info_hash = (); 
my %warning_hash = (); 
my %error_hash = (); 
my %fatal_hash = (); 

my %level_hash = (
    "Info" => \%info_hash,
    "Warning" => \%warning_hash,
    "Error" => \%error_hash,
    "Fatal" => \%fatal_hash
);
# $B%?%$%`%9%1!<%kJ];}(B
my $global_timescale_str; # ex.) 1ps
my @global_timescale;     # ex.) 1ps -> (1, -12)

# $B?.9f$N%+%&%s%H(B($B%f%K!<%/(Bvar$B@8@.MQ(B)
my $global_var_cnt = 0;
my @var_chars = (
    'z','y','x','w','v','u','t','s',
    'r','q','p','o','n','m','l','k',
    'j','i','h','g','f','e','d','c',
    'b','a' );


#### main ############################################################

my $input_filename = $ARGV[0];

# $B%G%U%)%k%H%?%$%`%9%1!<%k$r@_Dj(B
&set_timescale( $default_timescale_str );

# var$B%G!<%?@8@.(B $B!u(B $B%O%C%7%e@8@.(B
&make_vcd_var_for_logfile( $input_filename, $tmp_filename );

# $B%O%C%7%e;2>H$7$F%X%C%@@8@.(B
&make_vcd_header( $tmp_header_filename );

# $B%U%!%$%k7k9g(B
system("cat $tmp_header_filename $tmp_filename > $out_filename");
system("rm -f $tmp_header_filename $tmp_filename" );

#### end of main #####################################################

# $B%?%$%`%9%1!<%k@_Dj(B
#  $BF~NO(B: $BJ8;zNs(B $BNc(B) 1ps, 100ns
#  $B=PNO(B: $BL5$7(B
sub set_timescale {
    my $time_str = shift(@_);
    my $time_num;
    my $time_exp;
    ($time_num, $time_exp) = &conv_time_to_exp( $time_str );
    if ($time_num < 0) {
        print "Error, in set_time_scale.\n";
        exit;
    }
    $global_timescale_str = $time_str;
    @global_timescale = ($time_num, $time_exp); # timescale$B@_Dj(B
}

# VCD$BMQ$N;~4V$r<hF@$9$k(B 
#  $BF~NO(B: $BJ8;zNs(B $BNc(B) 1ps, 20ns
#  $B=PNO(B: $B?tCM(B   $BNc(B) 1000, 2000000
sub get_time {
    my $time_str  = shift(@_);
    my $ret_time;

    my $time_num;
    my $time_exp;
    ($time_num, $time_exp) = &conv_time_to_exp( $time_str );
    if ($time_num < 0) {
        print "Error, in set_time_scale.";
        exit;
    }

    my $timescale_num;
    my $timescale_exp;
    ($timescale_num, $timescale_exp) = @global_timescale;
    $ret_time = $time_num / $timescale_num * &pow10($time_exp-$timescale_exp);

    return $ret_time;
}

# $B;~4V$NJQ49(B
# $BF~NO(B: $BNc(B 1ns,    100ms
# $B=PNO(B:    [1,-6], [100,-3]
sub conv_time_to_exp {
    my $time   = shift(@_);

    my $time_num;       # $B?tCM(B
    my $time_unit_str;  # $BC10L(B($BJ8;zNs(B)
    my $time_unit_exp;  # $BC10L(B

    if ($time =~ /^(\d+)\s*([a-z]+)$/) {
        $time_num = $1;
        $time_unit_str = $2;
    } else {
        print "Error, '$time' is not time.\n";
        return ( -1, 0 ); # -1$B$rJV$9(B
    }

    if ($time_unit_str eq "sec") {
        $time_unit_exp = 0;
    }
    elsif ($time_unit_str eq "ms") {
        $time_unit_exp = -3;
    }
    elsif ($time_unit_str eq "us") {
        $time_unit_exp = -6;
    }
    elsif ($time_unit_str eq "ns") {
        $time_unit_exp = -9;
    }
    elsif ($time_unit_str eq "ps") {
        $time_unit_exp = -12;
    }
    elsif ($time_unit_str eq "fs") {
        $time_unit_exp = -15;
    }
    else {
        print "Error, '$time_unit_str' is not time unit.\n";
        return ( -1, 0 ); # -1$B$rJV$9(B
    }
    return ( $time_num, $time_unit_exp );
}

# 10$B$N(Bp$B>h7W;;(B 
sub pow10 {
    my $p = shift(@_);
    my $ret = 1;
    for (my $i=0; $i<$p; $i++) {
        $ret = $ret * 10;
    }
    for (my $i=0; $i>$p; $i--) {
        $ret = $ret / 10;
    }
    return $ret;
}

#$B%f%K!<%/$J(Bvar$BL>$r<hF@$9$k(B
sub get_unique_var_name {
    my $str = "";
    my $c_num = @var_chars;

    my $n = $global_var_cnt;
    for (my $i=1; $i<=$unique_var_len; $i++) {
        $str = $var_chars[$n % $c_num] . $str;
        $n = int($n / $c_num);
    }
    $global_var_cnt++;
    return $str;
}

# $B%f%K!<%/(Bvar$B$H$=$NCM$r<hF@$9$k(B
# $BF~NO(B: $BG[Ns(B(LEVEL, ID)
# $B=PNO(B: $BG[Ns(B(var$BL>(B, $BCM(B)
#   $B;XDj(BID$B$,$J$$$H$-$O!"%O%C%7%e$K?7$?$K%-!<$r@8@.(B
#   $B;XDj(BID$B$,4{$K$"$k$H$-$O!"CM$r99?7(B(+1)
#
sub get_dump_var {
    my $level_str = shift(@_);
    my $id_str = shift(@_);

    my $var_name = "";
    my $value = 0;

#   Level$B%-!<$,B8:_$9$k$+(B
    if (exists( $level_hash{$level_str})) {

#       ID$B%-!<$,B8:_$9$k$+(B
        if (exists( $level_hash{$level_str}{$id_str})) {
            $var_name = $level_hash{$level_str}{$id_str}[0];
            $value    = $level_hash{$level_str}{$id_str}[1];

            $value = $value + 1;               # $B99?7(B 
            $level_hash{$level_str}{$id_str}[1] = $value;
        }
        else {
            $var_name = &get_unique_var_name;  # $B?75,(B
            $value = 1;

            $level_hash{$level_str}{$id_str}[0] = $var_name;
            $level_hash{$level_str}{$id_str}[1] = $value;
        }
    }
    else {
        print "Error, level'$level_str' not exists\n";
        exit;
    }
    return ($var_name, $value);
}


#
# $B%m%0%U%!%$%kF~NO(B
# $B$*$h$S(B VCD$B$N$?$a$N(Bvar$B%G!<%?@8@.(B
#
sub make_vcd_var_for_logfile {
    my $in_name = shift(@_);
    my $out_name = shift(@_);

    open (FIN, "$in_name")
        or die "can't file open $in_name";

    open (FOUT, "> $out_name")
        or die "can't file open $out_name";

    my $cur_time = -1;

# $BF~NOFI$_9~$_(B
    while (<FIN>) {
        my $line = $_;
        my $time_str;
        my $msg_level;
        my $msg_id;

        my $var_name;
        my $value;
        my $time_value;

        if($line =~ /^(\d+\s*[a-z]+)\s*[:]\s*(\w+)\s*[:]\s*(.+)[:].*$/) {
            $time_str = $1;   # $B;~4VJ8;zNs(B
            $msg_level = $2;  # $B%a%C%;!<%8%l%Y%k(B
            $msg_id = $3;     # $B%a%C%;!<%8(BID

#       $B%@%s%WMQ;~4V<hF@(B
            $time_value = int(&get_time( $time_str ));
#       $B%@%s%WMQ(Bvar$BCM<hF@(B
            ($var_name, $value) = &get_dump_var( $msg_level, $msg_id );

#       $B;~4V5-O?(B
            if ($time_value > $cur_time) {
                print FOUT "\n#$time_value\n";
                $cur_time = $time_value;
            }
            my $val_bin = &conv_dec_to_bin($value);
            print FOUT "$val_bin $var_name\n";
        }
    }

    close FOUT;
    close FIN;
}




#
# VCD$B$N$?$a$N%X%C%@$r:n@.(B
#
sub make_vcd_header {
    my $file_name = $_[0];

    open (FOUT, "> $file_name")
        || die "can't open file $file_name";

#   $B;~4V5-O?(B
    print FOUT "\$date\n";
    my $now_time = gmtime();
    print FOUT "    $now_time\n";
    print FOUT "\$end\n";
    print FOUT "\n";

#   $B%?%$%`%9%1!<%k@_Dj(B
    print FOUT "\$timescale\n";
    print FOUT "      $global_timescale_str\n";
    print FOUT "\$end\n";
    print FOUT "\n";

#   $B%9%3!<%W@_Dj(B
    print FOUT "\$scope module SyscInfo \$end\n";
    foreach my $level_key (keys( %level_hash )) {
        foreach my $id_key (keys( %{$level_hash{$level_key}}) ) {
            my $var_name = $level_hash{$level_key}{$id_key}[0];
            my $value    = $level_hash{$level_key}{$id_key}[1];
            print FOUT "\$var wire  32 $var_name $level_key.$id_key [31:0] \$end\n";
        }
    };
    print FOUT "\$upscope \$end\n";
    print FOUT "\$enddefinitions \$end\n";
    print FOUT "\n";

#   DumpVars$B@_Dj(B
    print FOUT "\$dumpvars\n";
    foreach my $level_key (keys( %level_hash )) {
        foreach my $id_key (keys( %{$level_hash{$level_key}}) ) {
            my $var_name = $level_hash{$level_key}{$id_key}[0];
            my $value    = $level_hash{$level_key}{$id_key}[1];
            print FOUT "b0 $var_name\n";
        }
    };
    print FOUT "\$end\n";
    print FOUT "\n";

    close FOUT;
}

# 10$B?J?t$+$i(B2$B?J?t$XJQ49(B
sub conv_dec_to_bin {
    my $dec = $_[0];
    my $bin = "b". unpack("B32", pack("C", $dec));
    return $bin;
}

