← Index
NYTProf Performance Profile   « block view • line view • sub view »
For bin/pan_genome_post_analysis
  Run on Fri Mar 27 11:43:32 2015
Reported on Fri Mar 27 11:46:02 2015

Filename/Users/ap13/perl5/perlbrew/perls/perl-5.16.2/lib/5.16.2/darwin-2level/B.pm
StatementsExecuted 55 statements in 2.72ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
15333411µs411µsB::::perlstring B::perlstring (xsub)
51120µs20µsB::::opnumber B::opnumber (xsub)
11112µs23µsB::::BEGIN@9 B::BEGIN@9
11110µs765µsB::::BEGIN@17 B::BEGIN@17
11110µs24µsB::::BEGIN@254 B::BEGIN@254
1112µs2µsB::::threadsv_names B::threadsv_names (xsub)
0000s0sB::GV::::SAFENAME B::GV::SAFENAME
0000s0sB::IV::::int_value B::IV::int_value
0000s0sB::Section::::addB::Section::add
0000s0sB::Section::::defaultB::Section::default
0000s0sB::Section::::getB::Section::get
0000s0sB::Section::::indexB::Section::index
0000s0sB::Section::::nameB::Section::name
0000s0sB::Section::::newB::Section::new
0000s0sB::Section::::outputB::Section::output
0000s0sB::Section::::symtableB::Section::symtable
0000s0sB::::class B::class
0000s0sB::::clearsym B::clearsym
0000s0sB::::compile_stats B::compile_stats
0000s0sB::::debug B::debug
0000s0sB::::objsym B::objsym
0000s0sB::::parents B::parents
0000s0sB::::peekop B::peekop
0000s0sB::::savesym B::savesym
0000s0sB::::timing_info B::timing_info
0000s0sB::::walkoptree_exec B::walkoptree_exec
0000s0sB::::walkoptree_slow B::walkoptree_slow
0000s0sB::::walksymtable B::walksymtable
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1# B.pm
2#
3# Copyright (c) 1996, 1997, 1998 Malcolm Beattie
4#
5# You may distribute under the terms of either the GNU General Public
6# License or the Artistic License, as specified in the README file.
7#
8package B;
9266µs235µs
# spent 23µs (12+11) within B::BEGIN@9 which was called: # once (12µs+11µs) by Moose::Meta::Attribute::BEGIN@6 at line 9
use strict;
# spent 23µs making 1 call to B::BEGIN@9 # spent 11µs making 1 call to strict::import
10
111800nsrequire Exporter;
1219µs@B::ISA = qw(Exporter);
13
14# walkoptree_slow comes from B.pm (you are there),
15# walkoptree comes from B.xs
16
17
# spent 765µs (10+755) within B::BEGIN@17 which was called: # once (10µs+755µs) by Moose::Meta::Attribute::BEGIN@6 at line 28
BEGIN {
181400ns $B::VERSION = '1.35';
191400ns @B::EXPORT_OK = ();
20
21 # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
22 # Want our constants loaded before the compiler meets OPf_KIDS below, as
23 # the combination of having the constant stay a Proxy Constant Subroutine
24 # and its value being inlined saves a little over .5K
25
261500ns require XSLoader;
271766µs1755µs XSLoader::load();
# spent 755µs making 1 call to XSLoader::load
2811.20ms1765µs}
# spent 765µs making 1 call to B::BEGIN@17
29
3018µspush @B::EXPORT_OK, (qw(minus_c ppname save_BEGINs
31 class peekop cast_I32 cstring cchar hash threadsv_names
32 main_root main_start main_cv svref_2object opnumber
33 sub_generation amagic_generation perlstring
34 walkoptree_slow walkoptree walkoptree_exec walksymtable
35 parents comppadlist sv_undef compile_stats timing_info
36 begin_av init_av check_av end_av regex_padav dowarn
37 defstash curstash warnhook diehook inc_gv @optype
38 @specialsv_name
39 ), $] > 5.009 && 'unitcheck_av');
40
4118µs@B::SV::ISA = 'B::OBJECT';
4213µs@B::NULL::ISA = 'B::SV';
4313µs@B::PV::ISA = 'B::SV';
4412µs@B::IV::ISA = 'B::SV';
4512µs@B::NV::ISA = 'B::SV';
46# RV is eliminated with 5.11.0, but effectively is a specialisation of IV now.
4714µs@B::RV::ISA = $] >= 5.011 ? 'B::IV' : 'B::SV';
4814µs@B::PVIV::ISA = qw(B::PV B::IV);
4915µs@B::PVNV::ISA = qw(B::PVIV B::NV);
5014µs@B::PVMG::ISA = 'B::PVNV';
5114µs@B::REGEXP::ISA = 'B::PVMG' if $] >= 5.011;
52# Change in the inheritance hierarchy post 5.9.0
5314µs@B::PVLV::ISA = $] > 5.009 ? 'B::GV' : 'B::PVMG';
54# BM is eliminated post 5.9.5, but effectively is a specialisation of GV now.
5512µs@B::BM::ISA = $] > 5.009005 ? 'B::GV' : 'B::PVMG';
5616µs@B::AV::ISA = 'B::PVMG';
57116µs@B::GV::ISA = 'B::PVMG';
5815µs@B::HV::ISA = 'B::PVMG';
5914µs@B::CV::ISA = 'B::PVMG';
6015µs@B::IO::ISA = 'B::PVMG';
6117µs@B::FM::ISA = 'B::CV';
62
6313µs@B::OP::ISA = 'B::OBJECT';
6414µs@B::UNOP::ISA = 'B::OP';
6513µs@B::BINOP::ISA = 'B::UNOP';
6613µs@B::LOGOP::ISA = 'B::UNOP';
6715µs@B::LISTOP::ISA = 'B::BINOP';
6812µs@B::SVOP::ISA = 'B::OP';
6912µs@B::PADOP::ISA = 'B::OP';
7012µs@B::PVOP::ISA = 'B::OP';
7113µs@B::LOOP::ISA = 'B::LISTOP';
7216µs@B::PMOP::ISA = 'B::LISTOP';
73136µs@B::COP::ISA = 'B::OP';
74
7513µs@B::SPECIAL::ISA = 'B::OBJECT';
76
7712µs@B::optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP);
78# bytecode.pl contained the following comment:
79# Nullsv *must* come first in the following so that the condition
80# ($$sv == 0) can continue to be used to test (sv == Nullsv).
8111µs@B::specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no
82 (SV*)pWARN_ALL (SV*)pWARN_NONE (SV*)pWARN_STD);
83
84{
85 # Stop "-w" from complaining about the lack of a real B::OBJECT class
861800ns package B::OBJECT;
87}
88
89sub B::GV::SAFENAME {
90 my $name = (shift())->NAME;
91
92 # The regex below corresponds to the isCONTROLVAR macro
93 # from toke.c
94
95 $name =~ s/^([\cA-\cZ\c\\c[\c]\c?\c_\c^])/"^".
96 chr( utf8::unicode_to_native( 64 ^ ord($1) ))/e;
97
98 # When we say unicode_to_native we really mean ascii_to_native,
99 # which matters iff this is a non-ASCII platform (EBCDIC).
100
101 return $name;
102}
103
104sub B::IV::int_value {
105 my ($self) = @_;
106 return (($self->FLAGS() & SVf_IVisUV()) ? $self->UVX : $self->IV);
107}
108
109sub B::NULL::as_string() {""}
11016µs*B::IV::as_string = \*B::IV::int_value;
11113µs*B::PV::as_string = \*B::PV::PV;
112
113# The input typemap checking makes no distinction between different SV types,
114# so the XS body will generate the same C code, despite the different XS
115# "types". So there is no change in behaviour from doing "newXS" like this,
116# compared with the old approach of having a (near) duplicate XS body.
117# We should fix the typemap checking.
11814µs*B::IV::RV = \*B::PV::RV if $] > 5.012;
119
1201100nsmy $debug;
1211200nsmy $op_count = 0;
1221300nsmy @parents = ();
123
124sub debug {
125 my ($class, $value) = @_;
126 $debug = $value;
127 walkoptree_debug($value);
128}
129
130sub class {
131 my $obj = shift;
132 my $name = ref $obj;
133 $name =~ s/^.*:://;
134 return $name;
135}
136
137sub parents { \@parents }
138
139# For debugging
140sub peekop {
141 my $op = shift;
142 return sprintf("%s (0x%x) %s", class($op), $$op, $op->name);
143}
144
145sub walkoptree_slow {
146 my($op, $method, $level) = @_;
147 $op_count++; # just for statistics
148 $level ||= 0;
149 warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
150 $op->$method($level) if $op->can($method);
151 if ($$op && ($op->flags & OPf_KIDS)) {
152 my $kid;
153 unshift(@parents, $op);
154 for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
155 walkoptree_slow($kid, $method, $level + 1);
156 }
157 shift @parents;
158 }
159 if (class($op) eq 'PMOP'
160 && ref($op->pmreplroot)
161 && ${$op->pmreplroot}
162 && $op->pmreplroot->isa( 'B::OP' ))
163 {
164 unshift(@parents, $op);
165 walkoptree_slow($op->pmreplroot, $method, $level + 1);
166 shift @parents;
167 }
168}
169
170sub compile_stats {
171 return "Total number of OPs processed: $op_count\n";
172}
173
174sub timing_info {
175 my ($sec, $min, $hr) = localtime;
176 my ($user, $sys) = times;
177 sprintf("%02d:%02d:%02d user=$user sys=$sys",
178 $hr, $min, $sec, $user, $sys);
179}
180
1811100nsmy %symtable;
182
183sub clearsym {
184 %symtable = ();
185}
186
187sub savesym {
188 my ($obj, $value) = @_;
189# warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
190 $symtable{sprintf("sym_%x", $$obj)} = $value;
191}
192
193sub objsym {
194 my $obj = shift;
195 return $symtable{sprintf("sym_%x", $$obj)};
196}
197
198sub walkoptree_exec {
199 my ($op, $method, $level) = @_;
200 $level ||= 0;
201 my ($sym, $ppname);
202 my $prefix = " " x $level;
203 for (; $$op; $op = $op->next) {
204 $sym = objsym($op);
205 if (defined($sym)) {
206 print $prefix, "goto $sym\n";
207 return;
208 }
209 savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
210 $op->$method($level);
211 $ppname = $op->name;
212 if ($ppname =~
213 /^(d?or(assign)?|and(assign)?|mapwhile|grepwhile|entertry|range|cond_expr)$/)
214 {
215 print $prefix, uc($1), " => {\n";
216 walkoptree_exec($op->other, $method, $level + 1);
217 print $prefix, "}\n";
218 } elsif ($ppname eq "match" || $ppname eq "subst") {
219 my $pmreplstart = $op->pmreplstart;
220 if ($$pmreplstart) {
221 print $prefix, "PMREPLSTART => {\n";
222 walkoptree_exec($pmreplstart, $method, $level + 1);
223 print $prefix, "}\n";
224 }
225 } elsif ($ppname eq "substcont") {
226 print $prefix, "SUBSTCONT => {\n";
227 walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
228 print $prefix, "}\n";
229 $op = $op->other;
230 } elsif ($ppname eq "enterloop") {
231 print $prefix, "REDO => {\n";
232 walkoptree_exec($op->redoop, $method, $level + 1);
233 print $prefix, "}\n", $prefix, "NEXT => {\n";
234 walkoptree_exec($op->nextop, $method, $level + 1);
235 print $prefix, "}\n", $prefix, "LAST => {\n";
236 walkoptree_exec($op->lastop, $method, $level + 1);
237 print $prefix, "}\n";
238 } elsif ($ppname eq "subst") {
239 my $replstart = $op->pmreplstart;
240 if ($$replstart) {
241 print $prefix, "SUBST => {\n";
242 walkoptree_exec($replstart, $method, $level + 1);
243 print $prefix, "}\n";
244 }
245 }
246 }
247}
248
249sub walksymtable {
250 my ($symref, $method, $recurse, $prefix) = @_;
251 my $sym;
252 my $ref;
253 my $fullname;
2542439µs238µs
# spent 24µs (10+14) within B::BEGIN@254 which was called: # once (10µs+14µs) by Moose::Meta::Attribute::BEGIN@6 at line 254
no strict 'refs';
# spent 24µs making 1 call to B::BEGIN@254 # spent 14µs making 1 call to strict::unimport
255 $prefix = '' unless defined $prefix;
256 while (($sym, $ref) = each %$symref) {
257 $fullname = "*main::".$prefix.$sym;
258 if ($sym =~ /::$/) {
259 $sym = $prefix . $sym;
260 if (svref_2object(\*$sym)->NAME ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
261 walksymtable(\%$fullname, $method, $recurse, $sym);
262 }
263 } else {
264 svref_2object(\*$fullname)->$method();
265 }
266 }
267}
268
269{
2701100ns package B::Section;
2711100ns my $output_fh;
2721400ns my %sections;
273
274 sub new {
275 my ($class, $section, $symtable, $default) = @_;
276 $output_fh ||= FileHandle->new_tmpfile;
277 my $obj = bless [-1, $section, $symtable, $default], $class;
278 $sections{$section} = $obj;
279 return $obj;
280 }
281
282 sub get {
283 my ($class, $section) = @_;
284 return $sections{$section};
285 }
286
287 sub add {
288 my $section = shift;
289 while (defined($_ = shift)) {
290 print $output_fh "$section->[1]\t$_\n";
291 $section->[0]++;
292 }
293 }
294
295 sub index {
296 my $section = shift;
297 return $section->[0];
298 }
299
300 sub name {
301 my $section = shift;
302 return $section->[1];
303 }
304
305 sub symtable {
306 my $section = shift;
307 return $section->[2];
308 }
309
310 sub default {
311 my $section = shift;
312 return $section->[3];
313 }
314
315 sub output {
316 my ($section, $fh, $format) = @_;
317 my $name = $section->name;
318 my $sym = $section->symtable || {};
319 my $default = $section->default;
320
321 seek($output_fh, 0, 0);
322 while (<$output_fh>) {
323 chomp;
324 s/^(.*?)\t//;
325 if ($1 eq $name) {
326 s{(s\\_[0-9a-f]+)} {
327 exists($sym->{$1}) ? $sym->{$1} : $default;
328 }ge;
329 printf $fh $format, $_;
330 }
331 }
332 }
333}
334
335157µs1;
336
337__END__
 
# spent 20µs within B::opnumber which was called 5 times, avg 4µs/call: # 5 times (20µs+0s) by B::Deparse::BEGIN@3051 at line 3052 of B/Deparse.pm, avg 4µs/call
sub B::opnumber; # xsub
# spent 411µs within B::perlstring which was called 153 times, avg 3µs/call: # 83 times (224µs+0s) by Moose::Meta::TypeConstraint::Class::__ANON__[/Users/ap13/perl5/lib/perl5/darwin-2level/Moose/Meta/TypeConstraint/Class.pm:25] at line 23 of Moose/Meta/TypeConstraint/Class.pm, avg 3µs/call # 64 times (171µs+0s) by Moose::Meta::Attribute::_inline_generate_default at line 915 of Moose/Meta/Attribute.pm, avg 3µs/call # 6 times (16µs+0s) by Moose::Meta::TypeConstraint::Role::__ANON__[/Users/ap13/perl5/lib/perl5/darwin-2level/Moose/Meta/TypeConstraint/Role.pm:27] at line 23 of Moose/Meta/TypeConstraint/Role.pm, avg 3µs/call
sub B::perlstring; # xsub
# spent 2µs within B::threadsv_names which was called: # once (2µs+0s) by Bio::Roary::OrderGenes::BEGIN@22 at line 3127 of B/Deparse.pm
sub B::threadsv_names; # xsub