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