← Index
NYTProf Performance Profile   « line view »
For ../prof.pl
  Run on Thu Dec 15 15:23:56 2022
Reported on Thu Dec 15 15:27:02 2022

Filename/Users/ether/perl5/perlbrew/perls/36.0/lib/5.36.0/darwin-2level/B.pm
StatementsExecuted 57 statements in 5.39ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
402922132.6ms32.6msB::::svref_2object B::svref_2object (xsub)
1866841.52ms1.52msB::::perlstring B::perlstring (xsub)
11161µs4.28msB::::BEGIN@22 B::BEGIN@22
11113µs21µsB::::BEGIN@268 B::BEGIN@268
55511µs11µsB::::import B::import
0000s0sB::GV::::SAFENAMEB::GV::SAFENAME
0000s0sB::IV::::int_valueB::IV::int_value
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;
9
1018µs@B::ISA = qw(Exporter);
11
12# If B is loaded without imports, we do not want to unnecessarily pollute the stash with Exporter.
13
# spent 11µs within B::import which was called 5 times, avg 2µs/call: # once (3µs+0s) by YAML::PP::Schema::Core::BEGIN@12 at line 12 of YAML/PP/Schema/Core.pm # once (2µs+0s) by YAML::PP::Schema::JSON::BEGIN@13 at line 13 of YAML/PP/Schema/JSON.pm # once (2µs+0s) by JSON::Schema::Modern::Utilities::BEGIN@16 at line 16 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Utilities.pm # once (2µs+0s) by YAML::PP::Schema::BEGIN@4 at line 4 of YAML/PP/Schema.pm # once (2µs+0s) by YAML::PP::Representer::BEGIN@18 at line 18 of YAML/PP/Representer.pm
sub import {
14516µs return unless scalar @_ > 1; # Called as a method call.
15 require Exporter;
16 B->export_to_level(1, @_);
17}
18
19# walkoptree_slow comes from B.pm (you are there),
20# walkoptree comes from B.xs
21
22
# spent 4.28ms (61µs+4.22) within B::BEGIN@22 which was called: # once (61µs+4.22ms) by Type::Tiny::inline_assert at line 33
BEGIN {
2311µs $B::VERSION = '1.83';
2410s @B::EXPORT_OK = ();
25
26 # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
27 # Want our constants loaded before the compiler meets OPf_KIDS below, as
28 # the combination of having the constant stay a Proxy Constant Subroutine
29 # and its value being inlined saves a little over .5K
30
3111µs require XSLoader;
3214.23ms14.22ms XSLoader::load();
# spent 4.22ms making 1 call to XSLoader::load
331835µs14.28ms}
# spent 4.28ms making 1 call to B::BEGIN@22
34
3515µspush @B::EXPORT_OK, (qw(minus_c ppname save_BEGINs
36 class peekop cast_I32 cstring cchar hash threadsv_names
37 main_root main_start main_cv svref_2object opnumber
38 sub_generation amagic_generation perlstring
39 walkoptree_slow walkoptree walkoptree_exec walksymtable
40 parents comppadlist sv_undef compile_stats timing_info
41 begin_av init_av check_av end_av regex_padav dowarn
42 defstash curstash warnhook diehook inc_gv @optype
43 @specialsv_name unitcheck_av safename));
44
4513µs@B::SV::ISA = 'B::OBJECT';
4613µs@B::NULL::ISA = 'B::SV';
4712µs@B::PV::ISA = 'B::SV';
4812µs@B::IV::ISA = 'B::SV';
4912µs@B::NV::ISA = 'B::SV';
50# RV is eliminated with 5.11.0, but effectively is a specialisation of IV now.
5115µs@B::RV::ISA = 'B::IV';
5215µs@B::PVIV::ISA = qw(B::PV B::IV);
5314µs@B::PVNV::ISA = qw(B::PVIV B::NV);
5415µs@B::PVMG::ISA = 'B::PVNV';
5513µs@B::REGEXP::ISA = 'B::PVMG';
5612µs@B::INVLIST::ISA = 'B::PV';
5715µs@B::PVLV::ISA = 'B::GV';
5812µs@B::BM::ISA = 'B::GV';
5916µs@B::AV::ISA = 'B::PVMG';
60111µs@B::GV::ISA = 'B::PVMG';
6112µs@B::HV::ISA = 'B::PVMG';
6213µs@B::CV::ISA = 'B::PVMG';
6313µs@B::IO::ISA = 'B::PVMG';
6418µs@B::FM::ISA = 'B::CV';
65
6612µs@B::OP::ISA = 'B::OBJECT';
6713µs@B::UNOP::ISA = 'B::OP';
6812µs@B::UNOP_AUX::ISA = 'B::UNOP';
6913µs@B::BINOP::ISA = 'B::UNOP';
7012µs@B::LOGOP::ISA = 'B::UNOP';
7113µs@B::LISTOP::ISA = 'B::BINOP';
7212µs@B::SVOP::ISA = 'B::OP';
7313µs@B::PADOP::ISA = 'B::OP';
7412µs@B::PVOP::ISA = 'B::OP';
7513µs@B::LOOP::ISA = 'B::LISTOP';
7612µs@B::PMOP::ISA = 'B::LISTOP';
7712µs@B::COP::ISA = 'B::OP';
7814µs@B::METHOP::ISA = 'B::OP';
79
8012µs@B::SPECIAL::ISA = 'B::OBJECT';
81
8211µsour @optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP
83 METHOP UNOP_AUX);
84# bytecode.pl contained the following comment:
85# Nullsv *must* come first in the following so that the condition
86# ($$sv == 0) can continue to be used to test (sv == Nullsv).
8710sour @specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no
88 (SV*)pWARN_ALL (SV*)pWARN_NONE (SV*)pWARN_STD
89 &PL_sv_zero);
90
91{
92 # Stop "-w" from complaining about the lack of a real B::OBJECT class
9310s package B::OBJECT;
94}
95
96sub B::GV::SAFENAME {
97 safename(shift()->NAME);
98}
99
100sub safename {
101 my $name = shift;
102
103 # The regex below corresponds to the isCONTROLVAR macro
104 # from toke.c
105
106 $name =~ s/^\c?/^?/
107 or $name =~ s/^([\cA-\cZ\c\\c[\c]\c_\c^])/
108 "^" . chr( utf8::unicode_to_native( 64 ^ ord($1) ))/e;
109
110 # When we say unicode_to_native we really mean ascii_to_native,
111 # which matters iff this is a non-ASCII platform (EBCDIC). '\c?' would
112 # not have to be special cased, except for non-ASCII.
113
114 return $name;
115}
116
117sub B::IV::int_value {
118 my ($self) = @_;
119 return (($self->FLAGS() & SVf_IVisUV()) ? $self->UVX : $self->IV);
120}
121
122sub B::NULL::as_string() {""}
12314µs*B::IV::as_string = *B::IV::as_string = \*B::IV::int_value;
12412µs*B::PV::as_string = *B::PV::as_string = \*B::PV::PV;
125
126# The input typemap checking makes no distinction between different SV types,
127# so the XS body will generate the same C code, despite the different XS
128# "types". So there is no change in behaviour from doing "newXS" like this,
129# compared with the old approach of having a (near) duplicate XS body.
130# We should fix the typemap checking.
131
132# Since perl 5.12.0
13311µs*B::IV::RV = *B::IV::RV = \*B::PV::RV;
134
13510smy $debug;
13610smy $op_count = 0;
13711µsmy @parents = ();
138
139sub debug {
140 my ($class, $value) = @_;
141 $debug = $value;
142 walkoptree_debug($value);
143}
144
145sub class {
146 my $obj = shift;
147 my $name = ref $obj;
148 $name =~ s/^.*:://;
149 return $name;
150}
151
152sub parents { \@parents }
153
154# For debugging
155sub peekop {
156 my $op = shift;
157 return sprintf("%s (0x%x) %s", class($op), $$op, $op->name);
158}
159
160sub walkoptree_slow {
161 my($op, $method, $level) = @_;
162 $op_count++; # just for statistics
163 $level ||= 0;
164 warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
165 $op->$method($level) if $op->can($method);
166 if ($$op && ($op->flags & OPf_KIDS)) {
167 my $kid;
168 unshift(@parents, $op);
169 for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
170 walkoptree_slow($kid, $method, $level + 1);
171 }
172 shift @parents;
173 }
174 if (class($op) eq 'PMOP'
175 && ref($op->pmreplroot)
176 && ${$op->pmreplroot}
177 && $op->pmreplroot->isa( 'B::OP' ))
178 {
179 unshift(@parents, $op);
180 walkoptree_slow($op->pmreplroot, $method, $level + 1);
181 shift @parents;
182 }
183}
184
185sub compile_stats {
186 return "Total number of OPs processed: $op_count\n";
187}
188
189sub timing_info {
190 my ($sec, $min, $hr) = localtime;
191 my ($user, $sys) = times;
192 sprintf("%02d:%02d:%02d user=$user sys=$sys",
193 $hr, $min, $sec, $user, $sys);
194}
195
19610smy %symtable;
197
198sub clearsym {
199 %symtable = ();
200}
201
202sub savesym {
203 my ($obj, $value) = @_;
204# warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
205 $symtable{sprintf("sym_%x", $$obj)} = $value;
206}
207
208sub objsym {
209 my $obj = shift;
210 return $symtable{sprintf("sym_%x", $$obj)};
211}
212
213sub walkoptree_exec {
214 my ($op, $method, $level) = @_;
215 $level ||= 0;
216 my ($sym, $ppname);
217 my $prefix = " " x $level;
218 for (; $$op; $op = $op->next) {
219 $sym = objsym($op);
220 if (defined($sym)) {
221 print $prefix, "goto $sym\n";
222 return;
223 }
224 savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
225 $op->$method($level);
226 $ppname = $op->name;
227 if ($ppname =~
228 /^(d?or(assign)?|and(assign)?|mapwhile|grepwhile|entertry|range|cond_expr)$/)
229 {
230 print $prefix, uc($1), " => {\n";
231 walkoptree_exec($op->other, $method, $level + 1);
232 print $prefix, "}\n";
233 } elsif ($ppname eq "match" || $ppname eq "subst") {
234 my $pmreplstart = $op->pmreplstart;
235 if ($$pmreplstart) {
236 print $prefix, "PMREPLSTART => {\n";
237 walkoptree_exec($pmreplstart, $method, $level + 1);
238 print $prefix, "}\n";
239 }
240 } elsif ($ppname eq "substcont") {
241 print $prefix, "SUBSTCONT => {\n";
242 walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
243 print $prefix, "}\n";
244 $op = $op->other;
245 } elsif ($ppname eq "enterloop") {
246 print $prefix, "REDO => {\n";
247 walkoptree_exec($op->redoop, $method, $level + 1);
248 print $prefix, "}\n", $prefix, "NEXT => {\n";
249 walkoptree_exec($op->nextop, $method, $level + 1);
250 print $prefix, "}\n", $prefix, "LAST => {\n";
251 walkoptree_exec($op->lastop, $method, $level + 1);
252 print $prefix, "}\n";
253 } elsif ($ppname eq "subst") {
254 my $replstart = $op->pmreplstart;
255 if ($$replstart) {
256 print $prefix, "SUBST => {\n";
257 walkoptree_exec($replstart, $method, $level + 1);
258 print $prefix, "}\n";
259 }
260 }
261 }
262}
263
264sub walksymtable {
265 my ($symref, $method, $recurse, $prefix) = @_;
266 my $sym;
267 my $fullname;
2682164µs229µs
# spent 21µs (13+8) within B::BEGIN@268 which was called: # once (13µs+8µs) by Type::Tiny::inline_assert at line 268
no strict 'refs';
# spent 21µs making 1 call to B::BEGIN@268 # spent 8µs making 1 call to strict::unimport
269 $prefix = '' unless defined $prefix;
270 foreach my $sym ( sort keys %$symref ) {
271 my $dummy = $symref->{$sym}; # Copying the glob and incrementing
272 # the GPs refcnt clears cached methods
273 $fullname = "*main::".$prefix.$sym;
274 if ($sym =~ /::$/) {
275 $sym = $prefix . $sym;
276 if (svref_2object(\*$sym)->NAME ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
277 walksymtable(\%$fullname, $method, $recurse, $sym);
278 }
279 } else {
280 svref_2object(\*$fullname)->$method();
281 }
282 }
283}
284
285111µs1;
286
287__END__
 
