Profile of Symbol.pm

← Index
NYTProf Performance Profile «line view»
For script/ponapi
Run on Wed Feb 10 15:51:26 2016
Reported on Thu Feb 11 09:43:09 2016

Filename | /usr/share/perl/5.18/Symbol.pm
Statements | Executed 1000048 statements in 3.07s

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
100005 | 1 | 1 | 1.46s | 1.46s | Symbol::::gensymSymbol::gensym
200006 | 2 | 2 | 704ms | 704ms | Symbol::::qualifySymbol::qualify
1 | 1 | 1 | 10µs | 10µs | Symbol::::BEGIN@3Symbol::BEGIN@3
0 | 0 | 0 | 0s | 0s | Symbol::::delete_packageSymbol::delete_package
0 | 0 | 0 | 0s | 0s | Symbol::::geniosymSymbol::geniosym
0 | 0 | 0 | 0s | 0s | Symbol::::qualify_to_refSymbol::qualify_to_ref
0 | 0 | 0 | 0s | 0s | Symbol::::ungensymSymbol::ungensym

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Symbol;
2 |  |  |  |  |
3 | 1 | 432µs | 1 | 10µs | # spent 10µs within Symbol::BEGIN@3 which was called: # once (10µs+0s) by IO::Dir::BEGIN@13 at line 3 BEGIN { require 5.005; } # spent 10µs making 1 call to Symbol::BEGIN@3
4 |  |  |  |  |
5 | 1 | 500ns |  |  | require Exporter;
6 | 1 | 5µs |  |  | @ISA = qw(Exporter);
7 | 1 | 800ns |  |  | @EXPORT = qw(gensym ungensym qualify qualify_to_ref);
8 | 1 | 300ns |  |  | @EXPORT_OK = qw(delete_package geniosym);
9 |  |  |  |  |
10 | 1 | 200ns |  |  | $VERSION = '1.07';
11 |  |  |  |  |
12 | 1 | 200ns |  |  | my $genpkg = "Symbol::";
13 | 1 | 100ns |  |  | my $genseq = 0;
14 |  |  |  |  |
15 | 1 | 6µ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 1.46s within Symbol::gensym which was called 100005 times, avg 15µs/call: # 100005 times (1.46s+0s) by IO::Handle::new at line 67 of IO/Handle.pm, avg 15µs/call sub gensym () {
23 | 100005 | 252ms |  |  | my $name = "GEN" . $genseq++;
24 | 100005 | 724ms |  |  | my $ref = \*{$genpkg . $name};
25 | 100005 | 162ms |  |  | delete $$genpkg{$name};
26 | 100005 | 734ms |  |  | $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 704ms within Symbol::qualify which was called 200006 times, avg 4µs/call: # 100003 times (490ms+0s) by IO::Handle::autoflush at line 236 of IO/Handle.pm, avg 5µs/call # 100003 times (214ms+0s) by SelectSaver::new at line 13 of SelectSaver.pm, avg 2µs/call sub qualify ($;$) {
39 | 200006 | 105ms |  |  | my ($name) = @_;
40 | 200006 | 160ms |  |  | if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) {
41 |  |  |  |  | my $pkg;
42 |  |  |  |  | # Global names: special character, "^xyz", or other.
43 |  |  |  |  | if ($name =~ /^(([^a-z])|(\^[a-z_]+))\z/i || $global{$name}) {
44 |  |  |  |  | # RGS 2001-11-05 : translate leading ^X to control-char
45 |  |  |  |  | $name =~ s/^\^([a-z_])/'qq(\c'.$1.')'/eei;
46 |  |  |  |  | $pkg = "main";
47 |  |  |  |  | }
48 |  |  |  |  | else {
49 |  |  |  |  | $pkg = (@_ > 1) ? $_[1] : caller;
50 |  |  |  |  | }
51 |  |  |  |  | $name = $pkg . "::" . $name;
52 |  |  |  |  | }
53 | 200006 | 932ms |  |  | $name;
54 |  |  |  |  | }
55 |  |  |  |  |
56 |  |  |  |  | sub qualify_to_ref ($;$) {
57 |  |  |  |  | return \*{ qualify $_[0], @_ > 1 ? $_[1] : caller };
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 | 5µs |  |  | 1;