package Perf::Trace::Core;
|
|
use 5.010000;
|
use strict;
|
use warnings;
|
|
require Exporter;
|
|
our @ISA = qw(Exporter);
|
|
our %EXPORT_TAGS = ( 'all' => [ qw(
|
) ] );
|
|
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
|
our @EXPORT = qw(
|
define_flag_field define_flag_value flag_str dump_flag_fields
|
define_symbolic_field define_symbolic_value symbol_str dump_symbolic_fields
|
trace_flag_str
|
);
|
|
our $VERSION = '0.01';
|
|
my %trace_flags = (0x00 => "NONE",
|
0x01 => "IRQS_OFF",
|
0x02 => "IRQS_NOSUPPORT",
|
0x04 => "NEED_RESCHED",
|
0x08 => "HARDIRQ",
|
0x10 => "SOFTIRQ");
|
|
sub trace_flag_str
|
{
|
my ($value) = @_;
|
|
my $string;
|
|
my $print_delim = 0;
|
|
foreach my $idx (sort {$a <=> $b} keys %trace_flags) {
|
if (!$value && !$idx) {
|
$string .= "NONE";
|
last;
|
}
|
|
if ($idx && ($value & $idx) == $idx) {
|
if ($print_delim) {
|
$string .= " | ";
|
}
|
$string .= "$trace_flags{$idx}";
|
$print_delim = 1;
|
$value &= ~$idx;
|
}
|
}
|
|
return $string;
|
}
|
|
my %flag_fields;
|
my %symbolic_fields;
|
|
sub flag_str
|
{
|
my ($event_name, $field_name, $value) = @_;
|
|
my $string;
|
|
if ($flag_fields{$event_name}{$field_name}) {
|
my $print_delim = 0;
|
foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event_name}{$field_name}{"values"}}) {
|
if (!$value && !$idx) {
|
$string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";
|
last;
|
}
|
if ($idx && ($value & $idx) == $idx) {
|
if ($print_delim && $flag_fields{$event_name}{$field_name}{'delim'}) {
|
$string .= " $flag_fields{$event_name}{$field_name}{'delim'} ";
|
}
|
$string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";
|
$print_delim = 1;
|
$value &= ~$idx;
|
}
|
}
|
}
|
|
return $string;
|
}
|
|
sub define_flag_field
|
{
|
my ($event_name, $field_name, $delim) = @_;
|
|
$flag_fields{$event_name}{$field_name}{"delim"} = $delim;
|
}
|
|
sub define_flag_value
|
{
|
my ($event_name, $field_name, $value, $field_str) = @_;
|
|
$flag_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;
|
}
|
|
sub dump_flag_fields
|
{
|
for my $event (keys %flag_fields) {
|
print "event $event:\n";
|
for my $field (keys %{$flag_fields{$event}}) {
|
print " field: $field:\n";
|
print " delim: $flag_fields{$event}{$field}{'delim'}\n";
|
foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event}{$field}{"values"}}) {
|
print " value $idx: $flag_fields{$event}{$field}{'values'}{$idx}\n";
|
}
|
}
|
}
|
}
|
|
sub symbol_str
|
{
|
my ($event_name, $field_name, $value) = @_;
|
|
if ($symbolic_fields{$event_name}{$field_name}) {
|
foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event_name}{$field_name}{"values"}}) {
|
if (!$value && !$idx) {
|
return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";
|
last;
|
}
|
if ($value == $idx) {
|
return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";
|
}
|
}
|
}
|
|
return undef;
|
}
|
|
sub define_symbolic_field
|
{
|
my ($event_name, $field_name) = @_;
|
|
# nothing to do, really
|
}
|
|
sub define_symbolic_value
|
{
|
my ($event_name, $field_name, $value, $field_str) = @_;
|
|
$symbolic_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;
|
}
|
|
sub dump_symbolic_fields
|
{
|
for my $event (keys %symbolic_fields) {
|
print "event $event:\n";
|
for my $field (keys %{$symbolic_fields{$event}}) {
|
print " field: $field:\n";
|
foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event}{$field}{"values"}}) {
|
print " value $idx: $symbolic_fields{$event}{$field}{'values'}{$idx}\n";
|
}
|
}
|
}
|
}
|
|
1;
|
__END__
|
=head1 NAME
|
|
Perf::Trace::Core - Perl extension for perf script
|
|
=head1 SYNOPSIS
|
|
use Perf::Trace::Core
|
|
=head1 SEE ALSO
|
|
Perf (script) documentation
|
|
=head1 AUTHOR
|
|
Tom Zanussi, E<lt>tzanussi@gmail.com<gt>
|
|
=head1 COPYRIGHT AND LICENSE
|
|
Copyright (C) 2009 by Tom Zanussi
|
|
This library is free software; you can redistribute it and/or modify
|
it under the same terms as Perl itself, either Perl version 5.10.0 or,
|
at your option, any later version of Perl 5 you may have available.
|
|
Alternatively, this software may be distributed under the terms of the
|
GNU General Public License ("GPL") version 2 as published by the Free
|
Software Foundation.
|
|
=cut
|
