| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
## This file generated by InlineX::C2XS (version 0.22) using Inline::C (version 0.5002) |
|
2
|
|
|
|
|
|
|
package Math::Decimal64; |
|
3
|
|
|
|
|
|
|
|
|
4
|
37
|
|
|
37
|
|
21711
|
use 5.006; |
|
|
37
|
|
|
|
|
318
|
|
|
5
|
|
|
|
|
|
|
|
|
6
|
37
|
|
|
37
|
|
173
|
use warnings; |
|
|
37
|
|
|
|
|
59
|
|
|
|
37
|
|
|
|
|
796
|
|
|
7
|
37
|
|
|
37
|
|
150
|
use strict; |
|
|
37
|
|
|
|
|
59
|
|
|
|
37
|
|
|
|
|
744
|
|
|
8
|
37
|
|
|
37
|
|
181
|
use Config; # So MEtoD64 can check whether sizeof(longdouble) > 8. |
|
|
37
|
|
|
|
|
87
|
|
|
|
37
|
|
|
|
|
3776
|
|
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
require Exporter; |
|
11
|
|
|
|
|
|
|
*import = \&Exporter::import; |
|
12
|
|
|
|
|
|
|
require DynaLoader; |
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
our $VERSION = '0.17'; |
|
15
|
|
|
|
|
|
|
#$VERSION = eval $VERSION; |
|
16
|
|
|
|
|
|
|
|
|
17
|
37
|
|
|
37
|
|
18056
|
use subs qw(DEC64_MAX DEC64_MIN); |
|
|
37
|
|
|
|
|
753
|
|
|
|
37
|
|
|
|
|
155
|
|
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
Math::Decimal64->DynaLoader::bootstrap($Math::Decimal64::VERSION); |
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
@Math::Decimal64::EXPORT = (); |
|
22
|
|
|
|
|
|
|
@Math::Decimal64::EXPORT_OK = qw( |
|
23
|
|
|
|
|
|
|
MEtoD64 UVtoD64 IVtoD64 NVtoD64 PVtoD64 STRtoD64 D64toME D64toNV |
|
24
|
|
|
|
|
|
|
FR64toME pFR D64toFSTR D64toRSTR |
|
25
|
|
|
|
|
|
|
InfD64 NaND64 UnityD64 ZeroD64 is_InfD64 is_NaND64 is_ZeroD64 |
|
26
|
|
|
|
|
|
|
D64toLD LDtoD64 DEC64_MAX DEC64_MIN |
|
27
|
|
|
|
|
|
|
assignME assignInf assignNaN assignPV Exp10 have_strtod64 |
|
28
|
|
|
|
|
|
|
assignIV assignUV assignNV assignD64 |
|
29
|
|
|
|
|
|
|
decode_d64 decode_bid decode_dpd d64_bytes hex2bin d64_fmt |
|
30
|
|
|
|
|
|
|
get_sign get_exp PVtoME MEtoPV assignDPD DPDtoD64 |
|
31
|
|
|
|
|
|
|
); |
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
%Math::Decimal64::EXPORT_TAGS = (all => [qw( |
|
34
|
|
|
|
|
|
|
MEtoD64 UVtoD64 IVtoD64 NVtoD64 PVtoD64 STRtoD64 D64toME D64toNV |
|
35
|
|
|
|
|
|
|
FR64toME pFR D64toFSTR D64toRSTR |
|
36
|
|
|
|
|
|
|
InfD64 NaND64 UnityD64 ZeroD64 is_InfD64 is_NaND64 is_ZeroD64 |
|
37
|
|
|
|
|
|
|
D64toLD LDtoD64 DEC64_MAX DEC64_MIN |
|
38
|
|
|
|
|
|
|
assignME assignInf assignNaN assignPV Exp10 have_strtod64 |
|
39
|
|
|
|
|
|
|
assignIV assignUV assignNV assignD64 |
|
40
|
|
|
|
|
|
|
decode_d64 decode_bid decode_dpd d64_bytes hex2bin d64_fmt |
|
41
|
|
|
|
|
|
|
get_sign get_exp PVtoME MEtoPV assignDPD DPDtoD64 |
|
42
|
|
|
|
|
|
|
)]); |
|
43
|
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
use overload |
|
45
|
37
|
|
|
|
|
905
|
'+' => \&_overload_add, |
|
46
|
|
|
|
|
|
|
'*' => \&_overload_mul, |
|
47
|
|
|
|
|
|
|
'-' => \&_overload_sub, |
|
48
|
|
|
|
|
|
|
'/' => \&_overload_div, |
|
49
|
|
|
|
|
|
|
'+=' => \&_overload_add_eq, |
|
50
|
|
|
|
|
|
|
'*=' => \&_overload_mul_eq, |
|
51
|
|
|
|
|
|
|
'-=' => \&_overload_sub_eq, |
|
52
|
|
|
|
|
|
|
'/=' => \&_overload_div_eq, |
|
53
|
|
|
|
|
|
|
'""' => \&_overload_string, |
|
54
|
|
|
|
|
|
|
'==' => \&_overload_equiv, |
|
55
|
|
|
|
|
|
|
'!=' => \&_overload_not_equiv, |
|
56
|
|
|
|
|
|
|
'<' => \&_overload_lt, |
|
57
|
|
|
|
|
|
|
'>' => \&_overload_gt, |
|
58
|
|
|
|
|
|
|
'<=' => \&_overload_lte, |
|
59
|
|
|
|
|
|
|
'>=' => \&_overload_gte, |
|
60
|
|
|
|
|
|
|
'<=>' => \&_overload_spaceship, |
|
61
|
|
|
|
|
|
|
'=' => \&_overload_copy, |
|
62
|
|
|
|
|
|
|
'!' => \&_overload_not, |
|
63
|
|
|
|
|
|
|
'bool' => \&_overload_true, |
|
64
|
|
|
|
|
|
|
'abs' => \&_overload_abs, |
|
65
|
|
|
|
|
|
|
'++' => \&_overload_inc, |
|
66
|
|
|
|
|
|
|
'--' => \&_overload_dec, |
|
67
|
|
|
|
|
|
|
'int' => \&_overload_int, |
|
68
|
|
|
|
|
|
|
'neg' => \&_overload_neg, |
|
69
|
37
|
|
|
37
|
|
49760
|
; |
|
|
37
|
|
|
|
|
35146
|
|
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
####################################################################### |
|
72
|
|
|
|
|
|
|
####################################################################### |
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
$Math::Decimal64::nan_str = unpack("a*", pack( "B*", '011111' . ('0' x 58))); |
|
75
|
|
|
|
|
|
|
$Math::Decimal64::ninf_str = unpack("a*", pack( "B*", '11111' . ('0' x 59))); |
|
76
|
|
|
|
|
|
|
$Math::Decimal64::pinf_str = unpack("a*", pack( "B*", '01111' . ('0' x 59))); |
|
77
|
|
|
|
|
|
|
$Math::Decimal64::fmt = d64_fmt(); |
|
78
|
|
|
|
|
|
|
$Math::Decimal64::NNW = 0; # set to 1 to enable a non-numeric warning whenever |
|
79
|
|
|
|
|
|
|
# a string containing any non-numeric characters is |
|
80
|
|
|
|
|
|
|
# treated as a number. |
|
81
|
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
####################################################################### |
|
83
|
|
|
|
|
|
|
####################################################################### |
|
84
|
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
%Math::Decimal64::dpd_encode = $Math::Decimal64::fmt eq 'DPD' ? ( |
|
86
|
|
|
|
|
|
|
'0000000000' => '000', '0000000001' => '001', '0000000010' => '002', '0000000011' => '003', |
|
87
|
|
|
|
|
|
|
'0000000100' => '004', '0000000101' => '005', '0000000110' => '006', '0000000111' => '007', |
|
88
|
|
|
|
|
|
|
'0000001000' => '008', '0000001001' => '009', '0000010000' => '010', '0000010001' => '011', |
|
89
|
|
|
|
|
|
|
'0000010010' => '012', '0000010011' => '013', '0000010100' => '014', '0000010101' => '015', |
|
90
|
|
|
|
|
|
|
'0000010110' => '016', '0000010111' => '017', '0000011000' => '018', '0000011001' => '019', |
|
91
|
|
|
|
|
|
|
'0000100000' => '020', '0000100001' => '021', '0000100010' => '022', '0000100011' => '023', |
|
92
|
|
|
|
|
|
|
'0000100100' => '024', '0000100101' => '025', '0000100110' => '026', '0000100111' => '027', |
|
93
|
|
|
|
|
|
|
'0000101000' => '028', '0000101001' => '029', '0000110000' => '030', '0000110001' => '031', |
|
94
|
|
|
|
|
|
|
'0000110010' => '032', '0000110011' => '033', '0000110100' => '034', '0000110101' => '035', |
|
95
|
|
|
|
|
|
|
'0000110110' => '036', '0000110111' => '037', '0000111000' => '038', '0000111001' => '039', |
|
96
|
|
|
|
|
|
|
'0001000000' => '040', '0001000001' => '041', '0001000010' => '042', '0001000011' => '043', |
|
97
|
|
|
|
|
|
|
'0001000100' => '044', '0001000101' => '045', '0001000110' => '046', '0001000111' => '047', |
|
98
|
|
|
|
|
|
|
'0001001000' => '048', '0001001001' => '049', '0001010000' => '050', '0001010001' => '051', |
|
99
|
|
|
|
|
|
|
'0001010010' => '052', '0001010011' => '053', '0001010100' => '054', '0001010101' => '055', |
|
100
|
|
|
|
|
|
|
'0001010110' => '056', '0001010111' => '057', '0001011000' => '058', '0001011001' => '059', |
|
101
|
|
|
|
|
|
|
'0001100000' => '060', '0001100001' => '061', '0001100010' => '062', '0001100011' => '063', |
|
102
|
|
|
|
|
|
|
'0001100100' => '064', '0001100101' => '065', '0001100110' => '066', '0001100111' => '067', |
|
103
|
|
|
|
|
|
|
'0001101000' => '068', '0001101001' => '069', '0001110000' => '070', '0001110001' => '071', |
|
104
|
|
|
|
|
|
|
'0001110010' => '072', '0001110011' => '073', '0001110100' => '074', '0001110101' => '075', |
|
105
|
|
|
|
|
|
|
'0001110110' => '076', '0001110111' => '077', '0001111000' => '078', '0001111001' => '079', |
|
106
|
|
|
|
|
|
|
'0000001010' => '080', '0000001011' => '081', '0000101010' => '082', '0000101011' => '083', |
|
107
|
|
|
|
|
|
|
'0001001010' => '084', '0001001011' => '085', '0001101010' => '086', '0001101011' => '087', |
|
108
|
|
|
|
|
|
|
'0001001110' => '088', '0001001111' => '089', '0000011010' => '090', '0000011011' => '091', |
|
109
|
|
|
|
|
|
|
'0000111010' => '092', '0000111011' => '093', '0001011010' => '094', '0001011011' => '095', |
|
110
|
|
|
|
|
|
|
'0001111010' => '096', '0001111011' => '097', '0001011110' => '098', '0001011111' => '099', |
|
111
|
|
|
|
|
|
|
'0010000000' => '100', '0010000001' => '101', '0010000010' => '102', '0010000011' => '103', |
|
112
|
|
|
|
|
|
|
'0010000100' => '104', '0010000101' => '105', '0010000110' => '106', '0010000111' => '107', |
|
113
|
|
|
|
|
|
|
'0010001000' => '108', '0010001001' => '109', '0010010000' => '110', '0010010001' => '111', |
|
114
|
|
|
|
|
|
|
'0010010010' => '112', '0010010011' => '113', '0010010100' => '114', '0010010101' => '115', |
|
115
|
|
|
|
|
|
|
'0010010110' => '116', '0010010111' => '117', '0010011000' => '118', '0010011001' => '119', |
|
116
|
|
|
|
|
|
|
'0010100000' => '120', '0010100001' => '121', '0010100010' => '122', '0010100011' => '123', |
|
117
|
|
|
|
|
|
|
'0010100100' => '124', '0010100101' => '125', '0010100110' => '126', '0010100111' => '127', |
|
118
|
|
|
|
|
|
|
'0010101000' => '128', '0010101001' => '129', '0010110000' => '130', '0010110001' => '131', |
|
119
|
|
|
|
|
|
|
'0010110010' => '132', '0010110011' => '133', '0010110100' => '134', '0010110101' => '135', |
|
120
|
|
|
|
|
|
|
'0010110110' => '136', '0010110111' => '137', '0010111000' => '138', '0010111001' => '139', |
|
121
|
|
|
|
|
|
|
'0011000000' => '140', '0011000001' => '141', '0011000010' => '142', '0011000011' => '143', |
|
122
|
|
|
|
|
|
|
'0011000100' => '144', '0011000101' => '145', '0011000110' => '146', '0011000111' => '147', |
|
123
|
|
|
|
|
|
|
'0011001000' => '148', '0011001001' => '149', '0011010000' => '150', '0011010001' => '151', |
|
124
|
|
|
|
|
|
|
'0011010010' => '152', '0011010011' => '153', '0011010100' => '154', '0011010101' => '155', |
|
125
|
|
|
|
|
|
|
'0011010110' => '156', '0011010111' => '157', '0011011000' => '158', '0011011001' => '159', |
|
126
|
|
|
|
|
|
|
'0011100000' => '160', '0011100001' => '161', '0011100010' => '162', '0011100011' => '163', |
|
127
|
|
|
|
|
|
|
'0011100100' => '164', '0011100101' => '165', '0011100110' => '166', '0011100111' => '167', |
|
128
|
|
|
|
|
|
|
'0011101000' => '168', '0011101001' => '169', '0011110000' => '170', '0011110001' => '171', |
|
129
|
|
|
|
|
|
|
'0011110010' => '172', '0011110011' => '173', '0011110100' => '174', '0011110101' => '175', |
|
130
|
|
|
|
|
|
|
'0011110110' => '176', '0011110111' => '177', '0011111000' => '178', '0011111001' => '179', |
|
131
|
|
|
|
|
|
|
'0010001010' => '180', '0010001011' => '181', '0010101010' => '182', '0010101011' => '183', |
|
132
|
|
|
|
|
|
|
'0011001010' => '184', '0011001011' => '185', '0011101010' => '186', '0011101011' => '187', |
|
133
|
|
|
|
|
|
|
'0011001110' => '188', '0011001111' => '189', '0010011010' => '190', '0010011011' => '191', |
|
134
|
|
|
|
|
|
|
'0010111010' => '192', '0010111011' => '193', '0011011010' => '194', '0011011011' => '195', |
|
135
|
|
|
|
|
|
|
'0011111010' => '196', '0011111011' => '197', '0011011110' => '198', '0011011111' => '199', |
|
136
|
|
|
|
|
|
|
'0100000000' => '200', '0100000001' => '201', '0100000010' => '202', '0100000011' => '203', |
|
137
|
|
|
|
|
|
|
'0100000100' => '204', '0100000101' => '205', '0100000110' => '206', '0100000111' => '207', |
|
138
|
|
|
|
|
|
|
'0100001000' => '208', '0100001001' => '209', '0100010000' => '210', '0100010001' => '211', |
|
139
|
|
|
|
|
|
|
'0100010010' => '212', '0100010011' => '213', '0100010100' => '214', '0100010101' => '215', |
|
140
|
|
|
|
|
|
|
'0100010110' => '216', '0100010111' => '217', '0100011000' => '218', '0100011001' => '219', |
|
141
|
|
|
|
|
|
|
'0100100000' => '220', '0100100001' => '221', '0100100010' => '222', '0100100011' => '223', |
|
142
|
|
|
|
|
|
|
'0100100100' => '224', '0100100101' => '225', '0100100110' => '226', '0100100111' => '227', |
|
143
|
|
|
|
|
|
|
'0100101000' => '228', '0100101001' => '229', '0100110000' => '230', '0100110001' => '231', |
|
144
|
|
|
|
|
|
|
'0100110010' => '232', '0100110011' => '233', '0100110100' => '234', '0100110101' => '235', |
|
145
|
|
|
|
|
|
|
'0100110110' => '236', '0100110111' => '237', '0100111000' => '238', '0100111001' => '239', |
|
146
|
|
|
|
|
|
|
'0101000000' => '240', '0101000001' => '241', '0101000010' => '242', '0101000011' => '243', |
|
147
|
|
|
|
|
|
|
'0101000100' => '244', '0101000101' => '245', '0101000110' => '246', '0101000111' => '247', |
|
148
|
|
|
|
|
|
|
'0101001000' => '248', '0101001001' => '249', '0101010000' => '250', '0101010001' => '251', |
|
149
|
|
|
|
|
|
|
'0101010010' => '252', '0101010011' => '253', '0101010100' => '254', '0101010101' => '255', |
|
150
|
|
|
|
|
|
|
'0101010110' => '256', '0101010111' => '257', '0101011000' => '258', '0101011001' => '259', |
|
151
|
|
|
|
|
|
|
'0101100000' => '260', '0101100001' => '261', '0101100010' => '262', '0101100011' => '263', |
|
152
|
|
|
|
|
|
|
'0101100100' => '264', '0101100101' => '265', '0101100110' => '266', '0101100111' => '267', |
|
153
|
|
|
|
|
|
|
'0101101000' => '268', '0101101001' => '269', '0101110000' => '270', '0101110001' => '271', |
|
154
|
|
|
|
|
|
|
'0101110010' => '272', '0101110011' => '273', '0101110100' => '274', '0101110101' => '275', |
|
155
|
|
|
|
|
|
|
'0101110110' => '276', '0101110111' => '277', '0101111000' => '278', '0101111001' => '279', |
|
156
|
|
|
|
|
|
|
'0100001010' => '280', '0100001011' => '281', '0100101010' => '282', '0100101011' => '283', |
|
157
|
|
|
|
|
|
|
'0101001010' => '284', '0101001011' => '285', '0101101010' => '286', '0101101011' => '287', |
|
158
|
|
|
|
|
|
|
'0101001110' => '288', '0101001111' => '289', '0100011010' => '290', '0100011011' => '291', |
|
159
|
|
|
|
|
|
|
'0100111010' => '292', '0100111011' => '293', '0101011010' => '294', '0101011011' => '295', |
|
160
|
|
|
|
|
|
|
'0101111010' => '296', '0101111011' => '297', '0101011110' => '298', '0101011111' => '299', |
|
161
|
|
|
|
|
|
|
'0110000000' => '300', '0110000001' => '301', '0110000010' => '302', '0110000011' => '303', |
|
162
|
|
|
|
|
|
|
'0110000100' => '304', '0110000101' => '305', '0110000110' => '306', '0110000111' => '307', |
|
163
|
|
|
|
|
|
|
'0110001000' => '308', '0110001001' => '309', '0110010000' => '310', '0110010001' => '311', |
|
164
|
|
|
|
|
|
|
'0110010010' => '312', '0110010011' => '313', '0110010100' => '314', '0110010101' => '315', |
|
165
|
|
|
|
|
|
|
'0110010110' => '316', '0110010111' => '317', '0110011000' => '318', '0110011001' => '319', |
|
166
|
|
|
|
|
|
|
'0110100000' => '320', '0110100001' => '321', '0110100010' => '322', '0110100011' => '323', |
|
167
|
|
|
|
|
|
|
'0110100100' => '324', '0110100101' => '325', '0110100110' => '326', '0110100111' => '327', |
|
168
|
|
|
|
|
|
|
'0110101000' => '328', '0110101001' => '329', '0110110000' => '330', '0110110001' => '331', |
|
169
|
|
|
|
|
|
|
'0110110010' => '332', '0110110011' => '333', '0110110100' => '334', '0110110101' => '335', |
|
170
|
|
|
|
|
|
|
'0110110110' => '336', '0110110111' => '337', '0110111000' => '338', '0110111001' => '339', |
|
171
|
|
|
|
|
|
|
'0111000000' => '340', '0111000001' => '341', '0111000010' => '342', '0111000011' => '343', |
|
172
|
|
|
|
|
|
|
'0111000100' => '344', '0111000101' => '345', '0111000110' => '346', '0111000111' => '347', |
|
173
|
|
|
|
|
|
|
'0111001000' => '348', '0111001001' => '349', '0111010000' => '350', '0111010001' => '351', |
|
174
|
|
|
|
|
|
|
'0111010010' => '352', '0111010011' => '353', '0111010100' => '354', '0111010101' => '355', |
|
175
|
|
|
|
|
|
|
'0111010110' => '356', '0111010111' => '357', '0111011000' => '358', '0111011001' => '359', |
|
176
|
|
|
|
|
|
|
'0111100000' => '360', '0111100001' => '361', '0111100010' => '362', '0111100011' => '363', |
|
177
|
|
|
|
|
|
|
'0111100100' => '364', '0111100101' => '365', '0111100110' => '366', '0111100111' => '367', |
|
178
|
|
|
|
|
|
|
'0111101000' => '368', '0111101001' => '369', '0111110000' => '370', '0111110001' => '371', |
|
179
|
|
|
|
|
|
|
'0111110010' => '372', '0111110011' => '373', '0111110100' => '374', '0111110101' => '375', |
|
180
|
|
|
|
|
|
|
'0111110110' => '376', '0111110111' => '377', '0111111000' => '378', '0111111001' => '379', |
|
181
|
|
|
|
|
|
|
'0110001010' => '380', '0110001011' => '381', '0110101010' => '382', '0110101011' => '383', |
|
182
|
|
|
|
|
|
|
'0111001010' => '384', '0111001011' => '385', '0111101010' => '386', '0111101011' => '387', |
|
183
|
|
|
|
|
|
|
'0111001110' => '388', '0111001111' => '389', '0110011010' => '390', '0110011011' => '391', |
|
184
|
|
|
|
|
|
|
'0110111010' => '392', '0110111011' => '393', '0111011010' => '394', '0111011011' => '395', |
|
185
|
|
|
|
|
|
|
'0111111010' => '396', '0111111011' => '397', '0111011110' => '398', '0111011111' => '399', |
|
186
|
|
|
|
|
|
|
'1000000000' => '400', '1000000001' => '401', '1000000010' => '402', '1000000011' => '403', |
|
187
|
|
|
|
|
|
|
'1000000100' => '404', '1000000101' => '405', '1000000110' => '406', '1000000111' => '407', |
|
188
|
|
|
|
|
|
|
'1000001000' => '408', '1000001001' => '409', '1000010000' => '410', '1000010001' => '411', |
|
189
|
|
|
|
|
|
|
'1000010010' => '412', '1000010011' => '413', '1000010100' => '414', '1000010101' => '415', |
|
190
|
|
|
|
|
|
|
'1000010110' => '416', '1000010111' => '417', '1000011000' => '418', '1000011001' => '419', |
|
191
|
|
|
|
|
|
|
'1000100000' => '420', '1000100001' => '421', '1000100010' => '422', '1000100011' => '423', |
|
192
|
|
|
|
|
|
|
'1000100100' => '424', '1000100101' => '425', '1000100110' => '426', '1000100111' => '427', |
|
193
|
|
|
|
|
|
|
'1000101000' => '428', '1000101001' => '429', '1000110000' => '430', '1000110001' => '431', |
|
194
|
|
|
|
|
|
|
'1000110010' => '432', '1000110011' => '433', '1000110100' => '434', '1000110101' => '435', |
|
195
|
|
|
|
|
|
|
'1000110110' => '436', '1000110111' => '437', '1000111000' => '438', '1000111001' => '439', |
|
196
|
|
|
|
|
|
|
'1001000000' => '440', '1001000001' => '441', '1001000010' => '442', '1001000011' => '443', |
|
197
|
|
|
|
|
|
|
'1001000100' => '444', '1001000101' => '445', '1001000110' => '446', '1001000111' => '447', |
|
198
|
|
|
|
|
|
|
'1001001000' => '448', '1001001001' => '449', '1001010000' => '450', '1001010001' => '451', |
|
199
|
|
|
|
|
|
|
'1001010010' => '452', '1001010011' => '453', '1001010100' => '454', '1001010101' => '455', |
|
200
|
|
|
|
|
|
|
'1001010110' => '456', '1001010111' => '457', '1001011000' => '458', '1001011001' => '459', |
|
201
|
|
|
|
|
|
|
'1001100000' => '460', '1001100001' => '461', '1001100010' => '462', '1001100011' => '463', |
|
202
|
|
|
|
|
|
|
'1001100100' => '464', '1001100101' => '465', '1001100110' => '466', '1001100111' => '467', |
|
203
|
|
|
|
|
|
|
'1001101000' => '468', '1001101001' => '469', '1001110000' => '470', '1001110001' => '471', |
|
204
|
|
|
|
|
|
|
'1001110010' => '472', '1001110011' => '473', '1001110100' => '474', '1001110101' => '475', |
|
205
|
|
|
|
|
|
|
'1001110110' => '476', '1001110111' => '477', '1001111000' => '478', '1001111001' => '479', |
|
206
|
|
|
|
|
|
|
'1000001010' => '480', '1000001011' => '481', '1000101010' => '482', '1000101011' => '483', |
|
207
|
|
|
|
|
|
|
'1001001010' => '484', '1001001011' => '485', '1001101010' => '486', '1001101011' => '487', |
|
208
|
|
|
|
|
|
|
'1001001110' => '488', '1001001111' => '489', '1000011010' => '490', '1000011011' => '491', |
|
209
|
|
|
|
|
|
|
'1000111010' => '492', '1000111011' => '493', '1001011010' => '494', '1001011011' => '495', |
|
210
|
|
|
|
|
|
|
'1001111010' => '496', '1001111011' => '497', '1001011110' => '498', '1001011111' => '499', |
|
211
|
|
|
|
|
|
|
'1010000000' => '500', '1010000001' => '501', '1010000010' => '502', '1010000011' => '503', |
|
212
|
|
|
|
|
|
|
'1010000100' => '504', '1010000101' => '505', '1010000110' => '506', '1010000111' => '507', |
|
213
|
|
|
|
|
|
|
'1010001000' => '508', '1010001001' => '509', '1010010000' => '510', '1010010001' => '511', |
|
214
|
|
|
|
|
|
|
'1010010010' => '512', '1010010011' => '513', '1010010100' => '514', '1010010101' => '515', |
|
215
|
|
|
|
|
|
|
'1010010110' => '516', '1010010111' => '517', '1010011000' => '518', '1010011001' => '519', |
|
216
|
|
|
|
|
|
|
'1010100000' => '520', '1010100001' => '521', '1010100010' => '522', '1010100011' => '523', |
|
217
|
|
|
|
|
|
|
'1010100100' => '524', '1010100101' => '525', '1010100110' => '526', '1010100111' => '527', |
|
218
|
|
|
|
|
|
|
'1010101000' => '528', '1010101001' => '529', '1010110000' => '530', '1010110001' => '531', |
|
219
|
|
|
|
|
|
|
'1010110010' => '532', '1010110011' => '533', '1010110100' => '534', '1010110101' => '535', |
|
220
|
|
|
|
|
|
|
'1010110110' => '536', '1010110111' => '537', '1010111000' => '538', '1010111001' => '539', |
|
221
|
|
|
|
|
|
|
'1011000000' => '540', '1011000001' => '541', '1011000010' => '542', '1011000011' => '543', |
|
222
|
|
|
|
|
|
|
'1011000100' => '544', '1011000101' => '545', '1011000110' => '546', '1011000111' => '547', |
|
223
|
|
|
|
|
|
|
'1011001000' => '548', '1011001001' => '549', '1011010000' => '550', '1011010001' => '551', |
|
224
|
|
|
|
|
|
|
'1011010010' => '552', '1011010011' => '553', '1011010100' => '554', '1011010101' => '555', |
|
225
|
|
|
|
|
|
|
'1011010110' => '556', '1011010111' => '557', '1011011000' => '558', '1011011001' => '559', |
|
226
|
|
|
|
|
|
|
'1011100000' => '560', '1011100001' => '561', '1011100010' => '562', '1011100011' => '563', |
|
227
|
|
|
|
|
|
|
'1011100100' => '564', '1011100101' => '565', '1011100110' => '566', '1011100111' => '567', |
|
228
|
|
|
|
|
|
|
'1011101000' => '568', '1011101001' => '569', '1011110000' => '570', '1011110001' => '571', |
|
229
|
|
|
|
|
|
|
'1011110010' => '572', '1011110011' => '573', '1011110100' => '574', '1011110101' => '575', |
|
230
|
|
|
|
|
|
|
'1011110110' => '576', '1011110111' => '577', '1011111000' => '578', '1011111001' => '579', |
|
231
|
|
|
|
|
|
|
'1010001010' => '580', '1010001011' => '581', '1010101010' => '582', '1010101011' => '583', |
|
232
|
|
|
|
|
|
|
'1011001010' => '584', '1011001011' => '585', '1011101010' => '586', '1011101011' => '587', |
|
233
|
|
|
|
|
|
|
'1011001110' => '588', '1011001111' => '589', '1010011010' => '590', '1010011011' => '591', |
|
234
|
|
|
|
|
|
|
'1010111010' => '592', '1010111011' => '593', '1011011010' => '594', '1011011011' => '595', |
|
235
|
|
|
|
|
|
|
'1011111010' => '596', '1011111011' => '597', '1011011110' => '598', '1011011111' => '599', |
|
236
|
|
|
|
|
|
|
'1100000000' => '600', '1100000001' => '601', '1100000010' => '602', '1100000011' => '603', |
|
237
|
|
|
|
|
|
|
'1100000100' => '604', '1100000101' => '605', '1100000110' => '606', '1100000111' => '607', |
|
238
|
|
|
|
|
|
|
'1100001000' => '608', '1100001001' => '609', '1100010000' => '610', '1100010001' => '611', |
|
239
|
|
|
|
|
|
|
'1100010010' => '612', '1100010011' => '613', '1100010100' => '614', '1100010101' => '615', |
|
240
|
|
|
|
|
|
|
'1100010110' => '616', '1100010111' => '617', '1100011000' => '618', '1100011001' => '619', |
|
241
|
|
|
|
|
|
|
'1100100000' => '620', '1100100001' => '621', '1100100010' => '622', '1100100011' => '623', |
|
242
|
|
|
|
|
|
|
'1100100100' => '624', '1100100101' => '625', '1100100110' => '626', '1100100111' => '627', |
|
243
|
|
|
|
|
|
|
'1100101000' => '628', '1100101001' => '629', '1100110000' => '630', '1100110001' => '631', |
|
244
|
|
|
|
|
|
|
'1100110010' => '632', '1100110011' => '633', '1100110100' => '634', '1100110101' => '635', |
|
245
|
|
|
|
|
|
|
'1100110110' => '636', '1100110111' => '637', '1100111000' => '638', '1100111001' => '639', |
|
246
|
|
|
|
|
|
|
'1101000000' => '640', '1101000001' => '641', '1101000010' => '642', '1101000011' => '643', |
|
247
|
|
|
|
|
|
|
'1101000100' => '644', '1101000101' => '645', '1101000110' => '646', '1101000111' => '647', |
|
248
|
|
|
|
|
|
|
'1101001000' => '648', '1101001001' => '649', '1101010000' => '650', '1101010001' => '651', |
|
249
|
|
|
|
|
|
|
'1101010010' => '652', '1101010011' => '653', '1101010100' => '654', '1101010101' => '655', |
|
250
|
|
|
|
|
|
|
'1101010110' => '656', '1101010111' => '657', '1101011000' => '658', '1101011001' => '659', |
|
251
|
|
|
|
|
|
|
'1101100000' => '660', '1101100001' => '661', '1101100010' => '662', '1101100011' => '663', |
|
252
|
|
|
|
|
|
|
'1101100100' => '664', '1101100101' => '665', '1101100110' => '666', '1101100111' => '667', |
|
253
|
|
|
|
|
|
|
'1101101000' => '668', '1101101001' => '669', '1101110000' => '670', '1101110001' => '671', |
|
254
|
|
|
|
|
|
|
'1101110010' => '672', '1101110011' => '673', '1101110100' => '674', '1101110101' => '675', |
|
255
|
|
|
|
|
|
|
'1101110110' => '676', '1101110111' => '677', '1101111000' => '678', '1101111001' => '679', |
|
256
|
|
|
|
|
|
|
'1100001010' => '680', '1100001011' => '681', '1100101010' => '682', '1100101011' => '683', |
|
257
|
|
|
|
|
|
|
'1101001010' => '684', '1101001011' => '685', '1101101010' => '686', '1101101011' => '687', |
|
258
|
|
|
|
|
|
|
'1101001110' => '688', '1101001111' => '689', '1100011010' => '690', '1100011011' => '691', |
|
259
|
|
|
|
|
|
|
'1100111010' => '692', '1100111011' => '693', '1101011010' => '694', '1101011011' => '695', |
|
260
|
|
|
|
|
|
|
'1101111010' => '696', '1101111011' => '697', '1101011110' => '698', '1101011111' => '699', |
|
261
|
|
|
|
|
|
|
'1110000000' => '700', '1110000001' => '701', '1110000010' => '702', '1110000011' => '703', |
|
262
|
|
|
|
|
|
|
'1110000100' => '704', '1110000101' => '705', '1110000110' => '706', '1110000111' => '707', |
|
263
|
|
|
|
|
|
|
'1110001000' => '708', '1110001001' => '709', '1110010000' => '710', '1110010001' => '711', |
|
264
|
|
|
|
|
|
|
'1110010010' => '712', '1110010011' => '713', '1110010100' => '714', '1110010101' => '715', |
|
265
|
|
|
|
|
|
|
'1110010110' => '716', '1110010111' => '717', '1110011000' => '718', '1110011001' => '719', |
|
266
|
|
|
|
|
|
|
'1110100000' => '720', '1110100001' => '721', '1110100010' => '722', '1110100011' => '723', |
|
267
|
|
|
|
|
|
|
'1110100100' => '724', '1110100101' => '725', '1110100110' => '726', '1110100111' => '727', |
|
268
|
|
|
|
|
|
|
'1110101000' => '728', '1110101001' => '729', '1110110000' => '730', '1110110001' => '731', |
|
269
|
|
|
|
|
|
|
'1110110010' => '732', '1110110011' => '733', '1110110100' => '734', '1110110101' => '735', |
|
270
|
|
|
|
|
|
|
'1110110110' => '736', '1110110111' => '737', '1110111000' => '738', '1110111001' => '739', |
|
271
|
|
|
|
|
|
|
'1111000000' => '740', '1111000001' => '741', '1111000010' => '742', '1111000011' => '743', |
|
272
|
|
|
|
|
|
|
'1111000100' => '744', '1111000101' => '745', '1111000110' => '746', '1111000111' => '747', |
|
273
|
|
|
|
|
|
|
'1111001000' => '748', '1111001001' => '749', '1111010000' => '750', '1111010001' => '751', |
|
274
|
|
|
|
|
|
|
'1111010010' => '752', '1111010011' => '753', '1111010100' => '754', '1111010101' => '755', |
|
275
|
|
|
|
|
|
|
'1111010110' => '756', '1111010111' => '757', '1111011000' => '758', '1111011001' => '759', |
|
276
|
|
|
|
|
|
|
'1111100000' => '760', '1111100001' => '761', '1111100010' => '762', '1111100011' => '763', |
|
277
|
|
|
|
|
|
|
'1111100100' => '764', '1111100101' => '765', '1111100110' => '766', '1111100111' => '767', |
|
278
|
|
|
|
|
|
|
'1111101000' => '768', '1111101001' => '769', '1111110000' => '770', '1111110001' => '771', |
|
279
|
|
|
|
|
|
|
'1111110010' => '772', '1111110011' => '773', '1111110100' => '774', '1111110101' => '775', |
|
280
|
|
|
|
|
|
|
'1111110110' => '776', '1111110111' => '777', '1111111000' => '778', '1111111001' => '779', |
|
281
|
|
|
|
|
|
|
'1110001010' => '780', '1110001011' => '781', '1110101010' => '782', '1110101011' => '783', |
|
282
|
|
|
|
|
|
|
'1111001010' => '784', '1111001011' => '785', '1111101010' => '786', '1111101011' => '787', |
|
283
|
|
|
|
|
|
|
'1111001110' => '788', '1111001111' => '789', '1110011010' => '790', '1110011011' => '791', |
|
284
|
|
|
|
|
|
|
'1110111010' => '792', '1110111011' => '793', '1111011010' => '794', '1111011011' => '795', |
|
285
|
|
|
|
|
|
|
'1111111010' => '796', '1111111011' => '797', '1111011110' => '798', '1111011111' => '799', |
|
286
|
|
|
|
|
|
|
'0000001100' => '800', '0000001101' => '801', '0100001100' => '802', '0100001101' => '803', |
|
287
|
|
|
|
|
|
|
'1000001100' => '804', '1000001101' => '805', '1100001100' => '806', '1100001101' => '807', |
|
288
|
|
|
|
|
|
|
'0000101110' => '808', '0000101111' => '809', '0000011100' => '810', '0000011101' => '811', |
|
289
|
|
|
|
|
|
|
'0100011100' => '812', '0100011101' => '813', '1000011100' => '814', '1000011101' => '815', |
|
290
|
|
|
|
|
|
|
'1100011100' => '816', '1100011101' => '817', '0000111110' => '818', '0000111111' => '819', |
|
291
|
|
|
|
|
|
|
'0000101100' => '820', '0000101101' => '821', '0100101100' => '822', '0100101101' => '823', |
|
292
|
|
|
|
|
|
|
'1000101100' => '824', '1000101101' => '825', '1100101100' => '826', '1100101101' => '827', |
|
293
|
|
|
|
|
|
|
'0100101110' => '828', '0100101111' => '829', '0000111100' => '830', '0000111101' => '831', |
|
294
|
|
|
|
|
|
|
'0100111100' => '832', '0100111101' => '833', '1000111100' => '834', '1000111101' => '835', |
|
295
|
|
|
|
|
|
|
'1100111100' => '836', '1100111101' => '837', '0100111110' => '838', '0100111111' => '839', |
|
296
|
|
|
|
|
|
|
'0001001100' => '840', '0001001101' => '841', '0101001100' => '842', '0101001101' => '843', |
|
297
|
|
|
|
|
|
|
'1001001100' => '844', '1001001101' => '845', '1101001100' => '846', '1101001101' => '847', |
|
298
|
|
|
|
|
|
|
'1000101110' => '848', '1000101111' => '849', '0001011100' => '850', '0001011101' => '851', |
|
299
|
|
|
|
|
|
|
'0101011100' => '852', '0101011101' => '853', '1001011100' => '854', '1001011101' => '855', |
|
300
|
|
|
|
|
|
|
'1101011100' => '856', '1101011101' => '857', '1000111110' => '858', '1000111111' => '859', |
|
301
|
|
|
|
|
|
|
'0001101100' => '860', '0001101101' => '861', '0101101100' => '862', '0101101101' => '863', |
|
302
|
|
|
|
|
|
|
'1001101100' => '864', '1001101101' => '865', '1101101100' => '866', '1101101101' => '867', |
|
303
|
|
|
|
|
|
|
'1100101110' => '868', '1100101111' => '869', '0001111100' => '870', '0001111101' => '871', |
|
304
|
|
|
|
|
|
|
'0101111100' => '872', '0101111101' => '873', '1001111100' => '874', '1001111101' => '875', |
|
305
|
|
|
|
|
|
|
'1101111100' => '876', '1101111101' => '877', '1100111110' => '878', '1100111111' => '879', |
|
306
|
|
|
|
|
|
|
'0000001110' => '880', '0000001111' => '881', '0100001110' => '882', '0100001111' => '883', |
|
307
|
|
|
|
|
|
|
'1000001110' => '884', '1000001111' => '885', '1100001110' => '886', '1100001111' => '887', |
|
308
|
|
|
|
|
|
|
'0001101110' => '888', '0001101111' => '889', '0000011110' => '890', '0000011111' => '891', |
|
309
|
|
|
|
|
|
|
'0100011110' => '892', '0100011111' => '893', '1000011110' => '894', '1000011111' => '895', |
|
310
|
|
|
|
|
|
|
'1100011110' => '896', '1100011111' => '897', '0001111110' => '898', '0001111111' => '899', |
|
311
|
|
|
|
|
|
|
'0010001100' => '900', '0010001101' => '901', '0110001100' => '902', '0110001101' => '903', |
|
312
|
|
|
|
|
|
|
'1010001100' => '904', '1010001101' => '905', '1110001100' => '906', '1110001101' => '907', |
|
313
|
|
|
|
|
|
|
'0010101110' => '908', '0010101111' => '909', '0010011100' => '910', '0010011101' => '911', |
|
314
|
|
|
|
|
|
|
'0110011100' => '912', '0110011101' => '913', '1010011100' => '914', '1010011101' => '915', |
|
315
|
|
|
|
|
|
|
'1110011100' => '916', '1110011101' => '917', '0010111110' => '918', '0010111111' => '919', |
|
316
|
|
|
|
|
|
|
'0010101100' => '920', '0010101101' => '921', '0110101100' => '922', '0110101101' => '923', |
|
317
|
|
|
|
|
|
|
'1010101100' => '924', '1010101101' => '925', '1110101100' => '926', '1110101101' => '927', |
|
318
|
|
|
|
|
|
|
'0110101110' => '928', '0110101111' => '929', '0010111100' => '930', '0010111101' => '931', |
|
319
|
|
|
|
|
|
|
'0110111100' => '932', '0110111101' => '933', '1010111100' => '934', '1010111101' => '935', |
|
320
|
|
|
|
|
|
|
'1110111100' => '936', '1110111101' => '937', '0110111110' => '938', '0110111111' => '939', |
|
321
|
|
|
|
|
|
|
'0011001100' => '940', '0011001101' => '941', '0111001100' => '942', '0111001101' => '943', |
|
322
|
|
|
|
|
|
|
'1011001100' => '944', '1011001101' => '945', '1111001100' => '946', '1111001101' => '947', |
|
323
|
|
|
|
|
|
|
'1010101110' => '948', '1010101111' => '949', '0011011100' => '950', '0011011101' => '951', |
|
324
|
|
|
|
|
|
|
'0111011100' => '952', '0111011101' => '953', '1011011100' => '954', '1011011101' => '955', |
|
325
|
|
|
|
|
|
|
'1111011100' => '956', '1111011101' => '957', '1010111110' => '958', '1010111111' => '959', |
|
326
|
|
|
|
|
|
|
'0011101100' => '960', '0011101101' => '961', '0111101100' => '962', '0111101101' => '963', |
|
327
|
|
|
|
|
|
|
'1011101100' => '964', '1011101101' => '965', '1111101100' => '966', '1111101101' => '967', |
|
328
|
|
|
|
|
|
|
'1110101110' => '968', '1110101111' => '969', '0011111100' => '970', '0011111101' => '971', |
|
329
|
|
|
|
|
|
|
'0111111100' => '972', '0111111101' => '973', '1011111100' => '974', '1011111101' => '975', |
|
330
|
|
|
|
|
|
|
'1111111100' => '976', '1111111101' => '977', '1110111110' => '978', '1110111111' => '979', |
|
331
|
|
|
|
|
|
|
'0010001110' => '980', '0010001111' => '981', '0110001110' => '982', '0110001111' => '983', |
|
332
|
|
|
|
|
|
|
'1010001110' => '984', '1010001111' => '985', '1110001110' => '986', '1110001111' => '987', |
|
333
|
|
|
|
|
|
|
'0011101110' => '988', '0011101111' => '989', '0010011110' => '990', '0010011111' => '991', |
|
334
|
|
|
|
|
|
|
'0110011110' => '992', '0110011111' => '993', '1010011110' => '994', '1010011111' => '995', |
|
335
|
|
|
|
|
|
|
'1110011110' => '996', '1110011111' => '997', '0011111110' => '998', '0011111111' => '999', |
|
336
|
|
|
|
|
|
|
) : (); |
|
337
|
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
####################################################################### |
|
339
|
|
|
|
|
|
|
####################################################################### |
|
340
|
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
# %Math::Decimal64::dpd_decode is simply %Math::Decimal64::dpd_encode |
|
342
|
|
|
|
|
|
|
# with the keys and values interchanged. |
|
343
|
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
for my $key(keys(%Math::Decimal64::dpd_encode)) { |
|
345
|
|
|
|
|
|
|
$Math::Decimal64::dpd_decode{$Math::Decimal64::dpd_encode{$key}} = $key; |
|
346
|
|
|
|
|
|
|
} |
|
347
|
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
####################################################################### |
|
349
|
|
|
|
|
|
|
####################################################################### |
|
350
|
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
%Math::Decimal64::bid_decode = $Math::Decimal64::fmt eq 'BID' ? ( |
|
352
|
|
|
|
|
|
|
0 => MEtoD64('1' . ('0' x 15), 0), 1 => MEtoD64('1' . ('0' x 14), 0), |
|
353
|
|
|
|
|
|
|
2 => MEtoD64('1' . ('0' x 13), 0), 3 => MEtoD64('1' . ('0' x 12), 0), |
|
354
|
|
|
|
|
|
|
4 => MEtoD64('1' . ('0' x 11), 0), 5 => MEtoD64('1' . ('0' x 10), 0), |
|
355
|
|
|
|
|
|
|
6 => MEtoD64('1' . ('0' x 9), 0), 7 => MEtoD64('1' . ('0' x 8), 0), |
|
356
|
|
|
|
|
|
|
8 => MEtoD64('1' . ('0' x 7), 0), 9 => MEtoD64('1' . ('0' x 6), 0), |
|
357
|
|
|
|
|
|
|
10 => MEtoD64('1' . ('0' x 5), 0), 11 => MEtoD64('1' . ('0' x 4), 0), |
|
358
|
|
|
|
|
|
|
12 => MEtoD64('1' . ('0' x 3), 0), 13 => MEtoD64('1' . ('0' x 2), 0), |
|
359
|
|
|
|
|
|
|
14 => MEtoD64('1' . ('0' x 1), 0), 15 => MEtoD64('1', 0) |
|
360
|
|
|
|
|
|
|
) : (); |
|
361
|
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
####################################################################### |
|
363
|
|
|
|
|
|
|
####################################################################### |
|
364
|
|
|
|
|
|
|
# Used by t/decode_cross_checks.t |
|
365
|
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
sub _decode_mant { |
|
367
|
1536
|
|
|
1536
|
|
13926
|
my $val = shift; |
|
368
|
1536
|
|
|
|
|
1718
|
my $ret = ''; |
|
369
|
1536
|
|
|
|
|
2351
|
for my $i(0 .. 15) { |
|
370
|
24576
|
|
|
|
|
25652
|
my $count = 0; |
|
371
|
24576
|
100
|
|
|
|
41729
|
if($val > 0) { |
|
372
|
19290
|
|
|
|
|
38100
|
while($val >= $Math::Decimal64::bid_decode{$i}) { |
|
373
|
58879
|
|
|
|
|
91666
|
$val -= $Math::Decimal64::bid_decode{$i}; |
|
374
|
58879
|
|
|
|
|
103936
|
$count++; |
|
375
|
|
|
|
|
|
|
} |
|
376
|
|
|
|
|
|
|
} |
|
377
|
24576
|
|
|
|
|
34487
|
$ret .= $count; |
|
378
|
|
|
|
|
|
|
} |
|
379
|
1536
|
|
|
|
|
4091
|
return $ret; |
|
380
|
|
|
|
|
|
|
} |
|
381
|
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
####################################################################### |
|
383
|
|
|
|
|
|
|
####################################################################### |
|
384
|
|
|
|
|
|
|
|
|
385
|
37
|
|
|
37
|
0
|
14627
|
sub dl_load_flags {0} # Prevent DynaLoader from complaining and croaking |
|
386
|
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
####################################################################### |
|
388
|
|
|
|
|
|
|
####################################################################### |
|
389
|
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
sub _overload_string { |
|
391
|
58
|
|
|
58
|
|
929
|
my @ret = D64toME($_[0]); |
|
392
|
58
|
100
|
66
|
|
|
238
|
if(is_InfD64($_[0]) || !$_[0]) {return $ret[0]} |
|
|
14
|
|
|
|
|
69
|
|
|
393
|
44
|
|
|
|
|
161
|
return $ret[0] . 'e' . $ret[1]; |
|
394
|
|
|
|
|
|
|
} |
|
395
|
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
####################################################################### |
|
397
|
|
|
|
|
|
|
####################################################################### |
|
398
|
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
sub pFR { |
|
400
|
0
|
|
|
0
|
0
|
0
|
my @ret = FR64toME($_[0]); |
|
401
|
0
|
0
|
0
|
|
|
0
|
if(is_InfD64($_[0]) || !$_[0]) {print $ret[0]} |
|
|
0
|
|
|
|
|
0
|
|
|
402
|
0
|
|
|
|
|
0
|
else {print $ret[0] . "e" . $ret[1]} |
|
403
|
|
|
|
|
|
|
} |
|
404
|
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
####################################################################### |
|
406
|
|
|
|
|
|
|
####################################################################### |
|
407
|
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
sub _overload_int { |
|
409
|
47732
|
100
|
100
|
47732
|
|
345206
|
if(is_NaND64($_[0]) || is_InfD64($_[0]) || is_ZeroD64($_[0])) {return $_[0]} |
|
|
361
|
|
100
|
|
|
904
|
|
|
410
|
47371
|
|
|
|
|
76935
|
my($man, $exp) = D64toME($_[0]); |
|
411
|
47371
|
100
|
|
|
|
94774
|
if($exp >= 0) {return $_[0]} |
|
|
23505
|
|
|
|
|
63843
|
|
|
412
|
23866
|
|
|
|
|
27555
|
my $man_length = length($man); |
|
413
|
23866
|
100
|
|
|
|
51903
|
$man_length-- if $man =~ /^\-/; |
|
414
|
23866
|
100
|
|
|
|
36086
|
if(-$exp >= $man_length) { # -1 <= $_[0] <= 1 |
|
415
|
23851
|
|
|
|
|
49272
|
my $z = ZeroD64(1); |
|
416
|
23851
|
100
|
|
|
|
65434
|
if($_[0] < $z) {return ZeroD64(-1)} # return -0 |
|
|
23850
|
|
|
|
|
106938
|
|
|
417
|
1
|
|
|
|
|
4
|
return $z; # return 0 |
|
418
|
|
|
|
|
|
|
} |
|
419
|
|
|
|
|
|
|
|
|
420
|
15
|
|
|
|
|
23
|
substr($man, $exp, -$exp, ''); |
|
421
|
15
|
|
|
|
|
24
|
return MEtoD64($man, 0); |
|
422
|
|
|
|
|
|
|
} |
|
423
|
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
####################################################################### |
|
425
|
|
|
|
|
|
|
####################################################################### |
|
426
|
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
sub new { |
|
428
|
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
# This function caters for 2 possibilities: |
|
430
|
|
|
|
|
|
|
# 1) that 'new' has been called OOP style - in which |
|
431
|
|
|
|
|
|
|
# case there will be a maximum of 2 args |
|
432
|
|
|
|
|
|
|
# 2) that 'new' has been called as a function - in |
|
433
|
|
|
|
|
|
|
# which case there will be a maximum of 1 arg. |
|
434
|
|
|
|
|
|
|
# If there are no args, then we just want to return a |
|
435
|
|
|
|
|
|
|
# Math::Decimal64 object that's a NaN. |
|
436
|
|
|
|
|
|
|
|
|
437
|
509413
|
100
|
|
509413
|
0
|
5748317
|
if(!@_) {return NaND64()} |
|
|
1
|
|
|
|
|
5
|
|
|
438
|
|
|
|
|
|
|
|
|
439
|
509412
|
100
|
|
|
|
745524
|
if(@_ > 3) {die "More than 3 arguments supplied to new()"} |
|
|
2
|
|
|
|
|
15
|
|
|
440
|
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
# If 'new' has been called OOP style, the first arg is the string |
|
442
|
|
|
|
|
|
|
# "Math::Decimal64" which we don't need - so let's remove it. However, |
|
443
|
|
|
|
|
|
|
# if the first arg is a Math::Decimal64 object (which is a possibility), |
|
444
|
|
|
|
|
|
|
# then we'll get a fatal error when we check it for equivalence to |
|
445
|
|
|
|
|
|
|
# the string "Math::Decimal64". So we first need to check that it's not |
|
446
|
|
|
|
|
|
|
# an object - which we'll do by using the ref() function: |
|
447
|
509410
|
100
|
100
|
|
|
1243482
|
if(!ref($_[0]) && $_[0] eq "Math::Decimal64") { |
|
448
|
509399
|
|
|
|
|
530150
|
shift; |
|
449
|
509399
|
100
|
|
|
|
701655
|
if(!@_) {return NaND64()} |
|
|
10
|
|
|
|
|
213
|
|
|
450
|
|
|
|
|
|
|
} |
|
451
|
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
# @_ can now contain max of 2 vals - the mantissa and exponent. |
|
453
|
|
|
|
|
|
|
# If @_ == 1 then it contains the value. |
|
454
|
509400
|
100
|
|
|
|
675557
|
if(@_ > 2) {die "Too many arguments supplied to new() - expected no more than 2"} |
|
|
1
|
|
|
|
|
4
|
|
|
455
|
|
|
|
|
|
|
|
|
456
|
509399
|
100
|
|
|
|
690669
|
if(@_ == 2) {return MEtoD64(shift, shift)} |
|
|
509266
|
|
|
|
|
679981
|
|
|
457
|
|
|
|
|
|
|
|
|
458
|
133
|
|
|
|
|
166
|
my $arg = shift; |
|
459
|
133
|
|
|
|
|
244
|
my $type = _itsa($arg); |
|
460
|
|
|
|
|
|
|
|
|
461
|
133
|
100
|
|
|
|
205
|
if($type == 1) { # UV |
|
462
|
13
|
|
|
|
|
156
|
return UVtoD64($arg); |
|
463
|
|
|
|
|
|
|
} |
|
464
|
|
|
|
|
|
|
|
|
465
|
120
|
100
|
|
|
|
172
|
if($type == 2) { # IV |
|
466
|
16
|
|
|
|
|
156
|
return IVtoD64($arg); |
|
467
|
|
|
|
|
|
|
} |
|
468
|
|
|
|
|
|
|
|
|
469
|
104
|
100
|
|
|
|
137
|
if($type == 3) { # NV |
|
470
|
3
|
|
|
|
|
13
|
die "new() cannot be used to assign an NV - use NVtoD64() instead"; |
|
471
|
|
|
|
|
|
|
} |
|
472
|
|
|
|
|
|
|
|
|
473
|
101
|
100
|
|
|
|
149
|
if($type == 4) { # PV |
|
474
|
73
|
50
|
|
|
|
142
|
return STRtoD64($arg) if have_strtod64(); |
|
475
|
73
|
|
|
|
|
435
|
return PVtoD64($arg); |
|
476
|
|
|
|
|
|
|
} |
|
477
|
|
|
|
|
|
|
|
|
478
|
28
|
100
|
|
|
|
58
|
if($type == 64) { # Math::Decimal64 object |
|
479
|
25
|
|
|
|
|
96
|
return D64toD64($arg); |
|
480
|
|
|
|
|
|
|
} |
|
481
|
|
|
|
|
|
|
|
|
482
|
3
|
|
|
|
|
15
|
die "Bad argument given to new"; |
|
483
|
|
|
|
|
|
|
} |
|
484
|
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
####################################################################### |
|
486
|
|
|
|
|
|
|
####################################################################### |
|
487
|
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
sub D64toME { |
|
489
|
|
|
|
|
|
|
|
|
490
|
178568
|
|
|
178568
|
0
|
435566
|
my($ret1, $ret2) = split /e/i, decode_d64($_[0]); |
|
491
|
178568
|
100
|
|
|
|
318660
|
$ret2 = 0 unless defined $ret2; |
|
492
|
178568
|
100
|
|
|
|
474938
|
$ret2 = 0 if is_ZeroD64($_[0]); |
|
493
|
178568
|
|
|
|
|
395752
|
return ($ret1, $ret2); |
|
494
|
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
## OLD - used strtold ## |
|
496
|
|
|
|
|
|
|
# return ('-0', '0') if (is_ZeroD64($_[0]) == -1); # Negative Zero. |
|
497
|
|
|
|
|
|
|
# my @ret = _D64toME($_[0]); |
|
498
|
|
|
|
|
|
|
# if(!defined($ret[1])) { |
|
499
|
|
|
|
|
|
|
# @ret = _sci2me($ret[0], $ret[2]); |
|
500
|
|
|
|
|
|
|
# } |
|
501
|
|
|
|
|
|
|
# return @ret; |
|
502
|
|
|
|
|
|
|
} |
|
503
|
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
####################################################################### |
|
505
|
|
|
|
|
|
|
####################################################################### |
|
506
|
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
sub FR64toME { |
|
508
|
|
|
|
|
|
|
|
|
509
|
0
|
|
|
0
|
0
|
0
|
my $fr = Math::MPFR::Rmpfr_init2(55); |
|
510
|
0
|
|
|
|
|
0
|
my $v = $Math::MPFR::VERSION; |
|
511
|
0
|
0
|
|
|
|
0
|
$v ge '3.23' ? Math::MPFR::Rmpfr_set_DECIMAL64($fr, $_[0], 0) |
|
512
|
|
|
|
|
|
|
: Math::MPFR::Rmpfr_set_decimal64($fr, $_[0], 0); # round to nearest |
|
513
|
|
|
|
|
|
|
|
|
514
|
0
|
0
|
0
|
|
|
0
|
if(Math::MPFR::Rmpfr_zero_p($fr) || |
|
|
|
|
0
|
|
|
|
|
|
515
|
|
|
|
|
|
|
Math::MPFR::Rmpfr_inf_p($fr) || |
|
516
|
|
|
|
|
|
|
Math::MPFR::Rmpfr_nan_p($fr)) { |
|
517
|
0
|
|
|
|
|
0
|
return D64toME($_[0]); |
|
518
|
|
|
|
|
|
|
} |
|
519
|
|
|
|
|
|
|
|
|
520
|
0
|
|
|
|
|
0
|
my($man, $exp) = Math::MPFR::Rmpfr_deref2($fr, 10, 16, 0); #MPFR_RNDN |
|
521
|
0
|
|
0
|
|
|
0
|
chop $man while(length($man) > 1 && $man =~ /0$/); |
|
522
|
0
|
|
|
|
|
0
|
$exp -= length($man); |
|
523
|
0
|
0
|
|
|
|
0
|
$exp++ if $man =~/^\-/; |
|
524
|
0
|
|
|
|
|
0
|
return ($man, $exp); |
|
525
|
|
|
|
|
|
|
} |
|
526
|
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
####################################################################### |
|
528
|
|
|
|
|
|
|
####################################################################### |
|
529
|
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
sub MEtoD64 { |
|
531
|
|
|
|
|
|
|
# Check that 2 args are supplied |
|
532
|
546898
|
50
|
|
546898
|
0
|
1564540
|
die "MEtoD64 takes 2 args" if @_ != 2; |
|
533
|
|
|
|
|
|
|
|
|
534
|
546898
|
|
|
|
|
774044
|
my($arg1, $arg2) = (shift, shift); |
|
535
|
|
|
|
|
|
|
|
|
536
|
546898
|
100
|
|
|
|
1016858
|
die "Invalid 1st arg ($arg1) to MEtoD64" if $arg1 =~ /[^0-9\-\+]/; |
|
537
|
546897
|
50
|
|
|
|
801869
|
die "Invalid 2nd arg ($arg2) to MEtoD64" if $arg2 =~ /[^0-9\-\+]/; |
|
538
|
|
|
|
|
|
|
|
|
539
|
546897
|
|
|
|
|
672599
|
$arg1 =~ s/^\+//; |
|
540
|
546897
|
|
|
|
|
571545
|
$arg2 =~ s/^\+//; |
|
541
|
546897
|
100
|
|
|
|
1029448
|
my $sign = $arg1 =~ s/^\-// ? '-' : ''; |
|
542
|
|
|
|
|
|
|
|
|
543
|
546897
|
|
|
|
|
635802
|
my $len_1 = length $arg1; |
|
544
|
|
|
|
|
|
|
|
|
545
|
546897
|
100
|
100
|
|
|
1127509
|
if($len_1 >= 16 || $arg2 < -398) { |
|
546
|
222488
|
100
|
|
|
|
284898
|
die "${sign}${arg1} exceeds _Decimal64 precision. It needs to be shortened to no more than 16 decimal digits" |
|
547
|
|
|
|
|
|
|
if $len_1 > 16; |
|
548
|
222487
|
100
|
|
|
|
283541
|
($arg1, $arg2) = _round_as_needed($arg1, $arg2) if $arg2 < -398; |
|
549
|
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
# Need to handle the possibility that strtold can't handle all 16-digit values correctly. |
|
551
|
222487
|
50
|
|
|
|
959829
|
if($Config{longdblsize} == 8) { |
|
552
|
0
|
|
|
|
|
0
|
my $len = length $arg1; # length of $arg1 may have changed |
|
553
|
0
|
0
|
|
|
|
0
|
if($len == 16) { |
|
554
|
0
|
|
|
|
|
0
|
return _MEtoD64($sign . substr($arg1, 0, 8), $arg2 + 8) + |
|
555
|
|
|
|
|
|
|
_MEtoD64($sign . substr($arg1, 8, 8), $arg2); |
|
556
|
|
|
|
|
|
|
} |
|
557
|
|
|
|
|
|
|
} |
|
558
|
|
|
|
|
|
|
} |
|
559
|
|
|
|
|
|
|
|
|
560
|
546896
|
|
|
|
|
4669324
|
return _MEtoD64($sign . $arg1, $arg2); |
|
561
|
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
} |
|
563
|
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
####################################################################### |
|
565
|
|
|
|
|
|
|
####################################################################### |
|
566
|
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
# Values such as (d, -400), (dd, -401), (ddd, -402), etc evaluate to zero. |
|
568
|
|
|
|
|
|
|
# But values such as (dddd, -400), (ddd, -401), (dddddddd, -402), etc may be non-zero. |
|
569
|
|
|
|
|
|
|
# In such cases we'll remove the ignored (trailing) digits, rounding the leading |
|
570
|
|
|
|
|
|
|
# digits to nearest - tied to even for midway cases. |
|
571
|
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
sub _round_as_needed { |
|
573
|
3470
|
|
|
3470
|
|
5189
|
my($sign, $man, $exp) = ('', shift, shift); |
|
574
|
|
|
|
|
|
|
|
|
575
|
3470
|
50
|
|
|
|
5165
|
if($man =~ /^\-/) { |
|
576
|
0
|
|
|
|
|
0
|
$man =~ s/^\-//; |
|
577
|
0
|
|
|
|
|
0
|
$sign = '-'; |
|
578
|
|
|
|
|
|
|
} |
|
579
|
|
|
|
|
|
|
|
|
580
|
3470
|
|
|
|
|
3675
|
my $length = length $man; |
|
581
|
3470
|
|
|
|
|
3820
|
my $maxlen = -398 - $exp; |
|
582
|
|
|
|
|
|
|
|
|
583
|
3470
|
100
|
|
|
|
4780
|
if($length >= $maxlen) { |
|
584
|
1102
|
|
|
|
|
1364
|
my $rounder = substr($man, $length - $maxlen); # The trailing (ignored) digits |
|
585
|
1102
|
100
|
|
|
|
1718
|
$man = $length > $maxlen ? substr($man, 0, $length - $maxlen) |
|
586
|
|
|
|
|
|
|
: '0'; |
|
587
|
1102
|
|
|
|
|
1199
|
my $roundup = 0; |
|
588
|
1102
|
100
|
|
|
|
1730
|
$roundup = 1 if substr($rounder, 0, 1) > 5; |
|
589
|
1102
|
100
|
100
|
|
|
1960
|
$roundup = 1 if ((substr($rounder, 0, 1) == 5) && |
|
|
|
|
100
|
|
|
|
|
|
590
|
|
|
|
|
|
|
((substr($rounder, 1) =~ /[1-9]/) || (substr($man, -1, 1) %2 == 1))); |
|
591
|
|
|
|
|
|
|
|
|
592
|
1102
|
100
|
|
|
|
1605
|
$man++ if $roundup; |
|
593
|
1102
|
|
|
|
|
1290
|
$exp += $maxlen; # Removal of trailing digits moved the implied |
|
594
|
|
|
|
|
|
|
# decimal point $maxlen places to the left |
|
595
|
|
|
|
|
|
|
} |
|
596
|
|
|
|
|
|
|
|
|
597
|
3470
|
|
|
|
|
7664
|
return ($sign . $man, $exp); |
|
598
|
|
|
|
|
|
|
} |
|
599
|
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
####################################################################### |
|
601
|
|
|
|
|
|
|
####################################################################### |
|
602
|
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
sub assignME { |
|
604
|
|
|
|
|
|
|
# Check that 3 args are supplied |
|
605
|
10
|
50
|
|
10
|
0
|
429
|
die "assignME takes 3 args" if @_ != 3; |
|
606
|
|
|
|
|
|
|
|
|
607
|
10
|
|
|
|
|
15
|
my $arg1 = shift; |
|
608
|
10
|
|
|
|
|
12
|
my $arg2 = shift; |
|
609
|
10
|
|
|
|
|
13
|
my $arg3 = shift; |
|
610
|
|
|
|
|
|
|
|
|
611
|
10
|
100
|
|
|
|
41
|
die "Invalid 1st arg ($arg1) to assignME" if _itsa($arg1) != 64; |
|
612
|
8
|
50
|
|
|
|
21
|
die "Invalid 2nd arg ($arg2) to assignME" if $arg2 =~ /[^0-9\-]/; |
|
613
|
8
|
50
|
|
|
|
16
|
die "Invalid 3rd arg ($arg3) to assignME" if $arg3 =~ /[^0-9\-]/; |
|
614
|
|
|
|
|
|
|
|
|
615
|
8
|
|
|
|
|
10
|
my $len_2 = length($arg2); |
|
616
|
8
|
100
|
|
|
|
20
|
$len_2-- if $arg2 =~ /^\-/; |
|
617
|
|
|
|
|
|
|
|
|
618
|
8
|
100
|
66
|
|
|
26
|
if($len_2 >= 16 || $arg3 < -398) { |
|
619
|
1
|
50
|
|
|
|
3
|
die "$arg2 exceeds _Decimal64 precision. It needs to be shortened to no more than 16 decimal digits" |
|
620
|
|
|
|
|
|
|
if $len_2 > 16; |
|
621
|
1
|
50
|
|
|
|
3
|
($arg2, $arg3) = _round_as_needed($arg2, $arg3) if $arg3 < -398; |
|
622
|
|
|
|
|
|
|
# Need to handle the possibility that strtold can't handle all 16-digit values correctly. |
|
623
|
1
|
50
|
|
|
|
23
|
if($Config{longdblsize} == 8) { |
|
624
|
0
|
|
|
|
|
0
|
$len_2 = length $arg2; |
|
625
|
0
|
|
|
|
|
0
|
my ($sign, $inc) = ('', 0); |
|
626
|
0
|
0
|
|
|
|
0
|
if($arg2 =~ /^\-/) { |
|
627
|
0
|
|
|
|
|
0
|
$len_2--; |
|
628
|
0
|
|
|
|
|
0
|
$sign = '-'; |
|
629
|
0
|
|
|
|
|
0
|
$inc++; |
|
630
|
|
|
|
|
|
|
} |
|
631
|
0
|
0
|
|
|
|
0
|
if($len_2 == 16) { |
|
632
|
0
|
|
|
|
|
0
|
assignD64($arg1, |
|
633
|
|
|
|
|
|
|
_MEtoD64($sign . substr($arg2, 0 + $inc, 8), $arg3 + 8) + |
|
634
|
|
|
|
|
|
|
_MEtoD64($sign . substr($arg2, 8 + $inc, 8), $arg3)); |
|
635
|
|
|
|
|
|
|
} |
|
636
|
|
|
|
|
|
|
} |
|
637
|
|
|
|
|
|
|
} |
|
638
|
|
|
|
|
|
|
|
|
639
|
8
|
|
|
|
|
74
|
_assignME($arg1, $arg2, $arg3); |
|
640
|
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
} |
|
642
|
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
####################################################################### |
|
644
|
|
|
|
|
|
|
####################################################################### |
|
645
|
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
sub _sci2me { |
|
647
|
0
|
|
|
0
|
|
0
|
my @ret = split /e/i, $_[0]; |
|
648
|
0
|
|
|
|
|
0
|
chop $ret[0] while $ret[0] =~ /0\b/; |
|
649
|
0
|
|
|
|
|
0
|
my @adj = split /\./, $ret[0]; |
|
650
|
0
|
0
|
|
|
|
0
|
my $adj = defined $adj[1] ? length($adj[1]) |
|
651
|
|
|
|
|
|
|
: 0; |
|
652
|
0
|
|
|
|
|
0
|
$ret[0] =~ s/\.//; |
|
653
|
0
|
|
|
|
|
0
|
$ret[1] += $_[1] - $adj; |
|
654
|
|
|
|
|
|
|
|
|
655
|
0
|
|
|
|
|
0
|
return @ret; |
|
656
|
|
|
|
|
|
|
} |
|
657
|
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
####################################################################### |
|
659
|
|
|
|
|
|
|
####################################################################### |
|
660
|
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
sub d64_bytes { |
|
662
|
183909
|
|
|
183909
|
0
|
733796
|
my @ret = _d64_bytes($_[0]); |
|
663
|
183909
|
|
|
|
|
488608
|
return join '', @ret; |
|
664
|
|
|
|
|
|
|
} |
|
665
|
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
####################################################################### |
|
667
|
|
|
|
|
|
|
####################################################################### |
|
668
|
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
sub hex2bin { |
|
670
|
182285
|
|
|
182285
|
0
|
512952
|
my $ret = unpack("B*", (pack "H*", $_[0])); |
|
671
|
182285
|
|
|
|
|
218019
|
my $len = length $ret; |
|
672
|
182285
|
50
|
|
|
|
261048
|
die "hex2bin() yielded $len bits" if $len != 64; |
|
673
|
182285
|
|
|
|
|
258378
|
return $ret; |
|
674
|
|
|
|
|
|
|
} |
|
675
|
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
####################################################################### |
|
677
|
|
|
|
|
|
|
####################################################################### |
|
678
|
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
sub d64_fmt { |
|
680
|
44
|
|
|
44
|
0
|
329
|
my $d64 = MEtoD64('1234567890123456', 0); |
|
681
|
|
|
|
|
|
|
# BID: 31C462D53C8ABAC0 |
|
682
|
|
|
|
|
|
|
# DPD: 263934B9C1E28E56 |
|
683
|
44
|
50
|
|
|
|
241
|
return 'DPD' if d64_bytes($d64) =~ /E56$/i; |
|
684
|
44
|
50
|
|
|
|
153
|
return 'BID' if d64_bytes($d64) =~ /AC0$/i; |
|
685
|
0
|
|
|
|
|
0
|
return 'Unknown'; |
|
686
|
|
|
|
|
|
|
} |
|
687
|
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
####################################################################### |
|
689
|
|
|
|
|
|
|
####################################################################### |
|
690
|
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
sub decode_dpd { |
|
692
|
|
|
|
|
|
|
# Takes the Math::Decimal64 object as its arg. |
|
693
|
|
|
|
|
|
|
# Decodes Densely Packed Decimal formatting of the Decimal64 value. |
|
694
|
0
|
|
|
0
|
0
|
0
|
my $binstring = hex2bin(d64_bytes($_[0])); |
|
695
|
0
|
|
|
|
|
0
|
my @first = decode_dpd_1st($binstring); |
|
696
|
0
|
0
|
0
|
|
|
0
|
return ($first[0] . $first[1]) if ($first[1] =~ /inf/i || $first[1] =~ /nan/i); |
|
697
|
0
|
|
|
|
|
0
|
my $mantissa = $first[1] . decode_dpd_2nd($binstring); |
|
698
|
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
# Remove leading zeroes from the mantissa |
|
700
|
0
|
|
|
|
|
0
|
$mantissa =~ s/^0+//; |
|
701
|
0
|
0
|
|
|
|
0
|
if($mantissa eq '') {$mantissa = '0'} |
|
|
0
|
|
|
|
|
0
|
|
|
702
|
|
|
|
|
|
|
else { |
|
703
|
|
|
|
|
|
|
# Remove trailing zeroes |
|
704
|
0
|
|
|
|
|
0
|
while($mantissa =~ /0$/) { |
|
705
|
0
|
|
|
|
|
0
|
$mantissa =~ s/0$//; |
|
706
|
0
|
|
|
|
|
0
|
$first[2]++; |
|
707
|
|
|
|
|
|
|
} |
|
708
|
|
|
|
|
|
|
} |
|
709
|
|
|
|
|
|
|
|
|
710
|
0
|
|
|
|
|
0
|
my $ret = $first[0] . $mantissa . 'e' . $first[2]; |
|
711
|
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
} |
|
713
|
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
####################################################################### |
|
715
|
|
|
|
|
|
|
####################################################################### |
|
716
|
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
sub decode_dpd_1st{ |
|
718
|
|
|
|
|
|
|
# Takes the entire binary string as its arg. |
|
719
|
0
|
0
|
|
0
|
0
|
0
|
die "Argument to decode_dpd_1st is wrong size (", length($_[0]), ")" |
|
720
|
|
|
|
|
|
|
if length($_[0]) != 64; |
|
721
|
0
|
|
|
|
|
0
|
my $leading_bits = 14; |
|
722
|
0
|
|
|
|
|
0
|
my $trailing_bits = 50; |
|
723
|
0
|
|
|
|
|
0
|
my $msd; # significand's most siginificant digit |
|
724
|
|
|
|
|
|
|
my $exp; # exponent |
|
725
|
0
|
|
|
|
|
0
|
my $keep = substr($_[0], 0, $leading_bits); |
|
726
|
0
|
0
|
|
|
|
0
|
my $sign = substr($keep, 0, 1) ? '-' : ''; |
|
727
|
0
|
0
|
|
|
|
0
|
return ('','nan') if substr($keep, 1, 5) eq '11111'; |
|
728
|
0
|
0
|
|
|
|
0
|
if(substr($keep, 1 ,5) eq '11110') {return ($sign, 'inf')} |
|
|
0
|
|
|
|
|
0
|
|
|
729
|
0
|
|
|
|
|
0
|
my $pre = substr($keep, 1, 2); |
|
730
|
0
|
0
|
0
|
|
|
0
|
if($pre eq '00' || $pre eq '01' || $pre eq '10') { |
|
|
|
|
0
|
|
|
|
|
|
731
|
0
|
|
|
|
|
0
|
$msd = oct('0b0' . substr($keep, 3, 3)); |
|
732
|
0
|
|
|
|
|
0
|
$exp = oct('0b' . $pre . substr($keep, 6, 8)) - 398; |
|
733
|
0
|
|
|
|
|
0
|
return ($sign, $msd, $exp); |
|
734
|
|
|
|
|
|
|
} |
|
735
|
0
|
|
|
|
|
0
|
$pre = substr($keep, 1, 4); |
|
736
|
0
|
0
|
0
|
|
|
0
|
if($pre eq '1100' || $pre eq '1101' || $pre eq '1110') { |
|
|
|
|
0
|
|
|
|
|
|
737
|
0
|
|
|
|
|
0
|
$exp = oct('0b' . substr($pre, 2, 2) . substr($keep, 6, 8)) - 398; |
|
738
|
0
|
|
|
|
|
0
|
$msd = oct('0b' . '100' . substr($keep, 5, 1)); |
|
739
|
0
|
|
|
|
|
0
|
return ($sign, $msd, $exp); |
|
740
|
|
|
|
|
|
|
} |
|
741
|
0
|
|
|
|
|
0
|
die "decode_dpd_1st function failed to parse its argument ($_[0])"; |
|
742
|
|
|
|
|
|
|
} |
|
743
|
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
####################################################################### |
|
745
|
|
|
|
|
|
|
####################################################################### |
|
746
|
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
sub decode_dpd_2nd { |
|
748
|
|
|
|
|
|
|
# Takes the entire binary string as its arg. |
|
749
|
0
|
0
|
|
0
|
0
|
0
|
die "Argument to decode_dpd_2nd is wrong size (", length($_[0]), ")" |
|
750
|
|
|
|
|
|
|
if length($_[0]) != 64; # 64 for Decimal64 |
|
751
|
0
|
|
|
|
|
0
|
my $leading_bits = 14; # 18 for Decimal28 |
|
752
|
0
|
|
|
|
|
0
|
my $trailing_bits = 50; # 110 for Decimal28 |
|
753
|
0
|
|
|
|
|
0
|
my $keep = substr($_[0], $leading_bits, $trailing_bits); |
|
754
|
0
|
|
|
|
|
0
|
my $ret = ''; |
|
755
|
0
|
|
|
|
|
0
|
for my $i(0, 10, 20, 30, 40) { |
|
756
|
0
|
|
|
|
|
0
|
my $key = substr($keep, $i, 10); |
|
757
|
0
|
|
|
|
|
0
|
$ret .= $Math::Decimal64::dpd_encode{$key}; |
|
758
|
|
|
|
|
|
|
} |
|
759
|
0
|
|
|
|
|
0
|
return $ret; |
|
760
|
|
|
|
|
|
|
} |
|
761
|
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
####################################################################### |
|
763
|
|
|
|
|
|
|
####################################################################### |
|
764
|
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
sub decode_bid { |
|
766
|
|
|
|
|
|
|
# Takes a Math::Decimal64 object as its arg. |
|
767
|
|
|
|
|
|
|
# Decodes Binary Integer Decimal formatting of the _Decimal64 value. |
|
768
|
|
|
|
|
|
|
|
|
769
|
180749
|
|
|
180749
|
0
|
245482
|
my $keep = hex2bin(d64_bytes($_[0])); |
|
770
|
180749
|
50
|
|
|
|
280819
|
die "Base 2 representation is wrong size (", length($keep), ")" |
|
771
|
|
|
|
|
|
|
if length($keep) != 64; # 64 for Decimal64 |
|
772
|
180749
|
|
|
|
|
190152
|
my $leading_bits = 13; |
|
773
|
180749
|
|
|
|
|
182125
|
my $trailing_bits = 51; |
|
774
|
180749
|
|
|
|
|
209207
|
my @mantissa; |
|
775
|
|
|
|
|
|
|
my $exp; # exponent |
|
776
|
180749
|
100
|
|
|
|
290374
|
my $sign = substr($keep, 0, 1) ? '-' : ''; |
|
777
|
180749
|
100
|
|
|
|
268629
|
return 'nan' if substr($keep, 1, 5) eq '11111'; |
|
778
|
180736
|
100
|
|
|
|
248571
|
if(substr($keep, 1 ,5) eq '11110') {return $sign . 'inf'} |
|
|
25
|
|
|
|
|
73
|
|
|
779
|
180711
|
|
|
|
|
205347
|
my $pre = substr($keep, 1, 2); |
|
780
|
180711
|
100
|
100
|
|
|
441270
|
if($pre eq '00' || $pre eq '01' || $pre eq '10') { |
|
|
|
|
100
|
|
|
|
|
|
781
|
171812
|
|
|
|
|
299274
|
$exp = oct('0b' . substr($keep, 1, 10)) - 398; |
|
782
|
171812
|
|
|
|
|
1117974
|
@mantissa = reverse(split(//, '0' . substr($keep, 11, 53))); |
|
783
|
171812
|
|
|
|
|
1125297
|
my $mantissa = _bid_mant(\@mantissa); |
|
784
|
171812
|
100
|
|
|
|
462719
|
if($mantissa !~ /[1-9]/) { $mantissa = '0'} |
|
|
914
|
|
|
|
|
1067
|
|
|
785
|
|
|
|
|
|
|
else { |
|
786
|
170898
|
|
|
|
|
367829
|
while($mantissa =~ /0$/) { |
|
787
|
633894
|
|
|
|
|
1046303
|
$mantissa =~ s/0$//; |
|
788
|
633894
|
|
|
|
|
1076291
|
$exp++; |
|
789
|
|
|
|
|
|
|
} |
|
790
|
|
|
|
|
|
|
} |
|
791
|
171812
|
|
|
|
|
947341
|
return $sign . $mantissa . 'e' . $exp; |
|
792
|
|
|
|
|
|
|
} |
|
793
|
8899
|
|
|
|
|
11643
|
$pre = substr($keep, 1, 4); |
|
794
|
8899
|
50
|
100
|
|
|
27304
|
if($pre eq '1100' || $pre eq '1101' || $pre eq '1110') { |
|
|
|
|
66
|
|
|
|
|
|
795
|
8899
|
|
|
|
|
16455
|
$exp = oct('0b' . substr($keep, 3, 10)) - 398; |
|
796
|
8899
|
|
|
|
|
62066
|
@mantissa = reverse(split(//,'100' . substr($keep, 13, 51))); |
|
797
|
8899
|
|
|
|
|
61062
|
my $mantissa = _bid_mant(\@mantissa); |
|
798
|
8899
|
50
|
|
|
|
26164
|
if($mantissa !~ /[1-9]/) { $mantissa = '0'} |
|
|
0
|
|
|
|
|
0
|
|
|
799
|
|
|
|
|
|
|
else { |
|
800
|
8899
|
|
|
|
|
22125
|
while($mantissa =~ /0$/) { |
|
801
|
59399
|
|
|
|
|
100036
|
$mantissa =~ s/0$//; |
|
802
|
59399
|
|
|
|
|
102140
|
$exp++; |
|
803
|
|
|
|
|
|
|
} |
|
804
|
|
|
|
|
|
|
} |
|
805
|
8899
|
|
|
|
|
48954
|
return $sign . $mantissa . 'e' . $exp; |
|
806
|
|
|
|
|
|
|
} |
|
807
|
0
|
|
|
|
|
0
|
die "decode_bid function failed to parse its argument ($_[0])"; |
|
808
|
|
|
|
|
|
|
} |
|
809
|
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
####################################################################### |
|
811
|
|
|
|
|
|
|
####################################################################### |
|
812
|
|
|
|
|
|
|
# Replaced by XSub of same name |
|
813
|
|
|
|
|
|
|
# sub PVtoD64 { |
|
814
|
|
|
|
|
|
|
# |
|
815
|
|
|
|
|
|
|
# my($arg1, $arg2) = PVtoME($_[0]); |
|
816
|
|
|
|
|
|
|
# |
|
817
|
|
|
|
|
|
|
# if($arg1 =~ /inf|nan/i) { |
|
818
|
|
|
|
|
|
|
# $arg1 =~ /nan/i ? return NaND64() |
|
819
|
|
|
|
|
|
|
# : $arg1 =~ /^\-/ ? return InfD64(-1) |
|
820
|
|
|
|
|
|
|
# : return InfD64(1); |
|
821
|
|
|
|
|
|
|
# } |
|
822
|
|
|
|
|
|
|
# |
|
823
|
|
|
|
|
|
|
# return MEtoD64($arg1, $arg2); |
|
824
|
|
|
|
|
|
|
#} |
|
825
|
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
####################################################################### |
|
827
|
|
|
|
|
|
|
####################################################################### |
|
828
|
|
|
|
|
|
|
# Replaced by XSub of same name |
|
829
|
|
|
|
|
|
|
# sub assignPV { |
|
830
|
|
|
|
|
|
|
# |
|
831
|
|
|
|
|
|
|
# my($arg1, $arg2) = PVtoME($_[1]); |
|
832
|
|
|
|
|
|
|
# if($arg1 =~ /inf|nan/i) { |
|
833
|
|
|
|
|
|
|
# $arg1 =~ /nan/i ? assignNaN($_[0]) |
|
834
|
|
|
|
|
|
|
# : $arg1 =~ /^\-/ ? assignInf($_[0], -1) |
|
835
|
|
|
|
|
|
|
# : assignInf($_[0], 1); |
|
836
|
|
|
|
|
|
|
# } |
|
837
|
|
|
|
|
|
|
# else { |
|
838
|
|
|
|
|
|
|
# assignME($_[0], $arg1, $arg2); |
|
839
|
|
|
|
|
|
|
# } |
|
840
|
|
|
|
|
|
|
#} |
|
841
|
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
####################################################################### |
|
843
|
|
|
|
|
|
|
####################################################################### |
|
844
|
|
|
|
|
|
|
|
|
845
|
8
|
|
|
8
|
|
107
|
sub DEC64_MAX () {return _DEC64_MAX()} |
|
846
|
9
|
|
|
9
|
|
73
|
sub DEC64_MIN () {return _DEC64_MIN()} |
|
847
|
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
####################################################################### |
|
849
|
|
|
|
|
|
|
####################################################################### |
|
850
|
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
sub get_exp { |
|
852
|
1536
|
|
|
1536
|
0
|
2114
|
my $keep = hex2bin(d64_bytes($_[0])); |
|
853
|
1536
|
|
|
|
|
2118
|
my $pre = substr($keep, 1, 2); |
|
854
|
1536
|
50
|
|
|
|
2303
|
if($Math::Decimal64::fmt eq 'DPD') { |
|
855
|
0
|
0
|
0
|
|
|
0
|
if($pre eq '00' || $pre eq '01' || $pre eq '10') { |
|
|
|
|
0
|
|
|
|
|
|
856
|
0
|
|
|
|
|
0
|
return oct('0b' . $pre . substr($keep, 6, 8)) - 398; |
|
857
|
|
|
|
|
|
|
} |
|
858
|
|
|
|
|
|
|
else { |
|
859
|
0
|
|
|
|
|
0
|
return oct('0b' . substr($pre, 2, 2) . substr($keep, 6, 8)) - 398; |
|
860
|
|
|
|
|
|
|
} |
|
861
|
|
|
|
|
|
|
} |
|
862
|
|
|
|
|
|
|
else { |
|
863
|
1536
|
100
|
100
|
|
|
4083
|
if($pre eq '00' || $pre eq '01' || $pre eq '10') { |
|
|
|
|
100
|
|
|
|
|
|
864
|
1455
|
|
|
|
|
3717
|
return oct('0b' . substr($keep, 1, 10)) - 398; |
|
865
|
|
|
|
|
|
|
} |
|
866
|
|
|
|
|
|
|
else { |
|
867
|
81
|
|
|
|
|
205
|
return oct('0b' . substr($keep, 3, 10)) - 398; |
|
868
|
|
|
|
|
|
|
} |
|
869
|
|
|
|
|
|
|
} |
|
870
|
|
|
|
|
|
|
} |
|
871
|
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
####################################################################### |
|
873
|
|
|
|
|
|
|
####################################################################### |
|
874
|
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
sub get_sign { |
|
876
|
1536
|
100
|
|
1536
|
0
|
5253
|
return '-' if hex(substr(d64_bytes($_[0]), 0, 1)) >= 8; |
|
877
|
768
|
|
|
|
|
1439
|
return '+'; |
|
878
|
|
|
|
|
|
|
} |
|
879
|
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
####################################################################### |
|
881
|
|
|
|
|
|
|
####################################################################### |
|
882
|
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
sub DPDtoD64 { |
|
884
|
|
|
|
|
|
|
# Usable only where DPD format is in use. |
|
885
|
|
|
|
|
|
|
# Converts the 64-bit string returned by _MEtoBINSTR into |
|
886
|
|
|
|
|
|
|
# a Math::Decimal64 object set to the value encoded by the |
|
887
|
|
|
|
|
|
|
# the 64-bit string. This is all done without having to calculate |
|
888
|
|
|
|
|
|
|
# the actual value - and is typically ~25 times quicker than |
|
889
|
|
|
|
|
|
|
# MEtoD64. |
|
890
|
6
|
|
|
6
|
0
|
123
|
my($man, $exp) = (shift, shift); |
|
891
|
6
|
|
|
|
|
12
|
my $arg = _MEtoBINSTR($man, $exp); |
|
892
|
6
|
|
|
|
|
36
|
return _DPDtoD64(unpack("a*", pack( "B*", $arg))); |
|
893
|
|
|
|
|
|
|
} |
|
894
|
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
####################################################################### |
|
896
|
|
|
|
|
|
|
####################################################################### |
|
897
|
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
sub PVtoME { |
|
899
|
|
|
|
|
|
|
|
|
900
|
0
|
|
|
0
|
0
|
0
|
my($arg1, $arg2) = split /e/i, $_[0]; |
|
901
|
|
|
|
|
|
|
|
|
902
|
0
|
0
|
|
|
|
0
|
if($arg1 =~ /^(\-|\+)?inf|^(\-|\+)?nan/i) { |
|
903
|
0
|
|
|
|
|
0
|
return ($arg1, 0); |
|
904
|
|
|
|
|
|
|
} |
|
905
|
|
|
|
|
|
|
|
|
906
|
0
|
|
|
|
|
0
|
_sanitise_args($arg1, $arg2); |
|
907
|
0
|
|
|
|
|
0
|
return ($arg1, $arg2); |
|
908
|
|
|
|
|
|
|
} |
|
909
|
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
sub MEtoPV { |
|
911
|
16
|
|
|
16
|
0
|
113
|
my $arg1 = shift; |
|
912
|
16
|
100
|
|
|
|
51
|
if($arg1 =~ /^(\-|\+)?inf|^(\-|\+)?nan/i) { |
|
913
|
8
|
|
|
|
|
14
|
$arg1 =~ s/\+//; |
|
914
|
8
|
|
|
|
|
16
|
return $arg1; |
|
915
|
|
|
|
|
|
|
} |
|
916
|
|
|
|
|
|
|
|
|
917
|
8
|
|
|
|
|
9
|
my $arg2 = shift; |
|
918
|
8
|
|
|
|
|
16
|
return $arg1 . 'e' . $arg2; |
|
919
|
|
|
|
|
|
|
} |
|
920
|
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
####################################################################### |
|
922
|
|
|
|
|
|
|
####################################################################### |
|
923
|
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
sub _sanitise_args { |
|
925
|
0
|
0
|
|
0
|
|
0
|
$_[1] = 0 unless defined $_[1]; |
|
926
|
0
|
|
|
|
|
0
|
$_[0] =~ s/\.0+$//; |
|
927
|
0
|
|
|
|
|
0
|
my @split = split /\./, $_[0]; |
|
928
|
0
|
0
|
|
|
|
0
|
$split[1] = '' unless defined $split[1]; |
|
929
|
0
|
|
|
|
|
0
|
$_[1] -= length($split[1]); |
|
930
|
0
|
|
|
|
|
0
|
$_[0] =~ s/\.//; |
|
931
|
0
|
|
|
|
|
0
|
$_[0] =~ s/^0+//; |
|
932
|
|
|
|
|
|
|
} |
|
933
|
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
####################################################################### |
|
935
|
|
|
|
|
|
|
####################################################################### |
|
936
|
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
sub assignDPD { |
|
938
|
6
|
|
|
6
|
0
|
51
|
_assignDPD($_[0], unpack("a*", pack("B*", _MEtoBINSTR($_[1], $_[2])))); |
|
939
|
|
|
|
|
|
|
} |
|
940
|
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
####################################################################### |
|
942
|
|
|
|
|
|
|
####################################################################### |
|
943
|
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
sub _MEtoBINSTR { |
|
945
|
|
|
|
|
|
|
# Converts (mantissa, exponent) strings to DPD encoded 64-bit string - without |
|
946
|
|
|
|
|
|
|
# the need to actually calculate the value. |
|
947
|
12
|
|
|
12
|
|
16
|
my $man = shift; |
|
948
|
|
|
|
|
|
|
|
|
949
|
12
|
50
|
|
|
|
45
|
if($man =~ /^(\-|\+)?inf|^(\-|\+)?nan/i) { |
|
950
|
12
|
100
|
|
|
|
70
|
$man =~ /\-inf/i ? return '11111' . ('0' x 59) |
|
|
|
100
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
: $man =~ /^(\-|\+)?nan/i ? return '011111' . ('0' x 58) |
|
952
|
|
|
|
|
|
|
: return '01111' . ('0' x 59); |
|
953
|
|
|
|
|
|
|
} |
|
954
|
|
|
|
|
|
|
|
|
955
|
0
|
|
|
|
|
0
|
my $exp = shift; |
|
956
|
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
# Determine the sign, and remove it. |
|
958
|
0
|
0
|
|
|
|
0
|
my $sign = $man =~ /^\-/ ? '1' : '0'; |
|
959
|
0
|
|
|
|
|
0
|
$man =~ s/[\+\-]//; |
|
960
|
0
|
0
|
|
|
|
0
|
die "_MEtoBINSTR has been passed (probably from DPDtoBINSTR) an illegal mantissa" |
|
961
|
|
|
|
|
|
|
if $man =~ /[^0-9]/; |
|
962
|
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
# Remove leading zeroes, and return zero (of appropriate sign) |
|
964
|
|
|
|
|
|
|
# if we're left with the empty string. |
|
965
|
0
|
|
|
|
|
0
|
$man =~ s/^0+//; |
|
966
|
0
|
0
|
|
|
|
0
|
return $sign . '0100001101101' . ('0' x 50) unless $man; |
|
967
|
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
# Fill the mantissa with 16 digits - by zero padding the end. |
|
969
|
0
|
|
|
|
|
0
|
my $add_zeroes = 16 - length($man); |
|
970
|
0
|
|
|
|
|
0
|
$man .= '0' x $add_zeroes; |
|
971
|
0
|
|
|
|
|
0
|
$exp -= $add_zeroes; |
|
972
|
|
|
|
|
|
|
|
|
973
|
0
|
0
|
0
|
|
|
0
|
if(length($man) > 16 || $exp < -398) { |
|
974
|
0
|
0
|
|
|
|
0
|
die "$man exceeds _Decimal64 precision. It needs to be shortened to no more than 16 decimal digits" |
|
975
|
|
|
|
|
|
|
if length($man) > 16; |
|
976
|
0
|
|
|
|
|
0
|
($man, $exp) = _round_as_needed($man, $exp); |
|
977
|
|
|
|
|
|
|
} |
|
978
|
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
# Return 0 if $exp is still less that -398. |
|
980
|
0
|
0
|
|
|
|
0
|
return $sign . '0100001101101' . ('0' x 50) if $exp < -398; |
|
981
|
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
# Return -inf/inf if value is infinite |
|
983
|
0
|
0
|
|
|
|
0
|
if($exp > 369) { |
|
984
|
0
|
0
|
|
|
|
0
|
return $sign . '1111' . ('0' x 59) if (length($man) + $exp) > 385; |
|
985
|
|
|
|
|
|
|
} |
|
986
|
|
|
|
|
|
|
|
|
987
|
0
|
|
|
|
|
0
|
$man = '0' . $man while length($man) < 16; |
|
988
|
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
# The last 50 bits encode the last 15 digits. |
|
990
|
0
|
|
|
|
|
0
|
my $last_15_dig = substr($man, 1, 15); |
|
991
|
0
|
|
|
|
|
0
|
my $last_50_bits; |
|
992
|
0
|
|
|
|
|
0
|
for(my $i = 0; $i < 13; $i += 3) { |
|
993
|
0
|
|
|
|
|
0
|
$last_50_bits .= $Math::Decimal64::dpd_decode{substr($last_15_dig, $i, 3)} |
|
994
|
|
|
|
|
|
|
} |
|
995
|
|
|
|
|
|
|
|
|
996
|
0
|
|
|
|
|
0
|
my $len = length($last_50_bits); |
|
997
|
0
|
0
|
|
|
|
0
|
die "Wrong bitsize ($len != 50) in _MEtoBINSTR()" if $len != 50; |
|
998
|
|
|
|
|
|
|
|
|
999
|
0
|
|
|
|
|
0
|
my $leading_digit = substr($man, 0, 1); # ie the msd (most siginificant digit). |
|
1000
|
0
|
|
|
|
|
0
|
my $exp_base_2 = sprintf "%010b", $exp + 398; |
|
1001
|
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
# The encoding of the exponent and msd depends upon the value of the msd. |
|
1003
|
|
|
|
|
|
|
# If it's 0..7, it's done one way; if it's 8 or 9 it's done th'other way. |
|
1004
|
0
|
0
|
|
|
|
0
|
if($leading_digit < 8) { |
|
1005
|
0
|
|
|
|
|
0
|
my $leading_digit_bits = sprintf "%03b", $leading_digit; |
|
1006
|
0
|
|
|
|
|
0
|
substr($exp_base_2, 2, 0, $leading_digit_bits); |
|
1007
|
|
|
|
|
|
|
} |
|
1008
|
|
|
|
|
|
|
else { |
|
1009
|
0
|
0
|
|
|
|
0
|
my $leading_digit_bit = $leading_digit == 8 ? '0' : '1'; |
|
1010
|
0
|
|
|
|
|
0
|
$exp_base_2 = '11' . substr($exp_base_2, 0, 2) . $leading_digit_bit . substr($exp_base_2, 2, 8); |
|
1011
|
|
|
|
|
|
|
} |
|
1012
|
|
|
|
|
|
|
|
|
1013
|
0
|
|
|
|
|
0
|
$len = length($exp_base_2); |
|
1014
|
0
|
0
|
|
|
|
0
|
die "Exponent (= $exp) component length is wrong ($len != 13) in _MEtoBINSTR()" if $len != 13; |
|
1015
|
|
|
|
|
|
|
|
|
1016
|
0
|
|
|
|
|
0
|
return $sign . $exp_base_2 . $last_50_bits; |
|
1017
|
|
|
|
|
|
|
} |
|
1018
|
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
####################################################################### |
|
1020
|
|
|
|
|
|
|
####################################################################### |
|
1021
|
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
sub D64toFSTR { |
|
1023
|
|
|
|
|
|
|
# Converts the argument (M::D64 object) to a string in floating point |
|
1024
|
|
|
|
|
|
|
# format - as distinct from scientific notation. |
|
1025
|
413
|
|
|
413
|
0
|
1111
|
my($m, $e) = D64toME($_[0]); |
|
1026
|
413
|
100
|
|
|
|
932
|
return 'nan' if is_NaND64($_[0]); |
|
1027
|
402
|
100
|
|
|
|
1244
|
if(is_InfD64($_[0])) { |
|
1028
|
22
|
100
|
|
|
|
57
|
return 'inf' if is_InfD64($_[0])> 0; |
|
1029
|
11
|
|
|
|
|
18
|
return '-inf'; |
|
1030
|
|
|
|
|
|
|
} |
|
1031
|
380
|
100
|
|
|
|
878
|
return $m . '0' x $e if $e >= 0; |
|
1032
|
234
|
|
|
|
|
329
|
my($len, $sign) = (length $m, ''); |
|
1033
|
234
|
|
|
|
|
441
|
$m =~ s/^\-//; |
|
1034
|
234
|
100
|
|
|
|
372
|
if($len != length $m) { |
|
1035
|
114
|
|
|
|
|
122
|
$len--; |
|
1036
|
114
|
|
|
|
|
136
|
$sign = '-'; |
|
1037
|
|
|
|
|
|
|
} |
|
1038
|
234
|
100
|
|
|
|
371
|
if($len + $e > 0) { |
|
1039
|
87
|
|
|
|
|
113
|
substr($m, $e, 0, '.'); |
|
1040
|
87
|
|
|
|
|
169
|
return $sign . $m; |
|
1041
|
|
|
|
|
|
|
} |
|
1042
|
147
|
100
|
|
|
|
238
|
if($len + $e < 0) { |
|
1043
|
126
|
|
|
|
|
339
|
return $sign . '0.' . '0' x -($len + $e) . $m; |
|
1044
|
|
|
|
|
|
|
} |
|
1045
|
21
|
|
|
|
|
44
|
return $sign . '0.' . $m; |
|
1046
|
|
|
|
|
|
|
} |
|
1047
|
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
####################################################################### |
|
1049
|
|
|
|
|
|
|
####################################################################### |
|
1050
|
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
sub D64toRSTR { |
|
1052
|
|
|
|
|
|
|
# As for D64toFSTR, but rounds the string to the no. of |
|
1053
|
|
|
|
|
|
|
# decimal places specified by the second arg. |
|
1054
|
|
|
|
|
|
|
|
|
1055
|
123
|
100
|
|
123
|
0
|
550
|
die "2nd arg to D64toRSTR() must be greater than zero" |
|
1056
|
|
|
|
|
|
|
unless $_[1] >= 0; |
|
1057
|
|
|
|
|
|
|
|
|
1058
|
122
|
100
|
|
|
|
177
|
my $dp = $_[1] ? '.' : ''; |
|
1059
|
|
|
|
|
|
|
|
|
1060
|
122
|
|
|
|
|
175
|
my $str = D64toFSTR($_[0]); |
|
1061
|
|
|
|
|
|
|
|
|
1062
|
122
|
100
|
|
|
|
264
|
return $str if $str =~ /n/i; # inf/nan |
|
1063
|
|
|
|
|
|
|
|
|
1064
|
92
|
100
|
|
|
|
177
|
return $str . "$dp" . '0' x $_[1] unless $str =~ /\./; |
|
1065
|
|
|
|
|
|
|
|
|
1066
|
84
|
|
|
|
|
162
|
my($leading, $trailing) = split /\./, $str; |
|
1067
|
84
|
|
|
|
|
95
|
my $len_trail = length $trailing ; |
|
1068
|
|
|
|
|
|
|
|
|
1069
|
84
|
100
|
|
|
|
164
|
return $str if ($_[1] == $len_trail); |
|
1070
|
|
|
|
|
|
|
|
|
1071
|
66
|
100
|
|
|
|
91
|
if(length($trailing) <= $_[1]) { |
|
1072
|
14
|
|
|
|
|
21
|
$trailing .= '0' x ($_[1] - length($trailing)); |
|
1073
|
14
|
|
|
|
|
33
|
return $leading . "$dp" . $trailing; |
|
1074
|
|
|
|
|
|
|
} |
|
1075
|
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
# $len_trail > specified number of decimal places ($_[1]). |
|
1077
|
|
|
|
|
|
|
# We need to round (to nearest, ties to even) from here on. |
|
1078
|
|
|
|
|
|
|
|
|
1079
|
52
|
100
|
100
|
|
|
216
|
return $leading . "$dp" . substr($trailing, 0, $_[1]) |
|
|
|
|
100
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
if (substr($trailing, $_[1], 1) <= 4) || |
|
1081
|
|
|
|
|
|
|
(substr($trailing, $_[1]) =~ /^5(0+)?$/ && substr($trailing, $_[1] - 1, 1) % 2 == 0); |
|
1082
|
|
|
|
|
|
|
|
|
1083
|
34
|
|
|
|
|
47
|
my $to_inc = substr($trailing, 0, $_[1]); |
|
1084
|
|
|
|
|
|
|
|
|
1085
|
34
|
|
|
|
|
50
|
my $carry = _increment($to_inc); # $carry will either be mt string or '1'. If '1', then we |
|
1086
|
|
|
|
|
|
|
# also need to increment $leading. |
|
1087
|
|
|
|
|
|
|
|
|
1088
|
34
|
100
|
|
|
|
64
|
return $leading . "$dp" . $to_inc |
|
1089
|
|
|
|
|
|
|
if $carry eq ''; |
|
1090
|
|
|
|
|
|
|
|
|
1091
|
24
|
|
|
|
|
41
|
my($sign, $len_lead) = ('', length($leading)); |
|
1092
|
|
|
|
|
|
|
|
|
1093
|
24
|
|
|
|
|
64
|
$leading =~ s/^\-//; |
|
1094
|
|
|
|
|
|
|
|
|
1095
|
24
|
100
|
|
|
|
36
|
if($len_lead != length($leading)) { |
|
1096
|
12
|
|
|
|
|
15
|
$sign = '-'; |
|
1097
|
12
|
|
|
|
|
14
|
$len_lead--; |
|
1098
|
|
|
|
|
|
|
} |
|
1099
|
|
|
|
|
|
|
|
|
1100
|
24
|
|
|
|
|
31
|
$carry = _increment($leading); |
|
1101
|
|
|
|
|
|
|
|
|
1102
|
24
|
|
|
|
|
61
|
return $sign . $carry . $leading . "$dp" . $to_inc; |
|
1103
|
|
|
|
|
|
|
} |
|
1104
|
|
|
|
|
|
|
|
|
1105
|
|
|
|
|
|
|
####################################################################### |
|
1106
|
|
|
|
|
|
|
####################################################################### |
|
1107
|
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
sub _increment { |
|
1109
|
58
|
|
|
58
|
|
61
|
my $carry = 1; |
|
1110
|
58
|
|
|
|
|
67
|
my $len = length($_[0]) * -1; |
|
1111
|
|
|
|
|
|
|
|
|
1112
|
58
|
|
|
|
|
95
|
for(my $offset = -1; $offset >= $len; $offset--) { |
|
1113
|
52
|
|
|
|
|
88
|
substr($_[0], $offset, 1) = (substr($_[0], $offset, 1) + 1) % 10; |
|
1114
|
52
|
100
|
|
|
|
88
|
if(substr($_[0], $offset, 1) ne '0') { |
|
1115
|
30
|
|
|
|
|
32
|
$carry = ''; |
|
1116
|
30
|
|
|
|
|
41
|
last; |
|
1117
|
|
|
|
|
|
|
} |
|
1118
|
|
|
|
|
|
|
} |
|
1119
|
|
|
|
|
|
|
|
|
1120
|
58
|
|
|
|
|
78
|
return $carry; |
|
1121
|
|
|
|
|
|
|
} |
|
1122
|
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
####################################################################### |
|
1124
|
|
|
|
|
|
|
####################################################################### |
|
1125
|
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
*decode_d64 = $Math::Decimal64::fmt eq 'DPD' ? \&decode_dpd : \&decode_bid; |
|
1127
|
|
|
|
|
|
|
|
|
1128
|
|
|
|
|
|
|
####################################################################### |
|
1129
|
|
|
|
|
|
|
####################################################################### |
|
1130
|
|
|
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
1; |
|
1132
|
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
__END__ |