| Filename | /Users/ap13/perl5/perlbrew/perls/perl-5.16.2/lib/5.16.2/darwin-2level/B.pm |
| Statements | Executed 55 statements in 2.72ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 153 | 3 | 3 | 411µs | 411µs | B::perlstring (xsub) |
| 5 | 1 | 1 | 20µs | 20µs | B::opnumber (xsub) |
| 1 | 1 | 1 | 12µs | 23µs | B::BEGIN@9 |
| 1 | 1 | 1 | 10µs | 765µs | B::BEGIN@17 |
| 1 | 1 | 1 | 10µs | 24µs | B::BEGIN@254 |
| 1 | 1 | 1 | 2µs | 2µs | B::threadsv_names (xsub) |
| 0 | 0 | 0 | 0s | 0s | B::GV::SAFENAME |
| 0 | 0 | 0 | 0s | 0s | B::IV::int_value |
| 0 | 0 | 0 | 0s | 0s | B::Section::add |
| 0 | 0 | 0 | 0s | 0s | B::Section::default |
| 0 | 0 | 0 | 0s | 0s | B::Section::get |
| 0 | 0 | 0 | 0s | 0s | B::Section::index |
| 0 | 0 | 0 | 0s | 0s | B::Section::name |
| 0 | 0 | 0 | 0s | 0s | B::Section::new |
| 0 | 0 | 0 | 0s | 0s | B::Section::output |
| 0 | 0 | 0 | 0s | 0s | B::Section::symtable |
| 0 | 0 | 0 | 0s | 0s | B::class |
| 0 | 0 | 0 | 0s | 0s | B::clearsym |
| 0 | 0 | 0 | 0s | 0s | B::compile_stats |
| 0 | 0 | 0 | 0s | 0s | B::debug |
| 0 | 0 | 0 | 0s | 0s | B::objsym |
| 0 | 0 | 0 | 0s | 0s | B::parents |
| 0 | 0 | 0 | 0s | 0s | B::peekop |
| 0 | 0 | 0 | 0s | 0s | B::savesym |
| 0 | 0 | 0 | 0s | 0s | B::timing_info |
| 0 | 0 | 0 | 0s | 0s | B::walkoptree_exec |
| 0 | 0 | 0 | 0s | 0s | B::walkoptree_slow |
| 0 | 0 | 0 | 0s | 0s | B::walksymtable |
| 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 | # | ||||
| 8 | package B; | ||||
| 9 | 2 | 66µs | 2 | 35µ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 # spent 23µs making 1 call to B::BEGIN@9
# spent 11µs making 1 call to strict::import |
| 10 | |||||
| 11 | 1 | 800ns | require Exporter; | ||
| 12 | 1 | 9µ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 | ||||
| 18 | 4 | 768µs | $B::VERSION = '1.35'; | ||
| 19 | @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 | |||||
| 26 | require XSLoader; | ||||
| 27 | 1 | 755µs | XSLoader::load(); # spent 755µs making 1 call to XSLoader::load | ||
| 28 | 1 | 1.20ms | 1 | 765µs | } # spent 765µs making 1 call to B::BEGIN@17 |
| 29 | |||||
| 30 | 1 | 8µs | push @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 | |||||
| 41 | 1 | 8µs | @B::SV::ISA = 'B::OBJECT'; | ||
| 42 | 1 | 3µs | @B::NULL::ISA = 'B::SV'; | ||
| 43 | 1 | 3µs | @B::PV::ISA = 'B::SV'; | ||
| 44 | 1 | 2µs | @B::IV::ISA = 'B::SV'; | ||
| 45 | 1 | 2µs | @B::NV::ISA = 'B::SV'; | ||
| 46 | # RV is eliminated with 5.11.0, but effectively is a specialisation of IV now. | ||||
| 47 | 1 | 4µs | @B::RV::ISA = $] >= 5.011 ? 'B::IV' : 'B::SV'; | ||
| 48 | 1 | 4µs | @B::PVIV::ISA = qw(B::PV B::IV); | ||
| 49 | 1 | 5µs | @B::PVNV::ISA = qw(B::PVIV B::NV); | ||
| 50 | 1 | 4µs | @B::PVMG::ISA = 'B::PVNV'; | ||
| 51 | 1 | 4µs | @B::REGEXP::ISA = 'B::PVMG' if $] >= 5.011; | ||
| 52 | # Change in the inheritance hierarchy post 5.9.0 | ||||
| 53 | 1 | 4µ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. | ||||
| 55 | 1 | 2µs | @B::BM::ISA = $] > 5.009005 ? 'B::GV' : 'B::PVMG'; | ||
| 56 | 1 | 6µs | @B::AV::ISA = 'B::PVMG'; | ||
| 57 | 1 | 16µs | @B::GV::ISA = 'B::PVMG'; | ||
| 58 | 1 | 5µs | @B::HV::ISA = 'B::PVMG'; | ||
| 59 | 1 | 4µs | @B::CV::ISA = 'B::PVMG'; | ||
| 60 | 1 | 5µs | @B::IO::ISA = 'B::PVMG'; | ||
| 61 | 1 | 7µs | @B::FM::ISA = 'B::CV'; | ||
| 62 | |||||
| 63 | 1 | 3µs | @B::OP::ISA = 'B::OBJECT'; | ||
| 64 | 1 | 4µs | @B::UNOP::ISA = 'B::OP'; | ||
| 65 | 1 | 3µs | @B::BINOP::ISA = 'B::UNOP'; | ||
| 66 | 1 | 3µs | @B::LOGOP::ISA = 'B::UNOP'; | ||
| 67 | 1 | 5µs | @B::LISTOP::ISA = 'B::BINOP'; | ||
| 68 | 1 | 2µs | @B::SVOP::ISA = 'B::OP'; | ||
| 69 | 1 | 2µs | @B::PADOP::ISA = 'B::OP'; | ||
| 70 | 1 | 2µs | @B::PVOP::ISA = 'B::OP'; | ||
| 71 | 1 | 3µs | @B::LOOP::ISA = 'B::LISTOP'; | ||
| 72 | 1 | 6µs | @B::PMOP::ISA = 'B::LISTOP'; | ||
| 73 | 1 | 36µs | @B::COP::ISA = 'B::OP'; | ||
| 74 | |||||
| 75 | 1 | 3µs | @B::SPECIAL::ISA = 'B::OBJECT'; | ||
| 76 | |||||
| 77 | 1 | 2µ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). | ||||
| 81 | 1 | 1µ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 | ||||
| 86 | 1 | 800ns | package B::OBJECT; | ||
| 87 | } | ||||
| 88 | |||||
| 89 | sub 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 | |||||
| 104 | sub B::IV::int_value { | ||||
| 105 | my ($self) = @_; | ||||
| 106 | return (($self->FLAGS() & SVf_IVisUV()) ? $self->UVX : $self->IV); | ||||
| 107 | } | ||||
| 108 | |||||
| 109 | sub B::NULL::as_string() {""} | ||||
| 110 | 1 | 6µs | *B::IV::as_string = \*B::IV::int_value; | ||
| 111 | 1 | 3µ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. | ||||
| 118 | 1 | 4µs | *B::IV::RV = \*B::PV::RV if $] > 5.012; | ||
| 119 | |||||
| 120 | 1 | 100ns | my $debug; | ||
| 121 | 1 | 200ns | my $op_count = 0; | ||
| 122 | 1 | 300ns | my @parents = (); | ||
| 123 | |||||
| 124 | sub debug { | ||||
| 125 | my ($class, $value) = @_; | ||||
| 126 | $debug = $value; | ||||
| 127 | walkoptree_debug($value); | ||||
| 128 | } | ||||
| 129 | |||||
| 130 | sub class { | ||||
| 131 | my $obj = shift; | ||||
| 132 | my $name = ref $obj; | ||||
| 133 | $name =~ s/^.*:://; | ||||
| 134 | return $name; | ||||
| 135 | } | ||||
| 136 | |||||
| 137 | sub parents { \@parents } | ||||
| 138 | |||||
| 139 | # For debugging | ||||
| 140 | sub peekop { | ||||
| 141 | my $op = shift; | ||||
| 142 | return sprintf("%s (0x%x) %s", class($op), $$op, $op->name); | ||||
| 143 | } | ||||
| 144 | |||||
| 145 | sub 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 | |||||
| 170 | sub compile_stats { | ||||
| 171 | return "Total number of OPs processed: $op_count\n"; | ||||
| 172 | } | ||||
| 173 | |||||
| 174 | sub 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 | |||||
| 181 | 1 | 100ns | my %symtable; | ||
| 182 | |||||
| 183 | sub clearsym { | ||||
| 184 | %symtable = (); | ||||
| 185 | } | ||||
| 186 | |||||
| 187 | sub 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 | |||||
| 193 | sub objsym { | ||||
| 194 | my $obj = shift; | ||||
| 195 | return $symtable{sprintf("sym_%x", $$obj)}; | ||||
| 196 | } | ||||
| 197 | |||||
| 198 | sub 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 | |||||
| 249 | sub walksymtable { | ||||
| 250 | my ($symref, $method, $recurse, $prefix) = @_; | ||||
| 251 | my $sym; | ||||
| 252 | my $ref; | ||||
| 253 | my $fullname; | ||||
| 254 | 2 | 439µs | 2 | 38µ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 # 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 | { | ||||
| 270 | 1 | 100ns | package B::Section; | ||
| 271 | 2 | 500ns | my $output_fh; | ||
| 272 | 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 | |||||
| 335 | 1 | 57µs | 1; | ||
| 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 | |||||
# 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 | |||||
# 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 |