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,
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,
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) = @_;
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}
107