Filename | /usr/share/perl/5.14/bigint.pm |
Statements | Executed 349 statements in 4.76ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
9 | 9 | 1 | 33.2ms | 60.6ms | import | bigint::
1 | 1 | 1 | 43µs | 43µs | BEGIN@2 | bigint::
1 | 1 | 1 | 24µs | 50µs | BEGIN@269 | bigint::
1 | 1 | 1 | 20µs | 60µs | BEGIN@5 | bigint::
1 | 1 | 1 | 18µs | 24µs | BEGIN@10 | bigint::
1 | 1 | 1 | 17µs | 38µs | BEGIN@275 | bigint::
1 | 1 | 1 | 15µs | 61µs | BEGIN@11 | bigint::
1 | 1 | 1 | 15µs | 97µs | BEGIN@18 | bigint::
1 | 1 | 1 | 15µs | 38µs | BEGIN@25 | bigint::
1 | 1 | 1 | 14µs | 33µs | BEGIN@33 | bigint::
0 | 0 | 0 | 0s | 0s | AUTOLOAD | bigint::
0 | 0 | 0 | 0s | 0s | NaN | bigint::
0 | 0 | 0 | 0s | 0s | PI | bigint::
0 | 0 | 0 | 0s | 0s | __ANON__[:262] | bigint::
0 | 0 | 0 | 0s | 0s | __ANON__[:264] | bigint::
0 | 0 | 0 | 0s | 0s | __ANON__[:39] | bigint::
0 | 0 | 0 | 0s | 0s | _binary_constant | bigint::
0 | 0 | 0 | 0s | 0s | _float_constant | bigint::
0 | 0 | 0 | 0s | 0s | _hex | bigint::
0 | 0 | 0 | 0s | 0s | _hex_global | bigint::
0 | 0 | 0 | 0s | 0s | _oct | bigint::
0 | 0 | 0 | 0s | 0s | _oct_global | bigint::
0 | 0 | 0 | 0s | 0s | bexp | bigint::
0 | 0 | 0 | 0s | 0s | bpi | bigint::
0 | 0 | 0 | 0s | 0s | e | bigint::
0 | 0 | 0 | 0s | 0s | in_effect | bigint::
0 | 0 | 0 | 0s | 0s | inf | bigint::
0 | 0 | 0 | 0s | 0s | unimport | bigint::
0 | 0 | 0 | 0s | 0s | upgrade | bigint::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package bigint; | ||||
2 | 2 | 114µs | 1 | 43µs | # spent 43µs within bigint::BEGIN@2 which was called:
# once (43µs+0s) by Value::Convertor::BEGIN@364 at line 2 # spent 43µs making 1 call to bigint::BEGIN@2 |
3 | |||||
4 | 1 | 2µs | $VERSION = '0.27'; | ||
5 | 2 | 120µs | 2 | 99µs | # spent 60µs (20+40) within bigint::BEGIN@5 which was called:
# once (20µs+40µs) by Value::Convertor::BEGIN@364 at line 5 # spent 60µs making 1 call to bigint::BEGIN@5
# spent 40µs making 1 call to Exporter::import |
6 | 1 | 13µs | @ISA = qw( Exporter ); | ||
7 | 1 | 2µs | @EXPORT_OK = qw( PI e bpi bexp ); | ||
8 | 1 | 1µs | @EXPORT = qw( inf NaN ); | ||
9 | |||||
10 | 2 | 48µs | 2 | 31µs | # spent 24µs (18+7) within bigint::BEGIN@10 which was called:
# once (18µs+7µs) by Value::Convertor::BEGIN@364 at line 10 # spent 24µs making 1 call to bigint::BEGIN@10
# spent 7µs making 1 call to strict::import |
11 | 2 | 83µs | 2 | 106µs | # spent 61µs (15+45) within bigint::BEGIN@11 which was called:
# once (15µs+45µs) by Value::Convertor::BEGIN@364 at line 11 # spent 61µs making 1 call to bigint::BEGIN@11
# spent 45µs making 1 call to overload::import |
12 | |||||
13 | ############################################################################## | ||||
14 | |||||
15 | # These are all alike, and thus faked by AUTOLOAD | ||||
16 | |||||
17 | 1 | 2µs | my @faked = qw/round_mode accuracy precision div_scale/; | ||
18 | 2 | 111µs | 2 | 180µs | # spent 97µs (15+82) within bigint::BEGIN@18 which was called:
# once (15µs+82µs) by Value::Convertor::BEGIN@364 at line 18 # spent 97µs making 1 call to bigint::BEGIN@18
# spent 82µs making 1 call to vars::import |
19 | |||||
20 | sub AUTOLOAD | ||||
21 | { | ||||
22 | my $name = $AUTOLOAD; | ||||
23 | |||||
24 | $name =~ s/.*:://; # split package | ||||
25 | 2 | 110µs | 2 | 62µs | # spent 38µs (15+24) within bigint::BEGIN@25 which was called:
# once (15µs+24µs) by Value::Convertor::BEGIN@364 at line 25 # spent 38µs making 1 call to bigint::BEGIN@25
# spent 24µs making 1 call to strict::unimport |
26 | foreach my $n (@faked) | ||||
27 | { | ||||
28 | if ($n eq $name) | ||||
29 | { | ||||
30 | *{"bigint::$name"} = sub | ||||
31 | { | ||||
32 | my $self = shift; | ||||
33 | 2 | 2.71ms | 2 | 52µs | # spent 33µs (14+19) within bigint::BEGIN@33 which was called:
# once (14µs+19µs) by Value::Convertor::BEGIN@364 at line 33 # spent 33µs making 1 call to bigint::BEGIN@33
# spent 19µs making 1 call to strict::unimport |
34 | if (defined $_[0]) | ||||
35 | { | ||||
36 | return Math::BigInt->$name($_[0]); | ||||
37 | } | ||||
38 | return Math::BigInt->$name(); | ||||
39 | }; | ||||
40 | return &$name; | ||||
41 | } | ||||
42 | } | ||||
43 | |||||
44 | # delayed load of Carp and avoid recursion | ||||
45 | require Carp; | ||||
46 | Carp::croak ("Can't call bigint\-\>$name, not a valid method"); | ||||
47 | } | ||||
48 | |||||
49 | sub upgrade | ||||
50 | { | ||||
51 | $Math::BigInt::upgrade; | ||||
52 | } | ||||
53 | |||||
54 | sub _binary_constant | ||||
55 | { | ||||
56 | # this takes a binary/hexadecimal/octal constant string and returns it | ||||
57 | # as string suitable for new. Basically it converts octal to decimal, and | ||||
58 | # passes every thing else unmodified back. | ||||
59 | my $string = shift; | ||||
60 | |||||
61 | return Math::BigInt->new($string) if $string =~ /^0[bx]/; | ||||
62 | |||||
63 | # so it must be an octal constant | ||||
64 | Math::BigInt->from_oct($string); | ||||
65 | } | ||||
66 | |||||
67 | sub _float_constant | ||||
68 | { | ||||
69 | # this takes a floating point constant string and returns it truncated to | ||||
70 | # integer. For instance, '4.5' => '4', '1.234e2' => '123' etc | ||||
71 | my $float = shift; | ||||
72 | |||||
73 | # some simple cases first | ||||
74 | return $float if ($float =~ /^[+-]?[0-9]+$/); # '+123','-1','0' etc | ||||
75 | return $float | ||||
76 | if ($float =~ /^[+-]?[0-9]+\.?[eE]\+?[0-9]+$/); # 123e2, 123.e+2 | ||||
77 | return '0' if ($float =~ /^[+-]?[0]*\.[0-9]+$/); # .2, 0.2, -.1 | ||||
78 | if ($float =~ /^[+-]?[0-9]+\.[0-9]*$/) # 1., 1.23, -1.2 etc | ||||
79 | { | ||||
80 | $float =~ s/\..*//; | ||||
81 | return $float; | ||||
82 | } | ||||
83 | my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split($float); | ||||
84 | return $float if !defined $mis; # doesn't look like a number to me | ||||
85 | my $ec = int($$ev); | ||||
86 | my $sign = $$mis; $sign = '' if $sign eq '+'; | ||||
87 | if ($$es eq '-') | ||||
88 | { | ||||
89 | # ignore fraction part entirely | ||||
90 | if ($ec >= length($$miv)) # 123.23E-4 | ||||
91 | { | ||||
92 | return '0'; | ||||
93 | } | ||||
94 | return $sign . substr ($$miv,0,length($$miv)-$ec); # 1234.45E-2 = 12 | ||||
95 | } | ||||
96 | # xE+y | ||||
97 | if ($ec >= length($$mfv)) | ||||
98 | { | ||||
99 | $ec -= length($$mfv); | ||||
100 | return $sign.$$miv.$$mfv if $ec == 0; # 123.45E+2 => 12345 | ||||
101 | return $sign.$$miv.$$mfv.'E'.$ec; # 123.45e+3 => 12345e1 | ||||
102 | } | ||||
103 | $mfv = substr($$mfv,0,$ec); | ||||
104 | $sign.$$miv.$mfv; # 123.45e+1 => 1234 | ||||
105 | } | ||||
106 | |||||
107 | sub unimport | ||||
108 | { | ||||
109 | $^H{bigint} = undef; # no longer in effect | ||||
110 | overload::remove_constant('binary','','float','','integer'); | ||||
111 | } | ||||
112 | |||||
113 | sub in_effect | ||||
114 | { | ||||
115 | my $level = shift || 0; | ||||
116 | my $hinthash = (caller($level))[10]; | ||||
117 | $hinthash->{bigint}; | ||||
118 | } | ||||
119 | |||||
120 | ############################################################################# | ||||
121 | # the following two routines are for "use bigint qw/hex oct/;": | ||||
122 | |||||
123 | sub _hex_global | ||||
124 | { | ||||
125 | my $i = $_[0]; | ||||
126 | $i = '0x'.$i unless $i =~ /^0x/; | ||||
127 | Math::BigInt->new($i); | ||||
128 | } | ||||
129 | |||||
130 | sub _oct_global | ||||
131 | { | ||||
132 | my $i = $_[0]; | ||||
133 | return Math::BigInt->from_oct($i) if $i =~ /^0[0-7]/; | ||||
134 | Math::BigInt->new($i); | ||||
135 | } | ||||
136 | |||||
137 | ############################################################################# | ||||
138 | # the following two routines are for Perl 5.9.4 or later and are lexical | ||||
139 | |||||
140 | sub _hex | ||||
141 | { | ||||
142 | return CORE::hex($_[0]) unless in_effect(1); | ||||
143 | my $i = $_[0]; | ||||
144 | $i = '0x'.$i unless $i =~ /^0x/; | ||||
145 | Math::BigInt->new($i); | ||||
146 | } | ||||
147 | |||||
148 | sub _oct | ||||
149 | { | ||||
150 | return CORE::oct($_[0]) unless in_effect(1); | ||||
151 | my $i = $_[0]; | ||||
152 | return Math::BigInt->from_oct($i) if $i =~ /^0[0-7]/; | ||||
153 | Math::BigInt->new($i); | ||||
154 | } | ||||
155 | |||||
156 | sub import | ||||
157 | # spent 60.6ms (33.2+27.3) within bigint::import which was called 9 times, avg 6.73ms/call:
# once (32.4ms+24.4ms) by Value::Convertor::BEGIN@364 at line 364 of Value/Convertor.pm
# once (173µs+603µs) by Value::Convertor::BEGIN@1230 at line 1230 of Value/Convertor.pm
# once (178µs+572µs) by Value::Convertor::BEGIN@389 at line 389 of Value/Convertor.pm
# once (151µs+493µs) by Value::Convertor::BEGIN@1721 at line 1721 of Value/Convertor.pm
# once (72µs+281µs) by Value::Convertor::BEGIN@1801 at line 1801 of Value/Convertor.pm
# once (74µs+244µs) by Value::Convertor::BEGIN@2068 at line 2068 of Value/Convertor.pm
# once (73µs+241µs) by Value::Convertor::BEGIN@1774 at line 1774 of Value/Convertor.pm
# once (72µs+237µs) by Value::Convertor::BEGIN@1746 at line 1746 of Value/Convertor.pm
# once (68µs+236µs) by Value::Convertor::BEGIN@2047 at line 2047 of Value/Convertor.pm | ||||
158 | 9 | 7µs | my $self = shift; | ||
159 | |||||
160 | 9 | 35µs | $^H{bigint} = 1; # we are in effect | ||
161 | |||||
162 | 9 | 4µs | my ($hex,$oct); | ||
163 | # for newer Perls always override hex() and oct() with a lexical version: | ||||
164 | 9 | 9µs | if ($] > 5.009004) | ||
165 | { | ||||
166 | 9 | 9µs | $oct = \&_oct; | ||
167 | 9 | 5µs | $hex = \&_hex; | ||
168 | } | ||||
169 | # some defaults | ||||
170 | 18 | 5µs | my $lib = ''; my $lib_kind = 'try'; | ||
171 | |||||
172 | 9 | 11µs | my @import = ( ':constant' ); # drive it w/ constant | ||
173 | 27 | 10µs | my @a = @_; my $l = scalar @_; my $j = 0; | ||
174 | 9 | 2µs | my ($ver,$trace); # version? trace? | ||
175 | 9 | 2µs | my ($a,$p); # accuracy, precision | ||
176 | 9 | 10µs | for ( my $i = 0; $i < $l ; $i++,$j++ ) | ||
177 | { | ||||
178 | if ($_[$i] =~ /^(l|lib|try|only)$/) | ||||
179 | { | ||||
180 | # this causes a different low lib to take care... | ||||
181 | $lib_kind = $1; $lib_kind = 'lib' if $lib_kind eq 'l'; | ||||
182 | $lib = $_[$i+1] || ''; | ||||
183 | my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existent..." | ||||
184 | splice @a, $j, $s; $j -= $s; $i++; | ||||
185 | } | ||||
186 | elsif ($_[$i] =~ /^(a|accuracy)$/) | ||||
187 | { | ||||
188 | $a = $_[$i+1]; | ||||
189 | my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existent..." | ||||
190 | splice @a, $j, $s; $j -= $s; $i++; | ||||
191 | } | ||||
192 | elsif ($_[$i] =~ /^(p|precision)$/) | ||||
193 | { | ||||
194 | $p = $_[$i+1]; | ||||
195 | my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existent..." | ||||
196 | splice @a, $j, $s; $j -= $s; $i++; | ||||
197 | } | ||||
198 | elsif ($_[$i] =~ /^(v|version)$/) | ||||
199 | { | ||||
200 | $ver = 1; | ||||
201 | splice @a, $j, 1; $j --; | ||||
202 | } | ||||
203 | elsif ($_[$i] =~ /^(t|trace)$/) | ||||
204 | { | ||||
205 | $trace = 1; | ||||
206 | splice @a, $j, 1; $j --; | ||||
207 | } | ||||
208 | elsif ($_[$i] eq 'hex') | ||||
209 | { | ||||
210 | splice @a, $j, 1; $j --; | ||||
211 | $hex = \&_hex_global; | ||||
212 | } | ||||
213 | elsif ($_[$i] eq 'oct') | ||||
214 | { | ||||
215 | splice @a, $j, 1; $j --; | ||||
216 | $oct = \&_oct_global; | ||||
217 | } | ||||
218 | elsif ($_[$i] !~ /^(PI|e|bpi|bexp)\z/) | ||||
219 | { | ||||
220 | die ("unknown option $_[$i]"); | ||||
221 | } | ||||
222 | } | ||||
223 | 9 | 2µs | my $class; | ||
224 | 9 | 3µs | $_lite = 0; # using M::BI::L ? | ||
225 | 9 | 4µs | if ($trace) | ||
226 | { | ||||
227 | require Math::BigInt::Trace; $class = 'Math::BigInt::Trace'; | ||||
228 | } | ||||
229 | else | ||||
230 | { | ||||
231 | # see if we can find Math::BigInt::Lite | ||||
232 | 9 | 6µs | if (!defined $a && !defined $p) # rounding won't work to well | ||
233 | { | ||||
234 | 9 | 268µs | eval 'require Math::BigInt::Lite;'; # spent 397µs executing statements in 9 string evals (merged) | ||
235 | 9 | 7µs | if ($@ eq '') | ||
236 | { | ||||
237 | @import = ( ); # :constant in Lite, not MBI | ||||
238 | Math::BigInt::Lite->import( ':constant' ); | ||||
239 | $_lite= 1; # signal okay | ||||
240 | } | ||||
241 | } | ||||
242 | 9 | 190µs | require Math::BigInt if $_lite == 0; # not already loaded? | ||
243 | 9 | 4µs | $class = 'Math::BigInt'; # regardless of MBIL or not | ||
244 | } | ||||
245 | 9 | 3µs | push @import, $lib_kind => $lib if $lib ne ''; | ||
246 | # Math::BigInt::Trace or plain Math::BigInt | ||||
247 | 9 | 31µs | 9 | 24.7ms | $class->import(@import); # spent 24.7ms making 9 calls to Math::BigInt::import, avg 2.75ms/call |
248 | |||||
249 | 9 | 2µs | bigint->accuracy($a) if defined $a; | ||
250 | 9 | 1µs | bigint->precision($p) if defined $p; | ||
251 | 9 | 2µs | if ($ver) | ||
252 | { | ||||
253 | print "bigint\t\t\t v$VERSION\n"; | ||||
254 | print "Math::BigInt::Lite\t v$Math::BigInt::Lite::VERSION\n" if $_lite; | ||||
255 | print "Math::BigInt\t\t v$Math::BigInt::VERSION"; | ||||
256 | my $config = Math::BigInt->config(); | ||||
257 | print " lib => $config->{lib} v$config->{lib_version}\n"; | ||||
258 | exit; | ||||
259 | } | ||||
260 | # we take care of floating point constants, since BigFloat isn't available | ||||
261 | # and BigInt doesn't like them: | ||||
262 | 9 | 46µs | 9 | 156µs | overload::constant float => sub { Math::BigInt->new( _float_constant(shift) ); }; # spent 156µs making 9 calls to overload::constant, avg 17µs/call |
263 | # Take care of octal/hexadecimal constants | ||||
264 | 9 | 33µs | 9 | 111µs | overload::constant binary => sub { _binary_constant(shift) }; # spent 111µs making 9 calls to overload::constant, avg 12µs/call |
265 | |||||
266 | # if another big* was already loaded: | ||||
267 | 9 | 20µs | my ($package) = caller(); | ||
268 | |||||
269 | 2 | 118µs | 2 | 76µs | # spent 50µs (24+26) within bigint::BEGIN@269 which was called:
# once (24µs+26µs) by Value::Convertor::BEGIN@364 at line 269 # spent 50µs making 1 call to bigint::BEGIN@269
# spent 26µs making 1 call to strict::unimport |
270 | 18 | 20µs | if (!defined *{"${package}::inf"}) | ||
271 | { | ||||
272 | 1 | 9µs | 1 | 34µs | $self->export_to_level(1,$self,@a); # export inf and NaN, e and PI # spent 34µs making 1 call to Exporter::export_to_level |
273 | } | ||||
274 | { | ||||
275 | 11 | 515µs | 2 | 58µs | # spent 38µs (17+20) within bigint::BEGIN@275 which was called:
# once (17µs+20µs) by Value::Convertor::BEGIN@364 at line 275 # spent 38µs making 1 call to bigint::BEGIN@275
# spent 20µs making 1 call to warnings::unimport |
276 | 9 | 7µs | *CORE::GLOBAL::oct = $oct if $oct; | ||
277 | 9 | 31µs | *CORE::GLOBAL::hex = $hex if $hex; | ||
278 | } | ||||
279 | } | ||||
280 | |||||
281 | sub inf () { Math::BigInt::binf(); } | ||||
282 | sub NaN () { Math::BigInt::bnan(); } | ||||
283 | |||||
284 | sub PI () { Math::BigInt->new(3); } | ||||
285 | sub e () { Math::BigInt->new(2); } | ||||
286 | sub bpi ($) { Math::BigInt->new(3); } | ||||
287 | sub bexp ($$) { my $x = Math::BigInt->new($_[0]); $x->bexp($_[1]); } | ||||
288 | |||||
289 | 1 | 13µs | 1; | ||
290 | |||||
291 | __END__ |