Profile of re.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:11 2016

Filename | /usr/lib/perl/5.18/re.pm
Statements | Executed 63 statements in 1.30ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
3 | 1 | 1 | 56µs | 62µs | re::::bitsre::bits
3 | 3 | 3 | 21µs | 84µs | re::::importre::import
1 | 1 | 1 | 13µs | 36µs | re::::BEGIN@4re::BEGIN@4
1 | 1 | 1 | 8µs | 17µs | re::::BEGIN@5re::BEGIN@5
2 | 2 | 1 | 4µs | 4µs | re::::CORE:substre::CORE:subst (opcode)
3 | 2 | 1 | 3µs | 3µs | re::::CORE:matchre::CORE:match (opcode)
0 | 0 | 0 | 0s | 0s | re::::_load_unloadre::_load_unload
0 | 0 | 0 | 0s | 0s | re::::setcolorre::setcolor
0 | 0 | 0 | 0s | 0s | re::::unimportre::unimport

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

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package re;
2 |  |  |  |  |
3 |  |  |  |  | # pragma for controlling the regexp engine
4 | 2 | 24µs | 2 | 59µs | # spent 36µs (13+23) within re::BEGIN@4 which was called: # once (13µs+23µs) by Moose::Util::TypeConstraints::BEGIN@621 at line 4 use strict; # spent 36µs making 1 call to re::BEGIN@4 # spent 23µs making 1 call to strict::import
5 | 2 | 944µs | 2 | 26µs | # spent 17µs (8+9) within re::BEGIN@5 which was called: # once (8µs+9µs) by Moose::Util::TypeConstraints::BEGIN@621 at line 5 use warnings; # spent 17µs making 1 call to re::BEGIN@5 # spent 9µs making 1 call to warnings::import
6 |  |  |  |  |
7 | 1 | 400ns |  |  | our $VERSION = "0.23";
8 | 1 | 9µs |  |  | our @ISA = qw(Exporter);
9 | 1 | 1µs |  |  | our @EXPORT_OK = ('regmust',
10 |  |  |  |  | qw(is_regexp regexp_pattern
11 |  |  |  |  | regname regnames regnames_count));
12 | 1 | 7µs |  |  | our %EXPORT_OK = map { $_ => 1 } @EXPORT_OK;
13 |  |  |  |  |
14 | 1 | 1µs |  |  | my %bitmask = (
15 |  |  |  |  | taint => 0x00100000, # HINT_RE_TAINT
16 |  |  |  |  | eval => 0x00200000, # HINT_RE_EVAL
17 |  |  |  |  | );
18 |  |  |  |  |
19 | 1 | 200ns |  |  | my $flags_hint = 0x02000000; # HINT_RE_FLAGS
20 | 1 | 0s |  |  | my $PMMOD_SHIFT = 0;
21 | 1 | 5µs |  |  | my %reflags = (
22 |  |  |  |  | m => 1 << ($PMMOD_SHIFT + 0),
23 |  |  |  |  | s => 1 << ($PMMOD_SHIFT + 1),
24 |  |  |  |  | i => 1 << ($PMMOD_SHIFT + 2),
25 |  |  |  |  | x => 1 << ($PMMOD_SHIFT + 3),
26 |  |  |  |  | p => 1 << ($PMMOD_SHIFT + 4),
27 |  |  |  |  | # special cases:
28 |  |  |  |  | d => 0,
29 |  |  |  |  | l => 1,
30 |  |  |  |  | u => 2,
31 |  |  |  |  | a => 3,
32 |  |  |  |  | aa => 4,
33 |  |  |  |  | );
34 |  |  |  |  |
35 |  |  |  |  | sub setcolor {
36 |  |  |  |  | eval { # Ignore errors
37 |  |  |  |  | require Term::Cap;
38 |  |  |  |  |
39 |  |  |  |  | my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning.
40 |  |  |  |  | my $props = $ENV{PERL_RE_TC} || 'md,me,so,se,us,ue';
41 |  |  |  |  | my @props = split /,/, $props;
42 |  |  |  |  | my $colors = join "\t", map {$terminal->Tputs($_,1)} @props;
43 |  |  |  |  |
44 |  |  |  |  | $colors =~ s/\0//g;
45 |  |  |  |  | $ENV{PERL_RE_COLORS} = $colors;
46 |  |  |  |  | };
47 |  |  |  |  | if ($@) {
48 |  |  |  |  | $ENV{PERL_RE_COLORS} ||= qq'\t\t> <\t> <\t\t';
49 |  |  |  |  | }
50 |  |  |  |  |
51 |  |  |  |  | }
52 |  |  |  |  |
53 | 1 | 7µs |  |  | my %flags = (
54 |  |  |  |  | COMPILE => 0x0000FF,
55 |  |  |  |  | PARSE => 0x000001,
56 |  |  |  |  | OPTIMISE => 0x000002,
57 |  |  |  |  | TRIEC => 0x000004,
58 |  |  |  |  | DUMP => 0x000008,
59 |  |  |  |  | FLAGS => 0x000010,
60 |  |  |  |  |
61 |  |  |  |  | EXECUTE => 0x00FF00,
62 |  |  |  |  | INTUIT => 0x000100,
63 |  |  |  |  | MATCH => 0x000200,
64 |  |  |  |  | TRIEE => 0x000400,
65 |  |  |  |  |
66 |  |  |  |  | EXTRA => 0xFF0000,
67 |  |  |  |  | TRIEM => 0x010000,
68 |  |  |  |  | OFFSETS => 0x020000,
69 |  |  |  |  | OFFSETSDBG => 0x040000,
70 |  |  |  |  | STATE => 0x080000,
71 |  |  |  |  | OPTIMISEM => 0x100000,
72 |  |  |  |  | STACK => 0x280000,
73 |  |  |  |  | BUFFERS => 0x400000,
74 |  |  |  |  | GPOS => 0x800000,
75 |  |  |  |  | );
76 | 1 | 2µs |  |  | $flags{ALL} = -1 & ~($flags{OFFSETS}|$flags{OFFSETSDBG}|$flags{BUFFERS});
77 | 1 | 600ns |  |  | $flags{All} = $flags{all} = $flags{DUMP} | $flags{EXECUTE};
78 | 1 | 500ns |  |  | $flags{Extra} = $flags{EXECUTE} | $flags{COMPILE} | $flags{GPOS};
79 | 1 | 600ns |  |  | $flags{More} = $flags{MORE} = $flags{All} | $flags{TRIEC} | $flags{TRIEM} | $flags{STATE};
80 | 1 | 400ns |  |  | $flags{State} = $flags{DUMP} | $flags{EXECUTE} | $flags{STATE};
81 | 1 | 400ns |  |  | $flags{TRIE} = $flags{DUMP} | $flags{EXECUTE} | $flags{TRIEC};
82 |  |  |  |  |
83 | 1 | 3µs |  |  | if (defined &DynaLoader::boot_DynaLoader) {
84 | 1 | 1µs |  |  | require XSLoader;
85 | 1 | 189µs | 1 | 177µs | XSLoader::load(); # spent 177µs making 1 call to XSLoader::load
86 |  |  |  |  | }
87 |  |  |  |  | # else we're miniperl
88 |  |  |  |  | # We need to work for miniperl, because the XS toolchain uses Text::Wrap, which
89 |  |  |  |  | # uses re 'taint'.
90 |  |  |  |  |
91 |  |  |  |  | sub _load_unload {
92 |  |  |  |  | my ($on)= @_;
93 |  |  |  |  | if ($on) {
94 |  |  |  |  | # We call install() every time, as if we didn't, we wouldn't
95 |  |  |  |  | # "see" any changes to the color environment var since
96 |  |  |  |  | # the last time it was called.
97 |  |  |  |  |
98 |  |  |  |  | # install() returns an integer, which if casted properly
99 |  |  |  |  | # in C resolves to a structure containing the regexp
100 |  |  |  |  | # hooks. Setting it to a random integer will guarantee
101 |  |  |  |  | # segfaults.
102 |  |  |  |  | $^H{regcomp} = install();
103 |  |  |  |  | } else {
104 |  |  |  |  | delete $^H{regcomp};
105 |  |  |  |  | }
106 |  |  |  |  | }
107 |  |  |  |  |
108 |  |  |  |  | # spent 62µs (56+6) within re::bits which was called 3 times, avg 21µs/call: # 3 times (56µs+6µs) by re::import at line 215, avg 21µs/call sub bits {
109 | 3 | 2µs |  |  | my $on = shift;
110 | 3 | 500ns |  |  | my $bits = 0;
111 |  |  |  |  | ARG:
112 | 3 | 5µs |  |  | foreach my $idx (0..$#_){
113 | 3 | 2µs |  |  | my $s=$_[$idx];
114 | 3 | 18µs | 1 | 2µs | if ($s eq 'Debug' or $s eq 'Debugcolor') { # spent 2µs making 1 call to re::CORE:subst
115 |  |  |  |  | setcolor() if $s =~/color/i;
116 |  |  |  |  | ${^RE_DEBUG_FLAGS} = 0 unless defined ${^RE_DEBUG_FLAGS};
117 |  |  |  |  | for my $idx ($idx+1..$#_) {
118 |  |  |  |  | if ($flags{$_[$idx]}) {
119 |  |  |  |  | if ($on) {
120 |  |  |  |  | ${^RE_DEBUG_FLAGS} |= $flags{$_[$idx]};
121 |  |  |  |  | } else {
122 |  |  |  |  | ${^RE_DEBUG_FLAGS} &= ~ $flags{$_[$idx]};
123 |  |  |  |  | }
124 |  |  |  |  | } else {
125 |  |  |  |  | require Carp;
126 |  |  |  |  | Carp::carp("Unknown \"re\" Debug flag '$_[$idx]', possible flags: ",
127 |  |  |  |  | join(", ",sort keys %flags ) );
128 |  |  |  |  | }
129 |  |  |  |  | }
130 |  |  |  |  | _load_unload($on ? 1 : ${^RE_DEBUG_FLAGS});
131 |  |  |  |  | last;
132 |  |  |  |  | } elsif ($s eq 'debug' or $s eq 'debugcolor') {
133 |  |  |  |  | setcolor() if $s =~/color/i;
134 |  |  |  |  | _load_unload($on);
135 |  |  |  |  | last;
136 |  |  |  |  | } elsif (exists $bitmask{$s}) {
137 |  |  |  |  | $bits |= $bitmask{$s};
138 |  |  |  |  | } elsif ($EXPORT_OK{$s}) {
139 |  |  |  |  | require Exporter;
140 |  |  |  |  | re->export_to_level(2, 're', $s);
141 |  |  |  |  | } elsif ($s =~ s/^\///) {
142 | 1 | 700ns |  |  | my $reflags = $^H{reflags} || 0;
143 | 1 | 100ns |  |  | my $seen_charset;
144 | 1 | 5µs | 1 | 2µs | while ($s =~ m/( . )/gx) { # spent 2µs making 1 call to re::CORE:match
145 | 1 | 4µs |  |  | local $_ = $1;
146 | 1 | 6µs | 2 | 1µs | if (/[adul]/) { # spent 1µs making 2 calls to re::CORE:match, avg 550ns/call
147 |  |  |  |  | # The 'a' may be repeated; hide this from the rest of the
148 |  |  |  |  | # code by counting and getting rid of all of them, then
149 |  |  |  |  | # changing to 'aa' if there is a repeat.
150 | 1 | 700ns |  |  | if ($_ eq 'a') {
151 | 1 | 400ns |  |  | my $sav_pos = pos $s;
152 | 1 | 4µs | 1 | 2µs | my $a_count = $s =~ s/a//g; # spent 2µs making 1 call to re::CORE:subst
153 | 1 | 2µs |  |  | pos $s = $sav_pos - 1; # -1 because got rid of the 'a'
154 | 1 | 1µs |  |  | if ($a_count > 2) {
155 |  |  |  |  | require Carp;
156 |  |  |  |  | Carp::carp(
157 |  |  |  |  | qq 'The "a" flag may only appear a maximum of twice'
158 |  |  |  |  | );
159 |  |  |  |  | }
160 |  |  |  |  | elsif ($a_count == 2) {
161 | 1 | 300ns |  |  | $_ = 'aa';
162 |  |  |  |  | }
163 |  |  |  |  | }
164 | 1 | 400ns |  |  | if ($on) {
165 | 1 | 200ns |  |  | if ($seen_charset) {
166 |  |  |  |  | require Carp;
167 |  |  |  |  | if ($seen_charset ne $_) {
168 |  |  |  |  | Carp::carp(
169 |  |  |  |  | qq 'The "$seen_charset" and "$_" flags '
170 |  |  |  |  | .qq 'are exclusive'
171 |  |  |  |  | );
172 |  |  |  |  | }
173 |  |  |  |  | else {
174 |  |  |  |  | Carp::carp(
175 |  |  |  |  | qq 'The "$seen_charset" flag may not appear '
176 |  |  |  |  | .qq 'twice'
177 |  |  |  |  | );
178 |  |  |  |  | }
179 |  |  |  |  | }
180 | 1 | 2µs |  |  | $^H{reflags_charset} = $reflags{$_};
181 | 1 | 2µs |  |  | $seen_charset = $_;
182 |  |  |  |  | }
183 |  |  |  |  | else {
184 |  |  |  |  | delete $^H{reflags_charset}
185 |  |  |  |  | if defined $^H{reflags_charset}
186 |  |  |  |  | && $^H{reflags_charset} == $reflags{$_};
187 |  |  |  |  | }
188 |  |  |  |  | } elsif (exists $reflags{$_}) {
189 |  |  |  |  | $on
190 |  |  |  |  | ? $reflags |= $reflags{$_}
191 |  |  |  |  | : ($reflags &= ~$reflags{$_});
192 |  |  |  |  | } else {
193 |  |  |  |  | require Carp;
194 |  |  |  |  | Carp::carp(
195 |  |  |  |  | qq'Unknown regular expression flag "$_"'
196 |  |  |  |  | );
197 |  |  |  |  | next ARG;
198 |  |  |  |  | }
199 |  |  |  |  | }
200 | 1 | 3µs |  |  | ($^H{reflags} = $reflags or defined $^H{reflags_charset})
201 |  |  |  |  | ? $^H |= $flags_hint
202 |  |  |  |  | : ($^H &= ~$flags_hint);
203 |  |  |  |  | } else {
204 |  |  |  |  | require Carp;
205 |  |  |  |  | Carp::carp("Unknown \"re\" subpragma '$s' (known ones are: ",
206 |  |  |  |  | join(', ', map {qq('$_')} 'debug', 'debugcolor', sort keys %bitmask),
207 |  |  |  |  | ")");
208 |  |  |  |  | }
209 |  |  |  |  | }
210 | 3 | 10µs |  |  | $bits;
211 |  |  |  |  | }
212 |  |  |  |  |
213 |  |  |  |  | # spent 84µs (21+62) within re::import which was called 3 times, avg 28µs/call: # once (6µs+47µs) by utf8::BEGIN@4 at line 4 of utf8_heavy.pl # once (8µs+9µs) by B::Deparse::BEGIN@3871 at line 3871 of B/Deparse.pm # once (8µs+6µs) by Moose::Util::TypeConstraints::BEGIN@621 at line 621 of Moose/Util/TypeConstraints.pm sub import {
214 | 3 | 2µs |  |  | shift;
215 | 3 | 18µs | 3 | 62µs | $^H |= bits(1, @_); # spent 62µs making 3 calls to re::bits, avg 21µs/call
216 |  |  |  |  | }
217 |  |  |  |  |
218 |  |  |  |  | sub unimport {
219 |  |  |  |  | shift;
220 |  |  |  |  | $^H &= ~ bits(0, @_);
221 |  |  |  |  | }
222 |  |  |  |  |
223 | 1 | 15µs |  |  | 1;
224 |  |  |  |  |
225 |  |  |  |  | __END__
|  |  |  |  | # spent 3µs within re::CORE:match which was called 3 times, avg 867ns/call: # 2 times (1µs+0s) by re::bits at line 146, avg 550ns/call # once (2µs+0s) by re::bits at line 144 sub re::CORE:match; # opcode
|  |  |  |  | # spent 4µs within re::CORE:subst which was called 2 times, avg 2µs/call: # once (2µs+0s) by re::bits at line 152 # once (2µs+0s) by re::bits at line 114 sub re::CORE:subst; # opcode