diff options
Diffstat (limited to 'kcachegrind/converters/dprof2calltree')
-rw-r--r-- | kcachegrind/converters/dprof2calltree | 199 |
1 files changed, 0 insertions, 199 deletions
diff --git a/kcachegrind/converters/dprof2calltree b/kcachegrind/converters/dprof2calltree deleted file mode 100644 index f276e188..00000000 --- a/kcachegrind/converters/dprof2calltree +++ /dev/null @@ -1,199 +0,0 @@ -#!/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 tdecachegrind 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 tdecachegrind 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 : |