Profile of feature.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/share/perl/5.18/feature.pm
Statements | Executed 15 statements in 25µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
0 | 0 | 0 | 0s | 0s | feature::::__commonfeature::__common
0 | 0 | 0 | 0s | 0s | feature::::croakfeature::croak
0 | 0 | 0 | 0s | 0s | feature::::importfeature::import
0 | 0 | 0 | 0s | 0s | feature::::unimportfeature::unimport
0 | 0 | 0 | 0s | 0s | feature::::unknown_featurefeature::unknown_feature
0 | 0 | 0 | 0s | 0s | feature::::unknown_feature_bundlefeature::unknown_feature_bundle

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

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | # -*- buffer-read-only: t -*-
2 |  |  |  |  | # !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
3 |  |  |  |  | # This file is built by regen/feature.pl.
4 |  |  |  |  | # Any changes made here will be lost!
5 |  |  |  |  |
6 |  |  |  |  | package feature;
7 |  |  |  |  |
8 | 1 | 400ns |  |  | our $VERSION = '1.32';
9 |  |  |  |  |
10 | 1 | 6µs |  |  | our %feature = (
11 |  |  |  |  | fc => 'feature_fc',
12 |  |  |  |  | say => 'feature_say',
13 |  |  |  |  | state => 'feature_state',
14 |  |  |  |  | switch => 'feature_switch',
15 |  |  |  |  | evalbytes => 'feature_evalbytes',
16 |  |  |  |  | array_base => 'feature_arybase',
17 |  |  |  |  | current_sub => 'feature___SUB__',
18 |  |  |  |  | lexical_subs => 'feature_lexsubs',
19 |  |  |  |  | unicode_eval => 'feature_unieval',
20 |  |  |  |  | unicode_strings => 'feature_unicode',
21 |  |  |  |  | );
22 |  |  |  |  |
23 | 1 | 6µs |  |  | our %feature_bundle = (
24 |  |  |  |  | "5.10" => [qw(array_base say state switch)],
25 |  |  |  |  | "5.11" => [qw(array_base say state switch unicode_strings)],
26 |  |  |  |  | "5.15" => [qw(current_sub evalbytes fc say state switch unicode_eval unicode_strings)],
27 |  |  |  |  | "all" => [qw(array_base current_sub evalbytes fc lexical_subs say state switch unicode_eval unicode_strings)],
28 |  |  |  |  | "default" => [qw(array_base)],
29 |  |  |  |  | );
30 |  |  |  |  |
31 | 1 | 1µs |  |  | $feature_bundle{"5.12"} = $feature_bundle{"5.11"};
32 | 1 | 300ns |  |  | $feature_bundle{"5.13"} = $feature_bundle{"5.11"};
33 | 1 | 400ns |  |  | $feature_bundle{"5.14"} = $feature_bundle{"5.11"};
34 | 1 | 300ns |  |  | $feature_bundle{"5.16"} = $feature_bundle{"5.15"};
35 | 1 | 200ns |  |  | $feature_bundle{"5.17"} = $feature_bundle{"5.15"};
36 | 1 | 100ns |  |  | $feature_bundle{"5.18"} = $feature_bundle{"5.15"};
37 | 1 | 200ns |  |  | $feature_bundle{"5.9.5"} = $feature_bundle{"5.10"};
38 |  |  |  |  |
39 | 1 | 100ns |  |  | our $hint_shift = 26;
40 | 1 | 0s |  |  | our $hint_mask = 0x1c000000;
41 | 1 | 900ns |  |  | our @hint_bundles = qw( default 5.10 5.11 5.15 );
42 |  |  |  |  |
43 |  |  |  |  | # This gets set (for now) in $^H as well as in %^H,
44 |  |  |  |  | # for runtime speed of the uc/lc/ucfirst/lcfirst functions.
45 |  |  |  |  | # See HINT_UNI_8_BIT in perl.h.
46 | 1 | 100ns |  |  | our $hint_uni8bit = 0x00000800;
47 |  |  |  |  |
48 |  |  |  |  | # TODO:
49 |  |  |  |  | # - think about versioned features (use feature switch => 2)
50 |  |  |  |  |
51 |  |  |  |  | sub import {
52 |  |  |  |  | my $class = shift;
53 |  |  |  |  |
54 |  |  |  |  | if (!@_) {
55 |  |  |  |  | croak("No features specified");
56 |  |  |  |  | }
57 |  |  |  |  |
58 |  |  |  |  | __common(1, @_);
59 |  |  |  |  | }
60 |  |  |  |  |
61 |  |  |  |  | sub unimport {
62 |  |  |  |  | my $class = shift;
63 |  |  |  |  |
64 |  |  |  |  | # A bare C<no feature> should reset to the default bundle
65 |  |  |  |  | if (!@_) {
66 |  |  |  |  | $^H &= ~($hint_uni8bit|$hint_mask);
67 |  |  |  |  | return;
68 |  |  |  |  | }
69 |  |  |  |  |
70 |  |  |  |  | __common(0, @_);
71 |  |  |  |  | }
72 |  |  |  |  |
73 |  |  |  |  | sub __common {
74 |  |  |  |  | my $import = shift;
75 |  |  |  |  | my $bundle_number = $^H & $hint_mask;
76 |  |  |  |  | my $features = $bundle_number != $hint_mask
77 |  |  |  |  | && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]};
78 |  |  |  |  | if ($features) {
79 |  |  |  |  | # Features are enabled implicitly via bundle hints.
80 |  |  |  |  | # Delete any keys that may be left over from last time.
81 |  |  |  |  | delete @^H{ values(%feature) };
82 |  |  |  |  | $^H |= $hint_mask;
83 |  |  |  |  | for (@$features) {
84 |  |  |  |  | $^H{$feature{$_}} = 1;
85 |  |  |  |  | $^H |= $hint_uni8bit if $_ eq 'unicode_strings';
86 |  |  |  |  | }
87 |  |  |  |  | }
88 |  |  |  |  | while (@_) {
89 |  |  |  |  | my $name = shift;
90 |  |  |  |  | if (substr($name, 0, 1) eq ":") {
91 |  |  |  |  | my $v = substr($name, 1);
92 |  |  |  |  | if (!exists $feature_bundle{$v}) {
93 |  |  |  |  | $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/;
94 |  |  |  |  | if (!exists $feature_bundle{$v}) {
95 |  |  |  |  | unknown_feature_bundle(substr($name, 1));
96 |  |  |  |  | }
97 |  |  |  |  | }
98 |  |  |  |  | unshift @_, @{$feature_bundle{$v}};
99 |  |  |  |  | next;
100 |  |  |  |  | }
101 |  |  |  |  | if (!exists $feature{$name}) {
102 |  |  |  |  | unknown_feature($name);
103 |  |  |  |  | }
104 |  |  |  |  | if ($import) {
105 |  |  |  |  | $^H{$feature{$name}} = 1;
106 |  |  |  |  | $^H |= $hint_uni8bit if $name eq 'unicode_strings';
107 |  |  |  |  | } else {
108 |  |  |  |  | delete $^H{$feature{$name}};
109 |  |  |  |  | $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';
110 |  |  |  |  | }
111 |  |  |  |  | }
112 |  |  |  |  | }
113 |  |  |  |  |
114 |  |  |  |  | sub unknown_feature {
115 |  |  |  |  | my $feature = shift;
116 |  |  |  |  | croak(sprintf('Feature "%s" is not supported by Perl %vd',
117 |  |  |  |  | $feature, $^V));
118 |  |  |  |  | }
119 |  |  |  |  |
120 |  |  |  |  | sub unknown_feature_bundle {
121 |  |  |  |  | my $feature = shift;
122 |  |  |  |  | croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',
123 |  |  |  |  | $feature, $^V));
124 |  |  |  |  | }
125 |  |  |  |  |
126 |  |  |  |  | sub croak {
127 |  |  |  |  | require Carp;
128 |  |  |  |  | Carp::croak(@_);
129 |  |  |  |  | }
130 |  |  |  |  |
131 | 1 | 8µs |  |  | 1;
132 |  |  |  |  |
133 |  |  |  |  | # ex: set ro: