utils/profiling/addtailcalls.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 my @stack = ();
   7
   8 sub firstfield {
   9   my $arg = shift;
  10   if (!defined($arg)) { return undef; }
  11   $arg =~ /([^\t]*)/;
  12   return $1;
  13 }
  14
  15 while (<STDIN> =~ /(\w)\t([^\t]*)\t(.*)/) {
  16   my ($action, $called, $rest) = ($1, $2, $3);
  17   if ($action eq "e") {
  18     push(@stack, "$called\t$rest");
  19     print "e\t$called\t$rest\n";
  20   }
  21   elsif ($action eq "x") {
  22     my $parent = pop(@stack);
  23     if (defined $parent) {
  24       my $parentcalled = firstfield($parent);
  25       while (defined $parent and $parentcalled ne $called) {
  26         print "x\t$parentcalled\t$rest\n";
  27         $parent = pop(@stack);
  28         $parentcalled = firstfield($parent);
  29       }
  30     }
  31     print "x\t$called\t$rest\n";
  32   }
  33 }