| 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__ |