scripts/perl/check-perf-trace.pl

0001 # perf script event handlers, generated by perf script -g perl
0002 # (c) 2009, Tom Zanussi <tzanussi@gmail.com>
0003 # Licensed under the terms of the GNU GPL License version 2
0004
0005 # This script tests basic functionality such as flag and symbol
0006 # strings, common_xxx() calls back into perf, begin, end, unhandled
0007 # events, etc.  Basically, if this script runs successfully and
0008 # displays expected results, perl scripting support should be ok.
0009
0010 use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
0011 use lib "./Perf-Trace-Util/lib";
0012 use Perf::Trace::Core;
0013 use Perf::Trace::Context;
0014 use Perf::Trace::Util;
0015
0016 sub trace_begin
0017 {
0018     print "trace_begin\n";
0019 }
0020
0021 sub trace_end
0022 {
0023     print "trace_end\n";
0024
0025     print_unhandled();
0026 }
0027
0028 sub irq::softirq_entry
0029 {
0030     my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
0031         $common_pid, $common_comm, $common_callchain,
0032         $vec) = @_;
0033
0034     print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
0035              $common_pid, $common_comm);
0036
0037     print_uncommon($context);
0038
0039     printf("vec=%s\n",
0040            symbol_str("irq::softirq_entry", "vec", $vec));
0041 }
0042
0043 sub kmem::kmalloc
0044 {
0045     my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
0046         $common_pid, $common_comm, $common_callchain,
0047         $call_site, $ptr, $bytes_req, $bytes_alloc,
0048         $gfp_flags) = @_;
0049
0050     print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
0051              $common_pid, $common_comm);
0052
0053     print_uncommon($context);
0054
0055     printf("call_site=%p, ptr=%p, bytes_req=%u, bytes_alloc=%u, ".
0056            "gfp_flags=%s\n",
0057            $call_site, $ptr, $bytes_req, $bytes_alloc,
0058
0059            flag_str("kmem::kmalloc", "gfp_flags", $gfp_flags));
0060 }
0061
0062 # print trace fields not included in handler args
0063 sub print_uncommon
0064 {
0065     my ($context) = @_;
0066
0067     printf("common_preempt_count=%d, common_flags=%s, common_lock_depth=%d, ",
0068        common_pc($context), trace_flag_str(common_flags($context)),
0069        common_lock_depth($context));
0070
0071 }
0072
0073 my %unhandled;
0074
0075 sub print_unhandled
0076 {
0077     if ((scalar keys %unhandled) == 0) {
0078     return;
0079     }
0080
0081     print "\nunhandled events:\n\n";
0082
0083     printf("%-40s  %10s\n", "event", "count");
0084     printf("%-40s  %10s\n", "----------------------------------------",
0085        "-----------");
0086
0087     foreach my $event_name (keys %unhandled) {
0088     printf("%-40s  %10d\n", $event_name, $unhandled{$event_name});
0089     }
0090 }
0091
0092 sub trace_unhandled
0093 {
0094     my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
0095     $common_pid, $common_comm, $common_callchain) = @_;
0096
0097     $unhandled{$event_name}++;
0098 }
0099
0100 sub print_header
0101 {
0102     my ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;
0103
0104     printf("%-20s %5u %05u.%09u %8u %-20s ",
0105            $event_name, $cpu, $secs, $nsecs, $pid, $comm);
0106 }