######################################################################
# Copyright (c) 2009-2015, Intel Corporation
# All rights reserved.
# Redistribution and use in source and binary forms, with or without 
# modification, are permitted provided that the following conditions are met:
#   * Redistributions of source code must retain the above copyright notice, 
#     this list of conditions and the following disclaimer.
#   * Redistributions in binary form must reproduce the above copyright notice, 
#     this list of conditions and the following disclaimer in the documentation 
#     and/or other materials provided with the distribution.
#   * Neither the name of Intel Corporation nor the names of its contributors 
#     may be used to endorse or promote products derived from this software 
#     without specific prior written permission.

# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE 
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 
# POSSIBILITY OF SUCH DAMAGE.
######################################################################


######################################################################
# Create Basic XML File from PerlDB
######################################################################

#  Establishing base version - use '-v' to change
$PerlDBEvents  = "../../UncoreRM/v0.10/skx_uc_events.v0.10p.pl";
$PerlDBDerived = "../../UncoreRM/v0.10/skx_uc_derived.v0.10p.pl";

&main;



#######################################################################
#  Some Helper Functions - 
#    Few used by this script, but good for changing event ordering
#######################################################################
#######################################################################
#   Some sorting functions for Arrays
#######################################################################
sub by_code
{
   my $acode = hex($a->{EvSel});
   my $bcode = hex($b->{EvSel});
   $acode <=> $bcode;
}

sub by_internal { $a->{internal} <=> $b->{internal}; }
sub by_name { $a->{name} cmp $b->{name}; }
sub by_box { $a->{box} cmp $b->{box}; }
sub by_cat { $a->{category} cmp $b->{category}; }


#######################################################################
#   Some sorting functions for Hashes (by value rather than name)
#######################################################################
sub by_evsel
{
   my (%hash) = @_;
   return hex($hash{$a}->{EvSel}) <=> hex($hash{$b}->{EvSel});
}
sub by_internal
{
   my (%hash) = @_;
   return hex($hash{$a}->{Internal}) <=> hex($hash{$b}->{Internal});
}

sub by_umask
{
   my (%hash) = @_;
   my $umask_a = $hash{$a}->{Umask};  $umask_a =~ s/x/0/g;  $umask_a =~ s/b//;
   my $umask_b = $hash{$b}->{Umask};  $umask_b =~ s/x/0/g;  $umask_b =~ s/b//;
   my $val_a   = &bin2dec($umask_a);  my $val_b = &bin2dec($umask_b);

   print "$a $umask_a - $val_a  vs. $b $umask_b - $val_b\n"
     if ($UMASK_SORT_DBG);
   return $val_a <=> $val_b; 

}

sub bin2dec 
{
   return unpack("N", pack("B32", substr("0" x 32 . shift, -32)));
}


######################################################################
# Turn Counter Range into list of Counters 
######################################################################
sub ctr_range_to_list
{
   my ($event) = @_;
   my ($lo,$hi,$ctr_str) = (0,0,"");
   if ($event->{Counters} =~ /(\d+)(\s*-\s*)?(\d+)?/)
   {
      ($lo,$hi) = (defined $3) ? ($1,$3) : ($1,$1);  
      for (my $i = $lo; $i <= $hi; $i++) { $ctr_str .= "$i,";  }
   }
   chop $ctr_str;  # Remove last ","
   return $ctr_str;
}




######################################################################
#  Simple XML helper functions
######################################################################
######################################################################
# Scrub string to be 'safe' for XML
######################################################################
sub scrub_str_for_XML
{
   my ($str) = @_;
   chomp $str;
   $str  =~ s/&/&amp;/g; $str =~ s/</&lt;/g; $str  =~ s/>/&gt;/g;
   $str =~ s/"/\\"/g; $str =~ s/\n/\\n/g;
   return $str;
}

##################################################################
# Tag a string 
#   <$tag>$str</$tag>
##################################################################
sub tag_str
{
   my ($col, $tag, $str) = @_;
   return " " x $col . "<$tag>$str<\/$tag>\n";
}

