1: // Copyright (C) 1985-1998 by Symantec 2: // Copyright (C) 2000-2011 by Digital Mars 3: // All Rights Reserved 4: // http://www.digitalmars.com 5: // Written by Walter Bright 6: /* 7: * This source file is made available for personal use 8: * only. The license is in /dmd/src/dmd/backendlicense.txt 9: * or /dm/src/dmd/backendlicense.txt 10: * For any other uses, please contact Digital Mars. 11: */ 12: 13: #include <stdio.h> 14: #include <stdlib.h> 15: #include <ctype.h> 16: #include <float.h> 17: #include <string.h> 18: #include <math.h> 19: #if _WIN32 && !_MSC_VER 20: #include <fenv.h> 21: #include <fltpnt.h> 22: #endif 23: #if linux || __APPLE__ || __FreeBSD__ || __OpenBSD__ || __sun&&__SVR4 24: #include <errno.h> 25: #endif 26: 27: #include "cdef.h" 28: 29: #if _WIN32 30: // from \sc\src\include\setlocal.h 31: extern char * __cdecl __locale_decpoint;warning C4229: anachronism used : modifiers on data are ignored32: void __pascal __set_errno (int an_errno); 33: #endif 34: 35: #if __DMC__ || linux || __APPLE__ || __FreeBSD__ || __OpenBSD__ || __sun&&__SVR4 36: 37: #if 0 38: /* This is for compilers that don't support hex float literals, 39: * and also makes it clearer what constants we're trying to use. 40: */ 41: 42: static long double negtab[] = 43: {1e-4096L,1e-2048L,1e-1024L,1e-512L, 44: 1e-256L,1e-128L,1e-64L,1e-32L,1e-16L,1e-8L,1e-4L,1e-2L,1e-1L,1.0L}; 45: 46: static long double postab[] = 47: {1e+4096L,1e+2048L,1e+1024L,1e+512L, 48: 1e+256L,1e+128L,1e+64L,1e+32L,1e+16L,1e+8L,1e+4L,1e+2L,1e+1L}; 49: 50: #elif defined(__GNUC__) && __FreeBSD__ && __i386__ 51: 52: // GCC on FreeBSD/i386 incorrectly rounds long double constants to double precision. Workaround: 53: 54: // Note that the [sizeof(long double)] takes care of whatever the 0 padding is for the 55: // target platform 56: 57: static unsigned char _negtab_bytes[][sizeof(long double)] = 58: { { 0xDE,0x9F,0xCE,0xD2,0xC8,0x04,0xDD,0xA6,0xD8,0x0A,0xBF,0xBF }, 59: { 0xE4,0x2D,0x36,0x34,0x4F,0x53,0xAE,0xCE,0x6B,0x25,0xBF,0xBF }, 60: { 0xBE,0xC0,0x57,0xDA,0xA5,0x82,0xA6,0xA2,0xB5,0x32,0xBF,0xBF }, 61: { 0x1C,0xD2,0x23,0xDB,0x32,0xEE,0x49,0x90,0x5A,0x39,0xBF,0xBF }, 62: { 0x3A,0x19,0x7A,0x63,0x25,0x43,0x31,0xC0,0xAC,0x3C,0xBF,0xBF }, 63: { 0xA1,0xE4,0xBC,0x64,0x7C,0x46,0xD0,0xDD,0x55,0x3E,0xBF,0xBF }, 64: { 0xA5,0xE9,0x39,0xA5,0x27,0xEA,0x7F,0xA8,0x2A,0x3F,0xBF,0xBF }, 65: { 0xBA,0x94,0x39,0x45,0xAD,0x1E,0xB1,0xCF,0x94,0x3F,0xBF,0xBF }, 66: { 0x5B,0xE1,0x4D,0xC4,0xBE,0x94,0x95,0xE6,0xC9,0x3F,0xBF,0xBF }, 67: { 0xFD,0xCE,0x61,0x84,0x11,0x77,0xCC,0xAB,0xE4,0x3F,0xBF,0xBF }, 68: { 0x2C,0x65,0x19,0xE2,0x58,0x17,0xB7,0xD1,0xF1,0x3F,0xBF,0xBF }, 69: { 0x0A,0xD7,0xA3,0x70,0x3D,0x0A,0xD7,0xA3,0xF8,0x3F,0xBF,0xBF }, 70: { 0xCD,0xCC,0xCC,0xCC,0xCC,0xCC,0xCC,0xCC,0xFB,0x3F,0xBF,0xBF }, 71: { 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xFF,0x3F,0xBF,0xBF } }; 72: 73: static unsigned char _postab_bytes[][sizeof(long double)] = 74: { { 0x9B,0x97,0x20,0x8A,0x02,0x52,0x60,0xC4,0x25,0x75,0x18,0x28 }, 75: { 0xE5,0x5D,0x3D,0xC5,0x5D,0x3B,0x8B,0x9E,0x92,0x5A,0x18,0x28 }, 76: { 0x17,0x0C,0x75,0x81,0x86,0x75,0x76,0xC9,0x48,0x4D,0x18,0x28 }, 77: { 0xC7,0x91,0x0E,0xA6,0xAE,0xA0,0x19,0xE3,0xA3,0x46,0x18,0x28 }, 78: { 0x8E,0xDE,0xF9,0x9D,0xFB,0xEB,0x7E,0xAA,0x51,0x43,0x18,0x28 }, 79: { 0xE0,0x8C,0xE9,0x80,0xC9,0x47,0xBA,0x93,0xA8,0x41,0x18,0x28 }, 80: { 0xD5,0xA6,0xCF,0xFF,0x49,0x1F,0x78,0xC2,0xD3,0x40,0x18,0x28 }, 81: { 0x9E,0xB5,0x70,0x2B,0xA8,0xAD,0xC5,0x9D,0x69,0x40,0x18,0x28 }, 82: { 0x00,0x00,0x00,0x04,0xBF,0xC9,0x1B,0x8E,0x34,0x40,0x18,0x28 }, 83: { 0x00,0x00,0x00,0x00,0x00,0x20,0xBC,0xBE,0x19,0x40,0x18,0x28 }, 84: { 0x00,0x00,0x00,0x00,0x00,0x00,0x40,0x9C,0x0C,0x40,0x18,0x28 }, 85: { 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xC8,0x05,0x40,0x18,0x28 }, 86: { 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xA0,0x02,0x40,0x18,0x28 }, 87: { 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xFF,0x3F,0x18,0x28 } }; 88: 89: static long double *negtab = (long double *) _negtab_bytes; 90: static long double *postab = (long double *) _postab_bytes; 91: 92: #else 93: 94: // Use exact values, computed separately, to bootstrap. 95: // The digits here past 17 are just for amusement value, they 96: // only contribute to the 'sticky' bit. 97: 98: static long double negtab[] = 99: { 100: 1 / 0x62.30290145104bcd64a60a9fc025254932bb0fd922271133eeae7be4a2f9151ffff868e970c234d8f51c5563f48bd2b496d868b27518ae42404964046f87cc1d213d5d0b54f74eb9281bb6c6e435fcb457200c03a5bca35f7792959da22e8d623b3e7b21e2b6100fab123cd8a1a75409f23956d4b941c759f83557de068edd2d00bcdd9d4a52ec8721ac7867f9e974996fb03d7ecd2fdc6349af06940d48741a6c2ed4684e5ab8d9c7bd7991dc03b4f63b8afd6b25ff66e42caeee333b7000a51987ec7038aec29e6ee8cac982a4ba47440496fcbe00d313d584e857fd214495bbdf373f41fd86fe49b70a5c7d2b17e0b2544f10cd4d8bfa89d0d73df29d0176cca7c234f4e6d2767113fd01c8c1a08a138c4ef80456c02d9a0ff4f1d4e3e51cb9255858325ed8d2399faddd9e9985a2df904ff6bf5c4f2ef0650ebc692c5508c2cbd6667097aced8e437b3d7fe03b2b6341a4c954108b89bc108f19ade5b533458e0dd75a53400d03119534074e89541bae9641fdd6266a3fdcbf778900fc509ba674343dd6769f3b72b882e7282566fbc6cc3f8d6b0dd9bc96119b31a96ddeff35e836b5d298f9994b8c90918e7b9a73491260806f233b7c94ab6feba2ebd6c1d9960e2d73a130d84c4a74fde9ce4724ed5bf546a03f40a8fb126ab1c32da38338eb3acc1a67778cfbe8b12acf1b23504dcd6cd995aca6a8b492ed8aa19adb95484971870239f4cea6e9cfda20c33857b32c450c3fecb534b71bd1a45b060904788f6e50fe78d6823613c8509ee3352c90ca19cfe90afb779eea37c8ab8db59a0a80627ce41d3cc425971d582dfe6d97ee63302b8e13e25feeaf19e63d326a7eb6d1c7bf2608c4cf1cc939c1307641d9b2c39497a8fcd8e0cd9e8d7c3172826ac9df13cb3d04e8d2fca26a9ff7d8b57e27ecf57bbb9373f46fee7aab86deb3f078787e2ab608b89572dac789bf627ede440b3f251f2b2322ab312bb95893d4b850be10e02d2408206e7bb8272181327ec8fa2e8a37a2d4390caea134c53c0adf9462ea75ecf9b5d0ed4d542dc19e1faf7a872e74f984d83e2dd8d92580152f18390a2b295138753d1fa8fd5d59c89f1b095edc162e2690f3cd8f62ff42923bbd87d1cde840b464a0e137d5e9a4eb8f8cde35c88baf63b71292baf1deeca19beb77fb8af6176ca776743074fa7021b97a1e0a68173c20ee69e79dadf7eb83cadbdfea5242a8329761ffe062053ccb5b92ac50b9c175a697b2b5341743c994a4503b9af26b398c6fed037d19eef4090ee8ae0725b1655fec303297cd0c2bd9cc1110c4e9968738b909454eb2a0dcfe388f15b8c898d3967a1b6dc3a5b4811a4f04f3618ac0280f4d3295a842bcfd82373a3f8ec72af2acd5071a8309cb2130504dd97d9556a1ebcad7947e0d0e30c7ae41eb659fb878f061814f6cea9c441c2d473bfe167b1a1c304e7613b22454ab9c41ff0b0905bc13176168dde6d488052f8cf8169c84cb4bf982870097012c23481161959127142e0e80cab3e6d7af6a25743dbeabcd0f237f1a016b67b2c2dfae78e341be10d6bfdf759b8ba1e81d1f4cce7c4823da7e1e7c34c0591cc245155e93b86ae5be806c0ed3f0da6146e599574efb29b172506be82913b1bb5154e05154ef084117f89a1e908efe7ae7d4724e8d2a67c001p+13600L, 101: 1 / 0x9.e8b3b5dc53d5de4a74d28ce329ace526a3197bbebe3034f77154ce2bcba19648b21c11eb962b1b61b93cf2ee5ca6f7e928e61d08e2d694222771e50f30278c9836230af908b40a753b7d77cd8c6be7151aab4efac5dcd83e49d6907855eeb028af623f6f7024d2c36fa9ce9d04a487fa1fb992be221ef1bd0ad5f775677ce0de08402ad3fa140eac7d56c7c9dee0bedd8a6c038f9245b2e87c348ad803ecca8f0070f8dbb57a6a445f278b3d5cf42915e818415c7f3ef82df84658ccf45cfad379433f3389a4408f43c513ef5a83fb8886fbf56d9d4bd5f860792e55ecee70beb1810d76ce39de9ec24bcf99d01953761abd9d7389c0a244de3c195355d84eeebeee6f46eadb56c6815b785ce6b7b125ac8edb0708fd8f6cae5f5715f7915b33eb417bf03c19d7917c7ba1fc6b9681428c85744695f0e866d7efc9ac375d77c1a42f40660460944545ff87a7dc62d752f7a66a57b1ab730f203c1aa9f44484d80e2e5fc5a04779c56b8a9e110c7bcbea4ca7982da4663cfe491d0dbd21feab49869733554c36685e5510c4a656654419bd438e48ff35d6c7d6ab91bac974fb1264b4f111821fa2bca416afe609c313b41e449952fbed5a151440967abbb3a8281ed6a8f16f9210c17f94e3892ee98074ff01e3cb64f32dbb6643a7a8289c8c6c54de34c101349713b44938209ce1f3861ce0fb7fedcc235552eb57a7842d71c7fd8f66912e4ad2f869c29279498719342c12866ed6f1c850dabc98342c9e51b78db2ea50d142fd8277732ed56d55a5e5a191368b8abbb6067584ee87e354ec2e472149e28dcfb27d4d3fe30968651333e001p+6800L, 102: 1 / 0x3.25d9d61a05d4305d9434f4a3c62d433949ae6209d4926c3f5bd2db49ef47187094c1a6970ca7e6bd2a73c5534936a8de061e8d4649f4f3235e005b80411640114a88bc491b9fc4ed520190fba035faaba6c356e38a31b5653f445975836cb0b6c975a351a28e4262ce3ce3a0b8df68368ae26a7b7e976a3310fc8f1f9031eb0f669a20288280bda5a580d98089dc1a47fe6b7595fb101a3616b6f4654b31fb6bfdf56deeecb1b896bc8fc51a16bf3fdeb3d814b505ba34c4118ad822a51abe1de3045b7a748e1042c462be695a9f9f2a07a7e89431922bbb9fc96359861c5cd134f451218b65dc60d7233e55c7231d2b9c9fce837d1e43f61f7de16cfb896634ee0ed1440ecc2cd8194c7d1e1a140ac53515c51a88991c4e871ec29f866e7c215bf55b2b722919f001p+3400L, 103: 1 / 0x1c.633415d4c1d238d98cab8a978a0b1f138cb07303a269974845a71d46b099bc817343afac69be5b0e9449775c1366732a93abade4b2908ee0f95f635e85a91924c3fc0695e7fc7153329c57aebfa3edac96e14f5dbc51fb2eb21a2f221e25cfea703ed321aa1da1bf28f8733b4475b579c88976c194e6574746c40513c31e1ad9b83a8a975d96976f8f9546dc77f27267fc6cf801p+1696L, 104: 1 / 0x5.53f75fdcefcef46eeddc80dcc7f755bc28f265f9ef17cc5573c063ff540e3c42d35a1d153624adc666b026b2716ed595d80fcf4a6e706bde50c612152f87d8d99f72bed3875b982e7c01p+848L, 105: 1 / 0x2.4ee91f2603a6337f19bccdb0dac404dc08d3cff5ec2374e42f0f1538fd03df99092e953e01p+424L, 106: 1 / 0x18.4f03e93ff9f4daa797ed6e38ed64bf6a1f01p+208L, 107: 1 / 0x4.ee2d6d415b85acef81p+104L, 108: 1 / 0x23.86f26fc1p+48L, 109: 1 / 0x5.f5e1p+24L, 110: 1 / 0x27.10p+8L, 111: 1 / 0x64.p+0L, 112: 1 / 0xa.p+0L, 113: }; 114: 115: static long double postab[] = 116: { 117: 0x62.30290145104bcd64a60a9fc025254932bb0fd922271133eeae7be4a2f9151ffff868e970c234d8f51c5563f48bd2b496d868b27518ae42404964046f87cc1d213d5d0b54f74eb9281bb6c6e435fcb457200c03a5bca35f7792959da22e8d623b3e7b21e2b6100fab123cd8a1a75409f23956d4b941c759f83557de068edd2d00bcdd9d4a52ec8721ac7867f9e974996fb03d7ecd2fdc6349af06940d48741a6c2ed4684e5ab8d9c7bd7991dc03b4f63b8afd6b25ff66e42caeee333b7000a51987ec7038aec29e6ee8cac982a4ba47440496fcbe00d313d584e857fd214495bbdf373f41fd86fe49b70a5c7d2b17e0b2544f10cd4d8bfa89d0d73df29d0176cca7c234f4e6d2767113fd01c8c1a08a138c4ef80456c02d9a0ff4f1d4e3e51cb9255858325ed8d2399faddd9e9985a2df904ff6bf5c4f2ef0650ebc692c5508c2cbd6667097aced8e437b3d7fe03b2b6341a4c954108b89bc108f19ade5b533458e0dd75a53400d03119534074e89541bae9641fdd6266a3fdcbf778900fc509ba674343dd6769f3b72b882e7282566fbc6cc3f8d6b0dd9bc96119b31a96ddeff35e836b5d298f9994b8c90918e7b9a73491260806f233b7c94ab6feba2ebd6c1d9960e2d73a130d84c4a74fde9ce4724ed5bf546a03f40a8fb126ab1c32da38338eb3acc1a67778cfbe8b12acf1b23504dcd6cd995aca6a8b492ed8aa19adb95484971870239f4cea6e9cfda20c33857b32c450c3fecb534b71bd1a45b060904788f6e50fe78d6823613c8509ee3352c90ca19cfe90afb779eea37c8ab8db59a0a80627ce41d3cc425971d582dfe6d97ee63302b8e13e25feeaf19e63d326a7eb6d1c7bf2608c4cf1cc939c1307641d9b2c39497a8fcd8e0cd9e8d7c3172826ac9df13cb3d04e8d2fca26a9ff7d8b57e27ecf57bbb9373f46fee7aab86deb3f078787e2ab608b89572dac789bf627ede440b3f251f2b2322ab312bb95893d4b850be10e02d2408206e7bb8272181327ec8fa2e8a37a2d4390caea134c53c0adf9462ea75ecf9b5d0ed4d542dc19e1faf7a872e74f984d83e2dd8d92580152f18390a2b295138753d1fa8fd5d59c89f1b095edc162e2690f3cd8f62ff42923bbd87d1cde840b464a0e137d5e9a4eb8f8cde35c88baf63b71292baf1deeca19beb77fb8af6176ca776743074fa7021b97a1e0a68173c20ee69e79dadf7eb83cadbdfea5242a8329761ffe062053ccb5b92ac50b9c175a697b2b5341743c994a4503b9af26b398c6fed037d19eef4090ee8ae0725b1655fec303297cd0c2bd9cc1110c4e9968738b909454eb2a0dcfe388f15b8c898d3967a1b6dc3a5b4811a4f04f3618ac0280f4d3295a842bcfd82373a3f8ec72af2acd5071a8309cb2130504dd97d9556a1ebcad7947e0d0e30c7ae41eb659fb878f061814f6cea9c441c2d473bfe167b1a1c304e7613b22454ab9c41ff0b0905bc13176168dde6d488052f8cf8169c84cb4bf982870097012c23481161959127142e0e80cab3e6d7af6a25743dbeabcd0f237f1a016b67b2c2dfae78e341be10d6bfdf759b8ba1e81d1f4cce7c4823da7e1e7c34c0591cc245155e93b86ae5be806c0ed3f0da6146e599574efb29b172506be82913b1bb5154e05154ef084117f89a1e908efe7ae7d4724e8d2a67c001p+13600L, 118: 0x9.e8b3b5dc53d5de4a74d28ce329ace526a3197bbebe3034f77154ce2bcba19648b21c11eb962b1b61b93cf2ee5ca6f7e928e61d08e2d694222771e50f30278c9836230af908b40a753b7d77cd8c6be7151aab4efac5dcd83e49d6907855eeb028af623f6f7024d2c36fa9ce9d04a487fa1fb992be221ef1bd0ad5f775677ce0de08402ad3fa140eac7d56c7c9dee0bedd8a6c038f9245b2e87c348ad803ecca8f0070f8dbb57a6a445f278b3d5cf42915e818415c7f3ef82df84658ccf45cfad379433f3389a4408f43c513ef5a83fb8886fbf56d9d4bd5f860792e55ecee70beb1810d76ce39de9ec24bcf99d01953761abd9d7389c0a244de3c195355d84eeebeee6f46eadb56c6815b785ce6b7b125ac8edb0708fd8f6cae5f5715f7915b33eb417bf03c19d7917c7ba1fc6b9681428c85744695f0e866d7efc9ac375d77c1a42f40660460944545ff87a7dc62d752f7a66a57b1ab730f203c1aa9f44484d80e2e5fc5a04779c56b8a9e110c7bcbea4ca7982da4663cfe491d0dbd21feab49869733554c36685e5510c4a656654419bd438e48ff35d6c7d6ab91bac974fb1264b4f111821fa2bca416afe609c313b41e449952fbed5a151440967abbb3a8281ed6a8f16f9210c17f94e3892ee98074ff01e3cb64f32dbb6643a7a8289c8c6c54de34c101349713b44938209ce1f3861ce0fb7fedcc235552eb57a7842d71c7fd8f66912e4ad2f869c29279498719342c12866ed6f1c850dabc98342c9e51b78db2ea50d142fd8277732ed56d55a5e5a191368b8abbb6067584ee87e354ec2e472149e28dcfb27d4d3fe30968651333e001p+6800L, 119: 0x3.25d9d61a05d4305d9434f4a3c62d433949ae6209d4926c3f5bd2db49ef47187094c1a6970ca7e6bd2a73c5534936a8de061e8d4649f4f3235e005b80411640114a88bc491b9fc4ed520190fba035faaba6c356e38a31b5653f445975836cb0b6c975a351a28e4262ce3ce3a0b8df68368ae26a7b7e976a3310fc8f1f9031eb0f669a20288280bda5a580d98089dc1a47fe6b7595fb101a3616b6f4654b31fb6bfdf56deeecb1b896bc8fc51a16bf3fdeb3d814b505ba34c4118ad822a51abe1de3045b7a748e1042c462be695a9f9f2a07a7e89431922bbb9fc96359861c5cd134f451218b65dc60d7233e55c7231d2b9c9fce837d1e43f61f7de16cfb896634ee0ed1440ecc2cd8194c7d1e1a140ac53515c51a88991c4e871ec29f866e7c215bf55b2b722919f001p+3400L, 120: 0x1c.633415d4c1d238d98cab8a978a0b1f138cb07303a269974845a71d46b099bc817343afac69be5b0e9449775c1366732a93abade4b2908ee0f95f635e85a91924c3fc0695e7fc7153329c57aebfa3edac96e14f5dbc51fb2eb21a2f221e25cfea703ed321aa1da1bf28f8733b4475b579c88976c194e6574746c40513c31e1ad9b83a8a975d96976f8f9546dc77f27267fc6cf801p+1696L, 121: 0x5.53f75fdcefcef46eeddc80dcc7f755bc28f265f9ef17cc5573c063ff540e3c42d35a1d153624adc666b026b2716ed595d80fcf4a6e706bde50c612152f87d8d99f72bed3875b982e7c01p+848L, 122: 0x2.4ee91f2603a6337f19bccdb0dac404dc08d3cff5ec2374e42f0f1538fd03df99092e953e01p+424L, 123: 0x18.4f03e93ff9f4daa797ed6e38ed64bf6a1f01p+208L, 124: 0x4.ee2d6d415b85acef81p+104L, 125: 0x23.86f26fc1p+48L, 126: 0x5.f5e1p+24L, 127: 0x27.10p+8L, 128: 0x64.p+0L, 129: 0xa.p+0L, 130: }; 131: 132: #endif 133: 134: /************************* 135: * Convert string to double. 136: * Terminates on first unrecognized character. 137: */ 138: 139: long double strtold(const char *p,char **endp) 140: { 141: long double ldval; 142: int exp; 143: long long msdec,lsdec; 144: unsigned long msscale; 145: char dot,sign; 146: int pow; 147: int ndigits; 148: const char *pinit = p; 149: static char infinity[] = "infinity"; 150: static char nans[] = "nans"; 151: unsigned int old_cw; 152: unsigned int old_status; 153: 154: #if _WIN32 && !_MSC_VER 155: fenv_t flagp; 156: fegetenv(&flagp); /* Store all exceptions, and current status word */ 157: if (_8087) 158: { 159: // disable exceptions from occurring, set max precision, and round to nearest 160: #if __DMC__ 161: __asm 162: { 163: fstcw word ptr old_cw 164: mov EAX,old_cw 165: mov ECX,EAX 166: and EAX,0xf0c0 167: or EAX,033fh 168: mov old_cw,EAX 169: fldcw word ptr old_cw 170: mov old_cw,ECX 171: } 172: #else 173: old_cw = _control87(_MCW_EM | _PC_64 | _RC_NEAR, 174: _MCW_EM | _MCW_PC | _MCW_RC); 175: #endif 176: } 177: #endif 178: 179: while (isspace(*p)) 180: p++; 181: sign = 0; /* indicating + */ 182: switch (*p) 183: { case '-': 184: sign++; 185: /* FALL-THROUGH */ 186: case '+': 187: p++; 188: } 189: ldval = 0.0; 190: dot = 0; /* if decimal point has been seen */ 191: exp = 0; 192: msdec = lsdec = 0; 193: msscale = 1; 194: ndigits = 0; 195: 196: #if __DMC__ 197: switch (*p) 198: { case 'i': 199: case 'I': 200: if (memicmp(p,infinity,8) == 0) 201: { p += 8; 202: goto L4; 203: } 204: if (memicmp(p,infinity,3) == 0) /* is it "inf"? */ 205: { p += 3; 206: L4: 207: ldval = HUGE_VAL; 208: goto L3; 209: } 210: break; 211: case 'n': 212: case 'N': 213: if (memicmp(p,nans,4) == 0) /* "nans"? */ 214: { p += 4; 215: ldval = NANS; 216: goto L5; 217: } 218: if (memicmp(p,nans,3) == 0) /* "nan"? */ 219: { p += 3; 220: ldval = NAN; 221: L5: 222: if (*p == '(') /* if (n-char-sequence) */ 223: goto Lerr; /* invalid input */ 224: goto L3; 225: } 226: } 227: #endif 228: 229: if (*p == '0' && (p[1] == 'x' || p[1] == 'X')) 230: { int guard = 0; 231: int anydigits = 0; 232: 233: p += 2; 234: while (1) 235: { int i = *p; 236: 237: while (isxdigit(i)) 238: { 239: anydigits = 1; 240: i = isalpha(i) ? ((i & ~0x20) - ('A' - 10)) : i - '0'; 241: if (ndigits < 16) 242: { 243: msdec = msdec * 16 + i; 244: if (msdec) 245: ndigits++; 246: } 247: else if (ndigits == 16) 248: { 249: while (msdec >= 0) 250: { 251: exp--; 252: msdec <<= 1; 253: i <<= 1; 254: if (i & 0x10) 255: msdec |= 1; 256: } 257: guard = i << 4; 258: ndigits++; 259: exp += 4; 260: } 261: else 262: { 263: guard |= i; 264: exp += 4; 265: } 266: exp -= dot; 267: i = *++p; 268: } 269: #ifdef _WIN32 270: if (i == *__locale_decpoint && !dot) 271: #else 272: if (i == '.' && !dot) 273: #endif 274: { p++; 275: dot = 4; 276: } 277: else 278: break; 279: } 280: 281: // Round up if (guard && (sticky || odd)) 282: if (guard & 0x80 && (guard & 0x7F || msdec & 1)) 283: { 284: msdec++; 285: if (msdec == 0) // overflow 286: { msdec = 0x8000000000000000LL; 287: exp++; 288: } 289: } 290: 291: if (anydigits == 0) // if error (no digits seen) 292: goto Lerr; 293: if (*p == 'p' || *p == 'P') 294: { 295: char sexp; 296: int e; 297: 298: sexp = 0; 299: switch (*++p) 300: { case '-': sexp++; 301: case '+': p++; 302: } 303: ndigits = 0; 304: e = 0; 305: while (isdigit(*p)) 306: { 307: if (e < 0x7FFFFFFF / 10 - 10) // prevent integer overflow 308: { 309: e = e * 10 + *p - '0'; 310: } 311: p++; 312: ndigits = 1; 313: } 314: exp += (sexp) ? -e : e; 315: if (!ndigits) // if no digits in exponent 316: goto Lerr; 317: 318: if (msdec) 319: { 320: #if __DMC__ 321: // The 8087 has no instruction to load an 322: // unsigned long long 323: if (msdec < 0) 324: { 325: *(long long *)&ldval = msdec; 326: ((unsigned short *)&ldval)[4] = 0x3FFF + 63; 327: } 328: else 329: { // But does for a signed one 330: __asm 331: { 332: fild qword ptr msdec 333: fstp tbyte ptr ldval 334: } 335: } 336: #else 337: int e2 = 0x3FFF + 63; 338: 339: // left justify mantissa 340: while (msdec >= 0) 341: { msdec <<= 1; 342: e2--; 343: } 344: 345: // Stuff mantissa directly into long double 346: *(long long *)&ldval = msdec; 347: ((unsigned short *)&ldval)[4] = e2; 348: #endif 349: 350: #if 0 351: if (0) 352: { int i; 353: printf("msdec = x%llx, ldval = %Lg\n", msdec, ldval); 354: for (i = 0; i < 5; i++) 355: printf("%04x ",((unsigned short *)&ldval)[i]); 356: printf("\n"); 357: printf("%llx\n",ldval); 358: } 359: #endif 360: // Exponent is power of 2, not power of 10 361: #if _WIN32 && __DMC__ 362: __asm 363: { 364: fild dword ptr exp 365: fld tbyte ptr ldval 366: fscale // ST(0) = ST(0) * (2**ST(1)) 367: fstp ST(1) 368: fstp tbyte ptr ldval 369: } 370: #else 371: ldval = ldexpl(ldval,exp); 372: #endif 373: } 374: goto L6; 375: } 376: else 377: goto Lerr; // exponent is required 378: } 379: else 380: { 381: while (1) 382: { int i = *p; 383: 384: while (isdigit(i)) 385: { 386: ndigits = 1; /* must have at least 1 digit */ 387: if (msdec < (0x7FFFFFFFFFFFLL-10)/10) 388: msdec = msdec * 10 + (i - '0'); 389: else if (msscale < (0xFFFFFFFF-10)/10) 390: { lsdec = lsdec * 10 + (i - '0'); 391: msscale *= 10; 392: } 393: else 394: { 395: exp++; 396: } 397: exp -= dot; 398: i = *++p; 399: } 400: #if _WIN32 401: if (i == *__locale_decpoint && !dot) 402: #else 403: if (i == '.' && !dot) 404: #endif 405: { p++; 406: dot++; 407: } 408: else 409: break; 410: } 411: if (!ndigits) // if error (no digits seen) 412: goto Lerr; // return 0.0 413: } 414: if (*p == 'e' || *p == 'E') 415: { 416: char sexp; 417: int e; 418: 419: sexp = 0; 420: switch (*++p) 421: { case '-': sexp++; 422: case '+': p++; 423: } 424: ndigits = 0; 425: e = 0; 426: while (isdigit(*p)) 427: { 428: if (e < 0x7FFFFFFF / 10 - 10) // prevent integer overflow 429: { 430: e = e * 10 + *p - '0'; 431: } 432: p++; 433: ndigits = 1; 434: } 435: exp += (sexp) ? -e : e; 436: if (!ndigits) // if no digits in exponent 437: goto Lerr; // return 0.0 438: } 439: 440: #if _WIN32 441: __asm 442: { 443: fild qword ptr msdec 444: mov EAX,msscale 445: cmp EAX,1 446: je La1 447: fild long ptr msscale 448: fmul 449: fild qword ptr lsdec 450: fadd 451: La1: 452: fstp tbyte ptr ldval 453: } 454: #else 455: ldval = msdec; 456: if (msscale != 1) /* if stuff was accumulated in lsdec */ 457: ldval = ldval * msscale + lsdec; 458: #endif 459: if (ldval) 460: { unsigned u; 461: 462: u = 0; 463: pow = 4096; 464: 465: #if _WIN32 466: //printf("msdec = x%x, lsdec = x%x, msscale = x%x\n",msdec,lsdec,msscale); 467: //printf("dval = %g, x%llx, exp = %d\n",dval,dval,exp); 468: __asm fld tbyte ptr ldval 469: #endif 470: 471: while (exp > 0) 472: { 473: while (exp >= pow) 474: { 475: #if _WIN32 476: __asm 477: { 478: mov EAX,u 479: imul EAX,10 480: fld tbyte ptr postab[EAX] 481: fmul 482: } 483: #else 484: ldval *= postab[u]; 485: #endif 486: exp -= pow; 487: } 488: pow >>= 1; 489: u++; 490: } 491: #if _WIN32 492: __asm fstp tbyte ptr ldval 493: #endif 494: while (exp < 0) 495: { while (exp <= -pow) 496: { 497: #if _WIN32 498: __asm 499: { 500: mov EAX,u 501: imul EAX,10 502: fld tbyte ptr ldval 503: fld tbyte ptr negtab[EAX] 504: fmul 505: fstp tbyte ptr ldval 506: } 507: #else 508: ldval *= negtab[u]; 509: #endif 510: if (ldval == 0) 511: #if _WIN32 512: __set_errno (ERANGE); 513: #else 514: errno = ERANGE; 515: #endif 516: exp += pow; 517: } 518: pow >>= 1; 519: u++; 520: } 521: #if 0 522: if (0) 523: { int i; 524: for (i = 0; i < 5; i++) 525: printf("%04x ",ldval.value[i]); 526: printf("\n"); 527: printf("%llx\n",dval); 528: } 529: #endif 530: } 531: L6: // if overflow occurred 532: if (ldval == HUGE_VAL) 533: #if _WIN32 534: __set_errno (ERANGE); // range error 535: #else 536: errno = ERANGE; 537: #endif 538: 539: L1: 540: if (endp) 541: { 542: *endp = (char *) p; 543: } 544: L3: 545: #if _WIN32 && !_MSC_VER 546: fesetenv(&flagp); // reset floating point environment 547: if (_8087) 548: { 549: __asm 550: { 551: xor EAX,EAX 552: fstsw AX 553: fclex 554: fldcw word ptr old_cw 555: } 556: } 557: #endif 558: 559: return (sign) ? -ldval : ldval; 560: 561: Lerr: 562: p = pinit; 563: goto L1; 564: } 565: 566: #else 567: 568: long double strtold(const char *p,char **endp) 569: { 570: return strtod(p, endp); 571: } 572: 573: #endif 574: 575: /************************* Test ************************************/ 576: 577: #if 0 578: 579: #include <stdio.h> 580: #include <float.h> 581: #include <errno.h> 582: 583: extern "C" long double strtold(const char *p,char **endp); 584: 585: struct longdouble 586: { 587: unsigned short value[5]; 588: }; 589: 590: void main() 591: { 592: long double ld; 593: struct longdouble x; 594: int i; 595: 596: errno = 0; 597: // ld = strtold("0x1.FFFFFFFFFFFFFFFEp16383", NULL); 598: ld = strtold("0x1.FFFFFFFFFFFFFFFEp-16382", NULL); 599: x = *(struct longdouble *)&ld; 600: for (i = 4; i >= 0; i--) 601: { 602: printf("%04x ", x.value[i]); 603: } 604: printf("\t%d\n", errno); 605: 606: ld = strtold("1.0e5", NULL); 607: x = *(struct longdouble *)&ld; 608: for (i = 4; i >= 0; i--) 609: { 610: printf("%04x ", x.value[i]); 611: } 612: printf("\n"); 613: } 614: 615: #endif 616: 617: /************************* Bigint ************************************/ 618: 619: #if 0 620: 621: /* This program computes powers of 10 exactly. 622: * Used to generate postab[]. 623: */ 624: 625: 626: #include <stdio.h> 627: #include <stdlib.h> 628: #include <string.h> 629: 630: #define NDIGITS 4096 631: 632: void times10(unsigned *a) 633: { 634: int i; 635: 636: for (i = 0; i < NDIGITS; i++) 637: { 638: a[i] *= 10; 639: if (i) 640: { 641: a[i] += a[i - 1] >> 8; 642: a[i - 1] &= 0xFF; 643: } 644: } 645: } 646: 647: void print(unsigned *a) 648: { 649: int i; 650: int p; 651: int j; 652: 653: for (i = NDIGITS; i; ) 654: { 655: --i; 656: if (a[i]) 657: break; 658: } 659: 660: printf("0x%x.", a[i]); 661: p = i * 8; 662: i--; 663: for (j = 0; j < i; j++) 664: if (a[j]) 665: break; 666: for (; i >= j; i--) 667: { 668: printf("%02x", a[i]); 669: } 670: printf("p+%d", p); 671: } 672: 673: void main() 674: { 675: unsigned a[NDIGITS]; 676: int i; 677: int j; 678: 679: static long double tab[] = 680: { 681: 0x62.30290145104bcd64a60a9fc025254932bb0fd922271133eeae7be4a2f9151ffff868e970c234d8f51c5563f48bd2b496d868b27518ae42404964046f87cc1d213d5d0b54f74eb9281bb6c6e435fcb457200c03a5bca35f7792959da22e8d623b3e7b21e2b6100fab123cd8a1a75409f23956d4b941c759f83557de068edd2d00bcdd9d4a52ec8721ac7867f9e974996fb03d7ecd2fdc6349af06940d48741a6c2ed4684e5ab8d9c7bd7991dc03b4f63b8afd6b25ff66e42caeee333b7000a51987ec7038aec29e6ee8cac982a4ba47440496fcbe00d313d584e857fd214495bbdf373f41fd86fe49b70a5c7d2b17e0b2544f10cd4d8bfa89d0d73df29d0176cca7c234f4e6d2767113fd01c8c1a08a138c4ef80456c02d9a0ff4f1d4e3e51cb9255858325ed8d2399faddd9e9985a2df904ff6bf5c4f2ef0650ebc692c5508c2cbd6667097aced8e437b3d7fe03b2b6341a4c954108b89bc108f19ade5b533458e0dd75a53400d03119534074e89541bae9641fdd6266a3fdcbf778900fc509ba674343dd6769f3b72b882e7282566fbc6cc3f8d6b0dd9bc96119b31a96ddeff35e836b5d298f9994b8c90918e7b9a73491260806f233b7c94ab6feba2ebd6c1d9960e2d73a130d84c4a74fde9ce4724ed5bf546a03f40a8fb126ab1c32da38338eb3acc1a67778cfbe8b12acf1b23504dcd6cd995aca6a8b492ed8aa19adb95484971870239f4cea6e9cfda20c33857b32c450c3fecb534b71bd1a45b060904788f6e50fe78d6823613c8509ee3352c90ca19cfe90afb779eea37c8ab8db59a0a80627ce41d3cc425971d582dfe6d97ee63302b8e13e25feeaf19e63d326a7eb6d1c7bf2608c4cf1cc939c1307641d9b2c39497a8fcd8e0cd9e8d7c3172826ac9df13cb3d04e8d2fca26a9ff7d8b57e27ecf57bbb9373f46fee7aab86deb3f078787e2ab608b89572dac789bf627ede440b3f251f2b2322ab312bb95893d4b850be10e02d2408206e7bb8272181327ec8fa2e8a37a2d4390caea134c53c0adf9462ea75ecf9b5d0ed4d542dc19e1faf7a872e74f984d83e2dd8d92580152f18390a2b295138753d1fa8fd5d59c89f1b095edc162e2690f3cd8f62ff42923bbd87d1cde840b464a0e137d5e9a4eb8f8cde35c88baf63b71292baf1deeca19beb77fb8af6176ca776743074fa7021b97a1e0a68173c20ee69e79dadf7eb83cadbdfea5242a8329761ffe062053ccb5b92ac50b9c175a697b2b5341743c994a4503b9af26b398c6fed037d19eef4090ee8ae0725b1655fec303297cd0c2bd9cc1110c4e9968738b909454eb2a0dcfe388f15b8c898d3967a1b6dc3a5b4811a4f04f3618ac0280f4d3295a842bcfd82373a3f8ec72af2acd5071a8309cb2130504dd97d9556a1ebcad7947e0d0e30c7ae41eb659fb878f061814f6cea9c441c2d473bfe167b1a1c304e7613b22454ab9c41ff0b0905bc13176168dde6d488052f8cf8169c84cb4bf982870097012c23481161959127142e0e80cab3e6d7af6a25743dbeabcd0f237f1a016b67b2c2dfae78e341be10d6bfdf759b8ba1e81d1f4cce7c4823da7e1e7c34c0591cc245155e93b86ae5be806c0ed3f0da6146e599574efb29b172506be82913b1bb5154e05154ef084117f89a1e908efe7ae7d4724e8d2a67c001p+13600L, 682: 0x9.e8b3b5dc53d5de4a74d28ce329ace526a3197bbebe3034f77154ce2bcba19648b21c11eb962b1b61b93cf2ee5ca6f7e928e61d08e2d694222771e50f30278c9836230af908b40a753b7d77cd8c6be7151aab4efac5dcd83e49d6907855eeb028af623f6f7024d2c36fa9ce9d04a487fa1fb992be221ef1bd0ad5f775677ce0de08402ad3fa140eac7d56c7c9dee0bedd8a6c038f9245b2e87c348ad803ecca8f0070f8dbb57a6a445f278b3d5cf42915e818415c7f3ef82df84658ccf45cfad379433f3389a4408f43c513ef5a83fb8886fbf56d9d4bd5f860792e55ecee70beb1810d76ce39de9ec24bcf99d01953761abd9d7389c0a244de3c195355d84eeebeee6f46eadb56c6815b785ce6b7b125ac8edb0708fd8f6cae5f5715f7915b33eb417bf03c19d7917c7ba1fc6b9681428c85744695f0e866d7efc9ac375d77c1a42f40660460944545ff87a7dc62d752f7a66a57b1ab730f203c1aa9f44484d80e2e5fc5a04779c56b8a9e110c7bcbea4ca7982da4663cfe491d0dbd21feab49869733554c36685e5510c4a656654419bd438e48ff35d6c7d6ab91bac974fb1264b4f111821fa2bca416afe609c313b41e449952fbed5a151440967abbb3a8281ed6a8f16f9210c17f94e3892ee98074ff01e3cb64f32dbb6643a7a8289c8c6c54de34c101349713b44938209ce1f3861ce0fb7fedcc235552eb57a7842d71c7fd8f66912e4ad2f869c29279498719342c12866ed6f1c850dabc98342c9e51b78db2ea50d142fd8277732ed56d55a5e5a191368b8abbb6067584ee87e354ec2e472149e28dcfb27d4d3fe30968651333e001p+6800L, 683: 0x3.25d9d61a05d4305d9434f4a3c62d433949ae6209d4926c3f5bd2db49ef47187094c1a6970ca7e6bd2a73c5534936a8de061e8d4649f4f3235e005b80411640114a88bc491b9fc4ed520190fba035faaba6c356e38a31b5653f445975836cb0b6c975a351a28e4262ce3ce3a0b8df68368ae26a7b7e976a3310fc8f1f9031eb0f669a20288280bda5a580d98089dc1a47fe6b7595fb101a3616b6f4654b31fb6bfdf56deeecb1b896bc8fc51a16bf3fdeb3d814b505ba34c4118ad822a51abe1de3045b7a748e1042c462be695a9f9f2a07a7e89431922bbb9fc96359861c5cd134f451218b65dc60d7233e55c7231d2b9c9fce837d1e43f61f7de16cfb896634ee0ed1440ecc2cd8194c7d1e1a140ac53515c51a88991c4e871ec29f866e7c215bf55b2b722919f001p+3400L, 684: 0x1c.633415d4c1d238d98cab8a978a0b1f138cb07303a269974845a71d46b099bc817343afac69be5b0e9449775c1366732a93abade4b2908ee0f95f635e85a91924c3fc0695e7fc7153329c57aebfa3edac96e14f5dbc51fb2eb21a2f221e25cfea703ed321aa1da1bf28f8733b4475b579c88976c194e6574746c40513c31e1ad9b83a8a975d96976f8f9546dc77f27267fc6cf801p+1696L, 685: 0x5.53f75fdcefcef46eeddc80dcc7f755bc28f265f9ef17cc5573c063ff540e3c42d35a1d153624adc666b026b2716ed595d80fcf4a6e706bde50c612152f87d8d99f72bed3875b982e7c01p+848L, 686: 0x2.4ee91f2603a6337f19bccdb0dac404dc08d3cff5ec2374e42f0f1538fd03df99092e953e01p+424L, 687: 0x18.4f03e93ff9f4daa797ed6e38ed64bf6a1f01p+208L, 688: 0x4.ee2d6d415b85acef81p+104L, 689: 0x23.86f26fc1p+48L, 690: 0x5.f5e1p+24L, 691: 0x27.10p+8L, 692: 0x64.p+0L, 693: 0xa.p+0L, 694: }; 695: 696: for (j = 1; j <= 4096; j *= 2) 697: { 698: printf("%4d: ", j); 699: memset(a, 0, sizeof(a)); 700: a[0] = 1; 701: for (i = 0; i < j; i++) 702: times10(a); 703: print(a); 704: printf("L,\n"); 705: } 706: 707: for (i = 0; i < 13; i++) 708: { 709: printf("tab[%d] = %Lg\n", i, tab[i]); 710: } 711: } 712: 713: #endif 714: 715: