← Index
NYTProf Performance Profile   « line view »
For /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
  Run on Mon Jan 29 16:55:34 2018
Reported on Mon Jan 29 16:57:06 2018

Filename/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/5.22.0/x86_64-linux/B.pm
StatementsExecuted 58 statements in 1.98ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
52833326µs326µsB::::perlstring B::perlstring (xsub)
141117µs17µsB::::opnumber B::opnumber (xsub)
11110µs27µsB::::BEGIN@261 B::BEGIN@261
1119µs594µsB::::BEGIN@17 B::BEGIN@17
1117µs8µsB::::BEGIN@9 B::BEGIN@9
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::::safename B::safename
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;
9249µs29µs
# spent 8µs (7+1) within B::BEGIN@9 which was called: # once (7µs+1µs) by Moose::Meta::Attribute::BEGIN@6 at line 9
use strict;
# spent 8µs making 1 call to B::BEGIN@9 # spent 1µs making 1 call to strict::import
10
111500nsrequire Exporter;
1218µ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 594µs (9+585) within B::BEGIN@17 which was called: # once (9µs+585µs) by Moose::Meta::Attribute::BEGIN@6 at line 28
BEGIN {
181200ns $B::VERSION = '1.58';
191500ns @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
261400ns require XSLoader;
271594µs1585µs XSLoader::load();
# spent 585µs making 1 call to XSLoader::load
281841µs1594µs}
# spent 594µs making 1 call to B::BEGIN@17
29
3017µ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 unitcheck_av safename));
39
4014µs@B::SV::ISA = 'B::OBJECT';
4114µs@B::NULL::ISA = 'B::SV';
4212µs@B::PV::ISA = 'B::SV';
4312µs@B::IV::ISA = 'B::SV';
4412µs@B::NV::ISA = 'B::SV';
45# RV is eliminated with 5.11.0, but effectively is a specialisation of IV now.
4614µs@B::RV::ISA = $] >= 5.011 ? 'B::IV' : 'B::SV';
4713µs@B::PVIV::ISA = qw(B::PV B::IV);
4815µs@B::PVNV::ISA = qw(B::PVIV B::NV);
4913µs@B::PVMG::ISA = 'B::PVNV';
5013µs@B::REGEXP::ISA = 'B::PVMG' if $] >= 5.011;
5112µs@B::INVLIST::ISA = 'B::PV' if $] >= 5.019;
5213µs@B::PVLV::ISA = 'B::GV';
5311µs@B::BM::ISA = 'B::GV';
5413µs@B::AV::ISA = 'B::PVMG';
55113µs@B::GV::ISA = 'B::PVMG';
5613µs@B::HV::ISA = 'B::PVMG';
5715µs@B::CV::ISA = 'B::PVMG';
5813µs@B::IO::ISA = 'B::PVMG';
59116µs@B::FM::ISA = 'B::CV';
60
6112µs@B::OP::ISA = 'B::OBJECT';
6212µs@B::UNOP::ISA = 'B::OP';
6312µs@B::UNOP_AUX::ISA = 'B::UNOP';
6412µs@B::BINOP::ISA = 'B::UNOP';
6512µs@B::LOGOP::ISA = 'B::UNOP';
6612µs@B::LISTOP::ISA = 'B::BINOP';
6712µs@B::SVOP::ISA = 'B::OP';
6811µs@B::PADOP::ISA = 'B::OP';
6912µs@B::PVOP::ISA = 'B::OP';
7013µs@B::LOOP::ISA = 'B::LISTOP';
7112µs@B::PMOP::ISA = 'B::LISTOP';
7211µs@B::COP::ISA = 'B::OP';
7312µs@B::METHOP::ISA = 'B::OP';
74
7512µs@B::SPECIAL::ISA = 'B::OBJECT';
76
771900ns@B::optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP
78 METHOP UNOP_AUX);
79# bytecode.pl contained the following comment:
80# Nullsv *must* come first in the following so that the condition
81# ($$sv == 0) can continue to be used to test (sv == Nullsv).
821700ns@B::specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no
83 (SV*)pWARN_ALL (SV*)pWARN_NONE (SV*)pWARN_STD);
84
85{
86 # Stop "-w" from complaining about the lack of a real B::OBJECT class
871500ns package B::OBJECT;
88}
89
90sub B::GV::SAFENAME {
91 safename(shift()->NAME);
92}
93
94sub safename {
95 my $name = shift;
96
97 # The regex below corresponds to the isCONTROLVAR macro
98 # from toke.c
99
100 $name =~ s/^\c?/^?/
101 or $name =~ s/^([\cA-\cZ\c\\c[\c]\c_\c^])/
102 "^" . chr( utf8::unicode_to_native( 64 ^ ord($1) ))/e;
103
104 # When we say unicode_to_native we really mean ascii_to_native,
105 # which matters iff this is a non-ASCII platform (EBCDIC). '\c?' would
106 # not have to be special cased, except for non-ASCII.
107
108 return $name;
109}
110
111sub B::IV::int_value {
112 my ($self) = @_;
113 return (($self->FLAGS() & SVf_IVisUV()) ? $self->UVX : $self->IV);
114}
115
116sub B::NULL::as_string() {""}
11717µs*B::IV::as_string = \*B::IV::int_value;
11812µs*B::PV::as_string = \*B::PV::PV;
119
120# The input typemap checking makes no distinction between different SV types,
121# so the XS body will generate the same C code, despite the different XS
122# "types". So there is no change in behaviour from doing "newXS" like this,
123# compared with the old approach of having a (near) duplicate XS body.
124# We should fix the typemap checking.
12512µs*B::IV::RV = \*B::PV::RV if $] > 5.012;
126
1271200nsmy $debug;
1281200nsmy $op_count = 0;
1291200nsmy @parents = ();
130
131sub debug {
132 my ($class, $value) = @_;
133 $debug = $value;
134 walkoptree_debug($value);
135}
136
137sub class {
138 my $obj = shift;
139 my $name = ref $obj;
140 $name =~ s/^.*:://;
141 return $name;
142}
143
144sub parents { \@parents }
145
146# For debugging
147sub peekop {
148 my $op = shift;
149 return sprintf("%s (0x%x) %s", class($op), $$op, $op->name);
150}
151
152sub walkoptree_slow {
153 my($op, $method, $level) = @_;
154 $op_count++; # just for statistics
155 $level ||= 0;
156 warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
157 $op->$method($level) if $op->can($method);
158 if ($$op && ($op->flags & OPf_KIDS)) {
159 my $kid;
160 unshift(@parents, $op);
161 for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
162 walkoptree_slow($kid, $method, $level + 1);
163 }
164 shift @parents;
165 }
166 if (class($op) eq 'PMOP'
167 && ref($op->pmreplroot)
168 && ${$op->pmreplroot}
169 && $op->pmreplroot->isa( 'B::OP' ))
170 {
171 unshift(@parents, $op);
172 walkoptree_slow($op->pmreplroot, $method, $level + 1);
173 shift @parents;
174 }
175}
176
177sub compile_stats {
178 return "Total number of OPs processed: $op_count\n";
179}
180
181sub timing_info {
182 my ($sec, $min, $hr) = localtime;
183 my ($user, $sys) = times;
184 sprintf("%02d:%02d:%02d user=$user sys=$sys",
185 $hr, $min, $sec, $user, $sys);
186}
187
1881200nsmy %symtable;
189
190sub clearsym {
191 %symtable = ();
192}
193
194sub savesym {
195 my ($obj, $value) = @_;
196# warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
197 $symtable{sprintf("sym_%x", $$obj)} = $value;
198}
199
200sub objsym {
201 my $obj = shift;
202 return $symtable{sprintf("sym_%x", $$obj)};
203}
204
205sub walkoptree_exec {
206 my ($op, $method, $level) = @_;
207 $level ||= 0;
208 my ($sym, $ppname);
209 my $prefix = " " x $level;
210 for (; $$op; $op = $op->next) {
211 $sym = objsym($op);
212 if (defined($sym)) {
213 print $prefix, "goto $sym\n";
214 return;
215 }
216 savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
217 $op->$method($level);
218 $ppname = $op->name;
219 if ($ppname =~
220 /^(d?or(assign)?|and(assign)?|mapwhile|grepwhile|entertry|range|cond_expr)$/)
221 {
222 print $prefix, uc($1), " => {\n";
223 walkoptree_exec($op->other, $method, $level + 1);
224 print $prefix, "}\n";
225 } elsif ($ppname eq "match" || $ppname eq "subst") {
226 my $pmreplstart = $op->pmreplstart;
227 if ($$pmreplstart) {
228 print $prefix, "PMREPLSTART => {\n";
229 walkoptree_exec($pmreplstart, $method, $level + 1);
230 print $prefix, "}\n";
231 }
232 } elsif ($ppname eq "substcont") {
233 print $prefix, "SUBSTCONT => {\n";
234 walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
235 print $prefix, "}\n";
236 $op = $op->other;
237 } elsif ($ppname eq "enterloop") {
238 print $prefix, "REDO => {\n";
239 walkoptree_exec($op->redoop, $method, $level + 1);
240 print $prefix, "}\n", $prefix, "NEXT => {\n";
241 walkoptree_exec($op->nextop, $method, $level + 1);
242 print $prefix, "}\n", $prefix, "LAST => {\n";
243 walkoptree_exec($op->lastop, $method, $level + 1);
244 print $prefix, "}\n";
245 } elsif ($ppname eq "subst") {
246 my $replstart = $op->pmreplstart;
247 if ($$replstart) {
248 print $prefix, "SUBST => {\n";
249 walkoptree_exec($replstart, $method, $level + 1);
250 print $prefix, "}\n";
251 }
252 }
253 }
254}
255
256sub walksymtable {
257 my ($symref, $method, $recurse, $prefix) = @_;
258 my $sym;
259 my $ref;
260 my $fullname;
2612342µs245µs
# spent 27µs (10+18) within B::BEGIN@261 which was called: # once (10µs+18µs) by Moose::Meta::Attribute::BEGIN@6 at line 261
no strict 'refs';
# spent 27µs making 1 call to B::BEGIN@261 # spent 18µs making 1 call to strict::unimport
262 $prefix = '' unless defined $prefix;
263 foreach my $sym ( sort keys %$symref ) {
264 $ref= $symref->{$sym};
265 $fullname = "*main::".$prefix.$sym;
266 if ($sym =~ /::$/) {
267 $sym = $prefix . $sym;
268 if (svref_2object(\*$sym)->NAME ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
269 walksymtable(\%$fullname, $method, $recurse, $sym);
270 }
271 } else {
272 svref_2object(\*$fullname)->$method();
273 }
274 }
275}
276
277{
278 package B::Section;
2791100ns my $output_fh;
2801400ns my %sections;
281
282 sub new {
283 my ($class, $section, $symtable, $default) = @_;
284 $output_fh ||= FileHandle->new_tmpfile;
285 my $obj = bless [-1, $section, $symtable, $default], $class;
286 $sections{$section} = $obj;
287 return $obj;
288 }
289
290 sub get {
291 my ($class, $section) = @_;
292 return $sections{$section};
293 }
294
295 sub add {
296 my $section = shift;
297 while (defined($_ = shift)) {
298 print $output_fh "$section->[1]\t$_\n";
299 $section->[0]++;
300 }
301 }
302
303 sub index {
304 my $section = shift;
305 return $section->[0];
306 }
307
308 sub name {
309 my $section = shift;
310 return $section->[1];
311 }
312
313 sub symtable {
314 my $section = shift;
315 return $section->[2];
316 }
317
318 sub default {
319 my $section = shift;
320 return $section->[3];
321 }
322
323 sub output {
324 my ($section, $fh, $format) = @_;
325 my $name = $section->name;
326 my $sym = $section->symtable || {};
327 my $default = $section->default;
328
329 seek($output_fh, 0, 0);
330 while (<$output_fh>) {
331 chomp;
332 s/^(.*?)\t//;
333 if ($1 eq $name) {
334 s{(s\\_[0-9a-f]+)} {
335 exists($sym->{$1}) ? $sym->{$1} : $default;
336 }ge;
337 printf $fh $format, $_;
338 }
339 }
340 }
341}
342
343214µs1;
344
345__END__
 
# spent 17µs within B::opnumber which was called 14 times, avg 1µs/call: # 14 times (17µs+0s) by B::Deparse::BEGIN@363 at line 365 of B/Deparse.pm, avg 1µs/call
sub B::opnumber; # xsub
# spent 326µs within B::perlstring which was called 528 times, avg 617ns/call: # 469 times (239µs+0s) by Sub::Quote::quotify at line 24 of Sub/Quote.pm, avg 509ns/call # 35 times (53µs+0s) by Moose::Meta::TypeConstraint::Class::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/x86_64-linux/Moose/Meta/TypeConstraint/Class.pm:25] at line 23 of Moose/Meta/TypeConstraint/Class.pm, avg 2µs/call # 24 times (34µs+0s) by Moose::Meta::TypeConstraint::Role::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/x86_64-linux/Moose/Meta/TypeConstraint/Role.pm:27] at line 23 of Moose/Meta/TypeConstraint/Role.pm, avg 1µs/call
sub B::perlstring; # xsub