# spent 1.52ms within B::perlstring which was called 1866 times, avg 815ns/call: # 948 times (756µs+0s) by Sub::Quote::quotify at line 119 of Sub/Quote.pm, avg 797ns/call # 612 times (400µs+0s) by Type::Tiny::inline_assert at line 935 of Type/Tiny.pm, avg 654ns/call # 134 times (123µs+0s) by Types::Standard::Dict::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard/Dict.pm:161] at line 148 of Types/Standard/Dict.pm, avg 918ns/call # 80 times (66µs+0s) by Type::Tiny::____make_key at line 1016 of Type/Tiny.pm, avg 825ns/call # 64 times (154µs+0s) by Type::Tiny::inline_assert at line 947 of Type/Tiny.pm, avg 2µs/call # 19 times (12µs+0s) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:1059] at line 1054 of Types/Standard.pm, avg 632ns/call # 7 times (6µs+0s) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:987] at line 970 of Types/Standard.pm, avg 857ns/call # 2 times (4µs+0s) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:1033] at line 1028 of Types/Standard.pm, avg 2µs/call
sub B::perlstring; # xsub
# spent 32.6ms within B::svref_2object which was called 40292 times, avg 809ns/call: # 35065 times (27.0ms+0s) by JSON::Schema::Modern::Utilities::get_type at line 105 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Utilities.pm, avg 770ns/call # 5227 times (5.59ms+0s) by JSON::Schema::Modern::Utilities::is_type at line 71 of /Users/ether/git/JSON-Schema-Modern/lib/JSON/Schema/Modern/Utilities.pm, avg 1µs/call
sub B::svref_2object; # xsub
Report produced by the NYTProf 6.12 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.