# ========== Copyright Header Begin ==========================================
# 
# OpenSPARC T2 Processor File: Logfile.pm
# Copyright (C) 1995-2007 Sun Microsystems, Inc. All Rights Reserved
# 4150 Network Circle, Santa Clara, California 95054, U.S.A.
#
# * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. 
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
#
# 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.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# For the avoidance of doubt, and except that if any non-GPL license 
# choice is available it will apply instead, Sun elects to use only 
# the General Public License version 2 (GPLv2) at this time for any 
# software where a choice of GPL license versions is made 
# available with the language indicating that GPLv2 or any later version 
# may be used, or where a choice of which version of the GPL is applied is 
# otherwise unspecified. 
#
# Please contact Sun Microsystems, Inc., 4150 Network Circle, Santa Clara, 
# CA 95054 USA or visit www.sun.com if you need additional information or 
# have any questions. 
# 
# ========== Copyright Header End ============================================
package AnalyzeDiag::Logfile;

use strict;
use warnings;
use File::Spec;
use Math::BigInt;

use AnalyzeDiag::Output;

use fields qw(filename);

###############################################################################

sub create_from_dir {
  my $class = shift;
  my $dir = shift;

  my $vcslog = File::Spec->catfile($dir, 'sim.log');
  my $saslog = File::Spec->catfile($dir, 'sas.log');

  my $log;
  if(-e $vcslog) {
    # RTL Run
    $log = AnalyzeDiag::Logfile::Rtl->new();
    $log->filename($vcslog);
  } elsif(-e $saslog) {
    # Simulator Run
    $log = AnalyzeDiag::Logfile::Mom->new();
    $log->filename($saslog);
  } else {
    script_die "Cannot find '$vcslog' or '$saslog'.\n";
  }
  return $log;
}

###############################################################################

sub new {
  my $this = shift;

  unless (ref $this) {
    $this = fields::new($this);
  }

  return $this;
}

###############################################################################

sub filename {
  my $this = shift;
  my $filename = shift;
  $this->{filename} = $filename if defined $filename;
  return $this->{filename};
}

###############################################################################

sub get_cycle_period {
  my $this = shift;

  script_die "Can't get_cycle_period on abstract superclass!\n";
}

###############################################################################

