tools/perf/scripts/perl/check-perf-trace.pl

   1 # perf script event handlers, generated by perf script -g perl
   2 # (c) 2009, Tom Zanussi <tzanussi@gmail.com>
   3 # Licensed under the terms of the GNU GPL License version 2
   4
   5 # This script tests basic functionality such as flag and symbol
   6 # strings, common_xxx() calls back into perf, begin, end, unhandled
   7 # events, etc.  Basically, if this script runs successfully and
   8 # displays expected results, perl scripting support should be ok.
   9
  10 use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
  11 use lib "./Perf-Trace-Util/lib";
  12 use Perf::Trace::Core;
  13 use Perf::Trace::Context;
  14 use Perf::Trace::Util;
  15
  16 sub trace_begin
  17 {
  18     print "trace_begin\n";
  19 }
  20
  21 sub trace_end
  22 {
  23     print "trace_end\n";
  24
  25     print_unhandled();
  26 }
  27
  28 sub irq::softirq_entry
  29 {
  30         my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
  31             $common_pid, $common_comm,
  32             $vec) = @_;
  33
  34         print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
  35                      $common_pid, $common_comm);
  36
  37         print_uncommon($context);
  38
  39         printf("vec=%s\n",
  40                symbol_str("irq::softirq_entry", "vec", $vec));
  41 }
  42
  43 sub kmem::kmalloc
  44 {
  45         my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
  46             $common_pid, $common_comm,
  47             $call_site, $ptr, $bytes_req, $bytes_alloc,
  48             $gfp_flags) = @_;
  49
  50         print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
  51                      $common_pid, $common_comm);
  52
  53         print_uncommon($context);
  54
  55         printf("call_site=%p, ptr=%p, bytes_req=%u, bytes_alloc=%u, ".
  56                "gfp_flags=%s\n",
  57                $call_site, $ptr, $bytes_req, $bytes_alloc,
  58
  59                flag_str("kmem::kmalloc", "gfp_flags", $gfp_flags));
  60 }
  61
  62 # print trace fields not included in handler args
  63 sub print_uncommon
  64 {
  65     my ($context) = @_;
  66
  67     printf("common_preempt_count=%d, common_flags=%s, common_lock_depth=%d, ",
  68            common_pc($context), trace_flag_str(common_flags($context)),
  69            common_lock_depth($context));
  70
  71 }
  72
  73 my %unhandled;
  74
  75 sub print_unhandled
  76 {
  77     if ((scalar keys %unhandled) == 0) {
  78         return;
  79     }
  80
  81     print "\nunhandled events:\n\n";
  82
  83     printf("%-40s  %10s\n", "event", "count");
  84     printf("%-40s  %10s\n", "----------------------------------------",
  85            "-----------");
  86
  87     foreach my $event_name (keys %unhandled) {
  88         printf("%-40s  %10d\n", $event_name, $unhandled{$event_name});
  89     }
  90 }
  91
  92 sub trace_unhandled
  93 {
  94     my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
  95         $common_pid, $common_comm) = @_;
  96
  97     $unhandled{$event_name}++;
  98 }
  99
 100 sub print_header
 101 {
 102         my ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;
 103
 104         printf("%-20s %5u %05u.%09u %8u %-20s ",
 105                $event_name, $cpu, $secs, $nsecs, $pid, $comm);
 106 }