DXR is a code search and navigation tool aimed at making sense of large projects. It supports full-text and regex searches as well as structural queries.

Mercurial (b6057e17f856)

VCS Links

Line Code
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181
#!/usr/local/bin/perl -w
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at http://mozilla.org/MPL/2.0/.


# Perl script to analyze the xpcom output file
#
# To create xpcom output file :
#
# setenv NSPR_LOG_MODULES nsComponentManager:5
# setenv NSPR_LOG_FILE xpcom.out
# ./mozilla
#
# Also to try to convert CID -> contractID this program looks for
# a file reg.out in the current directory. To generate this file
#
# $ regExport > reg.out
#
# Usage: analyze-xpcom-log.pl < xpcom.out
# [does better if ./reg.out is available]
#
# Suresh Duddi <dpsuresh@netscape.net>


use strict;

# forward declarations
sub getContractID($);
sub sum($);

# Configuration parameters
# Print all ?
my $all = 0;

# hash of cid -> contractid
my %contractid;
my %contractid_n;
my %failedContractid_n;

# count of instances of objects created
my (%objs, %objs_contractid, %failedObjs) = ();

# dlls loaded
my @dlls;

# temporaries
my ($cid, $n, $str);

while (<>) {
    chomp;

    # dlls loaded
    if (/loading \"(.*)\"/) {
        push @dlls, $1;
        next;
    }

    # FAILED ContractIDToClassID
    if (/ContractIDToClassID\((.*)\).*\[FAILED\]/) {
        $failedContractid_n{$1}++;
        next;
    }

    # ContractIDToClassID
    if (/ContractIDToClassID\((.*)\).*\{(.*)\}/) {
        $contractid{$2} = $1;
        $contractid_n{$2}++;
        next;
    }

    # CreateInstance()
    if (/CreateInstance\(\{(.*)\}\) succeeded/) {
        $objs{$1}++;
        next;
    }

    # CreateInstanceByContractID()
    if (/CreateInstanceByContractID\((.*)\) succeeded/) {
        $objs_contractid{$1}++;
        next;
    }

    # FAILED CreateInstance()
    if (/CreateInstance\(\{(.*)\}\) FAILED/) {
        $failedObjs{$1}++;
        next;
    }
}

# if there is a file named reg.out in the current dir
# then use that to fill in the ContractIDToClassID mapping.
my $REG;
open REG, "<reg.out";
while (<REG>) {
    chomp;
    if (/contractID -  (.*)$/) {
        my $id = $1;
        $cid = <REG>;
        chomp($cid);
        $cid =~ s/^.*\{(.*)\}.*$/$1/;
        $contractid{$cid} = $id;
    }
}

# print results
# ----------------------------------------------------------------------

# dlls loaded
print "dlls loaded [", scalar @dlls, "]\n";
print "----------------------------------------------------------------------\n";
for ($n = 0; $n < scalar @dlls; $n++) {
    printf "%2d. %s\n", $n+1, $dlls[$n];
}
print "\n";

# Objects created
print "Object creations from CID [", sum(\%objs), "]\n";
print "----------------------------------------------------------------------\n";
foreach $cid (sort {$objs{$b} <=> $objs{$a} } keys %objs) {
    last if (!$all && $objs{$cid} < 50);
    printf "%5d. %s - %s\n", $objs{$cid}, $cid, getContractID($cid);
}
print "\n";

print "Object creations from ContractID [", sum(\%objs_contractid), "]\n";
print "----------------------------------------------------------------------\n";
foreach $cid (sort {$objs_contractid{$b} <=> $objs_contractid{$a} } keys %objs_contractid) {
    last if (!$all && $objs_contractid{$cid} < 50);
    printf "%5d. %s - %s\n", $objs_contractid{$cid}, $cid, getContractID($cid);
}
print "\n";

# FAILED Objects created
print "FAILED Objects creations [", sum(\%failedObjs), "]\n";
print "----------------------------------------------------------------------\n";
foreach $cid (sort {$failedObjs{$b} <=> $failedObjs{$a} } keys %failedObjs) {
    last if (!$all && $failedObjs{$cid} < 50);
    printf "%5d. %s - %s", $failedObjs{$cid}, $cid, getContractID($cid);
}
print "\n";

# ContractIDToClassID calls
print "ContractIDToClassID() calls [", sum(\%contractid_n),"]\n";
print "----------------------------------------------------------------------\n";
foreach $cid (sort {$contractid_n{$b} <=> $contractid_n{$a} } keys %contractid_n) {
    last if (!$all && $contractid_n{$cid} < 50);
    printf "%5d. %s - %s\n", $contractid_n{$cid}, $cid, getContractID($cid);
}
print "\n";


# FAILED ContractIDToClassID calls
print "FAILED ContractIDToClassID() calls [", sum(\%failedContractid_n), "]\n";
print "----------------------------------------------------------------------\n";
foreach $cid (sort {$failedContractid_n{$b} <=> $failedContractid_n{$a} } keys %failedContractid_n) {
    last if (!$all && $failedContractid_n{$cid} < 50);
    printf "%5d. %s\n", $failedContractid_n{$cid}, $cid;
}
print "\n";


# Subroutines

sub getContractID($) {
    my $cid = shift;
    my $ret = "";
    $ret = $contractid{$cid} if (exists $contractid{$cid});
    return $ret;
}

sub sum($) {
    my $hash_ref = shift;
    my %hash = %$hash_ref;
    my $total = 0;
    my $key;
    foreach $key (keys %hash) {
        $total += $hash{$key};
    }
    return $total;
}