## This file generated by InlineX::C2XS (version 0.22) using Inline::C (version 0.5002)
package Math::Decimal64;
use 5.006;
use warnings;
use strict;
use Config; # So MEtoD64 can check whether sizeof(longdouble) > 8.
require Exporter;
*import = \&Exporter::import;
require DynaLoader;
our $VERSION = '0.13';
#$VERSION = eval $VERSION;
use subs qw(DEC64_MAX DEC64_MIN);
DynaLoader::bootstrap Math::Decimal64 $Math::Decimal64::VERSION;
@Math::Decimal64::EXPORT = ();
@Math::Decimal64::EXPORT_OK = qw(
MEtoD64 UVtoD64 IVtoD64 NVtoD64 PVtoD64 STRtoD64 D64toME D64toNV
FR64toME pFR D64toFSTR D64toRSTR
InfD64 NaND64 UnityD64 ZeroD64 is_InfD64 is_NaND64 is_ZeroD64
D64toLD LDtoD64 DEC64_MAX DEC64_MIN
assignME assignInf assignNaN assignPV Exp10 have_strtod64
assignIV assignUV assignNV assignD64
decode_d64 decode_bid decode_dpd d64_bytes hex2bin d64_fmt
get_sign get_exp PVtoME MEtoPV assignDPD DPDtoD64
nnumflag clear_nnum set_nnum
);
%Math::Decimal64::EXPORT_TAGS = (all => [qw(
MEtoD64 UVtoD64 IVtoD64 NVtoD64 PVtoD64 STRtoD64 D64toME D64toNV
FR64toME pFR D64toFSTR D64toRSTR
InfD64 NaND64 UnityD64 ZeroD64 is_InfD64 is_NaND64 is_ZeroD64
D64toLD LDtoD64 DEC64_MAX DEC64_MIN
assignME assignInf assignNaN assignPV Exp10 have_strtod64
assignIV assignUV assignNV assignD64
decode_d64 decode_bid decode_dpd d64_bytes hex2bin d64_fmt
get_sign get_exp PVtoME MEtoPV assignDPD DPDtoD64
nnumflag clear_nnum set_nnum
)]);
use overload
'+' => \&_overload_add,
'*' => \&_overload_mul,
'-' => \&_overload_sub,
'/' => \&_overload_div,
'+=' => \&_overload_add_eq,
'*=' => \&_overload_mul_eq,
'-=' => \&_overload_sub_eq,
'/=' => \&_overload_div_eq,
'""' => \&_overload_string,
'==' => \&_overload_equiv,
'!=' => \&_overload_not_equiv,
'<' => \&_overload_lt,
'>' => \&_overload_gt,
'<=' => \&_overload_lte,
'>=' => \&_overload_gte,
'<=>' => \&_overload_spaceship,
'=' => \&_overload_copy,
'!' => \&_overload_not,
'bool' => \&_overload_true,
'abs' => \&_overload_abs,
'++' => \&_overload_inc,
'--' => \&_overload_dec,
'int' => \&_overload_int,
'neg' => \&_overload_neg,
;
#######################################################################
#######################################################################
$Math::Decimal64::nan_str = unpack("a*", pack( "B*", '011111' . ('0' x 58)));
$Math::Decimal64::ninf_str = unpack("a*", pack( "B*", '11111' . ('0' x 59)));
$Math::Decimal64::pinf_str = unpack("a*", pack( "B*", '01111' . ('0' x 59)));
$Math::Decimal64::fmt = d64_fmt();
#######################################################################
#######################################################################
%Math::Decimal64::dpd_encode = $Math::Decimal64::fmt eq 'DPD' ? (
'0000000000' => '000', '0000000001' => '001', '0000000010' => '002', '0000000011' => '003',
'0000000100' => '004', '0000000101' => '005', '0000000110' => '006', '0000000111' => '007',
'0000001000' => '008', '0000001001' => '009', '0000010000' => '010', '0000010001' => '011',
'0000010010' => '012', '0000010011' => '013', '0000010100' => '014', '0000010101' => '015',
'0000010110' => '016', '0000010111' => '017', '0000011000' => '018', '0000011001' => '019',
'0000100000' => '020', '0000100001' => '021', '0000100010' => '022', '0000100011' => '023',
'0000100100' => '024', '0000100101' => '025', '0000100110' => '026', '0000100111' => '027',
'0000101000' => '028', '0000101001' => '029', '0000110000' => '030', '0000110001' => '031',
'0000110010' => '032', '0000110011' => '033', '0000110100' => '034', '0000110101' => '035',
'0000110110' => '036', '0000110111' => '037', '0000111000' => '038', '0000111001' => '039',
'0001000000' => '040', '0001000001' => '041', '0001000010' => '042', '0001000011' => '043',
'0001000100' => '044', '0001000101' => '045', '0001000110' => '046', '0001000111' => '047',
'0001001000' => '048', '0001001001' => '049', '0001010000' => '050', '0001010001' => '051',
'0001010010' => '052', '0001010011' => '053', '0001010100' => '054', '0001010101' => '055',
'0001010110' => '056', '0001010111' => '057', '0001011000' => '058', '0001011001' => '059',
'0001100000' => '060', '0001100001' => '061', '0001100010' => '062', '0001100011' => '063',
'0001100100' => '064', '0001100101' => '065', '0001100110' => '066', '0001100111' => '067',
'0001101000' => '068', '0001101001' => '069', '0001110000' => '070', '0001110001' => '071',
'0001110010' => '072', '0001110011' => '073', '0001110100' => '074', '0001110101' => '075',
'0001110110' => '076', '0001110111' => '077', '0001111000' => '078', '0001111001' => '079',
'0000001010' => '080', '0000001011' => '081', '0000101010' => '082', '0000101011' => '083',
'0001001010' => '084', '0001001011' => '085', '0001101010' => '086', '0001101011' => '087',
'0001001110' => '088', '0001001111' => '089', '0000011010' => '090', '0000011011' => '091',
'0000111010' => '092', '0000111011' => '093', '0001011010' => '094', '0001011011' => '095',
'0001111010' => '096', '0001111011' => '097', '0001011110' => '098', '0001011111' => '099',
'0010000000' => '100', '0010000001' => '101', '0010000010' => '102', '0010000011' => '103',
'0010000100' => '104', '0010000101' => '105', '0010000110' => '106', '0010000111' => '107',
'0010001000' => '108', '0010001001' => '109', '0010010000' => '110', '0010010001' => '111',
'0010010010' => '112', '0010010011' => '113', '0010010100' => '114', '0010010101' => '115',
'0010010110' => '116', '0010010111' => '117', '0010011000' => '118', '0010011001' => '119',
'0010100000' => '120', '0010100001' => '121', '0010100010' => '122', '0010100011' => '123',
'0010100100' => '124', '0010100101' => '125', '0010100110' => '126', '0010100111' => '127',
'0010101000' => '128', '0010101001' => '129', '0010110000' => '130', '0010110001' => '131',
'0010110010' => '132', '0010110011' => '133', '0010110100' => '134', '0010110101' => '135',
'0010110110' => '136', '0010110111' => '137', '0010111000' => '138', '0010111001' => '139',
'0011000000' => '140', '0011000001' => '141', '0011000010' => '142', '0011000011' => '143',
'0011000100' => '144', '0011000101' => '145', '0011000110' => '146', '0011000111' => '147',
'0011001000' => '148', '0011001001' => '149', '0011010000' => '150', '0011010001' => '151',
'0011010010' => '152', '0011010011' => '153', '0011010100' => '154', '0011010101' => '155',
'0011010110' => '156', '0011010111' => '157', '0011011000' => '158', '0011011001' => '159',
'0011100000' => '160', '0011100001' => '161', '0011100010' => '162', '0011100011' => '163',
'0011100100' => '164', '0011100101' => '165', '0011100110' => '166', '0011100111' => '167',
'0011101000' => '168', '0011101001' => '169', '0011110000' => '170', '0011110001' => '171',
'0011110010' => '172', '0011110011' => '173', '0011110100' => '174', '0011110101' => '175',
'0011110110' => '176', '0011110111' => '177', '0011111000' => '178', '0011111001' => '179',
'0010001010' => '180', '0010001011' => '181', '0010101010' => '182', '0010101011' => '183',
'0011001010' => '184', '0011001011' => '185', '0011101010' => '186', '0011101011' => '187',
'0011001110' => '188', '0011001111' => '189', '0010011010' => '190', '0010011011' => '191',
'0010111010' => '192', '0010111011' => '193', '0011011010' => '194', '0011011011' => '195',
'0011111010' => '196', '0011111011' => '197', '0011011110' => '198', '0011011111' => '199',
'0100000000' => '200', '0100000001' => '201', '0100000010' => '202', '0100000011' => '203',
'0100000100' => '204', '0100000101' => '205', '0100000110' => '206', '0100000111' => '207',
'0100001000' => '208', '0100001001' => '209', '0100010000' => '210', '0100010001' => '211',
'0100010010' => '212', '0100010011' => '213', '0100010100' => '214', '0100010101' => '215',
'0100010110' => '216', '0100010111' => '217', '0100011000' => '218', '0100011001' => '219',
'0100100000' => '220', '0100100001' => '221', '0100100010' => '222', '0100100011' => '223',
'0100100100' => '224', '0100100101' => '225', '0100100110' => '226', '0100100111' => '227',
'0100101000' => '228', '0100101001' => '229', '0100110000' => '230', '0100110001' => '231',
'0100110010' => '232', '0100110011' => '233', '0100110100' => '234', '0100110101' => '235',
'0100110110' => '236', '0100110111' => '237', '0100111000' => '238', '0100111001' => '239',
'0101000000' => '240', '0101000001' => '241', '0101000010' => '242', '0101000011' => '243',
'0101000100' => '244', '0101000101' => '245', '0101000110' => '246', '0101000111' => '247',
'0101001000' => '248', '0101001001' => '249', '0101010000' => '250', '0101010001' => '251',
'0101010010' => '252', '0101010011' => '253', '0101010100' => '254', '0101010101' => '255',
'0101010110' => '256', '0101010111' => '257', '0101011000' => '258', '0101011001' => '259',
'0101100000' => '260', '0101100001' => '261', '0101100010' => '262', '0101100011' => '263',
'0101100100' => '264', '0101100101' => '265', '0101100110' => '266', '0101100111' => '267',
'0101101000' => '268', '0101101001' => '269', '0101110000' => '270', '0101110001' => '271',
'0101110010' => '272', '0101110011' => '273', '0101110100' => '274', '0101110101' => '275',
'0101110110' => '276', '0101110111' => '277', '0101111000' => '278', '0101111001' => '279',
'0100001010' => '280', '0100001011' => '281', '0100101010' => '282', '0100101011' => '283',
'0101001010' => '284', '0101001011' => '285', '0101101010' => '286', '0101101011' => '287',
'0101001110' => '288', '0101001111' => '289', '0100011010' => '290', '0100011011' => '291',
'0100111010' => '292', '0100111011' => '293', '0101011010' => '294', '0101011011' => '295',
'0101111010' => '296', '0101111011' => '297', '0101011110' => '298', '0101011111' => '299',
'0110000000' => '300', '0110000001' => '301', '0110000010' => '302', '0110000011' => '303',
'0110000100' => '304', '0110000101' => '305', '0110000110' => '306', '0110000111' => '307',
'0110001000' => '308', '0110001001' => '309', '0110010000' => '310', '0110010001' => '311',
'0110010010' => '312', '0110010011' => '313', '0110010100' => '314', '0110010101' => '315',
'0110010110' => '316', '0110010111' => '317', '0110011000' => '318', '0110011001' => '319',
'0110100000' => '320', '0110100001' => '321', '0110100010' => '322', '0110100011' => '323',
'0110100100' => '324', '0110100101' => '325', '0110100110' => '326', '0110100111' => '327',
'0110101000' => '328', '0110101001' => '329', '0110110000' => '330', '0110110001' => '331',
'0110110010' => '332', '0110110011' => '333', '0110110100' => '334', '0110110101' => '335',
'0110110110' => '336', '0110110111' => '337', '0110111000' => '338', '0110111001' => '339',
'0111000000' => '340', '0111000001' => '341', '0111000010' => '342', '0111000011' => '343',
'0111000100' => '344', '0111000101' => '345', '0111000110' => '346', '0111000111' => '347',
'0111001000' => '348', '0111001001' => '349', '0111010000' => '350', '0111010001' => '351',
'0111010010' => '352', '0111010011' => '353', '0111010100' => '354', '0111010101' => '355',
'0111010110' => '356', '0111010111' => '357', '0111011000' => '358', '0111011001' => '359',
'0111100000' => '360', '0111100001' => '361', '0111100010' => '362', '0111100011' => '363',
'0111100100' => '364', '0111100101' => '365', '0111100110' => '366', '0111100111' => '367',
'0111101000' => '368', '0111101001' => '369', '0111110000' => '370', '0111110001' => '371',
'0111110010' => '372', '0111110011' => '373', '0111110100' => '374', '0111110101' => '375',
'0111110110' => '376', '0111110111' => '377', '0111111000' => '378', '0111111001' => '379',
'0110001010' => '380', '0110001011' => '381', '0110101010' => '382', '0110101011' => '383',
'0111001010' => '384', '0111001011' => '385', '0111101010' => '386', '0111101011' => '387',
'0111001110' => '388', '0111001111' => '389', '0110011010' => '390', '0110011011' => '391',
'0110111010' => '392', '0110111011' => '393', '0111011010' => '394', '0111011011' => '395',
'0111111010' => '396', '0111111011' => '397', '0111011110' => '398', '0111011111' => '399',
'1000000000' => '400', '1000000001' => '401', '1000000010' => '402', '1000000011' => '403',
'1000000100' => '404', '1000000101' => '405', '1000000110' => '406', '1000000111' => '407',
'1000001000' => '408', '1000001001' => '409', '1000010000' => '410', '1000010001' => '411',
'1000010010' => '412', '1000010011' => '413', '1000010100' => '414', '1000010101' => '415',
'1000010110' => '416', '1000010111' => '417', '1000011000' => '418', '1000011001' => '419',
'1000100000' => '420', '1000100001' => '421', '1000100010' => '422', '1000100011' => '423',
'1000100100' => '424', '1000100101' => '425', '1000100110' => '426', '1000100111' => '427',
'1000101000' => '428', '1000101001' => '429', '1000110000' => '430', '1000110001' => '431',
'1000110010' => '432', '1000110011' => '433', '1000110100' => '434', '1000110101' => '435',
'1000110110' => '436', '1000110111' => '437', '1000111000' => '438', '1000111001' => '439',
'1001000000' => '440', '1001000001' => '441', '1001000010' => '442', '1001000011' => '443',
'1001000100' => '444', '1001000101' => '445', '1001000110' => '446', '1001000111' => '447',
'1001001000' => '448', '1001001001' => '449', '1001010000' => '450', '1001010001' => '451',
'1001010010' => '452', '1001010011' => '453', '1001010100' => '454', '1001010101' => '455',
'1001010110' => '456', '1001010111' => '457', '1001011000' => '458', '1001011001' => '459',
'1001100000' => '460', '1001100001' => '461', '1001100010' => '462', '1001100011' => '463',
'1001100100' => '464', '1001100101' => '465', '1001100110' => '466', '1001100111' => '467',
'1001101000' => '468', '1001101001' => '469', '1001110000' => '470', '1001110001' => '471',
'1001110010' => '472', '1001110011' => '473', '1001110100' => '474', '1001110101' => '475',
'1001110110' => '476', '1001110111' => '477', '1001111000' => '478', '1001111001' => '479',
'1000001010' => '480', '1000001011' => '481', '1000101010' => '482', '1000101011' => '483',
'1001001010' => '484', '1001001011' => '485', '1001101010' => '486', '1001101011' => '487',
'1001001110' => '488', '1001001111' => '489', '1000011010' => '490', '1000011011' => '491',
'1000111010' => '492', '1000111011' => '493', '1001011010' => '494', '1001011011' => '495',
'1001111010' => '496', '1001111011' => '497', '1001011110' => '498', '1001011111' => '499',
'1010000000' => '500', '1010000001' => '501', '1010000010' => '502', '1010000011' => '503',
'1010000100' => '504', '1010000101' => '505', '1010000110' => '506', '1010000111' => '507',
'1010001000' => '508', '1010001001' => '509', '1010010000' => '510', '1010010001' => '511',
'1010010010' => '512', '1010010011' => '513', '1010010100' => '514', '1010010101' => '515',
'1010010110' => '516', '1010010111' => '517', '1010011000' => '518', '1010011001' => '519',
'1010100000' => '520', '1010100001' => '521', '1010100010' => '522', '1010100011' => '523',
'1010100100' => '524', '1010100101' => '525', '1010100110' => '526', '1010100111' => '527',
'1010101000' => '528', '1010101001' => '529', '1010110000' => '530', '1010110001' => '531',
'1010110010' => '532', '1010110011' => '533', '1010110100' => '534', '1010110101' => '535',
'1010110110' => '536', '1010110111' => '537', '1010111000' => '538', '1010111001' => '539',
'1011000000' => '540', '1011000001' => '541', '1011000010' => '542', '1011000011' => '543',
'1011000100' => '544', '1011000101' => '545', '1011000110' => '546', '1011000111' => '547',
'1011001000' => '548', '1011001001' => '549', '1011010000' => '550', '1011010001' => '551',
'1011010010' => '552', '1011010011' => '553', '1011010100' => '554', '1011010101' => '555',
'1011010110' => '556', '1011010111' => '557', '1011011000' => '558', '1011011001' => '559',
'1011100000' => '560', '1011100001' => '561', '1011100010' => '562', '1011100011' => '563',
'1011100100' => '564', '1011100101' => '565', '1011100110' => '566', '1011100111' => '567',
'1011101000' => '568', '1011101001' => '569', '1011110000' => '570', '1011110001' => '571',
'1011110010' => '572', '1011110011' => '573', '1011110100' => '574', '1011110101' => '575',
'1011110110' => '576', '1011110111' => '577', '1011111000' => '578', '1011111001' => '579',
'1010001010' => '580', '1010001011' => '581', '1010101010' => '582', '1010101011' => '583',
'1011001010' => '584', '1011001011' => '585', '1011101010' => '586', '1011101011' => '587',
'1011001110' => '588', '1011001111' => '589', '1010011010' => '590', '1010011011' => '591',
'1010111010' => '592', '1010111011' => '593', '1011011010' => '594', '1011011011' => '595',
'1011111010' => '596', '1011111011' => '597', '1011011110' => '598', '1011011111' => '599',
'1100000000' => '600', '1100000001' => '601', '1100000010' => '602', '1100000011' => '603',
'1100000100' => '604', '1100000101' => '605', '1100000110' => '606', '1100000111' => '607',
'1100001000' => '608', '1100001001' => '609', '1100010000' => '610', '1100010001' => '611',
'1100010010' => '612', '1100010011' => '613', '1100010100' => '614', '1100010101' => '615',
'1100010110' => '616', '1100010111' => '617', '1100011000' => '618', '1100011001' => '619',
'1100100000' => '620', '1100100001' => '621', '1100100010' => '622', '1100100011' => '623',
'1100100100' => '624', '1100100101' => '625', '1100100110' => '626', '1100100111' => '627',
'1100101000' => '628', '1100101001' => '629', '1100110000' => '630', '1100110001' => '631',
'1100110010' => '632', '1100110011' => '633', '1100110100' => '634', '1100110101' => '635',
'1100110110' => '636', '1100110111' => '637', '1100111000' => '638', '1100111001' => '639',
'1101000000' => '640', '1101000001' => '641', '1101000010' => '642', '1101000011' => '643',
'1101000100' => '644', '1101000101' => '645', '1101000110' => '646', '1101000111' => '647',
'1101001000' => '648', '1101001001' => '649', '1101010000' => '650', '1101010001' => '651',
'1101010010' => '652', '1101010011' => '653', '1101010100' => '654', '1101010101' => '655',
'1101010110' => '656', '1101010111' => '657', '1101011000' => '658', '1101011001' => '659',
'1101100000' => '660', '1101100001' => '661', '1101100010' => '662', '1101100011' => '663',
'1101100100' => '664', '1101100101' => '665', '1101100110' => '666', '1101100111' => '667',
'1101101000' => '668', '1101101001' => '669', '1101110000' => '670', '1101110001' => '671',
'1101110010' => '672', '1101110011' => '673', '1101110100' => '674', '1101110101' => '675',
'1101110110' => '676', '1101110111' => '677', '1101111000' => '678', '1101111001' => '679',
'1100001010' => '680', '1100001011' => '681', '1100101010' => '682', '1100101011' => '683',
'1101001010' => '684', '1101001011' => '685', '1101101010' => '686', '1101101011' => '687',
'1101001110' => '688', '1101001111' => '689', '1100011010' => '690', '1100011011' => '691',
'1100111010' => '692', '1100111011' => '693', '1101011010' => '694', '1101011011' => '695',
'1101111010' => '696', '1101111011' => '697', '1101011110' => '698', '1101011111' => '699',
'1110000000' => '700', '1110000001' => '701', '1110000010' => '702', '1110000011' => '703',
'1110000100' => '704', '1110000101' => '705', '1110000110' => '706', '1110000111' => '707',
'1110001000' => '708', '1110001001' => '709', '1110010000' => '710', '1110010001' => '711',
'1110010010' => '712', '1110010011' => '713', '1110010100' => '714', '1110010101' => '715',
'1110010110' => '716', '1110010111' => '717', '1110011000' => '718', '1110011001' => '719',
'1110100000' => '720', '1110100001' => '721', '1110100010' => '722', '1110100011' => '723',
'1110100100' => '724', '1110100101' => '725', '1110100110' => '726', '1110100111' => '727',
'1110101000' => '728', '1110101001' => '729', '1110110000' => '730', '1110110001' => '731',
'1110110010' => '732', '1110110011' => '733', '1110110100' => '734', '1110110101' => '735',
'1110110110' => '736', '1110110111' => '737', '1110111000' => '738', '1110111001' => '739',
'1111000000' => '740', '1111000001' => '741', '1111000010' => '742', '1111000011' => '743',
'1111000100' => '744', '1111000101' => '745', '1111000110' => '746', '1111000111' => '747',
'1111001000' => '748', '1111001001' => '749', '1111010000' => '750', '1111010001' => '751',
'1111010010' => '752', '1111010011' => '753', '1111010100' => '754', '1111010101' => '755',
'1111010110' => '756', '1111010111' => '757', '1111011000' => '758', '1111011001' => '759',
'1111100000' => '760', '1111100001' => '761', '1111100010' => '762', '1111100011' => '763',
'1111100100' => '764', '1111100101' => '765', '1111100110' => '766', '1111100111' => '767',
'1111101000' => '768', '1111101001' => '769', '1111110000' => '770', '1111110001' => '771',
'1111110010' => '772', '1111110011' => '773', '1111110100' => '774', '1111110101' => '775',
'1111110110' => '776', '1111110111' => '777', '1111111000' => '778', '1111111001' => '779',
'1110001010' => '780', '1110001011' => '781', '1110101010' => '782', '1110101011' => '783',
'1111001010' => '784', '1111001011' => '785', '1111101010' => '786', '1111101011' => '787',
'1111001110' => '788', '1111001111' => '789', '1110011010' => '790', '1110011011' => '791',
'1110111010' => '792', '1110111011' => '793', '1111011010' => '794', '1111011011' => '795',
'1111111010' => '796', '1111111011' => '797', '1111011110' => '798', '1111011111' => '799',
'0000001100' => '800', '0000001101' => '801', '0100001100' => '802', '0100001101' => '803',
'1000001100' => '804', '1000001101' => '805', '1100001100' => '806', '1100001101' => '807',
'0000101110' => '808', '0000101111' => '809', '0000011100' => '810', '0000011101' => '811',
'0100011100' => '812', '0100011101' => '813', '1000011100' => '814', '1000011101' => '815',
'1100011100' => '816', '1100011101' => '817', '0000111110' => '818', '0000111111' => '819',
'0000101100' => '820', '0000101101' => '821', '0100101100' => '822', '0100101101' => '823',
'1000101100' => '824', '1000101101' => '825', '1100101100' => '826', '1100101101' => '827',
'0100101110' => '828', '0100101111' => '829', '0000111100' => '830', '0000111101' => '831',
'0100111100' => '832', '0100111101' => '833', '1000111100' => '834', '1000111101' => '835',
'1100111100' => '836', '1100111101' => '837', '0100111110' => '838', '0100111111' => '839',
'0001001100' => '840', '0001001101' => '841', '0101001100' => '842', '0101001101' => '843',
'1001001100' => '844', '1001001101' => '845', '1101001100' => '846', '1101001101' => '847',
'1000101110' => '848', '1000101111' => '849', '0001011100' => '850', '0001011101' => '851',
'0101011100' => '852', '0101011101' => '853', '1001011100' => '854', '1001011101' => '855',
'1101011100' => '856', '1101011101' => '857', '1000111110' => '858', '1000111111' => '859',
'0001101100' => '860', '0001101101' => '861', '0101101100' => '862', '0101101101' => '863',
'1001101100' => '864', '1001101101' => '865', '1101101100' => '866', '1101101101' => '867',
'1100101110' => '868', '1100101111' => '869', '0001111100' => '870', '0001111101' => '871',
'0101111100' => '872', '0101111101' => '873', '1001111100' => '874', '1001111101' => '875',
'1101111100' => '876', '1101111101' => '877', '1100111110' => '878', '1100111111' => '879',
'0000001110' => '880', '0000001111' => '881', '0100001110' => '882', '0100001111' => '883',
'1000001110' => '884', '1000001111' => '885', '1100001110' => '886', '1100001111' => '887',
'0001101110' => '888', '0001101111' => '889', '0000011110' => '890', '0000011111' => '891',
'0100011110' => '892', '0100011111' => '893', '1000011110' => '894', '1000011111' => '895',
'1100011110' => '896', '1100011111' => '897', '0001111110' => '898', '0001111111' => '899',
'0010001100' => '900', '0010001101' => '901', '0110001100' => '902', '0110001101' => '903',
'1010001100' => '904', '1010001101' => '905', '1110001100' => '906', '1110001101' => '907',
'0010101110' => '908', '0010101111' => '909', '0010011100' => '910', '0010011101' => '911',
'0110011100' => '912', '0110011101' => '913', '1010011100' => '914', '1010011101' => '915',
'1110011100' => '916', '1110011101' => '917', '0010111110' => '918', '0010111111' => '919',
'0010101100' => '920', '0010101101' => '921', '0110101100' => '922', '0110101101' => '923',
'1010101100' => '924', '1010101101' => '925', '1110101100' => '926', '1110101101' => '927',
'0110101110' => '928', '0110101111' => '929', '0010111100' => '930', '0010111101' => '931',
'0110111100' => '932', '0110111101' => '933', '1010111100' => '934', '1010111101' => '935',
'1110111100' => '936', '1110111101' => '937', '0110111110' => '938', '0110111111' => '939',
'0011001100' => '940', '0011001101' => '941', '0111001100' => '942', '0111001101' => '943',
'1011001100' => '944', '1011001101' => '945', '1111001100' => '946', '1111001101' => '947',
'1010101110' => '948', '1010101111' => '949', '0011011100' => '950', '0011011101' => '951',
'0111011100' => '952', '0111011101' => '953', '1011011100' => '954', '1011011101' => '955',
'1111011100' => '956', '1111011101' => '957', '1010111110' => '958', '1010111111' => '959',
'0011101100' => '960', '0011101101' => '961', '0111101100' => '962', '0111101101' => '963',
'1011101100' => '964', '1011101101' => '965', '1111101100' => '966', '1111101101' => '967',
'1110101110' => '968', '1110101111' => '969', '0011111100' => '970', '0011111101' => '971',
'0111111100' => '972', '0111111101' => '973', '1011111100' => '974', '1011111101' => '975',
'1111111100' => '976', '1111111101' => '977', '1110111110' => '978', '1110111111' => '979',
'0010001110' => '980', '0010001111' => '981', '0110001110' => '982', '0110001111' => '983',
'1010001110' => '984', '1010001111' => '985', '1110001110' => '986', '1110001111' => '987',
'0011101110' => '988', '0011101111' => '989', '0010011110' => '990', '0010011111' => '991',
'0110011110' => '992', '0110011111' => '993', '1010011110' => '994', '1010011111' => '995',
'1110011110' => '996', '1110011111' => '997', '0011111110' => '998', '0011111111' => '999',
) : ();
#######################################################################
#######################################################################
# %Math::Decimal64::dpd_decode is simply %Math::Decimal64::dpd_encode
# with the keys and values interchanged.
for my $key(keys(%Math::Decimal64::dpd_encode)) {
$Math::Decimal64::dpd_decode{$Math::Decimal64::dpd_encode{$key}} = $key;
}
#######################################################################
#######################################################################
%Math::Decimal64::bid_decode = $Math::Decimal64::fmt eq 'BID' ? (
0 => MEtoD64('1' . ('0' x 15), 0), 1 => MEtoD64('1' . ('0' x 14), 0),
2 => MEtoD64('1' . ('0' x 13), 0), 3 => MEtoD64('1' . ('0' x 12), 0),
4 => MEtoD64('1' . ('0' x 11), 0), 5 => MEtoD64('1' . ('0' x 10), 0),
6 => MEtoD64('1' . ('0' x 9), 0), 7 => MEtoD64('1' . ('0' x 8), 0),
8 => MEtoD64('1' . ('0' x 7), 0), 9 => MEtoD64('1' . ('0' x 6), 0),
10 => MEtoD64('1' . ('0' x 5), 0), 11 => MEtoD64('1' . ('0' x 4), 0),
12 => MEtoD64('1' . ('0' x 3), 0), 13 => MEtoD64('1' . ('0' x 2), 0),
14 => MEtoD64('1' . ('0' x 1), 0), 15 => MEtoD64('1', 0)
) : ();
#######################################################################
#######################################################################
# Used by t/decode_cross_checks.t
sub _decode_mant {
my $val = shift;
my $ret = '';
for my $i(0 .. 15) {
my $count = 0;
if($val > 0) {
while($val >= $Math::Decimal64::bid_decode{$i}) {
$val -= $Math::Decimal64::bid_decode{$i};
$count++;
}
}
$ret .= $count;
}
return $ret;
}
#######################################################################
#######################################################################
sub dl_load_flags {0} # Prevent DynaLoader from complaining and croaking
#######################################################################
#######################################################################
sub _overload_string {
my @ret = D64toME($_[0]);
if(is_InfD64($_[0]) || !$_[0]) {return $ret[0]}
return $ret[0] . 'e' . $ret[1];
}
#######################################################################
#######################################################################
sub pFR {
my @ret = FR64toME($_[0]);
if(is_InfD64($_[0]) || !$_[0]) {print $ret[0]}
else {print $ret[0] . "e" . $ret[1]}
}
#######################################################################
#######################################################################
sub _overload_int {
if(is_NaND64($_[0]) || is_InfD64($_[0]) || is_ZeroD64($_[0])) {return $_[0]}
my($man, $exp) = D64toME($_[0]);
if($exp >= 0) {return $_[0]}
my $man_length = length($man);
$man_length-- if $man =~ /^\-/;
if(-$exp >= $man_length) { # -1 <= $_[0] <= 1
my $z = ZeroD64(1);
if($_[0] < $z) {return ZeroD64(-1)} # return -0
return $z; # return 0
}
substr($man, $exp, -$exp, '');
return MEtoD64($man, 0);
}
#######################################################################
#######################################################################
sub new {
# This function caters for 2 possibilities:
# 1) that 'new' has been called OOP style - in which
# case there will be a maximum of 2 args
# 2) that 'new' has been called as a function - in
# which case there will be a maximum of 1 arg.
# If there are no args, then we just want to return a
# Math::Decimal64 object that's a NaN.
if(!@_) {return NaND64()}
if(@_ > 3) {die "More than 3 arguments supplied to new()"}
# If 'new' has been called OOP style, the first arg is the string
# "Math::Decimal64" which we don't need - so let's remove it. However,
# if the first arg is a Math::Decimal64 object (which is a possibility),
# then we'll get a fatal error when we check it for equivalence to
# the string "Math::Decimal64". So we first need to check that it's not
# an object - which we'll do by using the ref() function:
if(!ref($_[0]) && $_[0] eq "Math::Decimal64") {
shift;
if(!@_) {return NaND64()}
}
# @_ can now contain max of 2 vals - the mantissa and exponent.
# If @_ == 1 then it contains the value.
if(@_ > 2) {die "Too many arguments supplied to new() - expected no more than 2"}
if(@_ == 2) {return MEtoD64(shift, shift)}
my $arg = shift;
my $type = _itsa($arg);
if($type == 1) { # UV
return UVtoD64($arg);
}
if($type == 2) { # IV
return IVtoD64($arg);
}
if($type == 3) { # NV
die "new() cannot be used to assign an NV - use NVtoD64() instead";
}
if($type == 4) { # PV
return STRtoD64($arg) if have_strtod64();
return PVtoD64($arg);
}
if($type == 64) { # Math::Decimal64 object
return D64toD64($arg);
}
die "Bad argument given to new";
}
#######################################################################
#######################################################################
sub D64toME {
my($ret1, $ret2) = split /e/i, decode_d64($_[0]);
$ret2 = 0 unless defined $ret2;
$ret2 = 0 if is_ZeroD64($_[0]);
return ($ret1, $ret2);
## OLD - used strtold ##
# return ('-0', '0') if (is_ZeroD64($_[0]) == -1); # Negative Zero.
# my @ret = _D64toME($_[0]);
# if(!defined($ret[1])) {
# @ret = _sci2me($ret[0], $ret[2]);
# }
# return @ret;
}
#######################################################################
#######################################################################
sub FR64toME {
my $fr = Math::MPFR::Rmpfr_init2(55);
my $v = $Math::MPFR::VERSION;
$v ge '3.23' ? Math::MPFR::Rmpfr_set_DECIMAL64($fr, $_[0], 0)
: Math::MPFR::Rmpfr_set_decimal64($fr, $_[0], 0); # round to nearest
if(Math::MPFR::Rmpfr_zero_p($fr) ||
Math::MPFR::Rmpfr_inf_p($fr) ||
Math::MPFR::Rmpfr_nan_p($fr)) {
return D64toME($_[0]);
}
my($man, $exp) = Math::MPFR::Rmpfr_deref2($fr, 10, 16, 0); #MPFR_RNDN
chop $man while(length($man) > 1 && $man =~ /0$/);
$exp -= length($man);
$exp++ if $man =~/^\-/;
return ($man, $exp);
}
#######################################################################
#######################################################################
sub MEtoD64 {
# Check that 2 args are supplied
die "MEtoD64 takes 2 args" if @_ != 2;
my($arg1, $arg2) = (shift, shift);
die "Invalid 1st arg ($arg1) to MEtoD64" if $arg1 =~ /[^0-9\-\+]/;
die "Invalid 2nd arg ($arg2) to MEtoD64" if $arg2 =~ /[^0-9\-\+]/;
$arg1 =~ s/^\+//;
$arg2 =~ s/^\+//;
my $sign = $arg1 =~ s/^\-// ? '-' : '';
my $len_1 = length $arg1;
if($len_1 >= 16 || $arg2 < -398) {
die "${sign}${arg1} exceeds _Decimal64 precision. It needs to be shortened to no more than 16 decimal digits"
if $len_1 > 16;
($arg1, $arg2) = _round_as_needed($arg1, $arg2) if $arg2 < -398;
# Need to handle the possibility that strtold can't handle all 16-digit values correctly.
if($Config{longdblsize} == 8) {
my $len = length $arg1; # length of $arg1 may have changed
if($len == 16) {
return _MEtoD64($sign . substr($arg1, 0, 8), $arg2 + 8) +
_MEtoD64($sign . substr($arg1, 8, 8), $arg2);
}
}
}
return _MEtoD64($sign . $arg1, $arg2);
}
#######################################################################
#######################################################################
# Values such as (d, -400), (dd, -401), (ddd, -402), etc evaluate to zero.
# But values such as (dddd, -400), (ddd, -401), (dddddddd, -402), etc may be non-zero.
# In such cases we'll remove the ignored (trailing) digits, rounding the leading
# digits to nearest - tied to even for midway cases.
sub _round_as_needed {
my($sign, $man, $exp) = ('', shift, shift);
if($man =~ /^\-/) {
$man =~ s/^\-//;
$sign = '-';
}
my $length = length $man;
my $maxlen = -398 - $exp;
if($length >= $maxlen) {
my $rounder = substr($man, $length - $maxlen); # The trailing (ignored) digits
$man = $length > $maxlen ? substr($man, 0, $length - $maxlen)
: '0';
my $roundup = 0;
$roundup = 1 if substr($rounder, 0, 1) > 5;
$roundup = 1 if ((substr($rounder, 0, 1) == 5) &&
((substr($rounder, 1) =~ /[1-9]/) || (substr($man, -1, 1) %2 == 1)));
$man++ if $roundup;
$exp += $maxlen; # Removal of trailing digits moved the implied
# decimal point $maxlen places to the left
}
return ($sign . $man, $exp);
}
#######################################################################
#######################################################################
sub assignME {
# Check that 3 args are supplied
die "assignME takes 3 args" if @_ != 3;
my $arg1 = shift;
my $arg2 = shift;
my $arg3 = shift;
die "Invalid 1st arg ($arg1) to assignME" if _itsa($arg1) != 64;
die "Invalid 2nd arg ($arg2) to assignME" if $arg2 =~ /[^0-9\-]/;
die "Invalid 3rd arg ($arg3) to assignME" if $arg3 =~ /[^0-9\-]/;
my $len_2 = length($arg2);
$len_2-- if $arg2 =~ /^\-/;
if($len_2 >= 16 || $arg3 < -398) {
die "$arg2 exceeds _Decimal64 precision. It needs to be shortened to no more than 16 decimal digits"
if $len_2 > 16;
($arg2, $arg3) = _round_as_needed($arg2, $arg3) if $arg3 < -398;
# Need to handle the possibility that strtold can't handle all 16-digit values correctly.
if($Config{longdblsize} == 8) {
$len_2 = length $arg2;
my ($sign, $inc) = ('', 0);
if($arg2 =~ /^\-/) {
$len_2--;
$sign = '-';
$inc++;
}
if($len_2 == 16) {
assignD64($arg1,
_MEtoD64($sign . substr($arg2, 0 + $inc, 8), $arg3 + 8) +
_MEtoD64($sign . substr($arg2, 8 + $inc, 8), $arg3));
}
}
}
_assignME($arg1, $arg2, $arg3);
}
#######################################################################
#######################################################################
sub _sci2me {
my @ret = split /e/i, $_[0];
chop $ret[0] while $ret[0] =~ /0\b/;
my @adj = split /\./, $ret[0];
my $adj = defined $adj[1] ? length($adj[1])
: 0;
$ret[0] =~ s/\.//;
$ret[1] += $_[1] - $adj;
return @ret;
}
#######################################################################
#######################################################################
sub d64_bytes {
my @ret = _d64_bytes($_[0]);
return join '', @ret;
}
#######################################################################
#######################################################################
sub hex2bin {
my $ret = unpack("B*", (pack "H*", $_[0]));
my $len = length $ret;
die "hex2bin() yielded $len bits" if $len != 64;
return $ret;
}
#######################################################################
#######################################################################
sub d64_fmt {
my $d64 = MEtoD64('1234567890123456', 0);
# BID: 31C462D53C8ABAC0
# DPD: 263934B9C1E28E56
return 'DPD' if d64_bytes($d64) =~ /E56$/i;
return 'BID' if d64_bytes($d64) =~ /AC0$/i;
return 'Unknown';
}
#######################################################################
#######################################################################
sub decode_dpd {
# Takes the Math::Decimal64 object as its arg.
# Decodes Densely Packed Decimal formatting of the Decimal64 value.
my $binstring = hex2bin(d64_bytes($_[0]));
my @first = decode_dpd_1st($binstring);
return ($first[0] . $first[1]) if ($first[1] =~ /inf/i || $first[1] =~ /nan/i);
my $mantissa = $first[1] . decode_dpd_2nd($binstring);
# Remove leading zeroes from the mantissa
$mantissa =~ s/^0+//;
if($mantissa eq '') {$mantissa = '0'}
else {
# Remove trailing zeroes
while($mantissa =~ /0$/) {
$mantissa =~ s/0$//;
$first[2]++;
}
}
my $ret = $first[0] . $mantissa . 'e' . $first[2];
}
#######################################################################
#######################################################################
sub decode_dpd_1st{
# Takes the entire binary string as its arg.
die "Argument to decode_dpd_1st is wrong size (", length($_[0]), ")"
if length($_[0]) != 64;
my $leading_bits = 14;
my $trailing_bits = 50;
my $msd; # significand's most siginificant digit
my $exp; # exponent
my $keep = substr($_[0], 0, $leading_bits);
my $sign = substr($keep, 0, 1) ? '-' : '';
return ('','nan') if substr($keep, 1, 5) eq '11111';
if(substr($keep, 1 ,5) eq '11110') {return ($sign, 'inf')}
my $pre = substr($keep, 1, 2);
if($pre eq '00' || $pre eq '01' || $pre eq '10') {
$msd = oct('0b0' . substr($keep, 3, 3));
$exp = oct('0b' . $pre . substr($keep, 6, 8)) - 398;
return ($sign, $msd, $exp);
}
$pre = substr($keep, 1, 4);
if($pre eq '1100' || $pre eq '1101' || $pre eq '1110') {
$exp = oct('0b' . substr($pre, 2, 2) . substr($keep, 6, 8)) - 398;
$msd = oct('0b' . '100' . substr($keep, 5, 1));
return ($sign, $msd, $exp);
}
die "decode_dpd_1st function failed to parse its argument ($_[0])";
}
#######################################################################
#######################################################################
sub decode_dpd_2nd {
# Takes the entire binary string as its arg.
die "Argument to decode_dpd_2nd is wrong size (", length($_[0]), ")"
if length($_[0]) != 64; # 64 for Decimal64
my $leading_bits = 14; # 18 for Decimal28
my $trailing_bits = 50; # 110 for Decimal28
my $keep = substr($_[0], $leading_bits, $trailing_bits);
my $ret = '';
for my $i(0, 10, 20, 30, 40) {
my $key = substr($keep, $i, 10);
$ret .= $Math::Decimal64::dpd_encode{$key};
}
return $ret;
}
#######################################################################
#######################################################################
sub decode_bid {
# Takes a Math::Decimal64 object as its arg.
# Decodes Binary Integer Decimal formatting of the _Decimal64 value.
my $keep = hex2bin(d64_bytes($_[0]));
die "Base 2 representation is wrong size (", length($keep), ")"
if length($keep) != 64; # 64 for Decimal64
my $leading_bits = 13;
my $trailing_bits = 51;
my @mantissa;
my $exp; # exponent
my $sign = substr($keep, 0, 1) ? '-' : '';
return 'nan' if substr($keep, 1, 5) eq '11111';
if(substr($keep, 1 ,5) eq '11110') {return $sign . 'inf'}
my $pre = substr($keep, 1, 2);
if($pre eq '00' || $pre eq '01' || $pre eq '10') {
$exp = oct('0b' . substr($keep, 1, 10)) - 398;
@mantissa = reverse(split(//, '0' . substr($keep, 11, 53)));
my $mantissa = _bid_mant(\@mantissa);
if($mantissa !~ /[1-9]/) { $mantissa = '0'}
else {
while($mantissa =~ /0$/) {
$mantissa =~ s/0$//;
$exp++;
}
}
return $sign . $mantissa . 'e' . $exp;
}
$pre = substr($keep, 1, 4);
if($pre eq '1100' || $pre eq '1101' || $pre eq '1110') {
$exp = oct('0b' . substr($keep, 3, 10)) - 398;
@mantissa = reverse(split(//,'100' . substr($keep, 13, 51)));
my $mantissa = _bid_mant(\@mantissa);
if($mantissa !~ /[1-9]/) { $mantissa = '0'}
else {
while($mantissa =~ /0$/) {
$mantissa =~ s/0$//;
$exp++;
}
}
return $sign . $mantissa . 'e' . $exp;
}
die "decode_bid function failed to parse its argument ($_[0])";
}
#######################################################################
#######################################################################
# Replaced by XSub of same name
# sub PVtoD64 {
#
# my($arg1, $arg2) = PVtoME($_[0]);
#
# if($arg1 =~ /inf|nan/i) {
# $arg1 =~ /nan/i ? return NaND64()
# : $arg1 =~ /^\-/ ? return InfD64(-1)
# : return InfD64(1);
# }
#
# return MEtoD64($arg1, $arg2);
#}
#######################################################################
#######################################################################
# Replaced by XSub of same name
# sub assignPV {
#
# my($arg1, $arg2) = PVtoME($_[1]);
# if($arg1 =~ /inf|nan/i) {
# $arg1 =~ /nan/i ? assignNaN($_[0])
# : $arg1 =~ /^\-/ ? assignInf($_[0], -1)
# : assignInf($_[0], 1);
# }
# else {
# assignME($_[0], $arg1, $arg2);
# }
#}
#######################################################################
#######################################################################
sub DEC64_MAX {return _DEC64_MAX()}
sub DEC64_MIN {return _DEC64_MIN()}
#######################################################################
#######################################################################
sub get_exp {
my $keep = hex2bin(d64_bytes($_[0]));
my $pre = substr($keep, 1, 2);
if($Math::Decimal64::fmt eq 'DPD') {
if($pre eq '00' || $pre eq '01' || $pre eq '10') {
return oct('0b' . $pre . substr($keep, 6, 8)) - 398;
}
else {
return oct('0b' . substr($pre, 2, 2) . substr($keep, 6, 8)) - 398;
}
}
else {
if($pre eq '00' || $pre eq '01' || $pre eq '10') {
return oct('0b' . substr($keep, 1, 10)) - 398;
}
else {
return oct('0b' . substr($keep, 3, 10)) - 398;
}
}
}
#######################################################################
#######################################################################
sub get_sign {
return '-' if hex(substr(d64_bytes($_[0]), 0, 1)) >= 8;
return '+';
}
#######################################################################
#######################################################################
sub DPDtoD64 {
# Usable only where DPD format is in use.
# Converts the 64-bit string returned by _MEtoBINSTR into
# a Math::Decimal64 object set to the value encoded by the
# the 64-bit string. This is all done without having to calculate
# the actual value - and is typically ~25 times quicker than
# MEtoD64.
my($man, $exp) = (shift, shift);
my $arg = _MEtoBINSTR($man, $exp);
return _DPDtoD64(unpack("a*", pack( "B*", $arg)));
}
#######################################################################
#######################################################################
sub PVtoME {
my($arg1, $arg2) = split /e/i, $_[0];
if($arg1 =~ /^(\-|\+)?inf|^(\-|\+)?nan/i) {
return ($arg1, 0);
}
_sanitise_args($arg1, $arg2);
return ($arg1, $arg2);
}
sub MEtoPV {
my $arg1 = shift;
if($arg1 =~ /^(\-|\+)?inf|^(\-|\+)?nan/i) {
$arg1 =~ s/\+//;
return $arg1;
}
my $arg2 = shift;
return $arg1 . 'e' . $arg2;
}
#######################################################################
#######################################################################
sub _sanitise_args {
$_[1] = 0 unless defined $_[1];
$_[0] =~ s/\.0+$//;
my @split = split /\./, $_[0];
$split[1] = '' unless defined $split[1];
$_[1] -= length($split[1]);
$_[0] =~ s/\.//;
$_[0] =~ s/^0+//;
}
#######################################################################
#######################################################################
sub assignDPD {
_assignDPD($_[0], unpack("a*", pack("B*", _MEtoBINSTR($_[1], $_[2]))));
}
#######################################################################
#######################################################################
sub _MEtoBINSTR {
# Converts (mantissa, exponent) strings to DPD encoded 64-bit string - without
# the need to actually calculate the value.
my $man = shift;
if($man =~ /^(\-|\+)?inf|^(\-|\+)?nan/i) {
$man =~ /\-inf/i ? return '11111' . ('0' x 59)
: $man =~ /^(\-|\+)?nan/i ? return '011111' . ('0' x 58)
: return '01111' . ('0' x 59);
}
my $exp = shift;
# Determine the sign, and remove it.
my $sign = $man =~ /^\-/ ? '1' : '0';
$man =~ s/[\+\-]//;
die "_MEtoBINSTR has been passed (probably from DPDtoBINSTR) an illegal mantissa"
if $man =~ /[^0-9]/;
# Remove leading zeroes, and return zero (of appropriate sign)
# if we're left with the empty string.
$man =~ s/^0+//;
return $sign . '0100001101101' . ('0' x 50) unless $man;
# Fill the mantissa with 16 digits - by zero padding the end.
my $add_zeroes = 16 - length($man);
$man .= '0' x $add_zeroes;
$exp -= $add_zeroes;
if(length($man) > 16 || $exp < -398) {
die "$man exceeds _Decimal64 precision. It needs to be shortened to no more than 16 decimal digits"
if length($man) > 16;
($man, $exp) = _round_as_needed($man, $exp);
}
# Return 0 if $exp is still less that -398.
return $sign . '0100001101101' . ('0' x 50) if $exp < -398;
# Return -inf/inf if value is infinite
if($exp > 369) {
return $sign . '1111' . ('0' x 59) if (length($man) + $exp) > 385;
}
$man = '0' . $man while length($man) < 16;
# The last 50 bits encode the last 15 digits.
my $last_15_dig = substr($man, 1, 15);
my $last_50_bits;
for(my $i = 0; $i < 13; $i += 3) {
$last_50_bits .= $Math::Decimal64::dpd_decode{substr($last_15_dig, $i, 3)}
}
my $len = length($last_50_bits);
die "Wrong bitsize ($len != 50) in _MEtoBINSTR()" if $len != 50;
my $leading_digit = substr($man, 0, 1); # ie the msd (most siginificant digit).
my $exp_base_2 = sprintf "%010b", $exp + 398;
# The encoding of the exponent and msd depends upon the value of the msd.
# If it's 0..7, it's done one way; if it's 8 or 9 it's done th'other way.
if($leading_digit < 8) {
my $leading_digit_bits = sprintf "%03b", $leading_digit;
substr($exp_base_2, 2, 0, $leading_digit_bits);
}
else {
my $leading_digit_bit = $leading_digit == 8 ? '0' : '1';
$exp_base_2 = '11' . substr($exp_base_2, 0, 2) . $leading_digit_bit . substr($exp_base_2, 2, 8);
}
$len = length($exp_base_2);
die "Exponent (= $exp) component length is wrong ($len != 13) in _MEtoBINSTR()" if $len != 13;
return $sign . $exp_base_2 . $last_50_bits;
}
#######################################################################
#######################################################################
sub D64toFSTR {
# Converts the argument (M::D64 object) to a string in floating point
# format - as distinct from scientific notation.
my($m, $e) = D64toME($_[0]);
return 'nan' if is_NaND64($_[0]);
if(is_InfD64($_[0])) {
return 'inf' if is_InfD64($_[0])> 0;
return '-inf';
}
return $m . '0' x $e if $e >= 0;
my($len, $sign) = (length $m, '');
$m =~ s/^\-//;
if($len != length $m) {
$len--;
$sign = '-';
}
if($len + $e > 0) {
substr($m, $e, 0, '.');
return $sign . $m;
}
if($len + $e < 0) {
return $sign . '0.' . '0' x -($len + $e) . $m;
}
return $sign . '0.' . $m;
}
#######################################################################
#######################################################################
sub D64toRSTR {
# As for D64toFSTR, but rounds the string to the no. of
# decimal places specified by the second arg.
die "2nd arg to D64toRSTR() must be greater than zero"
unless $_[1] >= 0;
my $dp = $_[1] ? '.' : '';
my $str = D64toFSTR($_[0]);
return $str if $str =~ /n/i; # inf/nan
return $str . "$dp" . '0' x $_[1] unless $str =~ /\./;
my($leading, $trailing) = split /\./, $str;
my $len_trail = length $trailing ;
return $str if ($_[1] == $len_trail);
if(length($trailing) <= $_[1]) {
$trailing .= '0' x ($_[1] - length($trailing));
return $leading . "$dp" . $trailing;
}
# $len_trail > specified number of decimal places ($_[1]).
# We need to round (to nearest, ties to even) from here on.
return $leading . "$dp" . substr($trailing, 0, $_[1])
if (substr($trailing, $_[1], 1) <= 4) ||
(substr($trailing, $_[1]) =~ /^5(0+)?$/ && substr($trailing, $_[1] - 1, 1) % 2 == 0);
my $to_inc = substr($trailing, 0, $_[1]);
my $carry = _increment($to_inc); # $carry will either be mt string or '1'. If '1', then we
# also need to increment $leading.
return $leading . "$dp" . $to_inc
if $carry eq '';
my($sign, $len_lead) = ('', length($leading));
$leading =~ s/^\-//;
if($len_lead != length($leading)) {
$sign = '-';
$len_lead--;
}
$carry = _increment($leading);
return $sign . $carry . $leading . "$dp" . $to_inc;
}
#######################################################################
#######################################################################
sub _increment {
my $carry = 1;
my $len = length($_[0]) * -1;
for(my $offset = -1; $offset >= $len; $offset--) {
substr($_[0], $offset, 1) = (substr($_[0], $offset, 1) + 1) % 10;
if(substr($_[0], $offset, 1) ne '0') {
$carry = '';
last;
}
}
return $carry;
}
#######################################################################
#######################################################################
*decode_d64 = $Math::Decimal64::fmt eq 'DPD' ? \&decode_dpd : \&decode_bid;
#######################################################################
#######################################################################
1;
__END__
=head1 NAME
Math::Decimal64 - perl interface to C's _Decimal64 operations.
=head1 DEPENDENCIES
In order to compile this module, a C compiler that provides
the _Decimal64 type is needed.
=head1 DESCRIPTION
Math::Decimal64 supports up to 16 decimal digits of significand
(mantissa) and an exponent range of -383 to +384.
The smallest expressable value is -9.999999999999999e384 (which
is also equivalent to -9999999999999999e369).
The largest expressable value is 9.999999999999999e384 (which
also equivalent to 9999999999999999e369).
The closest we can get to zero is (plus or minus) 1e-384
(which is also equivalent to 1000000000000000e-399).
This module allows decimal floating point arithmetic via
operator overloading - see "OVERLOADING".
In the documentation that follows, "$mantissa" is a perl scalar
holding a string of up to 16 decimal digits, optionally prefixed
with a '+' or '-' sign:
$mantissa = '1234';
$mantissa = '1234567890123456';
=head1 SYNOPSIS
use Math::Decimal64 qw(:all);
my $d64_1 = MEtoD64('9927', -2); # the decimal 99.27
my $d64_2 = MEtoD64('3', 0); # the decimal 3.0
$d64_1 /= $d64_2;
print $d64_1; # prints 3309e-2 (33.09)
=head1 OVERLOADING
The following operations are overloaded:
+ - * /
+= -= *= /=
!= == <= >= <=> < >
++ --
=
abs bool int print neg
Arguments to the overloaded operations must be Math::Decimal64
objects, integer (IV/UV) values or string (PV) values.
Strings can match /^(\-|\+)?(nan|inf)/i or be in floating point,
scientific notation or integer formats. Eg '113', '12.34', '12e-9',
'-12.34e+106', '-9E8', '-NaN', 'inf' are all valid strings.
$d64_2 = $d64_1 + $d128_0; #ok
$d64_2 = $d64_1 + 15; #ok
$d64_2 = $d64_1 + 3.1; # Error
If you really want to add the NV 3.1 you need to:
$d64_2 = $d64_1 + NVtoD64(3.1);
If you instead wish to add the decimal value 3.1:
$d64_2 = $d64_1 + '3.1';
Overloading of floats (NV values) will probably never be enabled
as that would make it very easy to inadvertently introduce a value
that was not intended.
=head1 CREATION & ASSIGNMENT FUNCTIONS
The following create and assign a new Math::Decimal64 object.
##################################
# Create, and assign from a string
$d64 = PVtoD64($string);
eg: $d64 = PVtoD64('-9427199254740993');
$d64 = PVtoD64('-9307199254740993e-15');
$d64 = Math::Decimal64->new('-9787199254740.993e-20');
$d64 = Math::Decimal64->new('-9307199254740993e-23');
$d64 = Math::Decimal64->new('-inf');
$d64 = Math::Decimal64->new('nan');
The perl API function looks_like_number() is run on the arg. If
it returns false, then a global non-numeric flag which was
initialised to 0 is incremented. The nnumflag function returns
the current value of this global. It can be cleared to 0 by
running clear_nnum() and set to x with set_nnum(x). The arg can be
in either integer format, scientific notation, float format or
(+-)inf/nan. Doing Math::Decimal64->new($string) will also create
and assign using PVtoD64().
PVtoD64 is now a much improved way of creating and assigning - so
much so that I'm now recommending it as the preferred way of
creating a Math::Decimal64 object.
If you have a ($mantissa, $exponent) pair as your value and you
wish to create a Math::Decimal64 object using PVtoD64 you can do:
$d64 = PVtoD64(MEtoPV($mantissa, $exponent));
or simply:
$d64 = PVtoD64($mantissa . 'e' . $exponent);
###############################################
# Create, and assign from mantissa and exponent
$d64 = MEtoD64($mantissa, $exponent);
eg: $d64 = MEtoD64('12345', -3); # 12.345
It's a little kludgy, but this is a safe and sure way
of creating the Math::Decimal64 object with the intended
value.
Checks are conducted to ensure that the arguments are suitable.
The mantissa string must represent an integer. (There's an
implicit '.0' at the end of the string.)
Doing Math::Decimal64->new($mantissa, $exponent) will also
create and assign using MEtoD64(), and is equally acceptable.
###############################################
# Create, and assign from mantissa and exponent
$d64 = DPDtoD64($mantissa, $exponent);
eg: $d64 = DPDtoD64('12345', -3); # 12.345
This is perhaps a quicker way of creating the Math::Decimal64
object with the intended value - but works only for DPD format
- ie only if d64_fmt() returns 'DPD'.
The mantissa string can be 'inf' or 'nan', optionally prefixed
with '-' or '+'. Otherwise, the mantissa string must
represent an integer value (with implied '.0' at the end) - ie
cannot contain a decimal point.
#################################################
# Create, and assign from a UV (unsigned integer)
$d64 = UVtoD64($uv);
eg: $d64 = UVtoD64(~0);
Doing Math::Decimal64->new($uv) will also create and assign
using UVtoD64().
Assigns the designated UV value to the Math::Decimal64 object
(but loses precision if the _Decimal64 type has insufficient
precision to accommodate the precision of the IV).
################################################
# Create, and assign from an IV (signed integer)
$d64 = IVtoD64($iv);
eg: $d64 = IVtoD64(-15); # -15.0
Doing Math::Decimal64->new($iv) will also create and assign
using IVtoD64().
Assigns the designated IV value to the Math::Decimal64 object
(but loses precision if the _Decimal64 type has insufficient
precision to accommodate the precision of the IV).
############################################################
# Create, and assign from an existing Math::Decimal64 object
$d64 = D64toD64($d64_0);
Also:
$d64 = Math::Decimal64->new($d64_0);
$d64 = $d64_0; # uses overloaded '='
#######################################
# Create, and assign from an NV (real))
$d64 = NVtoD64($nv);
eg: $d64 = NVtoD64(-3.25);
Doing Math::Decimal64->new($nv) is now a fatal error. NV's can
now be assigned using only either NVtoD64() or assignNV().
Might not always assign the value you think it does, but should
be fine for assigning decimal values that have en exact base 2
representation. (Eg, see test 5 in t/overload_cmp.t.)
################################
# Create, and assign using new()
$d64 = Math::Decimal64->new([$arg1, [$arg2]]);
This function calls one of the above functions. It
determines the appropriate function to call by examining
the argument(s) provided.
If no argument is provided, a Math::Decimal64 object
with a value of NaN is returned.
If 2 arguments are supplied it uses MEtoD64().
If one argument is provided, that arg's internal flags are
used to determine the appropriate function to call.
Dies if that argument is an NV - allowing an NV argument makes
it very easy to inadvertently assign an unintended value, and
is therefore now disallowed.
###################################
# Create, and assign using STRtoD64
$d64 = STRtoD64($string);
If your C compiler provides the strtod64 function, and
you configured the Makefile.PL to enable access to that
function then you can use this function.
Usage is is as for PVtoD64().
##############################
=head1 ASSIGN A NEW VALUE TO AN EXISTING OBJECT
#####################################
assignME($d64, $mantissa, $exponent);
Assigns the value represented by ($mantissa, $exponent)
to the Math::Decimal64 object, $d64.
Performs same argument checking as MEtoD64.
eg: assignME($d64, '123459', -6); # 0.123459
######################################
assignDPD($d64, $mantissa, $exponent);
Assigns the value represented by ($mantissa, $exponent)
to the Math::Decimal64 object, $d64. This might work
more efficiently than assignME(), but works only when the
_Decimal64type is DPD-formatted. (The d64_fmt function
will tell you whether the _Decimal64 is DPD-formatted or
BID-formatted.)
eg: assignDPD($d64, '123459', -6); # 0.123459
########################
assignIV ($d64, $iv);
assignUV ($d64, $uv);
assignNV ($d64, $nv);
assignPV ($d64, $string); # See PVtoD64 doc (above)
assignD64($d64, $d64_0);
Assigns the value represented by the second arg (resp. the
IV,UV,NV,PV, Math::Decimal64 object) to the
Math::Decimal64 object, $d64.
eg: assignPV($d64, '12.3459e-6'); # 0.0000123459
################
assignNaN($d64);
Assigns a NaN to the Math::Decimal64 object, $d64.
#######################
assignInf($d64, $sign);
Assigns an Inf to the Math::Decimal64 object, $d64.
If $sign is negative, assigns -Inf; otherwise +Inf.
#######################
=head1 INF, NAN and ZERO OBJECTS
#####################
$d64 = InfD64($sign);
If $sign < 0, creates a new Math::Decimal64 object set to
negative infinity; else creates a Math::Decimal64 object set
to positive infinity.
################
$d64 = NaND64();
Creates a new Math::Decimal64 object set to NaN.
Same as "$d64 = Math::Decimal64->new();"
######################
$d64 = ZeroD64($sign);
If $sign < 0, creates a new Math::Decimal64 object set to
negative zero; else creates a Math::Decimal64 object set to
zero.
#######################
=head1 RETRIEVAL FUNCTIONS
The following functions provide ways of seeing the value of
Math::Decimal64 objects.
###########################
$string = decode_d64($d64);
This function calls either decode_dpd() or decode_bid(),
depending upon the formatting used to encode the
_Decimal64 value (as determined by the d64_fmt() sub).
It returns the value as a string of the form (-)ME, where:
"M" is the mantissa, containing up to 16 base 10 digits;
"E" is the letter "e" followed by the exponent;
A minus sign is prefixed to any -ve number (incl -0), but no
sign at all is prefixed for +ve numbers (incl +0).
Returns the strings '+inf', '-inf', 'nan' for (respectively)
+infinity, -infinity, NaN.
The value will be decoded correctly.
##################################
$string = decode_dpd($d64_binary);
$string = decode_bid($d64_binary);
As for decode_d64(), except it takes the 64-bit binary
representation of the _Decimal64 value as its argument. This
argument is derived from the Math::Decimal64 object ($d64)
by doing:
$binary = hex2bin(d64_bytes($d64));
DPD and BID formats will return different strings - so you
need to know which encoding (DPD or BID) was used, and then
call the appropriate decode_*() function for that encoding.
$Math::Decimal64::fmt will tell you which encoding is in use,
as also will the d64_fmt() subroutine.
###########################
$fstring = D64toFSTR($d64);
Returns a string in floating point format (as distinct from
scientific notation) - ie as 0.123 instead of 123e-3.
And, yes, (eg) the _Decimal64 value 123e201 will be returned
as a string consisting of '123' followed by 201 zeroes.
####################################
$rstring = D64toRSTR($d64, $places);
Same as D64toFSTR() but the returned string has been rounded
(to nearest, ties to even) to the number of decimal places
specified by $places.
Croaks with appropriate error message if $places < 0.
#######################################
($mantissa, $exponent) = D64toME($d64);
Returns the value of the Math::Decimal64 object as a
mantissa (string of up to 16 decimal digits) and exponent.
You can then manipulate those values to output the
value in your preferred format. Afaik, the value will be
decoded accurately.
########################################
($mantissa, $exponent) = FR64toME($d64);
Requires that Math::MPFR version 3.18 or later has been
loaded. It also requires that Math:MPFR has been built with
support for the mpfr library's Decimal64 conversion
functions - in which case Math::MPFR::_WANT_DECIMAL_FLOATS()
will return true. (Otherwise it returns false.)
Afaik, the value will be decoded accurately.
####################
$nv = D64toNV($d64);
This function returns the value of the Math::Decimal64
object to a perl scalar (NV). Under certain conditions
it may not translate the value accurately.
###########
print $d64;
Will print the value in the format (eg) -12345e-2, which
equates to the decimal -123.45. Uses D64toME().
#########
pFR $d64;
Will print the value in the format (eg) -12345e-2, which
equates to the decimal -123.45. Uses FR64toME() - which
should always print the value accurately, but requires
that Math::MPFR:
1) has been loaded;
2) supports the Decimal64 mpfr conversion functions.
#########
=head1 OTHER FUNCTIONS
#################
$iv = nnumflag();
Returns the value of the non-numeric flag. This flag is
initialized to zero, but incemented by 1 whenever the
_atodecimal function (used internally by assignPV and
PVtoD64) is handed a string containing non-numeric
characters. The value of the flag therefore tells us how
many times _atodecimal() was handed such a string. The flag
can be reset to 0 by running clear_nnum().
##############
set_nnum($iv);
Resets the global non-numeric flag to the value specified by
$iv.
#############
clear_nnum();
Resets the global non-numeric flag to 0.(Essentially the same
as running set_nnum(0).)
################################
($man, $exp) = PVtoME($string);
$string is a string representing a floating-point value - eg
'inf', '+nan', '123.456', '-1234.56e-1', or '12345.6E-2'.
The function returns an array of (mantissa, exponent), where
the mantissa is a string of base 10 digits (prefixed with a
'-' for -ve values) with an implied decimal point at the
end of the string. For strings such as 'inf' and 'nan', the
mantissa will be set to $string, and the exponent to 0.
For the example strings given above, the returned arrays
would be ('inf', 0), ('+nan', 0), ('123456', -3), ('-123456',
-3) and ('123456', -3) respectively.
#######################################
$string = MEtoPV($mantissa, $exponent);
If $mantissa =~ /inf|nan/i returns $mantissa.
Else returns $mantissa . 'e' . $exponent.
#################
$fmt = d64_fmt();
Returns either 'DPD' or 'BID', depending upon whether the
(internal) _Decimal64 values are encoded using the 'Densely
Packed Decimal' format or the 'Binary Integer Decimal'
format.
#######################
$hex = d64_bytes($d64);
Returns the hex representation of the _Decimal64 value
as a string of 16 hex characters.
############################
$binary = hex2bin($d64_hex);
Takes the string returned by d64_bytes (above) and
rewrites it in binary form - ie as a string of 64 base 2
digits.
#################
$d64 = DEC64_MAX; # 9999999999999999e369
$d64 = DEC64_MIN; # 1e-398
DEC64_MAX is the largest positive finite representable
_Decimal64 value.
DEC64_MIN is the smallest positive non-zero representable
_Decimal64 value.
Multiply these by -1 to get their negative counterparts.
###################
$d64 = Exp10($pow);
Returns a Math::Decimal64 object with a value of
10 ** $pow, for $pow in the range (-398 .. 384). Croaks
with appropriate message if $pow is not within that range.
########################
$bool = have_strtod64();
Returns true if, when building Math::Decimal64,
the Makefile.PL was configured to make the STRtoD64()
function available for your build of Math::Decimal64. Else
returns false.
(No use making this function available if your compiler's
C library doesn't provide the strtod64 function.)
#########################
$test = is_ZeroD64($d64);
Returns:
-1 if $d64 is negative zero;
1 if $d64 is zero, but not negative zero;
0 if $d64 is not zero.
########################
$test = is_InfD64($d64);
Returns:
-1 if $d64 is negative infinity;
1 if $d64 is positive infinity;
0 if $d64 is not infinity.
########################
$bool = is_NaND64($d64);
Returns:
1 if $d64 is a NaN;
0 if $d64 is not a NaN.
###################
LDtoD64($d64, $ld); # $ld is a Math::LongDouble object
D64toLD($ld, $d64); # $ld is a Math::LongDouble object
Conversions between Math::LongDouble and Math::Decimal64
objects - done by simply casting the long double value to a
_Decimal64 value, or (resp.) vice-versa.
Requires that Math::LongDouble has been loaded.
#######################
$sign = get_sign($d64);
Returns the sign ('+' or '-') of $d64.
#####################
$exp = get_exp($d64);
Returns the exponent of $d64. This is the exponent value
that's stored internally within the encapsulated _Decimal64
value; it may differ from the value that you assigned.
For example, if you've assigned the value MEtoD64('100', 0)
it will probably be held internally as '1e2', not '100e0',
in which case get_exp() would return 2, not 0.
####################
=head1 LICENSE
This program is free software; you may redistribute it and/or
modify it under the same terms as Perl itself.
Copyright 2012-15 Sisyphus
=head1 AUTHOR
Sisyphus <sisyphus at(@) cpan dot (.) org>
=cut