| Filename | /usr/share/perl/5.28/Symbol.pm |
| Statements | Executed 669370 statements in 2.64s |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 55780 | 2 | 1 | 865ms | 1.10s | Symbol::qualify_to_ref |
| 83670 | 2 | 2 | 693ms | 828ms | Symbol::qualify |
| 55780 | 2 | 1 | 536ms | 536ms | Symbol::gensym |
| 27890 | 1 | 1 | 104ms | 104ms | Symbol::CORE:match (opcode) |
| 27890 | 1 | 1 | 31.5ms | 31.5ms | Symbol::CORE:subst (opcode) |
| 1 | 1 | 1 | 122µs | 122µs | Symbol::BEGIN@3 |
| 0 | 0 | 0 | 0s | 0s | Symbol::delete_package |
| 0 | 0 | 0 | 0s | 0s | Symbol::geniosym |
| 0 | 0 | 0 | 0s | 0s | Symbol::ungensym |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Symbol; | ||||
| 2 | |||||
| 3 | 1 | 554µs | 1 | 122µs | # spent 122µs within Symbol::BEGIN@3 which was called:
# once (122µs+0s) by IO::Handle::BEGIN@6 at line 3 # spent 122µs making 1 call to Symbol::BEGIN@3 |
| 4 | |||||
| 5 | 1 | 500ns | require Exporter; | ||
| 6 | 1 | 6µs | @ISA = qw(Exporter); | ||
| 7 | 1 | 600ns | @EXPORT = qw(gensym ungensym qualify qualify_to_ref); | ||
| 8 | 1 | 400ns | @EXPORT_OK = qw(delete_package geniosym); | ||
| 9 | |||||
| 10 | 1 | 200ns | $VERSION = '1.08'; | ||
| 11 | |||||
| 12 | 1 | 200ns | my $genpkg = "Symbol::"; | ||
| 13 | 1 | 100ns | my $genseq = 0; | ||
| 14 | |||||
| 15 | 1 | 8µs | my %global = map {$_ => 1} qw(ARGV ARGVOUT ENV INC SIG STDERR STDIN STDOUT); | ||
| 16 | |||||
| 17 | # | ||||
| 18 | # Note that we never _copy_ the glob; we just make a ref to it. | ||||
| 19 | # If we did copy it, then SVf_FAKE would be set on the copy, and | ||||
| 20 | # glob-specific behaviors (e.g. C<*$ref = \&func>) wouldn't work. | ||||
| 21 | # | ||||
| 22 | # spent 536ms within Symbol::gensym which was called 55780 times, avg 10µs/call:
# 27890 times (375ms+0s) by IO::CaptureOutput::_proxy::new at line 156 of IO/CaptureOutput.pm, avg 13µs/call
# 27890 times (161ms+0s) by IO::CaptureOutput::_proxy::new at line 164 of IO/CaptureOutput.pm, avg 6µs/call | ||||
| 23 | 55780 | 38.2ms | my $name = "GEN" . $genseq++; | ||
| 24 | 55780 | 373ms | my $ref = \*{$genpkg . $name}; | ||
| 25 | 55780 | 45.7ms | delete $$genpkg{$name}; | ||
| 26 | 55780 | 243ms | $ref; | ||
| 27 | } | ||||
| 28 | |||||
| 29 | sub geniosym () { | ||||
| 30 | my $sym = gensym(); | ||||
| 31 | # force the IO slot to be filled | ||||
| 32 | select(select $sym); | ||||
| 33 | *$sym{IO}; | ||||
| 34 | } | ||||
| 35 | |||||
| 36 | sub ungensym ($) {} | ||||
| 37 | |||||
| 38 | # spent 828ms (693+136) within Symbol::qualify which was called 83670 times, avg 10µs/call:
# 55780 times (239ms+0s) by Symbol::qualify_to_ref at line 57, avg 4µs/call
# 27890 times (453ms+136ms) by IO::CaptureOutput::_proxy::new at line 148 of IO/CaptureOutput.pm, avg 21µs/call | ||||
| 39 | 83670 | 45.2ms | my ($name) = @_; | ||
| 40 | 83670 | 115ms | if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) { | ||
| 41 | 27890 | 5.25ms | my $pkg; | ||
| 42 | # Global names: special character, "^xyz", or other. | ||||
| 43 | 27890 | 266ms | 27890 | 104ms | if ($name =~ /^(([^a-z])|(\^[a-z_]+))\z/i || $global{$name}) { # spent 104ms making 27890 calls to Symbol::CORE:match, avg 4µs/call |
| 44 | # RGS 2001-11-05 : translate leading ^X to control-char | ||||
| 45 | 27890 | 164ms | 27890 | 31.5ms | $name =~ s/^\^([a-z_])/'qq(\c'.$1.')'/eei; # spent 31.5ms making 27890 calls to Symbol::CORE:subst, avg 1µs/call |
| 46 | 27890 | 18.3ms | $pkg = "main"; | ||
| 47 | } | ||||
| 48 | else { | ||||
| 49 | $pkg = (@_ > 1) ? $_[1] : caller; | ||||
| 50 | } | ||||
| 51 | 27890 | 22.7ms | $name = $pkg . "::" . $name; | ||
| 52 | } | ||||
| 53 | 83670 | 439ms | $name; | ||
| 54 | } | ||||
| 55 | |||||
| 56 | # spent 1.10s (865ms+239ms) within Symbol::qualify_to_ref which was called 55780 times, avg 20µs/call:
# 27890 times (627ms+191ms) by IO::CaptureOutput::_proxy::DESTROY at line 193 of IO/CaptureOutput.pm, avg 29µs/call
# 27890 times (238ms+48.1ms) by IO::CaptureOutput::_proxy::new at line 149 of IO/CaptureOutput.pm, avg 10µs/call | ||||
| 57 | 55780 | 862ms | 55780 | 239ms | return \*{ qualify $_[0], @_ > 1 ? $_[1] : caller }; # spent 239ms making 55780 calls to Symbol::qualify, avg 4µs/call |
| 58 | } | ||||
| 59 | |||||
| 60 | # | ||||
| 61 | # of Safe.pm lineage | ||||
| 62 | # | ||||
| 63 | sub delete_package ($) { | ||||
| 64 | my $pkg = shift; | ||||
| 65 | |||||
| 66 | # expand to full symbol table name if needed | ||||
| 67 | |||||
| 68 | unless ($pkg =~ /^main::.*::$/) { | ||||
| 69 | $pkg = "main$pkg" if $pkg =~ /^::/; | ||||
| 70 | $pkg = "main::$pkg" unless $pkg =~ /^main::/; | ||||
| 71 | $pkg .= '::' unless $pkg =~ /::$/; | ||||
| 72 | } | ||||
| 73 | |||||
| 74 | my($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/; | ||||
| 75 | my $stem_symtab = *{$stem}{HASH}; | ||||
| 76 | return unless defined $stem_symtab and exists $stem_symtab->{$leaf}; | ||||
| 77 | |||||
| 78 | # free all the symbols in the package | ||||
| 79 | |||||
| 80 | my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH}; | ||||
| 81 | foreach my $name (keys %$leaf_symtab) { | ||||
| 82 | undef *{$pkg . $name}; | ||||
| 83 | } | ||||
| 84 | |||||
| 85 | # delete the symbol table | ||||
| 86 | |||||
| 87 | %$leaf_symtab = (); | ||||
| 88 | delete $stem_symtab->{$leaf}; | ||||
| 89 | } | ||||
| 90 | |||||
| 91 | 1 | 8µs | 1; | ||
# spent 104ms within Symbol::CORE:match which was called 27890 times, avg 4µs/call:
# 27890 times (104ms+0s) by Symbol::qualify at line 43, avg 4µs/call | |||||
# spent 31.5ms within Symbol::CORE:subst which was called 27890 times, avg 1µs/call:
# 27890 times (31.5ms+0s) by Symbol::qualify at line 45, avg 1µs/call |