diff options
Diffstat (limited to 'kcachegrind/converters/dprof2calltree')
| -rw-r--r-- | kcachegrind/converters/dprof2calltree | 199 |
1 files changed, 199 insertions, 0 deletions
diff --git a/kcachegrind/converters/dprof2calltree b/kcachegrind/converters/dprof2calltree new file mode 100644 index 00000000..940457c8 --- /dev/null +++ b/kcachegrind/converters/dprof2calltree @@ -0,0 +1,199 @@ +#!/usr/bin/perl +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions are met: +# +# - Redistributions of source code must retain the above copyright notice, +# this list of conditions and the following disclaimer. +# +# - Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# - All advertising materials mentioning features or use of this software +# must display the following acknowledgement: This product includes software +# developed by OmniTI Computer Consulting. +# +# - Neither name of the company nor the names of its contributors may be +# used to endorse or promote products derived from this software without +# specific prior written permission. +# +# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS `AS IS'' AND ANY +# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +# DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY +# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +# +# Copyright (c) 2004 OmniTI Computer Consulting +# All rights reserved +# The following code was written by George Schlossnagle <george@omniti.com> +# and is provided completely free and without any warranty. +# + +# +# This script is designed to convert the tmon.out output emitted +# from Perl's Devel::DProf profiling package. To use this: +# +# 1) Run your perl script as +# > perl -d:DProf yoursript.pl +# This will create a file called tmon.out. If you want to +# inspect it on the command line, look at the man page +# for dprofp for details. +# +# 2) Run +# > dprof2calltree -f tmon.out +# or +# > dprof2calltree -f tmon.out -o cachegrind.out.foo +# +# This creates a cachegrind-style file called cachgrind.out.tmon.out or +# cachegrind.out.foo, respecitvely. +# +# 3) Run kcachegrind cachegrind.out.foo +# +# 4) Enjoy! + +use strict; +use Config; +use Getopt::Std; +use IO::File; + +my @callstack; +my %function_info; +my $tree = {}; +my $total_cost = 0; +my %opts; + +getopt('f:o:', \%opts); + +my $infd; +usage() unless ($opts{'f'} && ($infd = IO::File->new($opts{'f'}, "r"))); + +my $outfd; +my $outfile = $opts{'o'}; +unless($outfile) { + $opts{'f'} =~ m!([^/]+)$!; + $outfile = "cachegrind.out.$1"; +} +$outfd = new IO::File $outfile, "w"; +usage() unless defined $outfd; + +while(<$infd>) { + last if /^PART2/; +} +while(<$infd>) { + chomp; + my @args = split; + if($args[0] eq '@') { + # record timing event + my $call_element = pop @callstack; + if($call_element) { + $call_element->{'cost'} += $args[3]; + $call_element->{'cumm_cost'} += $args[3]; + $total_cost += $args[3]; + push @callstack, $call_element; + } + } + elsif($args[0] eq '&') { + # declare function + $function_info{$args[1]}->{'package'} = $args[2]; + if($args[2] ne 'main') { + $function_info{$args[1]}->{'name'} = $args[2]."::".$args[3]; + } else { + $function_info{$args[1]}->{'name'} = $args[3]; + } + } + elsif($args[0] eq '+') { + # push myself onto the stack + my $call_element = { 'specifier' => $args[1], 'cost' => 0 }; + push @callstack, $call_element; + } + elsif($args[0] eq '-') { + my $called = pop @callstack; + my $called_id = $called->{'specifier'}; + my $caller = pop @callstack; + if (exists $tree->{$called_id}) { + $tree->{$called_id}->{'cost'} += $called->{'cost'}; + } + else { + $tree->{$called_id} = $called; + } + if($caller) { + $caller->{'child_calls'}++; + my $caller_id = $caller->{'specifier'}; + if(! exists $tree->{$caller_id} ) { + $tree->{$caller_id} = { 'specifier' => $caller_id, 'cost' => 0 }; +# $tree->{$caller_id} = $caller; + } + $caller->{'cumm_cost'} += $called->{'cumm_cost'}; + $tree->{$caller_id}->{'called_funcs'}->[$tree->{$caller_id}->{'call_counter'}++]->{$called_id} += $called->{'cumm_cost'}; + push @callstack, $caller; + } + } + elsif($args[0] eq '*') { + # goto &func + # replace last caller with self + my $call_element = pop @callstack; + $call_element->{'specifier'} = $args[1]; + push @callstack, $call_element; + } + else {print STDERR "Unexpected line: $_\n";} +} + +# +# Generate output +# +my $output = ''; +$output .= "events: Tick\n"; +$output .= "summary: $total_cost\n"; +$output .= "cmd: your script\n\n"; +foreach my $specifier ( keys %$tree ) { + my $caller_package = $function_info{$specifier}->{'package'} || '???'; + my $caller_name = $function_info{$specifier}->{'name'} || '???'; + my $include = find_include($caller_package); + $output .= "ob=\n"; + $output .= sprintf "fl=%s\n", find_include($caller_package); + $output .= sprintf "fn=%s\n", $caller_name; + $output .= sprintf "1 %d\n", $tree->{$specifier}->{'cost'}; + if(exists $tree->{$specifier}->{'called_funcs'}) { + foreach my $items (@{$tree->{$specifier}->{'called_funcs'}}) { + while(my ($child_specifier, $costs) = each %$items) { + $output .= sprintf "cfn=%s\n", $function_info{$child_specifier}->{'name'}; + $output .= sprintf "cfi=%s\n", find_include($function_info{$child_specifier}->{'package'}); + $output .= "calls=1\n"; + $output .= sprintf "1 %d\n", $costs; + } + } + } + $output .= "\n"; +} +print STDERR "Writing kcachegrind output to $outfile\n"; +$outfd->print($output); + + + +sub find_include { + my $module = shift; + $module =~ s!::!/!g; + for (@INC) { + if ( -f "$_/$module.pm" ) { + return "$_/$module.pm"; + } + if ( -f "$_/$module.so" ) { + return "$_/$module.so"; + } + } + return "???"; +} + +sub usage() { + print STDERR "dprof2calltree -f <tmon.out> [-o outfile]\n"; + exit -1; +} + + +# vim: set sts=2 ts=2 bs ai expandtab : |