sub get_times_for_pcs {
  my $this   = shift;
  my $pclist = shift;

  my %pchash   = map { $_ => [] } @$pclist;
  my %shortpc  = map { $_ => $_ } @$pclist;

  foreach (values %shortpc) { s/^0+// }
  %shortpc = reverse %shortpc;

  debug "get_times_for_pcs: shortpc hash ->\n";
  foreach my $pc (keys %shortpc) {
    debug "  short=$pc, long=$shortpc{$pc}\n";
  }

 my $fh = IO::File->new("<$this->{filename}") or
   script_die "Can't open '$this->{filename}': $!\n";

  $this->search_file_for_pcs($fh, \%pchash, \%shortpc);

  return \%pchash;
}

###############################################################################

sub search_file_for_pcs {
  my $this = shift;
  my $fh = shift;
  my $pchash = shift;
  my $shortpc = shift;

  my $ref = ref $this;
  script_die "Error: search_file_for_pcs not implemented for $ref!\n";
}

###############################################################################

sub subtract_times {
  my $this = shift;
  my $arg1 = shift;
  my $arg2 = shift;

  if(ref $arg1 and ref $arg2) {
    script_die "Error: subtract_times args are different lengths!\n"
      unless @$arg1 == @$arg2;

    my @results;
    foreach my $i ( 0 .. (@$arg1 - 1) ) {
      my $diff = $this->subtract_times($arg1->[$i], $arg2->[$i]);
      push @results, $diff;
    }

    return @results;
  } elsif(not ref $arg1 and not ref $arg2) {
    my $bi1 = Math::BigInt->new($arg1);
    my $bi2 = Math::BigInt->new($arg2);
    my $diff = $bi1->bsub($bi2)->bstr();
    return $diff;
  } else {
    script_die "Error: subtract times needs two ref args or two scalar ".
      "args, not one of each!\n";
  }
}

###############################################################################

sub to_cycles {
  my $this = shift;
  my $arg = shift;

  if(ref $arg) {
    my @results;
    foreach my $elem (@$arg) {
      my $cycles = $this->to_cycles($elem);
      push @results, $cycles;
    }
    return @results;
  } else {
    my $period = $this->get_cycle_period();
    return $arg if $period == 1;
    my $num = Math::BigInt->new($arg);
    my $quotient = Math::BigInt->new('0');
    my $remainder = Math::BigInt->new('0');
    ($quotient, $remainder) = $num->bdiv($period);
    if ( $remainder > ($period - $remainder ) ) {
	$num->binc();
    }
    $num->bstr();
    return $num;
  }
}

###############################################################################
###############################################################################

package AnalyzeDiag::Logfile::Rtl;

use strict;
use warnings;

use IO::File;

use AnalyzeDiag::Output;

use base qw(AnalyzeDiag::Logfile);
use fields qw(cycle_period);

our $Freq_Regex_m1 = qr/Info:\s*Selected Core Clock Frequency\s(\d+)\s*MHz/;
our $Pll_Regex_m1 = qr/pll_clk frequency\s*=\s*(\d+)/;
our $Cmp_div_Regex_m1 = qr/cmp_clk divider\s*=\s*(\d+)/;
our $Cmp_clk_period_Regex_m1 = qr/cmp_clk period\s*=\s*(\d+)/;
our $Hex_Regex = qr/[\da-f]+/;

###############################################################################

sub new {
  my $this = shift;

  $this = fields::new($this);

  return $this;
}

###############################################################################

sub get_cycle_period {
  my $this = shift;
  return $this->{cycle_period} if defined $this->{cycle_period};

  my $fh = IO::File->new("<$this->{filename}") or
    script_die "Can't open '$this->{filename}': $!\n";

  # Used to be this was the only divider, so old versions of the model
  # didn't print it out.  Make it the default so we can handle old and
  # new.
  my $cmp_clk_divider = 2;
  my $pll_freq;

  while(<$fh>) {
    if(/$Cmp_clk_period_Regex_m1/) {
      # I found the period I'm looking for.  This trumps everything else.
      my $period_ps = $1;
      script_die "Found clock period of 0! in '$this->{filename}'!\n"
	unless $period_ps;
      $this->{cycle_period} = $period_ps;
      chat "Found cycle_period spelled out: $period_ps\n", 2;
      last;
    } elsif(/$Pll_Regex_m1/) {
      $pll_freq = $1;
      chat "Found PLL frequency: $pll_freq\n", 2;
    } elsif(/$Cmp_div_Regex_m1/) {
      $cmp_clk_divider = $1;
      chat "Found CMP clock divider: $cmp_clk_divider\n", 2;
    } elsif(/$Freq_Regex_m1/) {
      # Time's up.  Any timing-related messages that haven't shown up
      # by now aren't coming
      if(defined $pll_freq) {
	my $pll_period;
	# HACK!  These are periods hardcoded from cmp_clk.v.
	# Hopefully, we're using a version of hte model that has the
	# "cmp_period" defined, so we don't have to use this.
	my %pll_periods = (
			   2000 => 250,
			   2200 => 227,
			   2333 => 214,
			   2334 => 214, # from old sys_clk.v
			   2400 => 208,
			   2550 => 196,
			   2600 => 192,
			   2800 => 179,
			   default => 208,
			  );
	$pll_period = exists $pll_periods{$pll_freq} ?
	  $pll_periods{$pll_freq} : $pll_periods{default};
	my $period_ps = $pll_period * 2 * $cmp_clk_divider;
	$this->{cycle_period} = $period_ps;
	chat "Computed cycle_period from PLL ($pll_freq) and div ".
	  "($cmp_clk_divider): $period_ps\n", 2;
      } else {
	# Couldn't find anything but the frequency message.  Use that.
	my $freq = $1;
	my $period_ps = int(1 / $freq * 1000000);
	$this->{cycle_period} = $period_ps;
	chat "Guessed at cycle_period from frequency ($freq): $period_ps\n";
      }
      last;
    }
  }

  script_die "Could not find clock frequency in '$this->{filename}'\n"
    unless defined $this->{cycle_period};

  return $this->{cycle_period};
}

###############################################################################

sub search_file_for_pcs {
  my $this = shift;
  my $fh = shift;
  my $pchash = shift;
  my $shortpc = shift;

  my $last_inst;
  my $this_inst;

  my @work;


  while(<$fh>) {
    # Find time for PC, don't commit it yet since we don't know if it will
    # be restarted
    if(/^ \( (\d+) \) Info-perm \s* thread \( $Hex_Regex \) \s*
       pc \( 0* ($Hex_Regex)  \)/ox
      )
      {
	my ($time, $pc) = ($1, $2);
	next unless exists $shortpc->{$pc};

	my $long_pc = $shortpc->{$pc};
	if(exists $pchash->{$long_pc}) {
	  chat " Found pc=$pc, time=$time\n";
	  push @work, [$long_pc, $time];
	}
      }
    elsif(/^ \d+ \: pc-MATCH .* val \s* = \s* 0* ($Hex_Regex) \s* $/ox)
      {

	my $pc = $1;
	next unless exists $shortpc->{$pc};
	my $long_pc = $shortpc->{$pc};
	
	my $entry = shift @work;
	script_die "Parse error in log file: Bad pc $entry->[0] ".
	  "(expected $long_pc)!\n" unless $long_pc eq $entry->[0];

	if(not defined $last_inst or $last_inst ne 'retry') {
	  my $time = $entry->[1];
	  chat "PC=$long_pc, time=$time\n";
	  push @{$pchash->{$long_pc}}, $time;
	} else {
	  debug "Retry!\n";
	}
	
      }
    # Keep track of which instruction was the last one
    elsif(/^ \d+ \:sas\> \s+ \d+ \: \s+ \[swvp.*\] \s+
	  \<v\: $Hex_Regex \> \s+  \<p\: $Hex_Regex \> \s+ (\S+)/ox
	 )
      {
	$last_inst = $this_inst;
	$this_inst = $1;
      }
  }

}

###############################################################################
###############################################################################
###############################################################################

package AnalyzeDiag::Logfile::Mom;

use strict;
use warnings;

use AnalyzeDiag::Output;

use base qw(AnalyzeDiag::Logfile);
use fields qw();

###############################################################################

sub new {
  my $this = shift;

  $this = fields::new($this);

  return $this;
}

###############################################################################

sub get_cycle_period {
  my $this = shift;
  return 1;
}

###############################################################################

sub search_file_for_pcs {
  my $this = shift;
  my $fh = shift;
  my $pchash = shift;
  my $shortpc = shift;

  my $last_inst;
  my $this_inst;

  my @work;


  while(<$fh>) {

    if(/^ \@(\d+): \s+ \d+ \.pc \= ($Hex_Regex) \s+ \[ .* \s+ latency=\d+ \s+ 
       (\S+) /ox)
      {
	my ($time, $pc, $this_inst) = ($1, $2, $3);
	$pc =~ s/^0+//;

	next unless exists $shortpc->{$pc};
	my $long_pc = $shortpc->{$pc};
	chat "FOUND PC=$pc\n";
	chat "  Last inst = $last_inst\n" if defined $last_inst;
	if(not defined $last_inst or $last_inst ne 'retry') {
	  chat "PC=$long_pc, time=$time\n";
	  push @{$pchash->{$long_pc}}, $time;
	}

	$last_inst = $this_inst;

      }

  }

}

###############################################################################
###############################################################################
1;
