kernel/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm

   1 package Perf::Trace::Core;
   2
   3 use 5.010000;
   4 use strict;
   5 use warnings;
   6
   7 require Exporter;
   8
   9 our @ISA = qw(Exporter);
  10
  11 our %EXPORT_TAGS = ( 'all' => [ qw(
  12 ) ] );
  13
  14 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
  15
  16 our @EXPORT = qw(
  17 define_flag_field define_flag_value flag_str dump_flag_fields
  18 define_symbolic_field define_symbolic_value symbol_str dump_symbolic_fields
  19 trace_flag_str
  20 );
  21
  22 our $VERSION = '0.01';
  23
  24 my %trace_flags = (0x00 => "NONE",
  25                    0x01 => "IRQS_OFF",
  26                    0x02 => "IRQS_NOSUPPORT",
  27                    0x04 => "NEED_RESCHED",
  28                    0x08 => "HARDIRQ",
  29                    0x10 => "SOFTIRQ");
  30
  31 sub trace_flag_str
  32 {
  33     my ($value) = @_;
  34
  35     my $string;
  36
  37     my $print_delim = 0;
  38
  39     foreach my $idx (sort {$a <=> $b} keys %trace_flags) {
  40         if (!$value && !$idx) {
  41             $string .= "NONE";
  42             last;
  43         }
  44
  45         if ($idx && ($value & $idx) == $idx) {
  46             if ($print_delim) {
  47                 $string .= " | ";
  48             }
  49             $string .= "$trace_flags{$idx}";
  50             $print_delim = 1;
  51             $value &= ~$idx;
  52         }
  53     }
  54
  55     return $string;
  56 }
  57
  58 my %flag_fields;
  59 my %symbolic_fields;
  60
  61 sub flag_str
  62 {
  63     my ($event_name, $field_name, $value) = @_;
  64
  65     my $string;
  66
  67     if ($flag_fields{$event_name}{$field_name}) {
  68         my $print_delim = 0;
  69         foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event_name}{$field_name}{"values"}}) {
  70             if (!$value && !$idx) {
  71                 $string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";
  72                 last;
  73             }
  74             if ($idx && ($value & $idx) == $idx) {
  75                 if ($print_delim && $flag_fields{$event_name}{$field_name}{'delim'}) {
  76                     $string .= " $flag_fields{$event_name}{$field_name}{'delim'} ";
  77                 }
  78                 $string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";
  79                 $print_delim = 1;
  80                 $value &= ~$idx;
  81             }
  82         }
  83     }
  84
  85     return $string;
  86 }
  87
  88 sub define_flag_field
  89 {
  90     my ($event_name, $field_name, $delim) = @_;
  91
  92     $flag_fields{$event_name}{$field_name}{"delim"} = $delim;
  93 }
  94
  95 sub define_flag_value
  96 {
  97     my ($event_name, $field_name, $value, $field_str) = @_;
  98
  99     $flag_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;
 100 }
 101
 102 sub dump_flag_fields
 103 {
 104     for my $event (keys %flag_fields) {
 105         print "event $event:\n";
 106         for my $field (keys %{$flag_fields{$event}}) {
 107             print "    field: $field:\n";
 108             print "        delim: $flag_fields{$event}{$field}{'delim'}\n";
 109             foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event}{$field}{"values"}}) {
 110                 print "        value $idx: $flag_fields{$event}{$field}{'values'}{$idx}\n";
 111             }
 112         }
 113     }
 114 }
 115
 116 sub symbol_str
 117 {
 118     my ($event_name, $field_name, $value) = @_;
 119
 120     if ($symbolic_fields{$event_name}{$field_name}) {
 121         foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event_name}{$field_name}{"values"}}) {
 122             if (!$value && !$idx) {
 123                 return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";
 124                 last;
 125             }
 126             if ($value == $idx) {
 127                 return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";
 128             }
 129         }
 130     }
 131
 132     return undef;
 133 }
 134
 135 sub define_symbolic_field
 136 {
 137     my ($event_name, $field_name) = @_;
 138
 139     # nothing to do, really
 140 }
 141
 142 sub define_symbolic_value
 143 {
 144     my ($event_name, $field_name, $value, $field_str) = @_;
 145
 146     $symbolic_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;
 147 }
 148
 149 sub dump_symbolic_fields
 150 {
 151     for my $event (keys %symbolic_fields) {
 152         print "event $event:\n";
 153         for my $field (keys %{$symbolic_fields{$event}}) {
 154             print "    field: $field:\n";
 155             foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event}{$field}{"values"}}) {
 156                 print "        value $idx: $symbolic_fields{$event}{$field}{'values'}{$idx}\n";
 157             }
 158         }
 159     }
 160 }
 161
 162 1;
 163 __END__
 164 =head1 NAME
 165
 166 Perf::Trace::Core - Perl extension for perf script
 167
 168 =head1 SYNOPSIS
 169
 170   use Perf::Trace::Core
 171
 172 =head1 SEE ALSO
 173
 174 Perf (script) documentation
 175
 176 =head1 AUTHOR
 177
 178 Tom Zanussi, E<lt>tzanussi@gmail.com<gt>
 179
 180 =head1 COPYRIGHT AND LICENSE
 181
 182 Copyright (C) 2009 by Tom Zanussi
 183
 184 This library is free software; you can redistribute it and/or modify
 185 it under the same terms as Perl itself, either Perl version 5.10.0 or,
 186 at your option, any later version of Perl 5 you may have available.
 187
 188 Alternatively, this software may be distributed under the terms of the
 189 GNU General Public License ("GPL") version 2 as published by the Free
 190 Software Foundation.
 191
 192 =cut