| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
#!/usr/bin/perl |
|
2
|
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package Math::Base::Convert::CalcPP; |
|
4
|
|
|
|
|
|
|
|
|
5
|
20
|
|
|
20
|
|
135
|
use strict; |
|
|
20
|
|
|
|
|
45
|
|
|
|
20
|
|
|
|
|
882
|
|
|
6
|
20
|
|
|
20
|
|
104
|
use vars qw($VERSION); |
|
|
20
|
|
|
|
|
35
|
|
|
|
20
|
|
|
|
|
18162
|
|
|
7
|
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
$VERSION = do { my @r = (q$Revision: 0.03 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; |
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
# test number < 2^32 is NOT power of 2 |
|
11
|
|
|
|
|
|
|
# |
|
12
|
|
|
|
|
|
|
sub isnotp2 { |
|
13
|
62
|
|
|
62
|
0
|
622
|
my $ref = ref $_[0]; |
|
14
|
62
|
50
|
33
|
|
|
150
|
shift if ref $_[0] || $_[0] =~ /\D/; # class? |
|
15
|
62
|
|
|
|
|
139
|
$_[0] & $_[0] -1; |
|
16
|
|
|
|
|
|
|
} |
|
17
|
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# add a long n*32 bit number toa number < 65536 |
|
19
|
|
|
|
|
|
|
# add 'n' to array digits and propagate carry, return carry |
|
20
|
|
|
|
|
|
|
# |
|
21
|
|
|
|
|
|
|
sub addbaseno { |
|
22
|
11483
|
|
|
11483
|
1
|
16913
|
my($ap,$n) = @_; |
|
23
|
11483
|
|
|
|
|
13989
|
foreach (@$ap) { |
|
24
|
11483
|
|
|
|
|
12512
|
$_ += $n; |
|
25
|
11483
|
50
|
|
|
|
25354
|
return 0 unless $_ > 0xffffffff; |
|
26
|
0
|
|
|
|
|
0
|
$n = 1; |
|
27
|
0
|
|
|
|
|
0
|
$_ -= 4294967296; |
|
28
|
|
|
|
|
|
|
} |
|
29
|
0
|
|
|
|
|
0
|
1; # carry is one on exit, else would have taken return 0 branch |
|
30
|
|
|
|
|
|
|
} |
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# multiply a register of indeterminate length by a number < 65535 |
|
33
|
|
|
|
|
|
|
# |
|
34
|
|
|
|
|
|
|
# ap pointer to multiplicand array |
|
35
|
|
|
|
|
|
|
# multiplier |
|
36
|
|
|
|
|
|
|
# |
|
37
|
|
|
|
|
|
|
sub multiply { |
|
38
|
11483
|
|
|
11483
|
1
|
14413
|
my($ap,$m) = @_; |
|
39
|
|
|
|
|
|
|
# $m is always 2..65535 |
|
40
|
|
|
|
|
|
|
# $m &= 0xffff; # max value 65535 already done by VETTING |
|
41
|
|
|
|
|
|
|
# |
|
42
|
|
|
|
|
|
|
# perl uses doubles for arithmetic, $m << 65536 will fit |
|
43
|
11483
|
|
|
|
|
13184
|
my $carry = 0; |
|
44
|
11483
|
|
|
|
|
14694
|
foreach ( @$ap) { |
|
45
|
41961
|
|
|
|
|
44431
|
$_ *= $m; |
|
46
|
41961
|
|
|
|
|
43099
|
$_ += $carry; |
|
47
|
41961
|
100
|
|
|
|
49670
|
if ($_ > 0xffffffff) { |
|
48
|
26967
|
|
|
|
|
34231
|
$carry = int($_ / 4294967296); |
|
49
|
26967
|
|
|
|
|
30833
|
$_ %= 4294967296; |
|
50
|
|
|
|
|
|
|
} else { |
|
51
|
14994
|
|
|
|
|
18927
|
$carry = 0; |
|
52
|
|
|
|
|
|
|
} |
|
53
|
|
|
|
|
|
|
} |
|
54
|
11483
|
100
|
|
|
|
19686
|
push @$ap, $carry if $carry; |
|
55
|
|
|
|
|
|
|
} |
|
56
|
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub dividebybase { |
|
58
|
12780
|
|
|
12780
|
1
|
17390
|
my($np,$divisor) = @_; |
|
59
|
12780
|
|
|
|
|
16845
|
my @dividend = @$np; # 3% improvement |
|
60
|
12780
|
|
|
|
|
20482
|
while ($#dividend) { # 3% improvement |
|
61
|
10466
|
100
|
|
|
|
16795
|
last if $dividend[0]; |
|
62
|
1108
|
|
|
|
|
1825
|
shift @dividend; |
|
63
|
|
|
|
|
|
|
} |
|
64
|
12780
|
|
|
|
|
14291
|
my $remainder = 0; |
|
65
|
12780
|
|
|
|
|
13399
|
my @quotient; |
|
66
|
12780
|
|
|
|
|
17599
|
while (@dividend) { |
|
67
|
46200
|
|
|
|
|
51206
|
my $work = ($dividend[0] += ($remainder * 4294967296)); |
|
68
|
46200
|
|
|
|
|
60700
|
push @quotient, int($work / $divisor); |
|
69
|
46200
|
|
|
|
|
48991
|
$remainder = $work % $divisor; |
|
70
|
46200
|
|
|
|
|
66084
|
shift @dividend; |
|
71
|
|
|
|
|
|
|
} |
|
72
|
12780
|
|
|
|
|
20388
|
return (\@quotient,$remainder); |
|
73
|
|
|
|
|
|
|
} |
|
74
|
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
# simple versions of conversion, works for N < ~2^49 or 10^16 |
|
76
|
|
|
|
|
|
|
# |
|
77
|
|
|
|
|
|
|
#sub frombase { |
|
78
|
|
|
|
|
|
|
# my($hsh,$base,$str) = @_; |
|
79
|
|
|
|
|
|
|
# my $number = 0; |
|
80
|
|
|
|
|
|
|
# for( $str =~ /./g ) { |
|
81
|
|
|
|
|
|
|
# $number *= $base; |
|
82
|
|
|
|
|
|
|
# $number += $hsh->{$_}; |
|
83
|
|
|
|
|
|
|
# } |
|
84
|
|
|
|
|
|
|
# return $number; |
|
85
|
|
|
|
|
|
|
#} |
|
86
|
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
#sub tobase { |
|
88
|
|
|
|
|
|
|
#sub to_base |
|
89
|
|
|
|
|
|
|
# my($bp,$base,$num) = @_; |
|
90
|
|
|
|
|
|
|
# my $base = shift; |
|
91
|
|
|
|
|
|
|
# return $bp->[0] if $num == 0; |
|
92
|
|
|
|
|
|
|
# my $str = ''; |
|
93
|
|
|
|
|
|
|
# while( $num > 0 ) { |
|
94
|
|
|
|
|
|
|
# $str = $bp->[$num % $base] . $str; |
|
95
|
|
|
|
|
|
|
# $num = int( $num / $base ); |
|
96
|
|
|
|
|
|
|
# } |
|
97
|
|
|
|
|
|
|
# return $str; |
|
98
|
|
|
|
|
|
|
#} |
|
99
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# convert a number from its base to 32*N bit representation |
|
101
|
|
|
|
|
|
|
# |
|
102
|
|
|
|
|
|
|
sub useFROMbaseto32wide { |
|
103
|
559
|
|
|
559
|
1
|
2692
|
my $bc = shift; |
|
104
|
559
|
|
|
|
|
894
|
my($ary,$hsh,$base,$str) = @{$bc}{qw(from fhsh fbase nstr)}; |
|
|
559
|
|
|
|
|
1527
|
|
|
105
|
|
|
|
|
|
|
# check if decimal and interger from within perl's 32bit double representation |
|
106
|
|
|
|
|
|
|
# cutoff is 999,999,999,999,999 -- a bit less than 2^50 |
|
107
|
|
|
|
|
|
|
# |
|
108
|
|
|
|
|
|
|
# convert directly to base 2^32 arrays |
|
109
|
|
|
|
|
|
|
# |
|
110
|
559
|
|
|
|
|
1409
|
my @result = (0); |
|
111
|
|
|
|
|
|
|
|
|
112
|
559
|
100
|
100
|
|
|
1692
|
if ($base == 10 && length($str) < 16) { |
|
113
|
|
|
|
|
|
|
# unless ($str > 999999999999999) { # maximum 32 bit double float integer representation |
|
114
|
35
|
|
|
|
|
258
|
$result[0] = $str % 4294967296; |
|
115
|
35
|
|
|
|
|
85
|
my $quotient = int($str / 4294967296); |
|
116
|
35
|
100
|
|
|
|
77
|
$result[1] = $quotient if $quotient; |
|
117
|
35
|
|
|
|
|
91
|
$bc->{b32str} = \@result; |
|
118
|
|
|
|
|
|
|
} |
|
119
|
|
|
|
|
|
|
else { |
|
120
|
524
|
|
|
|
|
7337
|
for ($str =~ /./g) { |
|
121
|
11483
|
|
|
|
|
21389
|
multiply(\@result,$base); |
|
122
|
11483
|
50
|
|
|
|
31416
|
push @result, 1 if addbaseno(\@result,$hsh->{$_}); # propagate carry |
|
123
|
|
|
|
|
|
|
} |
|
124
|
|
|
|
|
|
|
# my @rv = reverse @result; |
|
125
|
524
|
|
|
|
|
2314
|
$bc->{b32str} = \@result; |
|
126
|
|
|
|
|
|
|
} |
|
127
|
559
|
|
|
|
|
1519
|
$bc; |
|
128
|
|
|
|
|
|
|
} |
|
129
|
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
#my %used = map {$_,0}(0..255); |
|
131
|
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
# convert 32*N bit representation to any base < 65536 |
|
133
|
|
|
|
|
|
|
# |
|
134
|
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
sub use32wideTObase { |
|
136
|
556
|
|
|
556
|
1
|
8027
|
my $bc = shift; |
|
137
|
556
|
|
|
|
|
852
|
my($ary,$base,$rquot) = @{$bc}{qw(to tbase b32str)}; |
|
|
556
|
|
|
|
|
1430
|
|
|
138
|
556
|
|
|
|
|
1939
|
my @quotient = reverse(@$rquot); |
|
139
|
556
|
|
|
|
|
862
|
my $quotient = \@quotient; |
|
140
|
556
|
|
|
|
|
903
|
my @answer; |
|
141
|
|
|
|
|
|
|
my $remainder; |
|
142
|
|
|
|
|
|
|
do { |
|
143
|
12780
|
|
|
|
|
17032
|
($quotient,$remainder) = dividebybase($quotient,$base); |
|
144
|
|
|
|
|
|
|
# these commented out print statements are for convert.t DO NOT REMOVE! |
|
145
|
|
|
|
|
|
|
#$used{$remainder} = 1; |
|
146
|
|
|
|
|
|
|
#print $remainder; |
|
147
|
|
|
|
|
|
|
#print " *" if $remainder > 86; |
|
148
|
|
|
|
|
|
|
#print "\n"; |
|
149
|
12780
|
|
|
|
|
25152
|
unshift @answer, $ary->[$remainder]; |
|
150
|
556
|
|
|
|
|
778
|
} while grep {$_} @$quotient; |
|
|
46200
|
|
|
|
|
58505
|
|
|
151
|
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
#foreach (sort {$b <=> $a} keys %used) { |
|
153
|
|
|
|
|
|
|
#print " $_,\n" if $used{$_} && $_ > 85; |
|
154
|
|
|
|
|
|
|
#print "\t$_\t=> \n" if !$used{$_} && $_ < 86; |
|
155
|
|
|
|
|
|
|
#} |
|
156
|
556
|
|
|
|
|
4390
|
join '', @answer; |
|
157
|
|
|
|
|
|
|
} |
|
158
|
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
1; |
|
160
|
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
__END__ |
|
162
|
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=head1 NAME |
|
164
|
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
Math::Base::Convert::CalcPP - standard methods used by Math::Base::Convert |
|
166
|
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
168
|
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
This module contains the standard methods used by B<Math::Base::Convert> to |
|
170
|
|
|
|
|
|
|
convert from one base number to another base number. |
|
171
|
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=over 4 |
|
173
|
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=item * $carry = addbaseno($reg32ptr,$int) |
|
175
|
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
This function adds an integer < 65536 to a long n*32 bit register and |
|
177
|
|
|
|
|
|
|
returns the carry. |
|
178
|
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=item * multiply($reg32ptr,$int) |
|
180
|
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
This function multiplies a long n*32 bit register by an integer < 65536 |
|
182
|
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=item * ($qptr,$remainder) = dividebybase($reg32ptr,$int) |
|
184
|
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
this function divides a long n*32 bit register by an integer < 65536 and |
|
186
|
|
|
|
|
|
|
returns a pointer to a long n*32 bit quotient and an integer remainder. |
|
187
|
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=item * $bc->useFROMbaseto32wide |
|
189
|
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
This method converts FROM an input base string to a long n*32 bit register using |
|
191
|
|
|
|
|
|
|
an algorithim like: |
|
192
|
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
$longnum = 0; |
|
194
|
|
|
|
|
|
|
for $char ( $in_str =~ /./g ) { |
|
195
|
|
|
|
|
|
|
$longnum *= $base; |
|
196
|
|
|
|
|
|
|
$longnum += $value{$char) |
|
197
|
|
|
|
|
|
|
} |
|
198
|
|
|
|
|
|
|
return $number; |
|
199
|
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=item * $output = $bc->use32wideTObase |
|
201
|
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
This method converts a long n*32 bit register TO a base number using an |
|
203
|
|
|
|
|
|
|
algorithim like: |
|
204
|
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
$output = ''; |
|
206
|
|
|
|
|
|
|
while( $longnum > 0 ) { |
|
207
|
|
|
|
|
|
|
$output = ( $longnum % $base ) . $output; |
|
208
|
|
|
|
|
|
|
$num = int( $longnum / $base ); |
|
209
|
|
|
|
|
|
|
} |
|
210
|
|
|
|
|
|
|
return $output; |
|
211
|
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=back |
|
213
|
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=head1 AUTHOR |
|
215
|
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
Michael Robinton, michael@bizsystems.com |
|
217
|
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=head1 COPYRIGHT |
|
219
|
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
Copyright 2012-15, Michael Robinton |
|
221
|
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
This program is free software; you may redistribute it and/or modify it |
|
223
|
|
|
|
|
|
|
under the same terms as Perl itself. |
|
224
|
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful, |
|
226
|
|
|
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
227
|
|
|
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. |
|
228
|
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=cut |
|
230
|
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
1; |