##################################################################
# Wrap a string of arbitrary content in an XML Tag 
# NOTE: $content must already be correctly spaced
#
#   <$xmltag>
#   $content
#   </$xmltag> 
##################################################################
sub wrap_in_xmltag
{
   my ($col, $xmltag, $content) = @_;
   my $sp = " " x $col; 
   my $str = sprintf "$sp<$xmltag>\n%s$sp<\/$xmltag>\n", 
             ($content =~ /\w/) ? "$content" : "";
   return $str;


}


######################################################################
# Create Records in an XML format 
#####################################################################
sub create_xml_recs
{
   my ($events_ref, $box, $fh)  = @_;
   my %events = %{ $events_ref };

   die "Couldn't find $box in the data structure\n" 
      if (!defined $events{$box});

   # Indent spaces for levels in hierarchy
   my ($box_sp, $evn_sp, $evf_sp, $subevn_sp, $subevf_sp) = 
      (" " x 3," " x 6," " x 9," " x 12," " x 15); 

   my %box_events = %{ $events{$box} };
   foreach my $evname (sort keys %box_events)
   {
      my $event = $box_events{$evname};
      my $ctr_str = &ctr_range_to_list($event);

      my $event_str = 
         &tag_str(9, "Event Name", $evname) .
         &tag_str(9, "Category", $event->{Category}) .
         &tag_str(9, "Event Select", sprintf("0x%02X", $event->{EvSel})) .
         &tag_str(9, "Counters", $ctr_str) .
         &tag_str(9, "Extra EvSel", ($event->{Internal}) ? "Y" : "N") .
         &tag_str(9, "MaxIncCyc", $event->{MaxIncCyc}) .
         &tag_str(9, "Filter", $event->{Filter}) .
         &tag_str(9, "Description", &scrub_str_for_XML($event->{Desc})) .
         &tag_str(9, "Definition", &scrub_str_for_XML($event->{Defn})); 
     
      if ((defined $event->{Subevents}) || (keys %{$event->{Subevents} }))  
      {
         foreach my $subevname (sort keys %{ $event->{Subevents} })
         {
            next if ($subevname =~ /NONE|UNDEF|ILLEGAL/);
            my $subev = $event->{Subevents}->{$subevname};

          # If would rather flatten records, attach event's desc to subevent 
#            my $subdesc = $desc . " -- " . &scrub_str_for_XML($subev->{Desc});
#            my $name =  $evname ."." . $subevname;
# NOTE: Can expand these into list of possible subevent combinations by 
#       replacing 'x's following umask with highest position bit.  

            # Converts bit mask for listed subevent to simple value.
            # NOTE: this would ignore any other possible combinations!
#            $umask =~ s/b//g;  $umask =~ s/x/0/g;
#            my $umask_val = &bin2dec($umask);

            my $xtra_field =""; 
            if ($box =~ /IIO/)
            {
               $xtra_field = &tag_str(12, "FCMask", $subev->{FCMask}) 
                    if ($subev->{FCMask});  
               $xtra_field .= &tag_str(12, "PortMask", $subev->{PortMask})
                    if ($subev->{PortMask});  
            } 
            elsif ($box =~ /KTI/)
            {
               $xtra_field = &tag_str(12, "UmaskExt", $subev->{UmaskExt})
                    if ($subev->{UmaskExt});  
            }


            my $subev_str = 
               &tag_str(12, "Name", $subevname) .
               &tag_str(12, "Umask", $subev->{Umask}) .
               $xtra_field . 
               &tag_str(12, "Filter", $subev->{Filter}) .
               &tag_str(12, "Description",&scrub_str_for_XML($subev->{Desc})) . 
               &tag_str(12, "Definition", &scrub_str_for_XML($subev->{Defn})); 
            $event_str .= &wrap_in_xmltag(9, "SUBEVENT", $subev_str);
         }
      }
      print $fh &wrap_in_xmltag(6, "EVENT", $event_str);
   }
}



