check-perf-trace.pl 2.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107
  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. # This script tests basic functionality such as flag and symbol
  5. # strings, common_xxx() calls back into perf, begin, end, unhandled
  6. # events, etc. Basically, if this script runs successfully and
  7. # displays expected results, perl scripting support should be ok.
  8. use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
  9. use lib "./Perf-Trace-Util/lib";
  10. use Perf::Trace::Core;
  11. use Perf::Trace::Context;
  12. use Perf::Trace::Util;
  13. sub trace_begin
  14. {
  15. print "trace_begin\n";
  16. }
  17. sub trace_end
  18. {
  19. print "trace_end\n";
  20. print_unhandled();
  21. }
  22. sub irq::softirq_entry
  23. {
  24. my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
  25. $common_pid, $common_comm,
  26. $vec) = @_;
  27. print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
  28. $common_pid, $common_comm);
  29. print_uncommon($context);
  30. printf("vec=%s\n",
  31. symbol_str("irq::softirq_entry", "vec", $vec));
  32. }
  33. sub kmem::kmalloc
  34. {
  35. my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
  36. $common_pid, $common_comm,
  37. $call_site, $ptr, $bytes_req, $bytes_alloc,
  38. $gfp_flags) = @_;
  39. print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
  40. $common_pid, $common_comm);
  41. print_uncommon($context);
  42. printf("call_site=%p, ptr=%p, bytes_req=%u, bytes_alloc=%u, ".
  43. "gfp_flags=%s\n",
  44. $call_site, $ptr, $bytes_req, $bytes_alloc,
  45. flag_str("kmem::kmalloc", "gfp_flags", $gfp_flags));
  46. }
  47. # print trace fields not included in handler args
  48. sub print_uncommon
  49. {
  50. my ($context) = @_;
  51. printf("common_preempt_count=%d, common_flags=%s, common_lock_depth=%d, ",
  52. common_pc($context), trace_flag_str(common_flags($context)),
  53. common_lock_depth($context));
  54. }
  55. my %unhandled;
  56. sub print_unhandled
  57. {
  58. if ((scalar keys %unhandled) == 0) {
  59. return;
  60. }
  61. print "\nunhandled events:\n\n";
  62. printf("%-40s %10s\n", "event", "count");
  63. printf("%-40s %10s\n", "----------------------------------------",
  64. "-----------");
  65. foreach my $event_name (keys %unhandled) {
  66. printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
  67. }
  68. }
  69. sub trace_unhandled
  70. {
  71. my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
  72. $common_pid, $common_comm) = @_;
  73. $unhandled{$event_name}++;
  74. }
  75. sub print_header
  76. {
  77. my ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;
  78. printf("%-20s %5u %05u.%09u %8u %-20s ",
  79. $event_name, $cpu, $secs, $nsecs, $pid, $comm);
  80. }