Home | History | Annotate | Download | only in perl 
      1 # perf script event handlers, generated by perf script -g perl
      2 # (c) 2009, Tom Zanussi <tzanussi (at] 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 }
    107