Mercurial > hg > xemacs-beta

comparison src/floatfns.c @ 4717:fcc7e89d5e68

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Properly handle continuable divide-by-zero errors. Fix truncation of a zero-valued ratio. See xemacs-patches message <870180fe0910080956h5d674f03q185d11aa6fc57bd2@mail.gmail.com>.
author Jerry James <james@xemacs.org>
date Mon, 12 Oct 2009 12:10:04 -0600
parents b5e1d4f6b66f
children f31c12360354 e0db3c197671
comparison
equal deleted inserted replaced
4716:dca5bb2adff1 4717:fcc7e89d5e68
106 #endif 106 #endif
107 107
108 108
109 #define arith_error(op,arg) \ 109 #define arith_error(op,arg) \
110 Fsignal (Qarith_error, list2 (build_msg_string (op), arg)) 110 Fsignal (Qarith_error, list2 (build_msg_string (op), arg))
111 #define arith_error2(op,a1,a2) \
112 Fsignal (Qarith_error, list3 (build_msg_string (op), a1, a2))
111 #define range_error(op,arg) \ 113 #define range_error(op,arg) \
112 Fsignal (Qrange_error, list2 (build_msg_string (op), arg)) 114 Fsignal (Qrange_error, list2 (build_msg_string (op), arg))
113 #define range_error2(op,a1,a2) \ 115 #define range_error2(op,a1,a2) \
114 Fsignal (Qrange_error, list3 (build_msg_string (op), a1, a2)) 116 Fsignal (Qrange_error, list3 (build_msg_string (op), a1, a2))
115 #define domain_error(op,arg) \ 117 #define domain_error(op,arg) \
887 RATIO, return_float); \ 889 RATIO, return_float); \
888 MAYBE_ONE_ARG_WITH_NUMBER_TYPES (conversion, \ 890 MAYBE_ONE_ARG_WITH_NUMBER_TYPES (conversion, \
889 BIGFLOAT, return_float); \ 891 BIGFLOAT, return_float); \
890 return conversion##_one_mundane_arg (number, divisor, \ 892 return conversion##_one_mundane_arg (number, divisor, \
891 return_float) 893 return_float)
892
893 894
894 #define CONVERT_WITHOUT_NUMBER_TYPES(conversion, return_float) \ 895 #define CONVERT_WITHOUT_NUMBER_TYPES(conversion, return_float) \
895 if (!NILP (divisor)) \ 896 if (!NILP (divisor)) \
896 { \ 897 { \
897 /* The promote_args call if number types are available \ 898 /* The promote_args call if number types are available \
941 case BIGNUM_T: \ 942 case BIGNUM_T: \
942 return conversion##_two_bignum (number, divisor, return_float) 943 return conversion##_two_bignum (number, divisor, return_float)
943 944
944 #define MAYBE_ONE_ARG_BIGNUM(converse, return_float) \ 945 #define MAYBE_ONE_ARG_BIGNUM(converse, return_float) \
945 if (BIGNUM_P (number)) \ 946 if (BIGNUM_P (number)) \
946 return conversion##_one_bignum (number, divisor, return_float) 947 return conversion##_one_bignum (number, divisor, return_float)
947 #else 948 #else
948 #define MAYBE_TWO_ARGS_BIGNUM(conversion, return_float) 949 #define MAYBE_TWO_ARGS_BIGNUM(conversion, return_float)
949 #define MAYBE_ONE_ARG_BIGNUM(converse, return_float) 950 #define MAYBE_ONE_ARG_BIGNUM(converse, return_float)
950 #endif 951 #endif
951 952
952 #ifdef HAVE_RATIO 953 #ifdef HAVE_RATIO
953 #define MAYBE_TWO_ARGS_RATIO(conversion, return_float) \ 954 #define MAYBE_TWO_ARGS_RATIO(conversion, return_float) \
954 case RATIO_T: \ 955 case RATIO_T: \
955 return conversion##_two_ratio (number, divisor, return_float) 956 return conversion##_two_ratio (number, divisor, return_float)
956 957
957 #define MAYBE_ONE_ARG_RATIO(conversion, return_float) \ 958 #define MAYBE_ONE_ARG_RATIO(conversion, return_float) \
958 if (RATIOP (number)) \ 959 if (RATIOP (number)) \
959 return conversion##_one_ratio (number, divisor, return_float) 960 return conversion##_one_ratio (number, divisor, return_float)
960 #else 961 #else
961 #define MAYBE_TWO_ARGS_RATIO(conversion, return_float) 962 #define MAYBE_TWO_ARGS_RATIO(conversion, return_float)
962 #define MAYBE_ONE_ARG_RATIO(converse, return_float) 963 #define MAYBE_ONE_ARG_RATIO(converse, return_float)
963 #endif 964 #endif
964 965
965 #ifdef HAVE_BIGFLOAT 966 #ifdef HAVE_BIGFLOAT
966 #define MAYBE_TWO_ARGS_BIGFLOAT(conversion, return_float) \ 967 #define MAYBE_TWO_ARGS_BIGFLOAT(conversion, return_float) \
967 case BIGFLOAT_T: \ 968 case BIGFLOAT_T: \
968 return conversion##_two_bigfloat (number, divisor, return_float) 969 return conversion##_two_bigfloat (number, divisor, return_float)
969 970
970 #define MAYBE_ONE_ARG_BIGFLOAT(conversion, return_float) \ 971 #define MAYBE_ONE_ARG_BIGFLOAT(conversion, return_float) \
971 if (BIGFLOATP (number)) \ 972 if (BIGFLOATP (number)) \
972 return conversion##_one_bigfloat (number, divisor, return_float) 973 return conversion##_one_bigfloat (number, divisor, return_float)
973 #else 974 #else
974 #define MAYBE_TWO_ARGS_BIGFLOAT(conversion, return_float) 975 #define MAYBE_TWO_ARGS_BIGFLOAT(conversion, return_float)
975 #define MAYBE_ONE_ARG_BIGFLOAT(converse, return_float) 976 #define MAYBE_ONE_ARG_BIGFLOAT(converse, return_float)
976 #endif 977 #endif
977 978
978 #define MAYBE_TWO_ARGS_WITH_NUMBER_TYPES(convers, upcase, return_float) \ 979 #define MAYBE_TWO_ARGS_WITH_NUMBER_TYPES(convers, upcase, return_float) \
979 MAYBE_TWO_ARGS_##upcase(convers, return_float) 980 MAYBE_TWO_ARGS_##upcase(convers, return_float)
980 981
1013 EMACS_INT i1 = XREALINT (number); 1014 EMACS_INT i1 = XREALINT (number);
1014 EMACS_INT i2 = XREALINT (divisor); 1015 EMACS_INT i2 = XREALINT (divisor);
1015 EMACS_INT i3 = 0, i4 = 0; 1016 EMACS_INT i3 = 0, i4 = 0;
1016 1017
1017 if (i2 == 0) 1018 if (i2 == 0)
1018 Fsignal (Qarith_error, Qnil); 1019 return arith_error2 ("ceiling", number, divisor);
1019 1020
1020 /* With C89's integer /, the result is implementation-defined if either 1021 /* With C89's integer /, the result is implementation-defined if either
1021 operand is negative, so use only nonnegative operands. Here we do 1022 operand is negative, so use only nonnegative operands. Here we do
1022 basically the opposite of what floor_two_fixnum does, we add one in the 1023 basically the opposite of what floor_two_fixnum does, we add one in the
1023 non-negative case: */ 1024 non-negative case: */
1078 int return_float) 1079 int return_float)
1079 { 1080 {
1080 Lisp_Object res0, res1; 1081 Lisp_Object res0, res1;
1081 1082
1082 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0) 1083 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
1083 { 1084 return arith_error2 ("ceiling", number, divisor);
1084 Fsignal (Qarith_error, Qnil);
1085 }
1086 1085
1087 bignum_ceil (scratch_bignum, XBIGNUM_DATA (number), XBIGNUM_DATA (divisor)); 1086 bignum_ceil (scratch_bignum, XBIGNUM_DATA (number), XBIGNUM_DATA (divisor));
1088 1087
1089 res0 = return_float ? make_float (bignum_to_double (scratch_bignum)) : 1088 res0 = return_float ? make_float (bignum_to_double (scratch_bignum)) :
1090 Fcanonicalize_number (make_bignum_bg (scratch_bignum)); 1089 Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1110 int return_float) 1109 int return_float)
1111 { 1110 {
1112 Lisp_Object res0, res1; 1111 Lisp_Object res0, res1;
1113 1112
1114 if (ratio_sign (XRATIO_DATA (divisor)) == 0) 1113 if (ratio_sign (XRATIO_DATA (divisor)) == 0)
1115 { 1114 return arith_error2 ("ceiling", number, divisor);
1116 Fsignal (Qarith_error, Qnil);
1117 }
1118 1115
1119 ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor)); 1116 ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor));
1120 1117
1121 bignum_ceil (scratch_bignum, ratio_numerator (scratch_ratio), 1118 bignum_ceil (scratch_bignum, ratio_numerator (scratch_ratio),
1122 ratio_denominator (scratch_ratio)); 1119 ratio_denominator (scratch_ratio));
1147 int return_float) 1144 int return_float)
1148 { 1145 {
1149 Lisp_Object res0; 1146 Lisp_Object res0;
1150 1147
1151 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0) 1148 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
1152 { 1149 return arith_error2 ("ceiling", number, divisor);
1153 Fsignal (Qarith_error, Qnil);
1154 }
1155 1150
1156 bigfloat_set_prec (scratch_bigfloat, max (XBIGFLOAT_GET_PREC (number), 1151 bigfloat_set_prec (scratch_bigfloat, max (XBIGFLOAT_GET_PREC (number),
1157 XBIGFLOAT_GET_PREC (divisor))); 1152 XBIGFLOAT_GET_PREC (divisor)));
1158 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number), 1153 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number),
1159 XBIGFLOAT_DATA (divisor)); 1154 XBIGFLOAT_DATA (divisor));
1246 { 1241 {
1247 double f1 = extract_float (number); 1242 double f1 = extract_float (number);
1248 double f2 = extract_float (divisor); 1243 double f2 = extract_float (divisor);
1249 double f0, remain; 1244 double f0, remain;
1250 Lisp_Object res0; 1245 Lisp_Object res0;
1251 1246
1252 if (f2 == 0.0) 1247 if (f2 == 0.0)
1253 { 1248 return arith_error2 ("ceiling", number, divisor);
1254 Fsignal (Qarith_error, Qnil); 1249
1255 }
1256
1257 IN_FLOAT2 (f0 = ceil (f1 / f2), MAYBE_EFF("ceiling"), number, divisor); 1250 IN_FLOAT2 (f0 = ceil (f1 / f2), MAYBE_EFF("ceiling"), number, divisor);
1258 IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF("ceiling"), number, divisor); 1251 IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF("ceiling"), number, divisor);
1259 1252
1260 if (return_float) 1253 if (return_float)
1261 { 1254 {
1304 return values2 (make_float ((double) XINT (number)), Qzero); 1297 return values2 (make_float ((double) XINT (number)), Qzero);
1305 } 1298 }
1306 #ifdef HAVE_BIGNUM 1299 #ifdef HAVE_BIGNUM
1307 else if (BIGNUMP (number)) 1300 else if (BIGNUMP (number))
1308 { 1301 {
1309 return values2 (make_float 1302 return values2 (make_float
1310 (bignum_to_double (XBIGNUM_DATA (number))), 1303 (bignum_to_double (XBIGNUM_DATA (number))),
1311 Qzero); 1304 Qzero);
1312 } 1305 }
1313 #endif 1306 #endif
1314 } 1307 }
1321 #endif 1314 #endif
1322 { 1315 {
1323 return values2 (number, Qzero); 1316 return values2 (number, Qzero);
1324 } 1317 }
1325 } 1318 }
1326 1319
1327 MAYBE_CHAR_OR_MARKER (ceiling); 1320 MAYBE_CHAR_OR_MARKER (ceiling);
1328 1321
1329 return Ffceiling (wrong_type_argument (Qnumberp, number), divisor); 1322 return Ffceiling (wrong_type_argument (Qnumberp, number), divisor);
1330 } 1323 }
1331 1324
1337 EMACS_INT i2 = XREALINT (divisor); 1330 EMACS_INT i2 = XREALINT (divisor);
1338 EMACS_INT i3 = 0, i4 = 0; 1331 EMACS_INT i3 = 0, i4 = 0;
1339 Lisp_Object res0; 1332 Lisp_Object res0;
1340 1333
1341 if (i2 == 0) 1334 if (i2 == 0)
1342 { 1335 return arith_error2 ("floor", number, divisor);
1343 Fsignal (Qarith_error, Qnil);
1344 }
1345 1336
1346 /* With C89's integer /, the result is implementation-defined if either 1337 /* With C89's integer /, the result is implementation-defined if either
1347 operand is negative, so use only nonnegative operands. Notice also that 1338 operand is negative, so use only nonnegative operands. Notice also that
1348 we're forcing the quotient of any negative numbers towards minus 1339 we're forcing the quotient of any negative numbers towards minus
1349 infinity. */ 1340 infinity. */
1371 int return_float) 1362 int return_float)
1372 { 1363 {
1373 Lisp_Object res0, res1; 1364 Lisp_Object res0, res1;
1374 1365
1375 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0) 1366 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
1376 { 1367 return arith_error2 ("floor", number, divisor);
1377 Fsignal (Qarith_error, Qnil);
1378 }
1379 1368
1380 bignum_floor (scratch_bignum, XBIGNUM_DATA (number), 1369 bignum_floor (scratch_bignum, XBIGNUM_DATA (number),
1381 XBIGNUM_DATA (divisor)); 1370 XBIGNUM_DATA (divisor));
1382 1371
1383 if (return_float) 1372 if (return_float)
1410 int return_float) 1399 int return_float)
1411 { 1400 {
1412 Lisp_Object res0, res1; 1401 Lisp_Object res0, res1;
1413 1402
1414 if (ratio_sign (XRATIO_DATA (divisor)) == 0) 1403 if (ratio_sign (XRATIO_DATA (divisor)) == 0)
1415 { 1404 return arith_error2 ("floor", number, divisor);
1416 Fsignal (Qarith_error, Qnil);
1417 }
1418 1405
1419 ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor)); 1406 ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor));
1420 1407
1421 bignum_floor (scratch_bignum, ratio_numerator (scratch_ratio), 1408 bignum_floor (scratch_bignum, ratio_numerator (scratch_ratio),
1422 ratio_denominator (scratch_ratio)); 1409 ratio_denominator (scratch_ratio));
1447 int return_float) 1434 int return_float)
1448 { 1435 {
1449 Lisp_Object res0; 1436 Lisp_Object res0;
1450 1437
1451 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0) 1438 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
1452 { 1439 return arith_error2 ("floor", number, divisor);
1453 Fsignal (Qarith_error, Qnil);
1454 }
1455 1440
1456 bigfloat_set_prec (scratch_bigfloat, max (XBIGFLOAT_GET_PREC (number), 1441 bigfloat_set_prec (scratch_bigfloat, max (XBIGFLOAT_GET_PREC (number),
1457 XBIGFLOAT_GET_PREC (divisor))); 1442 XBIGFLOAT_GET_PREC (divisor)));
1458 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number), 1443 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number),
1459 XBIGFLOAT_DATA (divisor)); 1444 XBIGFLOAT_DATA (divisor));
1544 int return_float) 1529 int return_float)
1545 { 1530 {
1546 double f1 = extract_float (number); 1531 double f1 = extract_float (number);
1547 double f2 = extract_float (divisor); 1532 double f2 = extract_float (divisor);
1548 double f0, remain; 1533 double f0, remain;
1549 1534
1550 if (f2 == 0.0) 1535 if (f2 == 0.0)
1551 { 1536 return arith_error2 ("floor", number, divisor);
1552 Fsignal (Qarith_error, Qnil); 1537
1553 }
1554
1555 IN_FLOAT2 (f0 = floor (f1 / f2), MAYBE_EFF ("floor"), number, divisor); 1538 IN_FLOAT2 (f0 = floor (f1 / f2), MAYBE_EFF ("floor"), number, divisor);
1556 IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF ("floor"), number, divisor); 1539 IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF ("floor"), number, divisor);
1557 1540
1558 if (return_float) 1541 if (return_float)
1559 { 1542 {
1619 } 1602 }
1620 1603
1621 /* Algorithm taken from cl-extra.el, now to be found as cl-round in 1604 /* Algorithm taken from cl-extra.el, now to be found as cl-round in
1622 tests/automated/lisp-tests.el. */ 1605 tests/automated/lisp-tests.el. */
1623 static Lisp_Object 1606 static Lisp_Object
1624 round_two_fixnum (Lisp_Object number, Lisp_Object divisor, 1607 round_two_fixnum (Lisp_Object number, Lisp_Object divisor, int return_float)
1625 int return_float)
1626 { 1608 {
1627 EMACS_INT i1 = XREALINT (number); 1609 EMACS_INT i1 = XREALINT (number);
1628 EMACS_INT i2 = XREALINT (divisor); 1610 EMACS_INT i2 = XREALINT (divisor);
1629 EMACS_INT i0, hi2, flooring, floored, flsecond; 1611 EMACS_INT i0, hi2, flooring, floored, flsecond;
1630 1612
1631 if (i2 == 0) 1613 if (i2 == 0)
1632 { 1614 return arith_error2 ("round", number, divisor);
1633 Fsignal (Qarith_error, Qnil);
1634 }
1635 1615
1636 hi2 = i2 < 0 ? -( -i2 / 2) : i2 / 2; 1616 hi2 = i2 < 0 ? -( -i2 / 2) : i2 / 2;
1637 1617
1638 flooring = hi2 + i1; 1618 flooring = hi2 + i1;
1639 1619
1714 *remain = make_bignum_bg (scratch_bignum); 1694 *remain = make_bignum_bg (scratch_bignum);
1715 } 1695 }
1716 } 1696 }
1717 1697
1718 static Lisp_Object 1698 static Lisp_Object
1719 round_two_bignum (Lisp_Object number, Lisp_Object divisor, 1699 round_two_bignum (Lisp_Object number, Lisp_Object divisor, int return_float)
1720 int return_float)
1721 { 1700 {
1722 Lisp_Object res0, res1; 1701 Lisp_Object res0, res1;
1723 1702
1724 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0) 1703 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
1725 { 1704 return arith_error2 ("round", number, divisor);
1726 Fsignal (Qarith_error, Qnil);
1727 }
1728 1705
1729 round_two_bignum_1 (XBIGNUM_DATA (number), XBIGNUM_DATA (divisor), 1706 round_two_bignum_1 (XBIGNUM_DATA (number), XBIGNUM_DATA (divisor),
1730 &res0, &res1); 1707 &res0, &res1);
1731 1708
1732 if (return_float) 1709 if (return_float)
1748 int return_float) 1725 int return_float)
1749 { 1726 {
1750 Lisp_Object res0, res1; 1727 Lisp_Object res0, res1;
1751 1728
1752 if (ratio_sign (XRATIO_DATA (divisor)) == 0) 1729 if (ratio_sign (XRATIO_DATA (divisor)) == 0)
1753 { 1730 return arith_error2 ("round", number, divisor);
1754 Fsignal (Qarith_error, Qnil);
1755 }
1756 1731
1757 ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor)); 1732 ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor));
1758 1733
1759 round_two_bignum_1 (ratio_numerator (scratch_ratio), 1734 round_two_bignum_1 (ratio_numerator (scratch_ratio),
1760 ratio_denominator (scratch_ratio), &res0, &res1); 1735 ratio_denominator (scratch_ratio), &res0, &res1);
1761 1736
1762 if (!ZEROP (res1)) 1737 if (!ZEROP (res1))
1763 { 1738 {
1764 /* The numerator and denominator don't round exactly, calculate a 1739 /* The numerator and denominator don't round exactly, calculate a
1765 ratio remainder: */ 1740 ratio remainder: */
1766 ratio_set_bignum (scratch_ratio2, XBIGNUM_DATA (res0)); 1741 ratio_set_bignum (scratch_ratio2, XBIGNUM_DATA (res0));
1767 ratio_mul (scratch_ratio, scratch_ratio2, XRATIO_DATA (divisor)); 1742 ratio_mul (scratch_ratio, scratch_ratio2, XRATIO_DATA (divisor));
1768 ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio); 1743 ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio);
1769 1744
1770 res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio)); 1745 res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio));
1771 } 1746 }
1772 1747
1773 res0 = return_float ? 1748 res0 = return_float ?
1774 make_float ((double)bignum_to_double(XBIGNUM_DATA (res0))) : 1749 make_float ((double)bignum_to_double(XBIGNUM_DATA (res0))) :
1851 1826
1852 unsigned long prec = max (XBIGFLOAT_GET_PREC (number), 1827 unsigned long prec = max (XBIGFLOAT_GET_PREC (number),
1853 XBIGFLOAT_GET_PREC (divisor)); 1828 XBIGFLOAT_GET_PREC (divisor));
1854 1829
1855 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0) 1830 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
1856 { 1831 return arith_error2 ("round", number, divisor);
1857 Fsignal (Qarith_error, Qnil);
1858 }
1859 1832
1860 bigfloat_init (divided); 1833 bigfloat_init (divided);
1861 bigfloat_set_prec (divided, prec); 1834 bigfloat_set_prec (divided, prec);
1862 1835
1863 bigfloat_div (divided, XBIGFLOAT_DATA (number), XBIGFLOAT_DATA (divisor)); 1836 bigfloat_div (divided, XBIGFLOAT_DATA (number), XBIGFLOAT_DATA (divisor));
1864 1837
1865 res0 = round_one_bigfloat_1 (divided); 1838 res0 = round_one_bigfloat_1 (divided);
1866 1839
1867 bigfloat_set_prec (scratch_bigfloat, prec); 1840 bigfloat_set_prec (scratch_bigfloat, prec);
1868 bigfloat_set_prec (scratch_bigfloat2, prec); 1841 bigfloat_set_prec (scratch_bigfloat2, prec);
1869 1842
1870 bigfloat_mul (scratch_bigfloat, XBIGFLOAT_DATA (res0), 1843 bigfloat_mul (scratch_bigfloat, XBIGFLOAT_DATA (res0),
1871 XBIGFLOAT_DATA (divisor)); 1844 XBIGFLOAT_DATA (divisor));
1872 bigfloat_sub (scratch_bigfloat2, XBIGFLOAT_DATA (number), 1845 bigfloat_sub (scratch_bigfloat2, XBIGFLOAT_DATA (number),
1873 scratch_bigfloat); 1846 scratch_bigfloat);
1874 1847
1919 int return_float) 1892 int return_float)
1920 { 1893 {
1921 Lisp_Object res0 = round_one_bigfloat_1 (XBIGFLOAT_DATA (number)); 1894 Lisp_Object res0 = round_one_bigfloat_1 (XBIGFLOAT_DATA (number));
1922 Lisp_Object res1; 1895 Lisp_Object res1;
1923 1896
1924 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number), 1897 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number),
1925 XBIGFLOAT_DATA (res0)); 1898 XBIGFLOAT_DATA (res0));
1926 1899
1927 res1 = make_bigfloat_bf (scratch_bigfloat); 1900 res1 = make_bigfloat_bf (scratch_bigfloat);
1928 1901
1929 if (!return_float) 1902 if (!return_float)
1946 int return_float) 1919 int return_float)
1947 { 1920 {
1948 double f1 = extract_float (number); 1921 double f1 = extract_float (number);
1949 double f2 = extract_float (divisor); 1922 double f2 = extract_float (divisor);
1950 double f0, remain; 1923 double f0, remain;
1951 1924
1952 if (f2 == 0.0) 1925 if (f2 == 0.0)
1953 Fsignal (Qarith_error, Qnil); 1926 return arith_error2 ("round", number, divisor);
1954 1927
1955 IN_FLOAT2 ((f0 = emacs_rint (f1 / f2)), MAYBE_EFF ("round"), number, 1928 IN_FLOAT2 ((f0 = emacs_rint (f1 / f2)), MAYBE_EFF ("round"), number,
1956 divisor); 1929 divisor);
1957 IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF ("round"), number, divisor); 1930 IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF ("round"), number, divisor);
1958 1931
1959 if (return_float) 1932 if (return_float)
1960 { 1933 {
1961 return values2 (make_float (f0), make_float (remain)); 1934 return values2 (make_float (f0), make_float (remain));
1971 round_one_float (Lisp_Object number, int return_float) 1944 round_one_float (Lisp_Object number, int return_float)
1972 { 1945 {
1973 double d; 1946 double d;
1974 /* Screw the prevailing rounding mode. */ 1947 /* Screw the prevailing rounding mode. */
1975 IN_FLOAT ((d = emacs_rint (XFLOAT_DATA (number))), MAYBE_EFF ("round"), 1948 IN_FLOAT ((d = emacs_rint (XFLOAT_DATA (number))), MAYBE_EFF ("round"),
1976 number); 1949 number);
1977 1950
1978 if (return_float) 1951 if (return_float)
1979 { 1952 {
1980 return values2 (make_float (d), make_float (XFLOAT_DATA (number) - d)); 1953 return values2 (make_float (d), make_float (XFLOAT_DATA (number) - d));
1981 } 1954 }
1982 else 1955 else
1983 { 1956 {
1984 return values2 ((float_to_int (d, MAYBE_EFF ("round"), number, 1957 return values2 ((float_to_int (d, MAYBE_EFF ("round"), number,
1985 Qunbound)), 1958 Qunbound)),
1986 make_float (XFLOAT_DATA (number) - d)); 1959 make_float (XFLOAT_DATA (number) - d));
1987 } 1960 }
1988 } 1961 }
1989 1962
1990 EXFUN (Fround, 2); 1963 EXFUN (Fround, 2);
2012 1985
2013 MAYBE_CHAR_OR_MARKER (round); 1986 MAYBE_CHAR_OR_MARKER (round);
2014 1987
2015 if (return_float) 1988 if (return_float)
2016 { 1989 {
2017 return Ffround (wrong_type_argument (Qnumberp, number), divisor); 1990 return Ffround (wrong_type_argument (Qnumberp, number), divisor);
2018 } 1991 }
2019 else 1992 else
2020 { 1993 {
2021 return Fround (wrong_type_argument (Qnumberp, number), divisor); 1994 return Fround (wrong_type_argument (Qnumberp, number), divisor);
2022 } 1995 }
2023 } 1996 }
2024 1997
2025 static Lisp_Object 1998 static Lisp_Object
2026 truncate_two_fixnum (Lisp_Object number, Lisp_Object divisor, 1999 truncate_two_fixnum (Lisp_Object number, Lisp_Object divisor,
2029 EMACS_INT i1 = XREALINT (number); 2002 EMACS_INT i1 = XREALINT (number);
2030 EMACS_INT i2 = XREALINT (divisor); 2003 EMACS_INT i2 = XREALINT (divisor);
2031 EMACS_INT i0; 2004 EMACS_INT i0;
2032 2005
2033 if (i2 == 0) 2006 if (i2 == 0)
2034 Fsignal (Qarith_error, Qnil); 2007 return arith_error2 ("truncate", number, divisor);
2035 2008
2036 /* We're truncating towards zero, so apart from avoiding the C89 2009 /* We're truncating towards zero, so apart from avoiding the C89
2037 implementation-defined behaviour with truncation and negative numbers, 2010 implementation-defined behaviour with truncation and negative numbers,
2038 we don't need to do anything further: */ 2011 we don't need to do anything further: */
2039 i0 = (i2 < 0 2012 i0 = (i2 < 0
2056 int return_float) 2029 int return_float)
2057 { 2030 {
2058 Lisp_Object res0; 2031 Lisp_Object res0;
2059 2032
2060 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0) 2033 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
2061 { 2034 return arith_error2 ("truncate", number, divisor);
2062 Fsignal (Qarith_error, Qnil);
2063 }
2064 2035
2065 bignum_div (scratch_bignum, XBIGNUM_DATA (number), 2036 bignum_div (scratch_bignum, XBIGNUM_DATA (number),
2066 XBIGNUM_DATA (divisor)); 2037 XBIGNUM_DATA (divisor));
2067 2038
2068 if (return_float) 2039 if (return_float)
2094 int return_float) 2065 int return_float)
2095 { 2066 {
2096 Lisp_Object res0; 2067 Lisp_Object res0;
2097 2068
2098 if (ratio_sign (XRATIO_DATA (divisor)) == 0) 2069 if (ratio_sign (XRATIO_DATA (divisor)) == 0)
2099 { 2070 return arith_error2 ("truncate", number, divisor);
2100 Fsignal (Qarith_error, Qnil);
2101 }
2102 2071
2103 ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor)); 2072 ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor));
2104 2073
2105 bignum_div (scratch_bignum, ratio_numerator (scratch_ratio), 2074 bignum_div (scratch_bignum, ratio_numerator (scratch_ratio),
2106 ratio_denominator (scratch_ratio)); 2075 ratio_denominator (scratch_ratio));
2136 Lisp_Object res0; 2105 Lisp_Object res0;
2137 unsigned long prec = max (XBIGFLOAT_GET_PREC (number), 2106 unsigned long prec = max (XBIGFLOAT_GET_PREC (number),
2138 XBIGFLOAT_GET_PREC (divisor)); 2107 XBIGFLOAT_GET_PREC (divisor));
2139 2108
2140 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0) 2109 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
2141 { 2110 return arith_error2 ("truncate", number, divisor);
2142 Fsignal (Qarith_error, Qnil);
2143 }
2144 2111
2145 bigfloat_set_prec (scratch_bigfloat, prec); 2112 bigfloat_set_prec (scratch_bigfloat, prec);
2146 bigfloat_set_prec (scratch_bigfloat2, prec); 2113 bigfloat_set_prec (scratch_bigfloat2, prec);
2147 2114
2148 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number), 2115 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number),
2160 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum)); 2127 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
2161 #else 2128 #else
2162 res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat)); 2129 res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
2163 #endif /* HAVE_BIGNUM */ 2130 #endif /* HAVE_BIGNUM */
2164 } 2131 }
2165 2132
2166 bigfloat_mul (scratch_bigfloat2, scratch_bigfloat, XBIGFLOAT_DATA (divisor)); 2133 bigfloat_mul (scratch_bigfloat2, scratch_bigfloat, XBIGFLOAT_DATA (divisor));
2167 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number), scratch_bigfloat2); 2134 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number), scratch_bigfloat2);
2168 2135
2169 return values2 (res0, make_bigfloat_bf (scratch_bigfloat)); 2136 return values2 (res0, make_bigfloat_bf (scratch_bigfloat));
2170 } 2137 }
2176 int return_float) 2143 int return_float)
2177 { 2144 {
2178 Lisp_Object res0; 2145 Lisp_Object res0;
2179 2146
2180 if (ratio_sign (XRATIO_DATA (number)) == 0) 2147 if (ratio_sign (XRATIO_DATA (number)) == 0)
2181 { 2148 return Qzero;
2182 Fsignal (Qarith_error, Qnil);
2183 }
2184 2149
2185 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number), 2150 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number),
2186 XRATIO_DENOMINATOR (number)); 2151 XRATIO_DENOMINATOR (number));
2187 if (return_float) 2152 if (return_float)
2188 { 2153 {
2232 } 2197 }
2233 2198
2234 bigfloat_sub (scratch_bigfloat2, XBIGFLOAT_DATA (number), scratch_bigfloat); 2199 bigfloat_sub (scratch_bigfloat2, XBIGFLOAT_DATA (number), scratch_bigfloat);
2235 2200
2236 return 2201 return
2237 values2 (res0, 2202 values2 (res0,
2238 Fcanonicalize_number (make_bigfloat_bf (scratch_bigfloat2))); 2203 Fcanonicalize_number (make_bigfloat_bf (scratch_bigfloat2)));
2239 } 2204 }
2240 #endif /* HAVE_BIGFLOAT */ 2205 #endif /* HAVE_BIGFLOAT */
2241 2206
2242 static Lisp_Object 2207 static Lisp_Object
2245 { 2210 {
2246 double f1 = extract_float (number); 2211 double f1 = extract_float (number);
2247 double f2 = extract_float (divisor); 2212 double f2 = extract_float (divisor);
2248 double f0, remain; 2213 double f0, remain;
2249 Lisp_Object res0; 2214 Lisp_Object res0;
2250 2215
2251 if (f2 == 0.0) 2216 if (f2 == 0.0)
2252 { 2217 return arith_error2 ("truncate", number, divisor);
2253 Fsignal (Qarith_error, Qnil);
2254 }
2255 2218
2256 res0 = float_to_int (f1 / f2, MAYBE_EFF ("truncate"), number, Qunbound); 2219 res0 = float_to_int (f1 / f2, MAYBE_EFF ("truncate"), number, Qunbound);
2257 f0 = extract_float (res0); 2220 f0 = extract_float (res0);
2258 2221
2259 IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF ("truncate"), number, divisor); 2222 IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF ("truncate"), number, divisor);
2323 2286
2324 DEFUN ("ceiling", Fceiling, 1, 2, 0, /* 2287 DEFUN ("ceiling", Fceiling, 1, 2, 0, /*
2325 Return the smallest integer no less than NUMBER. (Round toward +inf.) 2288 Return the smallest integer no less than NUMBER. (Round toward +inf.)
2326 2289
2327 With optional argument DIVISOR, return the smallest integer no less than 2290 With optional argument DIVISOR, return the smallest integer no less than
2328 the quotient of NUMBER and DIVISOR. 2291 the quotient of NUMBER and DIVISOR.
2329 2292
2330 This function returns multiple values; see `multiple-value-bind' and 2293 This function returns multiple values; see `multiple-value-bind' and
2331 `multiple-value-call'. The second returned value is the remainder in the 2294 `multiple-value-call'. The second returned value is the remainder in the
2332 calculation, which will be one minus the fractional part of NUMBER if DIVISOR 2295 calculation, which will be one minus the fractional part of NUMBER if DIVISOR
2333 is omitted or one. 2296 is omitted or one.