check-perf-trace.pl (2683B)
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 10use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib"; 11use lib "./Perf-Trace-Util/lib"; 12use Perf::Trace::Core; 13use Perf::Trace::Context; 14use Perf::Trace::Util; 15 16sub trace_begin 17{ 18 print "trace_begin\n"; 19} 20 21sub trace_end 22{ 23 print "trace_end\n"; 24 25 print_unhandled(); 26} 27 28sub irq::softirq_entry 29{ 30 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, 31 $common_pid, $common_comm, $common_callchain, 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 43sub kmem::kmalloc 44{ 45 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, 46 $common_pid, $common_comm, $common_callchain, 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 63sub 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 73my %unhandled; 74 75sub 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 92sub trace_unhandled 93{ 94 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, 95 $common_pid, $common_comm, $common_callchain) = @_; 96 97 $unhandled{$event_name}++; 98} 99 100sub 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}