######################################################################
######################################################################
sub print_per_box_xml
{
   my ($chip, $evlist_ref) = @_;

   # Indent spaces for levels in hierarchy
   foreach my $boxevents (sort keys %{ $evlist_ref })
   {
      my $box = $boxevents; $box =~ s/\s+Box Events\s*//; 
      my $boxname = $box; $boxname =~ s/\s/_/g;

      open(BOXXML, ">$boxname.xml") || 
         die "Couldn't open $boxname.mif for Writing\n";

      print BOXXML &xml_hdr($chip);
      printf BOXXML ("   <BoxName=\"%s\">\n", $box);
      &create_xml_recs($evlist_ref, $boxevents, \*BOXXML);
      printf BOXXML ("   </BoxName>\n");

      print BOXXML &xml_tail();
      close(BOXXML);
   }
}



######################################################################
######################################################################
sub print_merged_xml
{
   my ($chip, $evlist_ref) = @_;

   open(CHIPXML, ">$chip.xml") || die "Couldn't open $chip.mif for Writing\n";
   print CHIPXML &xml_hdr($chip);

   # Indent spaces for levels in hierarchy
   foreach my $boxevents (sort keys %{ $evlist_ref })
   {
      my $box = $boxevents; $box =~ s/\s+Box Events\s*//; 
      printf CHIPXML ("   <BoxName=\"%s\">\n", $box);
      &create_xml_recs($evlist_ref, $boxevents, \*CHIPXML);
      printf CHIPXML ("   </BoxName>\n");
   }
   print CHIPXML &xml_tail();
   close(CHIPXML);
}



######################################################################
######################################################################
sub xml_hdr
{
   my ($chip) = @_;
return <<EOH;
<?xml version="1.0" encoding="utf-8"?>
<Events ProcessorName="$chip" >
EOH
}

######################################################################
######################################################################
sub xml_tail
{
   return "</Events>\n";
}


#######################################################################
#######################################################################
sub help
{
print <<EOH;
Input flags to script:
   -h - Help - This
   -v - For easily switching versions of PerlDB Files 
        Changes 'v0.x' in path string to PerlDB Files 
   -c - Chip to generate doc for 
        Currently recognizes 'skx' 
EOH
}


#######################################################################
# Command Line Arguments:
#  -h - Help - This
#  -v - For easily switching versions of PerlDB Files 
#       Changes 'v0.x' in path string to PerlDB Files 
#  -c - Chip to generate doc for 
#       Currently recognizes 'skx' 
#######################################################################
sub main
{
   my ($gen_box_files) = (0);
   my $chip    = "SKX";  
   my $version = "0.10";

   while (my $arg = shift @ARGV)
   {
      if ($arg eq "-h") { &help; exit; }
      $gen_box_files  = 1 if ($arg eq "-b");
      if ($arg eq "-c") 
      { 
         $chiplc = shift @ARGV; 
         $chip   = uc($chiplc);
	 $PerlDBEvents  =~ s/skx/$chiplc/g;
	 $PerlDBDerived =~ s/skx/$chiplc/g;
      }
      if ($arg eq "-v")
      {
         $version = shift @ARGV;
	 $PerlDBEvents  =~ s/v0\.10/v$version/g;
	 $PerlDBDerived =~ s/v0\.10/v$version/g;
      } 
   }

print STDERR "Ready to read from $PerlDBEvents for CHIP $chip\n";

   require $PerlDBEvents || die "Couldn't find $PerlDBEvents";


   my $evlist_ref = (); my $derlist_ref = ();
   $evlist_ref   = \%SKX_UCEventList   if ($chip eq "SKX");

   if ($gen_derived)
   {
      require $PerlDBDerived || die "Couldn't find $PerlDBDerived";
      $derlist_ref = \%SKX_UCDerivedList if ($chip eq "SKX");
   }



   ($gen_box_files) ? 
      &print_per_box_xml($chip, $evlist_ref):
      &print_merged_xml($chip, $evlist_ref);

}


