Mercurial > hg > xemacs-beta

comparison src/floatfns.c @ 5118:e0db3c197671 ben-lisp-object

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge up to latest default branch, doesn't compile yet
author Ben Wing <ben@xemacs.org>
date Sat, 26 Dec 2009 21:18:49 -0600
parents 3742ea8250b5 fcc7e89d5e68
children 623d57b7fbe8
comparison
equal deleted inserted replaced
5117:3742ea8250b5 5118:e0db3c197671
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) \
194 196
195 static const struct memory_description float_description[] = { 197 static const struct memory_description float_description[] = {
196 { XD_END } 198 { XD_END }
197 }; 199 };
198 200
199 DEFINE_BASIC_LISP_OBJECT ("float", float, 201 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("float", float,
200 mark_float, print_float, 0, float_equal, 202 mark_float, print_float, 0, float_equal,
201 float_hash, float_description, 203 float_hash, float_description,
202 Lisp_Float); 204 Lisp_Float);
203 205
204 /* Extract a Lisp number as a `double', or signal an error. */ 206 /* Extract a Lisp number as a `double', or signal an error. */
766 { 768 {
767 if (INTP (number)) 769 if (INTP (number))
768 return make_float ((double) XINT (number)); 770 return make_float ((double) XINT (number));
769 771
770 #ifdef HAVE_BIGNUM 772 #ifdef HAVE_BIGNUM
771 if (BIGFLOATP (number)) 773 if (BIGNUMP (number))
772 { 774 {
773 #ifdef HAVE_BIGFLOAT 775 #ifdef HAVE_BIGFLOAT
774 if (ZEROP (Vdefault_float_precision)) 776 if (ZEROP (Vdefault_float_precision))
775 #endif 777 #endif
776 return make_float (bignum_to_double (XBIGNUM_DATA (number))); 778 return make_float (bignum_to_double (XBIGNUM_DATA (number)));
845 } 847 }
846 #endif /* ! HAVE_FREXP */ 848 #endif /* ! HAVE_FREXP */
847 #endif /* ! HAVE_LOGB */ 849 #endif /* ! HAVE_LOGB */
848 } 850 }
849 851
850 DEFUN ("ceiling", Fceiling, 1, 1, 0, /* 852 #ifdef WITH_NUMBER_TYPES
851 Return the smallest integer no less than NUMBER. (Round toward +inf.) 853 #define ROUNDING_CONVERT(conversion, return_float) \
852 */ 854 CONVERT_WITH_NUMBER_TYPES(conversion, return_float)
853 (number)) 855 #else
854 { 856 #define ROUNDING_CONVERT(conversion, return_float) \
855 if (FLOATP (number)) 857 CONVERT_WITHOUT_NUMBER_TYPES(conversion, return_float)
856 { 858 #endif
857 double d; 859
858 IN_FLOAT ((d = ceil (XFLOAT_DATA (number))), "ceiling", number); 860 #define CONVERT_WITH_NUMBER_TYPES(conversion, return_float) \
859 return (float_to_int (d, "ceiling", number, Qunbound)); 861 if (!NILP (divisor)) \
860 } 862 { \
861 863 switch (promote_args (&number, &divisor)) \
864 { \
865 case FIXNUM_T: \
866 return conversion##_two_fixnum (number, divisor, \
867 return_float); \
868 MAYBE_TWO_ARGS_WITH_NUMBER_TYPES (conversion, \
869 BIGNUM, \
870 return_float); \
871 MAYBE_TWO_ARGS_WITH_NUMBER_TYPES (conversion, \
872 RATIO, \
873 return_float); \
874 MAYBE_TWO_ARGS_WITH_NUMBER_TYPES (conversion, \
875 BIGFLOAT, \
876 return_float); \
877 default: /* FLOAT_T */ \
878 return conversion##_two_float (number,divisor, \
879 return_float); \
880 } \
881 } \
882 \
883 /* Try this first, the arg is probably a float: */ \
884 if (FLOATP (number)) \
885 return conversion##_one_float (number, return_float); \
886 \
887 MAYBE_ONE_ARG_WITH_NUMBER_TYPES (conversion, \
888 RATIO, return_float); \
889 MAYBE_ONE_ARG_WITH_NUMBER_TYPES (conversion, \
890 BIGFLOAT, return_float); \
891 return conversion##_one_mundane_arg (number, divisor, \
892 return_float)
893
894 #define CONVERT_WITHOUT_NUMBER_TYPES(conversion, return_float) \
895 if (!NILP (divisor)) \
896 { \
897 /* The promote_args call if number types are available \
898 does these conversions, we do them too for symmetry: */\
899 if (CHARP (number)) \
900 { \
901 number = make_int (XCHAR (number)); \
902 } \
903 else if (MARKERP (number)) \
904 { \
905 number = make_int (marker_position (number)); \
906 } \
907 \
908 if (CHARP (divisor)) \
909 { \
910 divisor = make_int (XCHAR (divisor)); \
911 } \
912 else if (MARKERP (divisor)) \
913 { \
914 divisor = make_int (marker_position (divisor)); \
915 } \
916 \
917 CHECK_INT_OR_FLOAT (divisor); \
918 if (INTP (number) && INTP (divisor)) \
919 { \
920 return conversion##_two_fixnum (number, divisor, \
921 return_float); \
922 } \
923 else \
924 { \
925 return conversion##_two_float (number, divisor, \
926 return_float); \
927 } \
928 } \
929 \
930 /* Try this first, the arg is probably a float: */ \
931 if (FLOATP (number)) \
932 return conversion##_one_float (number, return_float); \
933 \
934 return conversion##_one_mundane_arg (number, divisor, \
935 return_float) \
936
937 #ifdef WITH_NUMBER_TYPES
938
939 #ifdef HAVE_BIGNUM
940 #define MAYBE_TWO_ARGS_BIGNUM(conversion, return_float) \
941 case BIGNUM_T: \
942 return conversion##_two_bignum (number, divisor, return_float)
943
944 #define MAYBE_ONE_ARG_BIGNUM(converse, return_float) \
945 if (BIGNUM_P (number)) \
946 return conversion##_one_bignum (number, divisor, return_float)
947 #else
948 #define MAYBE_TWO_ARGS_BIGNUM(conversion, return_float)
949 #define MAYBE_ONE_ARG_BIGNUM(converse, return_float)
950 #endif
951
952 #ifdef HAVE_RATIO
953 #define MAYBE_TWO_ARGS_RATIO(conversion, return_float) \
954 case RATIO_T: \
955 return conversion##_two_ratio (number, divisor, return_float)
956
957 #define MAYBE_ONE_ARG_RATIO(conversion, return_float) \
958 if (RATIOP (number)) \
959 return conversion##_one_ratio (number, divisor, return_float)
960 #else
961 #define MAYBE_TWO_ARGS_RATIO(conversion, return_float)
962 #define MAYBE_ONE_ARG_RATIO(converse, return_float)
963 #endif
964
965 #ifdef HAVE_BIGFLOAT
966 #define MAYBE_TWO_ARGS_BIGFLOAT(conversion, return_float) \
967 case BIGFLOAT_T: \
968 return conversion##_two_bigfloat (number, divisor, return_float)
969
970 #define MAYBE_ONE_ARG_BIGFLOAT(conversion, return_float) \
971 if (BIGFLOATP (number)) \
972 return conversion##_one_bigfloat (number, divisor, return_float)
973 #else
974 #define MAYBE_TWO_ARGS_BIGFLOAT(conversion, return_float)
975 #define MAYBE_ONE_ARG_BIGFLOAT(converse, return_float)
976 #endif
977
978 #define MAYBE_TWO_ARGS_WITH_NUMBER_TYPES(convers, upcase, return_float) \
979 MAYBE_TWO_ARGS_##upcase(convers, return_float)
980
981 #define MAYBE_ONE_ARG_WITH_NUMBER_TYPES(convers, upcase, return_float) \
982 MAYBE_ONE_ARG_##upcase(convers, return_float)
983
984 #endif /* WITH_NUMBER_TYPES */
985
986 #define MAYBE_EFF(str) (return_float ? "f" str : str)
987
988 /* The WITH_NUMBER_TYPES code calls promote_args, which accepts chars and
989 markers as equivalent to ints. This block does the same for
990 single-argument calls. */
991 #define MAYBE_CHAR_OR_MARKER(conversion) do { \
992 if (CHARP (number)) \
993 { \
994 return conversion##_one_mundane_arg (make_int (XCHAR (number)), \
995 divisor, return_float); \
996 } \
997 \
998 if (MARKERP (number)) \
999 { \
1000 return conversion##_one_mundane_arg (make_int \
1001 (marker_position(number)), \
1002 divisor, return_float); \
1003 } \
1004 } while (0)
1005
1006
1007 /* The guts of the implementations of the various rounding functions: */
1008
1009 static Lisp_Object
1010 ceiling_two_fixnum (Lisp_Object number, Lisp_Object divisor,
1011 int return_float)
1012 {
1013 EMACS_INT i1 = XREALINT (number);
1014 EMACS_INT i2 = XREALINT (divisor);
1015 EMACS_INT i3 = 0, i4 = 0;
1016
1017 if (i2 == 0)
1018 return arith_error2 ("ceiling", number, divisor);
1019
1020 /* With C89's integer /, the result is implementation-defined if either
1021 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 non-negative case: */
1024
1025 /* Make sure we use the same signs for the modulus calculation as for the
1026 quotient calculation: */
1027 if (i2 < 0)
1028 {
1029 if (i1 <= 0)
1030 {
1031 i3 = -i1 / -i2;
1032 /* Quotient is positive; add one to give the figure for
1033 ceiling. */
1034 if (0 != (-i1 % -i2))
1035 {
1036 ++i3;
1037 }
1038 }
1039 else
1040 {
1041 /* Quotient is negative; no need to add one. */
1042 i3 = -(i1 / -i2);
1043 }
1044 }
1045 else
1046 {
1047 if (i1 < 0)
1048 {
1049 /* Quotient is negative; no need to add one. */
1050 i3 = -(-i1 / i2);
1051 }
1052 else
1053 {
1054 i3 = i1 / i2;
1055 /* Quotient is positive; add one to give the figure for
1056 ceiling. */
1057 if (0 != (i1 % i2))
1058 {
1059 ++i3;
1060 }
1061 }
1062 }
1063
1064 i4 = i1 - (i3 * i2);
1065
1066 if (!return_float)
1067 {
1068 return values2 (make_int (i3), make_int (i4));
1069 }
1070
1071 return values2 (make_float ((double)i3),
1072 make_int (i4));
1073 }
1074
1075 #ifdef HAVE_BIGNUM
1076 static Lisp_Object
1077 ceiling_two_bignum (Lisp_Object number, Lisp_Object divisor,
1078 int return_float)
1079 {
1080 Lisp_Object res0, res1;
1081
1082 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
1083 return arith_error2 ("ceiling", number, divisor);
1084
1085 bignum_ceil (scratch_bignum, XBIGNUM_DATA (number), XBIGNUM_DATA (divisor));
1086
1087 res0 = return_float ? make_float (bignum_to_double (scratch_bignum)) :
1088 Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1089
1090 if (bignum_divisible_p (XBIGNUM_DATA (number), XBIGNUM_DATA (divisor)))
1091 {
1092 res1 = Qzero;
1093 }
1094 else
1095 {
1096 bignum_mul (scratch_bignum, scratch_bignum, XBIGNUM_DATA (divisor));
1097 bignum_sub (scratch_bignum, XBIGNUM_DATA (number), scratch_bignum);
1098 res1 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1099 }
1100
1101 return values2 (res0, res1);
1102 }
1103 #endif /* HAVE_BIGNUM */
1104
1105 #ifdef HAVE_RATIO
1106 static Lisp_Object
1107 ceiling_two_ratio (Lisp_Object number, Lisp_Object divisor,
1108 int return_float)
1109 {
1110 Lisp_Object res0, res1;
1111
1112 if (ratio_sign (XRATIO_DATA (divisor)) == 0)
1113 return arith_error2 ("ceiling", number, divisor);
1114
1115 ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor));
1116
1117 bignum_ceil (scratch_bignum, ratio_numerator (scratch_ratio),
1118 ratio_denominator (scratch_ratio));
1119
1120 res0 = return_float ? make_float (bignum_to_double (scratch_bignum)) :
1121 Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1122
1123 if (bignum_divisible_p (ratio_numerator (scratch_ratio),
1124 ratio_denominator (scratch_ratio)))
1125 {
1126 res1 = Qzero;
1127 }
1128 else
1129 {
1130 ratio_set_bignum (scratch_ratio, scratch_bignum);
1131 ratio_mul (scratch_ratio2, scratch_ratio, XRATIO_DATA (divisor));
1132 ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio2);
1133 res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio));
1134 }
1135
1136 return values2 (res0, res1);
1137 }
1138 #endif /* HAVE_RATIO */
1139
1140 #ifdef HAVE_BIGFLOAT
1141 static Lisp_Object
1142 ceiling_two_bigfloat (Lisp_Object number, Lisp_Object divisor,
1143 int return_float)
1144 {
1145 Lisp_Object res0;
1146
1147 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
1148 return arith_error2 ("ceiling", number, divisor);
1149
1150 bigfloat_set_prec (scratch_bigfloat, max (XBIGFLOAT_GET_PREC (number),
1151 XBIGFLOAT_GET_PREC (divisor)));
1152 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number),
1153 XBIGFLOAT_DATA (divisor));
1154 bigfloat_ceil (scratch_bigfloat, scratch_bigfloat);
1155
1156 if (return_float)
1157 {
1158 res0 = make_bigfloat_bf (scratch_bigfloat);
1159 }
1160 else
1161 {
1162 #ifdef HAVE_BIGNUM
1163 bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
1164 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1165 #else
1166 res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
1167 #endif /* HAVE_BIGNUM */
1168 }
1169
1170 bigfloat_mul (scratch_bigfloat, scratch_bigfloat, XBIGFLOAT_DATA (divisor));
1171 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number), scratch_bigfloat);
1172 return values2 (res0,
1173 Fcanonicalize_number (make_bigfloat_bf (scratch_bigfloat)));
1174 }
1175 #endif /* HAVE_BIGFLOAT */
1176
1177 #ifdef HAVE_RATIO
1178 static Lisp_Object
1179 ceiling_one_ratio (Lisp_Object number, Lisp_Object UNUSED (divisor),
1180 int return_float)
1181 {
1182 Lisp_Object res0, res1;
1183
1184 bignum_ceil (scratch_bignum, XRATIO_NUMERATOR (number),
1185 XRATIO_DENOMINATOR (number));
1186
1187 res0 = return_float ? make_float (bignum_to_double (scratch_bignum)) :
1188 Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1189
1190 if (bignum_divisible_p (XRATIO_NUMERATOR (number),
1191 XRATIO_DENOMINATOR (number)))
1192 {
1193 res1 = Qzero;
1194 }
1195 else
1196 {
1197 ratio_set_bignum (scratch_ratio2, scratch_bignum);
1198 ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio2);
1199 res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio));
1200 }
1201
1202 return values2 (res0, res1);
1203 }
1204 #endif /* HAVE_RATIO */
1205
1206 #ifdef HAVE_BIGFLOAT
1207 static Lisp_Object
1208 ceiling_one_bigfloat (Lisp_Object number, Lisp_Object UNUSED (divisor),
1209 int return_float)
1210 {
1211 Lisp_Object res0, res1;
1212
1213 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number));
1214 bigfloat_ceil (scratch_bigfloat, XBIGFLOAT_DATA (number));
1215
1216 if (return_float)
1217 {
1218 res0 = make_bigfloat_bf (scratch_bigfloat);
1219 }
1220 else
1221 {
1222 #ifdef HAVE_BIGNUM
1223 bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
1224 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1225 #else
1226 res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
1227 #endif /* HAVE_BIGNUM */
1228 }
1229
1230 bigfloat_sub (scratch_bigfloat2, XBIGFLOAT_DATA (number), scratch_bigfloat);
1231
1232 res1 = make_bigfloat_bf (scratch_bigfloat2);
1233 return values2 (res0, res1);
1234 }
1235 #endif /* HAVE_BIGFLOAT */
1236
1237 static Lisp_Object
1238 ceiling_two_float (Lisp_Object number, Lisp_Object divisor,
1239 int return_float)
1240 {
1241 double f1 = extract_float (number);
1242 double f2 = extract_float (divisor);
1243 double f0, remain;
1244 Lisp_Object res0;
1245
1246 if (f2 == 0.0)
1247 return arith_error2 ("ceiling", number, divisor);
1248
1249 IN_FLOAT2 (f0 = ceil (f1 / f2), MAYBE_EFF("ceiling"), number, divisor);
1250 IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF("ceiling"), number, divisor);
1251
1252 if (return_float)
1253 {
1254 res0 = make_float(f0);
1255 }
1256 else
1257 {
1258 res0 = float_to_int (f0, MAYBE_EFF("ceiling"), number, divisor);
1259 }
1260
1261 return values2 (res0, make_float (remain));
1262 }
1263
1264 static Lisp_Object
1265 ceiling_one_float (Lisp_Object number, int return_float)
1266 {
1267 double d, remain;
1268 Lisp_Object res0;
1269
1270 IN_FLOAT ((d = ceil (XFLOAT_DATA (number))), MAYBE_EFF("ceiling"), number);
1271 IN_FLOAT ((remain = XFLOAT_DATA (number) - d), MAYBE_EFF("ceiling"), number);
1272
1273 if (return_float)
1274 {
1275 res0 = make_float (d);
1276 }
1277 else
1278 {
1279 res0 = float_to_int (d, MAYBE_EFF("ceiling"), number, Qunbound);
1280 }
1281 return values2 (res0, make_float (remain));
1282 }
1283
1284 EXFUN (Fceiling, 2);
1285 EXFUN (Ffceiling, 2);
1286
1287 static Lisp_Object
1288 ceiling_one_mundane_arg (Lisp_Object number, Lisp_Object divisor,
1289 int return_float)
1290 {
1291
1292 if (return_float)
1293 {
1294 if (INTP (number))
1295 {
1296 return values2 (make_float ((double) XINT (number)), Qzero);
1297 }
1298 #ifdef HAVE_BIGNUM
1299 else if (BIGNUMP (number))
1300 {
1301 return values2 (make_float
1302 (bignum_to_double (XBIGNUM_DATA (number))),
1303 Qzero);
1304 }
1305 #endif
1306 }
1307 else
1308 {
1309 #ifdef HAVE_BIGNUM
1310 if (INTEGERP (number))
1311 #else
1312 if (INTP (number))
1313 #endif
1314 {
1315 return values2 (number, Qzero);
1316 }
1317 }
1318
1319 MAYBE_CHAR_OR_MARKER (ceiling);
1320
1321 return Ffceiling (wrong_type_argument (Qnumberp, number), divisor);
1322 }
1323
1324 static Lisp_Object
1325 floor_two_fixnum (Lisp_Object number, Lisp_Object divisor,
1326 int return_float)
1327 {
1328 EMACS_INT i1 = XREALINT (number);
1329 EMACS_INT i2 = XREALINT (divisor);
1330 EMACS_INT i3 = 0, i4 = 0;
1331 Lisp_Object res0;
1332
1333 if (i2 == 0)
1334 return arith_error2 ("floor", number, divisor);
1335
1336 /* With C89's integer /, the result is implementation-defined if either
1337 operand is negative, so use only nonnegative operands. Notice also that
1338 we're forcing the quotient of any negative numbers towards minus
1339 infinity. */
1340 i3 = (i2 < 0
1341 ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2))
1342 : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2));
1343
1344 i4 = i1 - (i3 * i2);
1345
1346 if (return_float)
1347 {
1348 res0 = make_float ((double)i3);
1349 }
1350 else
1351 {
1352 res0 = make_int (i3);
1353 }
1354
1355 return values2 (res0, make_int (i4));
1356 }
1357
1358 #ifdef HAVE_BIGNUM
1359 static Lisp_Object
1360 floor_two_bignum (Lisp_Object number, Lisp_Object divisor,
1361 int return_float)
1362 {
1363 Lisp_Object res0, res1;
1364
1365 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
1366 return arith_error2 ("floor", number, divisor);
1367
1368 bignum_floor (scratch_bignum, XBIGNUM_DATA (number),
1369 XBIGNUM_DATA (divisor));
1370
1371 if (return_float)
1372 {
1373 res0 = make_float (bignum_to_double (scratch_bignum));
1374 }
1375 else
1376 {
1377 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1378 }
1379
1380 if (bignum_divisible_p (XBIGNUM_DATA (number), XBIGNUM_DATA (divisor)))
1381 {
1382 res1 = Qzero;
1383 }
1384 else
1385 {
1386 bignum_mul (scratch_bignum, scratch_bignum, XBIGNUM_DATA (divisor));
1387 bignum_sub (scratch_bignum, XBIGNUM_DATA (number), scratch_bignum);
1388 res1 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1389 }
1390
1391 return values2 (res0, res1);
1392 }
1393 #endif /* HAVE_BIGNUM */
1394
1395 #ifdef HAVE_RATIO
1396 static Lisp_Object
1397 floor_two_ratio (Lisp_Object number, Lisp_Object divisor,
1398 int return_float)
1399 {
1400 Lisp_Object res0, res1;
1401
1402 if (ratio_sign (XRATIO_DATA (divisor)) == 0)
1403 return arith_error2 ("floor", number, divisor);
1404
1405 ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor));
1406
1407 bignum_floor (scratch_bignum, ratio_numerator (scratch_ratio),
1408 ratio_denominator (scratch_ratio));
1409
1410 res0 = return_float ? make_float (bignum_to_double (scratch_bignum)) :
1411 Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1412
1413 if (bignum_divisible_p (ratio_numerator (scratch_ratio),
1414 ratio_denominator (scratch_ratio)))
1415 {
1416 res1 = Qzero;
1417 }
1418 else
1419 {
1420 ratio_set_bignum (scratch_ratio, scratch_bignum);
1421 ratio_mul (scratch_ratio, scratch_ratio, XRATIO_DATA (divisor));
1422 ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio);
1423 res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio));
1424 }
1425
1426 return values2 (res0, res1);
1427 }
1428 #endif /* HAVE_RATIO */
1429
1430 #ifdef HAVE_BIGFLOAT
1431 static Lisp_Object
1432 floor_two_bigfloat (Lisp_Object number, Lisp_Object divisor,
1433 int return_float)
1434 {
1435 Lisp_Object res0;
1436
1437 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
1438 return arith_error2 ("floor", number, divisor);
1439
1440 bigfloat_set_prec (scratch_bigfloat, max (XBIGFLOAT_GET_PREC (number),
1441 XBIGFLOAT_GET_PREC (divisor)));
1442 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number),
1443 XBIGFLOAT_DATA (divisor));
1444 bigfloat_floor (scratch_bigfloat, scratch_bigfloat);
1445
1446 if (return_float)
1447 {
1448 res0 = make_bigfloat_bf (scratch_bigfloat);
1449 }
1450 else
1451 {
1452 #ifdef HAVE_BIGNUM
1453 bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
1454 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1455 #else
1456 res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
1457 #endif /* HAVE_BIGNUM */
1458 }
1459
1460 bigfloat_mul (scratch_bigfloat2, scratch_bigfloat,
1461 XBIGFLOAT_DATA (divisor));
1462 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number), scratch_bigfloat2);
1463
1464 return values2 (res0, make_bigfloat_bf (scratch_bigfloat));
1465 }
1466 #endif /* HAVE_BIGFLOAT */
1467
1468 #ifdef HAVE_RATIO
1469 static Lisp_Object
1470 floor_one_ratio (Lisp_Object number, Lisp_Object UNUSED (divisor),
1471 int return_float)
1472 {
1473 Lisp_Object res0, res1;
1474
1475 bignum_floor (scratch_bignum, XRATIO_NUMERATOR (number),
1476 XRATIO_DENOMINATOR (number));
1477
1478 res0 = return_float ? make_float (bignum_to_double (scratch_bignum)) :
1479 Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1480
1481 if (bignum_divisible_p (XRATIO_NUMERATOR (number),
1482 XRATIO_DENOMINATOR (number)))
1483 {
1484 res1 = Qzero;
1485 }
1486 else
1487 {
1488 ratio_set_bignum (scratch_ratio2, scratch_bignum);
1489 ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio2);
1490 res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio));
1491 }
1492
1493 return values2 (res0, res1);
1494 }
1495 #endif /* HAVE_RATIO */
1496
1497 #ifdef HAVE_BIGFLOAT
1498 static Lisp_Object
1499 floor_one_bigfloat (Lisp_Object number, Lisp_Object UNUSED (divisor),
1500 int return_float)
1501 {
1502 Lisp_Object res0;
1503
1504 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number));
1505 bigfloat_floor (scratch_bigfloat, XBIGFLOAT_DATA (number));
1506
1507 if (return_float)
1508 {
1509 res0 = make_bigfloat_bf (scratch_bigfloat);
1510 }
1511 else
1512 {
1513 #ifdef HAVE_BIGNUM
1514 bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
1515 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1516 #else
1517 res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
1518 #endif /* HAVE_BIGNUM */
1519 }
1520
1521 bigfloat_sub (scratch_bigfloat2, XBIGFLOAT_DATA (number), scratch_bigfloat);
1522 return values2 (res0, make_bigfloat_bf (scratch_bigfloat2));
1523 }
1524 #endif /* HAVE_BIGFLOAT */
1525
1526 static Lisp_Object
1527 floor_two_float (Lisp_Object number, Lisp_Object divisor,
1528 int return_float)
1529 {
1530 double f1 = extract_float (number);
1531 double f2 = extract_float (divisor);
1532 double f0, remain;
1533
1534 if (f2 == 0.0)
1535 return arith_error2 ("floor", number, divisor);
1536
1537 IN_FLOAT2 (f0 = floor (f1 / f2), MAYBE_EFF ("floor"), number, divisor);
1538 IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF ("floor"), number, divisor);
1539
1540 if (return_float)
1541 {
1542 return values2 (make_float (f0), make_float (remain));
1543 }
1544
1545 return values2 (float_to_int (f0, MAYBE_EFF ("floor"), number, divisor),
1546 make_float (remain));
1547 }
1548
1549 static Lisp_Object
1550 floor_one_float (Lisp_Object number, int return_float)
1551 {
1552 double d, d1;
1553
1554 IN_FLOAT ((d = floor (XFLOAT_DATA (number))), MAYBE_EFF ("floor"), number);
1555 IN_FLOAT ((d1 = XFLOAT_DATA (number) - d), MAYBE_EFF ("floor"), number);
1556
1557 if (return_float)
1558 {
1559 return values2 (make_float (d), make_float (d1));
1560 }
1561 else
1562 {
1563 return values2 (float_to_int (d, MAYBE_EFF ("floor"), number, Qunbound),
1564 make_float (d1));
1565 }
1566 }
1567
1568 EXFUN (Ffloor, 2);
1569 EXFUN (Fffloor, 2);
1570
1571 static Lisp_Object
1572 floor_one_mundane_arg (Lisp_Object number, Lisp_Object divisor,
1573 int return_float)
1574 {
862 #ifdef HAVE_BIGNUM 1575 #ifdef HAVE_BIGNUM
863 if (INTEGERP (number)) 1576 if (INTEGERP (number))
864 #else 1577 #else
865 if (INTP (number)) 1578 if (INTP (number))
866 #endif 1579 #endif
867 return number; 1580 {
1581 if (return_float)
1582 {
1583 return values2 (make_float (extract_float (number)), Qzero);
1584 }
1585 else
1586 {
1587 return values2 (number, Qzero);
1588 }
1589 }
1590
1591 MAYBE_CHAR_OR_MARKER (floor);
1592
1593 if (return_float)
1594 {
1595 return Fffloor (wrong_type_argument (Qnumberp, number), divisor);
1596 }
1597 else
1598 {
1599 return Ffloor (wrong_type_argument (Qnumberp, number), divisor);
1600 }
1601 }
1602
1603 /* Algorithm taken from cl-extra.el, now to be found as cl-round in
1604 tests/automated/lisp-tests.el. */
1605 static Lisp_Object
1606 round_two_fixnum (Lisp_Object number, Lisp_Object divisor, int return_float)
1607 {
1608 EMACS_INT i1 = XREALINT (number);
1609 EMACS_INT i2 = XREALINT (divisor);
1610 EMACS_INT i0, hi2, flooring, floored, flsecond;
1611
1612 if (i2 == 0)
1613 return arith_error2 ("round", number, divisor);
1614
1615 hi2 = i2 < 0 ? -( -i2 / 2) : i2 / 2;
1616
1617 flooring = hi2 + i1;
1618
1619 floored = (i2 < 0
1620 ? (flooring <= 0 ? -flooring / -i2 : -1 - ((flooring - 1) / -i2))
1621 : (flooring < 0 ? -1 - ((-1 - flooring) / i2) : flooring / i2));
1622
1623 flsecond = flooring - (floored * i2);
1624
1625 if (0 == flsecond
1626 && (i2 == (hi2 + hi2))
1627 && (0 != (floored % 2)))
1628 {
1629 i0 = floored - 1;
1630 return values2 (return_float ? make_float ((double)i0) :
1631 make_int (i0), make_int (hi2));
1632 }
1633 else
1634 {
1635 return values2 (return_float ? make_float ((double)floored) :
1636 make_int (floored),
1637 make_int (flsecond - hi2));
1638 }
1639 }
1640
1641 #ifdef HAVE_BIGNUM
1642 static void
1643 round_two_bignum_1 (bignum number, bignum divisor,
1644 Lisp_Object *res, Lisp_Object *remain)
1645 {
1646 bignum flooring, floored, hi2, flsecond;
1647
1648 if (bignum_divisible_p (number, divisor))
1649 {
1650 bignum_div (scratch_bignum, number, divisor);
1651 *res = make_bignum_bg (scratch_bignum);
1652 *remain = Qzero;
1653 return;
1654 }
1655
1656 bignum_set_long (scratch_bignum, 2);
1657
1658 bignum_div (scratch_bignum2, divisor, scratch_bignum);
1659
1660 bignum_init (hi2);
1661 bignum_set (hi2, scratch_bignum2);
1662
1663 bignum_add (scratch_bignum, scratch_bignum2, number);
1664 bignum_init (flooring);
1665 bignum_set (flooring, scratch_bignum);
1666
1667 bignum_floor (scratch_bignum, flooring, divisor);
1668 bignum_init (floored);
1669 bignum_set (floored, scratch_bignum);
1670
1671 bignum_mul (scratch_bignum2, scratch_bignum, divisor);
1672 bignum_sub (scratch_bignum, flooring, scratch_bignum2);
1673 bignum_init (flsecond);
1674 bignum_set (flsecond, scratch_bignum);
1675
1676 bignum_set_long (scratch_bignum, 2);
1677 bignum_mul (scratch_bignum2, scratch_bignum, hi2);
1678
1679 if (bignum_sign (flsecond) == 0
1680 && bignum_eql (divisor, scratch_bignum2)
1681 && (1 == bignum_testbit (floored, 0)))
1682 {
1683 bignum_set_long (scratch_bignum, 1);
1684 bignum_sub (floored, floored, scratch_bignum);
1685 *res = make_bignum_bg (floored);
1686 *remain = make_bignum_bg (hi2);
1687 }
1688 else
1689 {
1690 bignum_sub (scratch_bignum, flsecond,
1691 hi2);
1692 *res = make_bignum_bg (floored);
1693 *remain = make_bignum_bg (scratch_bignum);
1694 }
1695 }
1696
1697 static Lisp_Object
1698 round_two_bignum (Lisp_Object number, Lisp_Object divisor, int return_float)
1699 {
1700 Lisp_Object res0, res1;
1701
1702 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
1703 return arith_error2 ("round", number, divisor);
1704
1705 round_two_bignum_1 (XBIGNUM_DATA (number), XBIGNUM_DATA (divisor),
1706 &res0, &res1);
1707
1708 if (return_float)
1709 {
1710 res0 = make_float (bignum_to_double (XBIGNUM_DATA (res0)));
1711 }
1712 else
1713 {
1714 res0 = Fcanonicalize_number (res0);
1715 }
1716
1717 return values2 (res0, Fcanonicalize_number (res1));
1718 }
1719 #endif /* HAVE_BIGNUM */
868 1720
869 #ifdef HAVE_RATIO 1721 #ifdef HAVE_RATIO
870 if (RATIOP (number)) 1722 static Lisp_Object
871 { 1723 round_two_ratio (Lisp_Object number, Lisp_Object divisor,
872 bignum_ceil (scratch_bignum, XRATIO_NUMERATOR (number), 1724 int return_float)
873 XRATIO_DENOMINATOR (number)); 1725 {
874 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); 1726 Lisp_Object res0, res1;
875 } 1727
876 #endif 1728 if (ratio_sign (XRATIO_DATA (divisor)) == 0)
1729 return arith_error2 ("round", number, divisor);
1730
1731 ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor));
1732
1733 round_two_bignum_1 (ratio_numerator (scratch_ratio),
1734 ratio_denominator (scratch_ratio), &res0, &res1);
1735
1736 if (!ZEROP (res1))
1737 {
1738 /* The numerator and denominator don't round exactly, calculate a
1739 ratio remainder: */
1740 ratio_set_bignum (scratch_ratio2, XBIGNUM_DATA (res0));
1741 ratio_mul (scratch_ratio, scratch_ratio2, XRATIO_DATA (divisor));
1742 ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio);
1743
1744 res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio));
1745 }
1746
1747 res0 = return_float ?
1748 make_float ((double)bignum_to_double(XBIGNUM_DATA (res0))) :
1749 Fcanonicalize_number (res0);
1750
1751 return values2 (res0, res1);
1752 }
1753 #endif /* HAVE_RATIO */
877 1754
878 #ifdef HAVE_BIGFLOAT 1755 #ifdef HAVE_BIGFLOAT
879 if (BIGFLOATP (number)) 1756 /* This is the logic of emacs_rint above, no more and no less. */
880 { 1757 static Lisp_Object
881 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); 1758 round_one_bigfloat_1 (bigfloat number)
882 bigfloat_ceil (scratch_bigfloat, XBIGFLOAT_DATA (number)); 1759 {
1760 Lisp_Object res0;
1761 unsigned long prec = bigfloat_get_prec (number);
1762
1763 assert ((bigfloat *)(&number) != (bigfloat *)&scratch_bigfloat
1764 && (bigfloat *)(&number) != (bigfloat *)(&scratch_bigfloat2));
1765
1766 bigfloat_set_prec (scratch_bigfloat, prec);
1767 bigfloat_set_prec (scratch_bigfloat2, prec);
1768
1769 bigfloat_set_double (scratch_bigfloat, 0.5);
1770 bigfloat_add (scratch_bigfloat2, scratch_bigfloat, number);
1771 bigfloat_floor (scratch_bigfloat, scratch_bigfloat2);
1772 res0 = make_bigfloat_bf (scratch_bigfloat);
1773
1774 bigfloat_sub (scratch_bigfloat2, scratch_bigfloat, number);
1775 bigfloat_abs (scratch_bigfloat, scratch_bigfloat2);
1776
1777 bigfloat_set_double (scratch_bigfloat2, 0.5);
1778
1779 do {
1780 if (!bigfloat_ge (scratch_bigfloat, scratch_bigfloat2))
1781 {
1782 break;
1783 }
1784
1785 if (!bigfloat_gt (scratch_bigfloat, scratch_bigfloat2))
1786 {
1787 bigfloat_set_double (scratch_bigfloat2, 2.0);
1788 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (res0),
1789 scratch_bigfloat2);
1790 bigfloat_floor (scratch_bigfloat2, scratch_bigfloat);
1791 bigfloat_set_double (scratch_bigfloat, 2.0);
1792 bigfloat_mul (scratch_bigfloat2, scratch_bigfloat2,
1793 scratch_bigfloat);
1794 if (bigfloat_eql (scratch_bigfloat2, XBIGFLOAT_DATA (res0)))
1795 {
1796 break;
1797 }
1798 }
1799
1800 if (bigfloat_lt (XBIGFLOAT_DATA (res0), number))
1801 {
1802 bigfloat_set_double (scratch_bigfloat2, 1.0);
1803 }
1804 else
1805 {
1806 bigfloat_set_double (scratch_bigfloat2, -1.0);
1807 }
1808
1809 bigfloat_set (scratch_bigfloat, XBIGFLOAT_DATA (res0));
1810
1811 bigfloat_add (XBIGFLOAT_DATA (res0), scratch_bigfloat2,
1812 scratch_bigfloat);
1813
1814 } while (0);
1815
1816 return res0;
1817 }
1818
1819 static Lisp_Object
1820 round_two_bigfloat (Lisp_Object number, Lisp_Object divisor,
1821 int return_float)
1822 {
1823 Lisp_Object res0, res1;
1824 bigfloat divided;
1825
1826 unsigned long prec = max (XBIGFLOAT_GET_PREC (number),
1827 XBIGFLOAT_GET_PREC (divisor));
1828
1829 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
1830 return arith_error2 ("round", number, divisor);
1831
1832 bigfloat_init (divided);
1833 bigfloat_set_prec (divided, prec);
1834
1835 bigfloat_div (divided, XBIGFLOAT_DATA (number), XBIGFLOAT_DATA (divisor));
1836
1837 res0 = round_one_bigfloat_1 (divided);
1838
1839 bigfloat_set_prec (scratch_bigfloat, prec);
1840 bigfloat_set_prec (scratch_bigfloat2, prec);
1841
1842 bigfloat_mul (scratch_bigfloat, XBIGFLOAT_DATA (res0),
1843 XBIGFLOAT_DATA (divisor));
1844 bigfloat_sub (scratch_bigfloat2, XBIGFLOAT_DATA (number),
1845 scratch_bigfloat);
1846
1847 res1 = make_bigfloat_bf (scratch_bigfloat2);
1848
1849 if (!return_float)
1850 {
1851 #ifdef HAVE_BIGNUM
1852 bignum_set_bigfloat (scratch_bignum, XBIGFLOAT_DATA (res0));
1853 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1854 #else
1855 res0 = make_int ((EMACS_INT) bigfloat_to_long (XBIGFLOAT_DATA (res0)));
1856 #endif /* HAVE_BIGNUM */
1857 }
1858
1859 return values2 (res0, res1);
1860 }
1861 #endif /* HAVE_BIGFLOAT */
1862
1863 #ifdef HAVE_RATIO
1864 static Lisp_Object
1865 round_one_ratio (Lisp_Object number, Lisp_Object UNUSED (divisor),
1866 int return_float)
1867 {
1868 Lisp_Object res0, res1;
1869
1870 round_two_bignum_1 (XRATIO_NUMERATOR (number), XRATIO_DENOMINATOR (number),
1871 &res0, &res1);
1872
1873 if (!ZEROP (res1))
1874 {
1875 ratio_set_bignum (scratch_ratio2, XBIGNUM_DATA (res0));
1876 ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio2);
1877 res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio));
1878 }
1879
1880 res0 = return_float ?
1881 make_float ((double)bignum_to_double(XBIGNUM_DATA (res0))) :
1882 Fcanonicalize_number (res0);
1883
1884 return values2 (res0, res1);
1885 }
1886 #endif /* HAVE_RATIO */
1887
1888 #ifdef HAVE_BIGFLOAT
1889 static Lisp_Object
1890 round_one_bigfloat (Lisp_Object number, Lisp_Object UNUSED (divisor),
1891 int return_float)
1892 {
1893 Lisp_Object res0 = round_one_bigfloat_1 (XBIGFLOAT_DATA (number));
1894 Lisp_Object res1;
1895
1896 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number),
1897 XBIGFLOAT_DATA (res0));
1898
1899 res1 = make_bigfloat_bf (scratch_bigfloat);
1900
1901 if (!return_float)
1902 {
1903 #ifdef HAVE_BIGNUM
1904 bignum_set_bigfloat (scratch_bignum, XBIGFLOAT_DATA (res0));
1905 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1906 #else
1907 res0 = make_int ((EMACS_INT) bigfloat_to_long
1908 (XBIGFLOAT_DATA (res0)));
1909 #endif /* HAVE_BIGNUM */
1910 }
1911
1912 return values2 (res0, res1);
1913 }
1914 #endif /* HAVE_BIGFLOAT */
1915
1916 static Lisp_Object
1917 round_two_float (Lisp_Object number, Lisp_Object divisor,
1918 int return_float)
1919 {
1920 double f1 = extract_float (number);
1921 double f2 = extract_float (divisor);
1922 double f0, remain;
1923
1924 if (f2 == 0.0)
1925 return arith_error2 ("round", number, divisor);
1926
1927 IN_FLOAT2 ((f0 = emacs_rint (f1 / f2)), MAYBE_EFF ("round"), number,
1928 divisor);
1929 IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF ("round"), number, divisor);
1930
1931 if (return_float)
1932 {
1933 return values2 (make_float (f0), make_float (remain));
1934 }
1935 else
1936 {
1937 return values2 (float_to_int (f0, MAYBE_EFF("round"), number, divisor),
1938 make_float (remain));
1939 }
1940 }
1941
1942 static Lisp_Object
1943 round_one_float (Lisp_Object number, int return_float)
1944 {
1945 double d;
1946 /* Screw the prevailing rounding mode. */
1947 IN_FLOAT ((d = emacs_rint (XFLOAT_DATA (number))), MAYBE_EFF ("round"),
1948 number);
1949
1950 if (return_float)
1951 {
1952 return values2 (make_float (d), make_float (XFLOAT_DATA (number) - d));
1953 }
1954 else
1955 {
1956 return values2 ((float_to_int (d, MAYBE_EFF ("round"), number,
1957 Qunbound)),
1958 make_float (XFLOAT_DATA (number) - d));
1959 }
1960 }
1961
1962 EXFUN (Fround, 2);
1963 EXFUN (Ffround, 2);
1964
1965 static Lisp_Object
1966 round_one_mundane_arg (Lisp_Object number, Lisp_Object divisor,
1967 int return_float)
1968 {
1969 #ifdef HAVE_BIGNUM
1970 if (INTEGERP (number))
1971 #else
1972 if (INTP (number))
1973 #endif
1974 {
1975 if (return_float)
1976 {
1977 return values2 (make_float (extract_float (number)), Qzero);
1978 }
1979 else
1980 {
1981 return values2 (number, Qzero);
1982 }
1983 }
1984
1985 MAYBE_CHAR_OR_MARKER (round);
1986
1987 if (return_float)
1988 {
1989 return Ffround (wrong_type_argument (Qnumberp, number), divisor);
1990 }
1991 else
1992 {
1993 return Fround (wrong_type_argument (Qnumberp, number), divisor);
1994 }
1995 }
1996
1997 static Lisp_Object
1998 truncate_two_fixnum (Lisp_Object number, Lisp_Object divisor,
1999 int return_float)
2000 {
2001 EMACS_INT i1 = XREALINT (number);
2002 EMACS_INT i2 = XREALINT (divisor);
2003 EMACS_INT i0;
2004
2005 if (i2 == 0)
2006 return arith_error2 ("truncate", number, divisor);
2007
2008 /* We're truncating towards zero, so apart from avoiding the C89
2009 implementation-defined behaviour with truncation and negative numbers,
2010 we don't need to do anything further: */
2011 i0 = (i2 < 0
2012 ? (i1 <= 0 ? -i1 / -i2 : -(i1 / -i2))
2013 : (i1 < 0 ? -(-i1 / i2) : i1 / i2));
2014
2015 if (return_float)
2016 {
2017 return values2 (make_float ((double)i0), make_int (i1 - (i0 * i2)));
2018 }
2019 else
2020 {
2021 return values2 (make_int (i0), make_int (i1 - (i0 * i2)));
2022 }
2023 }
2024
2025 #ifdef HAVE_BIGNUM
2026 static Lisp_Object
2027 truncate_two_bignum (Lisp_Object number, Lisp_Object divisor,
2028 int return_float)
2029 {
2030 Lisp_Object res0;
2031
2032 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
2033 return arith_error2 ("truncate", number, divisor);
2034
2035 bignum_div (scratch_bignum, XBIGNUM_DATA (number),
2036 XBIGNUM_DATA (divisor));
2037
2038 if (return_float)
2039 {
2040 res0 = make_float (bignum_to_double (scratch_bignum));
2041 }
2042 else
2043 {
2044 res0 = make_bignum_bg (scratch_bignum);
2045 }
2046
2047 if (bignum_divisible_p (XBIGNUM_DATA (number),
2048 XBIGNUM_DATA (divisor)))
2049 {
2050 return values2 (Fcanonicalize_number (res0), Qzero);
2051 }
2052
2053 bignum_mul (scratch_bignum2, scratch_bignum, XBIGNUM_DATA (divisor));
2054 bignum_sub (scratch_bignum, XBIGNUM_DATA (number), scratch_bignum2);
2055
2056 return values2 (Fcanonicalize_number (res0),
2057 Fcanonicalize_number (make_bignum_bg (scratch_bignum)));
2058 }
2059 #endif /* HAVE_BIGNUM */
2060
2061 #ifdef HAVE_RATIO
2062 static Lisp_Object
2063 truncate_two_ratio (Lisp_Object number, Lisp_Object divisor,
2064 int return_float)
2065 {
2066 Lisp_Object res0;
2067
2068 if (ratio_sign (XRATIO_DATA (divisor)) == 0)
2069 return arith_error2 ("truncate", number, divisor);
2070
2071 ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor));
2072
2073 bignum_div (scratch_bignum, ratio_numerator (scratch_ratio),
2074 ratio_denominator (scratch_ratio));
2075
2076 if (return_float)
2077 {
2078 res0 = make_float (bignum_to_double (scratch_bignum));
2079 }
2080 else
2081 {
2082 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
2083 }
2084
2085 if (bignum_divisible_p (ratio_numerator (scratch_ratio),
2086 ratio_denominator (scratch_ratio)))
2087 {
2088 return values2 (res0, Qzero);
2089 }
2090
2091 ratio_set_bignum (scratch_ratio2, scratch_bignum);
2092 ratio_mul (scratch_ratio, scratch_ratio2, XRATIO_DATA (divisor));
2093 ratio_sub (scratch_ratio2, XRATIO_DATA (number), scratch_ratio);
2094
2095 return values2 (res0, Fcanonicalize_number (make_ratio_rt(scratch_ratio2)));
2096 }
2097 #endif
2098
2099 #ifdef HAVE_BIGFLOAT
2100 static Lisp_Object
2101 truncate_two_bigfloat (Lisp_Object number, Lisp_Object divisor,
2102 int return_float)
2103 {
2104 Lisp_Object res0;
2105 unsigned long prec = max (XBIGFLOAT_GET_PREC (number),
2106 XBIGFLOAT_GET_PREC (divisor));
2107
2108 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
2109 return arith_error2 ("truncate", number, divisor);
2110
2111 bigfloat_set_prec (scratch_bigfloat, prec);
2112 bigfloat_set_prec (scratch_bigfloat2, prec);
2113
2114 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number),
2115 XBIGFLOAT_DATA (divisor));
2116 bigfloat_trunc (scratch_bigfloat, scratch_bigfloat);
2117
2118 if (return_float)
2119 {
2120 res0 = make_bigfloat_bf (scratch_bigfloat);
2121 }
2122 else
2123 {
883 #ifdef HAVE_BIGNUM 2124 #ifdef HAVE_BIGNUM
884 bignum_set_bigfloat (scratch_bignum, scratch_bigfloat); 2125 bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
885 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); 2126 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
886 #else 2127 #else
887 return make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat)); 2128 res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
888 #endif /* HAVE_BIGNUM */ 2129 #endif /* HAVE_BIGNUM */
889 } 2130 }
2131
2132 bigfloat_mul (scratch_bigfloat2, scratch_bigfloat, XBIGFLOAT_DATA (divisor));
2133 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number), scratch_bigfloat2);
2134
2135 return values2 (res0, make_bigfloat_bf (scratch_bigfloat));
2136 }
890 #endif /* HAVE_BIGFLOAT */ 2137 #endif /* HAVE_BIGFLOAT */
891 2138
892 return Fceiling (wrong_type_argument (Qnumberp, number)); 2139 #ifdef HAVE_RATIO
893 } 2140 static Lisp_Object
894 2141 truncate_one_ratio (Lisp_Object number, Lisp_Object UNUSED (divisor),
2142 int return_float)
2143 {
2144 Lisp_Object res0;
2145
2146 if (ratio_sign (XRATIO_DATA (number)) == 0)
2147 return Qzero;
2148
2149 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number),
2150 XRATIO_DENOMINATOR (number));
2151 if (return_float)
2152 {
2153 res0 = make_float (bignum_to_double (scratch_bignum));
2154 }
2155 else
2156 {
2157 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
2158 }
2159
2160 if (bignum_divisible_p (XRATIO_NUMERATOR (number),
2161 XRATIO_DENOMINATOR (number)))
2162 {
2163 return values2 (res0, Qzero);
2164 }
2165
2166 ratio_set_bignum (scratch_ratio2, scratch_bignum);
2167 ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio2);
2168
2169 return values2 (res0, Fcanonicalize_number (make_ratio_rt (scratch_ratio)));
2170 }
2171 #endif /* HAVE_RATIO */
2172
2173 #ifdef HAVE_BIGFLOAT
2174 static Lisp_Object
2175 truncate_one_bigfloat (Lisp_Object number, Lisp_Object UNUSED (divisor),
2176 int return_float)
2177 {
2178 Lisp_Object res0;
2179
2180 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number));
2181 bigfloat_set_prec (scratch_bigfloat2, XBIGFLOAT_GET_PREC (number));
2182 bigfloat_trunc (scratch_bigfloat, XBIGFLOAT_DATA (number));
2183
2184 if (return_float)
2185 {
2186 res0 = make_bigfloat_bf (scratch_bigfloat);
2187 }
2188 else
2189 {
2190 #ifdef HAVE_BIGNUM
2191 bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
2192 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum));
2193 #else
2194 res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
2195 #endif /* HAVE_BIGNUM */
2196 }
2197
2198 bigfloat_sub (scratch_bigfloat2, XBIGFLOAT_DATA (number), scratch_bigfloat);
2199
2200 return
2201 values2 (res0,
2202 Fcanonicalize_number (make_bigfloat_bf (scratch_bigfloat2)));
2203 }
2204 #endif /* HAVE_BIGFLOAT */
2205
2206 static Lisp_Object
2207 truncate_two_float (Lisp_Object number, Lisp_Object divisor,
2208 int return_float)
2209 {
2210 double f1 = extract_float (number);
2211 double f2 = extract_float (divisor);
2212 double f0, remain;
2213 Lisp_Object res0;
2214
2215 if (f2 == 0.0)
2216 return arith_error2 ("truncate", number, divisor);
2217
2218 res0 = float_to_int (f1 / f2, MAYBE_EFF ("truncate"), number, Qunbound);
2219 f0 = extract_float (res0);
2220
2221 IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF ("truncate"), number, divisor);
2222
2223 if (return_float)
2224 {
2225 res0 = make_float (f0);
2226 }
2227
2228 return values2 (res0, make_float (remain));
2229 }
2230
2231 static Lisp_Object
2232 truncate_one_float (Lisp_Object number, int return_float)
2233 {
2234 Lisp_Object res0
2235 = float_to_int (XFLOAT_DATA (number), MAYBE_EFF ("truncate"),
2236 number, Qunbound);
2237 if (return_float)
2238 {
2239 res0 = make_float ((double)XINT(res0));
2240 return values2 (res0, make_float ((XFLOAT_DATA (number)
2241 - XFLOAT_DATA (res0))));
2242 }
2243 else
2244 {
2245 return values2 (res0, make_float (XFLOAT_DATA (number)
2246 - XREALINT (res0)));
2247 }
2248 }
2249
2250 EXFUN (Fftruncate, 2);
2251
2252 static Lisp_Object
2253 truncate_one_mundane_arg (Lisp_Object number, Lisp_Object divisor,
2254 int return_float)
2255 {
2256 #ifdef HAVE_BIGNUM
2257 if (INTEGERP (number))
2258 #else
2259 if (INTP (number))
2260 #endif
2261 {
2262 if (return_float)
2263 {
2264 return values2 (make_float (extract_float (number)), Qzero);
2265 }
2266 else
2267 {
2268 return values2 (number, Qzero);
2269 }
2270 }
2271
2272 MAYBE_CHAR_OR_MARKER (truncate);
2273
2274 if (return_float)
2275 {
2276 return Fftruncate (wrong_type_argument (Qnumberp, number), divisor);
2277 }
2278 else
2279 {
2280 return Ftruncate (wrong_type_argument (Qnumberp, number), divisor);
2281 }
2282 }
2283
2284 /* Rounding functions that will not necessarily return floats: */
2285
2286 DEFUN ("ceiling", Fceiling, 1, 2, 0, /*
2287 Return the smallest integer no less than NUMBER. (Round toward +inf.)
2288
2289 With optional argument DIVISOR, return the smallest integer no less than
2290 the quotient of NUMBER and DIVISOR.
2291
2292 This function returns multiple values; see `multiple-value-bind' and
2293 `multiple-value-call'. The second returned value is the remainder in the
2294 calculation, which will be one minus the fractional part of NUMBER if DIVISOR
2295 is omitted or one.
2296 */
2297 (number, divisor))
2298 {
2299 ROUNDING_CONVERT(ceiling, 0);
2300 }
895 2301
896 DEFUN ("floor", Ffloor, 1, 2, 0, /* 2302 DEFUN ("floor", Ffloor, 1, 2, 0, /*
897 Return the largest integer no greater than NUMBER. (Round towards -inf.) 2303 Return the largest integer no greater than NUMBER. (Round towards -inf.)
898 With optional second argument DIVISOR, return the largest integer no 2304 With optional second argument DIVISOR, return the largest integer no
899 greater than NUMBER/DIVISOR. 2305 greater than the quotient of NUMBER and DIVISOR.
2306
2307 This function returns multiple values; see `multiple-value-call' and
2308 `multiple-value-bind'. The second returned value is the remainder in the
2309 calculation, which will just be the fractional part if DIVISOR is omitted or
2310 one.
900 */ 2311 */
901 (number, divisor)) 2312 (number, divisor))
902 { 2313 {
903 #ifdef WITH_NUMBER_TYPES 2314 ROUNDING_CONVERT(floor, 0);
904 CHECK_REAL (number); 2315 }
905 if (NILP (divisor)) 2316
906 { 2317 DEFUN ("round", Fround, 1, 2, 0, /*
907 if (FLOATP (number))
908 {
909 double d;
910 IN_FLOAT ((d = floor (XFLOAT_DATA (number))), "floor", number);
911 return (float_to_int (d, "floor", number, Qunbound));
912 }
913 #ifdef HAVE_RATIO
914 else if (RATIOP (number))
915 {
916 bignum_floor (scratch_bignum, XRATIO_NUMERATOR (number),
917 XRATIO_DENOMINATOR (number));
918 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
919 }
920 #endif
921 #ifdef HAVE_BIGFLOAT
922 else if (BIGFLOATP (number))
923 {
924 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number));
925 bigfloat_floor (scratch_bigfloat, XBIGFLOAT_DATA (number));
926 return make_bigfloat_bf (scratch_bigfloat);
927 }
928 #endif
929 return number;
930 }
931 else
932 {
933 CHECK_REAL (divisor);
934 switch (promote_args (&number, &divisor))
935 {
936 case FIXNUM_T:
937 {
938 EMACS_INT i1 = XREALINT (number);
939 EMACS_INT i2 = XREALINT (divisor);
940
941 if (i2 == 0)
942 Fsignal (Qarith_error, Qnil);
943
944 /* With C's /, the result is implementation-defined if either
945 operand is negative, so use only nonnegative operands. */
946 i1 = (i2 < 0
947 ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2))
948 : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2));
949
950 return make_int (i1);
951 }
952 #ifdef HAVE_BIGNUM
953 case BIGNUM_T:
954 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0)
955 Fsignal (Qarith_error, Qnil);
956 bignum_floor (scratch_bignum, XBIGNUM_DATA (number),
957 XBIGNUM_DATA (divisor));
958 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
959 #endif
960 #ifdef HAVE_RATIO
961 case RATIO_T:
962 if (ratio_sign (XRATIO_DATA (divisor)) == 0)
963 Fsignal (Qarith_error, Qnil);
964 ratio_div (scratch_ratio, XRATIO_DATA (number),
965 XRATIO_DATA (divisor));
966 bignum_floor (scratch_bignum, ratio_numerator (scratch_ratio),
967 ratio_denominator (scratch_ratio));
968 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
969 #endif
970 #ifdef HAVE_BIGFLOAT
971 case BIGFLOAT_T:
972 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0)
973 Fsignal (Qarith_error, Qnil);
974 bigfloat_set_prec (scratch_bigfloat,
975 max (XBIGFLOAT_GET_PREC (number),
976 XBIGFLOAT_GET_PREC (divisor)));
977 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number),
978 XBIGFLOAT_DATA (divisor));
979 bigfloat_floor (scratch_bigfloat, scratch_bigfloat);
980 return make_bigfloat_bf (scratch_bigfloat);
981 #endif
982 default: /* FLOAT_T */
983 {
984 double f1 = extract_float (number);
985 double f2 = extract_float (divisor);
986
987 if (f2 == 0.0)
988 Fsignal (Qarith_error, Qnil);
989
990 IN_FLOAT2 (f1 = floor (f1 / f2), "floor", number, divisor);
991 return float_to_int (f1, "floor", number, divisor);
992 }
993 }
994 }
995 #else /* !WITH_NUMBER_TYPES */
996 CHECK_INT_OR_FLOAT (number);
997
998 if (! NILP (divisor))
999 {
1000 EMACS_INT i1, i2;
1001
1002 CHECK_INT_OR_FLOAT (divisor);
1003
1004 if (FLOATP (number) || FLOATP (divisor))
1005 {
1006 double f1 = extract_float (number);
1007 double f2 = extract_float (divisor);
1008
1009 if (f2 == 0)
1010 Fsignal (Qarith_error, Qnil);
1011
1012 IN_FLOAT2 (f1 = floor (f1 / f2), "floor", number, divisor);
1013 return float_to_int (f1, "floor", number, divisor);
1014 }
1015
1016 i1 = XINT (number);
1017 i2 = XINT (divisor);
1018
1019 if (i2 == 0)
1020 Fsignal (Qarith_error, Qnil);
1021
1022 /* With C's /, the result is implementation-defined if either operand
1023 is negative, so use only nonnegative operands. */
1024 i1 = (i2 < 0
1025 ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2))
1026 : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2));
1027
1028 return (make_int (i1));
1029 }
1030
1031 if (FLOATP (number))
1032 {
1033 double d;
1034 IN_FLOAT ((d = floor (XFLOAT_DATA (number))), "floor", number);
1035 return (float_to_int (d, "floor", number, Qunbound));
1036 }
1037
1038 return number;
1039 #endif /* WITH_NUMBER_TYPES */
1040 }
1041
1042 DEFUN ("round", Fround, 1, 1, 0, /*
1043 Return the nearest integer to NUMBER. 2318 Return the nearest integer to NUMBER.
1044 */ 2319 If NUMBER is exactly halfway between two integers, return the one that
1045 (number)) 2320 is even.
1046 { 2321
1047 if (FLOATP (number)) 2322 Optional argument DIVISOR means return the nearest integer to NUMBER
1048 { 2323 divided by DIVISOR.
1049 double d; 2324
1050 /* Screw the prevailing rounding mode. */ 2325 This function returns multiple values; see `multiple-value-call' and
1051 IN_FLOAT ((d = emacs_rint (XFLOAT_DATA (number))), "round", number); 2326 `multiple-value-bind'. The second returned value is the remainder
1052 return (float_to_int (d, "round", number, Qunbound)); 2327 in the calculation.
1053 } 2328 */
1054 2329 (number, divisor))
1055 #ifdef HAVE_BIGNUM 2330 {
1056 if (INTEGERP (number)) 2331 ROUNDING_CONVERT(round, 0);
1057 #else 2332 }
1058 if (INTP (number)) 2333
1059 #endif 2334 DEFUN ("truncate", Ftruncate, 1, 2, 0, /*
1060 return number;
1061
1062 #ifdef HAVE_RATIO
1063 if (RATIOP (number))
1064 {
1065 if (bignum_divisible_p (XRATIO_NUMERATOR (number),
1066 XRATIO_DENOMINATOR (number)))
1067 {
1068 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number),
1069 XRATIO_DENOMINATOR (number));
1070 }
1071 else
1072 {
1073 bignum_add (scratch_bignum2, XRATIO_NUMERATOR (number),
1074 XRATIO_DENOMINATOR (number));
1075 bignum_div (scratch_bignum, scratch_bignum2,
1076 XRATIO_DENOMINATOR (number));
1077 }
1078 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1079 }
1080 #endif
1081
1082 #ifdef HAVE_BIGFLOAT
1083 if (BIGFLOATP (number))
1084 {
1085 unsigned long prec = XBIGFLOAT_GET_PREC (number);
1086 bigfloat_set_prec (scratch_bigfloat, prec);
1087 bigfloat_set_prec (scratch_bigfloat2, prec);
1088 bigfloat_set_double (scratch_bigfloat2,
1089 bigfloat_sign (XBIGFLOAT_DATA (number)) * 0.5);
1090 bigfloat_floor (scratch_bigfloat, scratch_bigfloat2);
1091 #ifdef HAVE_BIGNUM
1092 bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
1093 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1094 #else
1095 return make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
1096 #endif /* HAVE_BIGNUM */
1097 }
1098 #endif /* HAVE_BIGFLOAT */
1099
1100 return Fround (wrong_type_argument (Qnumberp, number));
1101 }
1102
1103 DEFUN ("truncate", Ftruncate, 1, 1, 0, /*
1104 Truncate a floating point number to an integer. 2335 Truncate a floating point number to an integer.
1105 Rounds the value toward zero. 2336 Rounds the value toward zero.
1106 */ 2337
1107 (number)) 2338 Optional argument DIVISOR means truncate NUMBER divided by DIVISOR.
1108 { 2339
1109 if (FLOATP (number)) 2340 This function returns multiple values; see `multiple-value-call' and
1110 return float_to_int (XFLOAT_DATA (number), "truncate", number, Qunbound); 2341 `multiple-value-bind'. The second returned value is the remainder.
1111 2342 */
1112 #ifdef HAVE_BIGNUM 2343 (number, divisor))
1113 if (INTEGERP (number)) 2344 {
1114 #else 2345 ROUNDING_CONVERT(truncate, 0);
1115 if (INTP (number))
1116 #endif
1117 return number;
1118
1119 #ifdef HAVE_RATIO
1120 if (RATIOP (number))
1121 {
1122 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number),
1123 XRATIO_DENOMINATOR (number));
1124 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1125 }
1126 #endif
1127
1128 #ifdef HAVE_BIGFLOAT
1129 if (BIGFLOATP (number))
1130 {
1131 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number));
1132 bigfloat_trunc (scratch_bigfloat, XBIGFLOAT_DATA (number));
1133 #ifdef HAVE_BIGNUM
1134 bignum_set_bigfloat (scratch_bignum, scratch_bigfloat);
1135 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
1136 #else
1137 return make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat));
1138 #endif /* HAVE_BIGNUM */
1139 }
1140 #endif /* HAVE_BIGFLOAT */
1141
1142 return Ftruncate (wrong_type_argument (Qnumberp, number));
1143 } 2346 }
1144 2347
1145 /* Float-rounding functions. */ 2348 /* Float-rounding functions. */
1146 2349
1147 DEFUN ("fceiling", Ffceiling, 1, 1, 0, /* 2350 DEFUN ("fceiling", Ffceiling, 1, 2, 0, /*
1148 Return the smallest integer no less than NUMBER, as a float. 2351 Return the smallest integer no less than NUMBER, as a float.
1149 \(Round toward +inf.\) 2352 \(Round toward +inf.\)
1150 */ 2353
1151 (number)) 2354 With optional argument DIVISOR, return the smallest integer no less than the
1152 { 2355 quotient of NUMBER and DIVISOR, as a float.
1153 double d = extract_float (number); 2356
1154 IN_FLOAT (d = ceil (d), "fceiling", number); 2357 This function returns multiple values; the second value is the remainder in
1155 return make_float (d); 2358 the calculation.
1156 } 2359 */
1157 2360 (number, divisor))
1158 DEFUN ("ffloor", Fffloor, 1, 1, 0, /* 2361 {
2362 ROUNDING_CONVERT(ceiling, 1);
2363 }
2364
2365 DEFUN ("ffloor", Fffloor, 1, 2, 0, /*
1159 Return the largest integer no greater than NUMBER, as a float. 2366 Return the largest integer no greater than NUMBER, as a float.
1160 \(Round towards -inf.\) 2367 \(Round towards -inf.\)
1161 */ 2368
1162 (number)) 2369 With optional argument DIVISOR, return the largest integer no greater than
1163 { 2370 the quotient of NUMBER and DIVISOR, as a float.
1164 double d = extract_float (number); 2371
1165 IN_FLOAT (d = floor (d), "ffloor", number); 2372 This function returns multiple values; the second value is the remainder in
1166 return make_float (d); 2373 the calculation.
1167 } 2374 */
1168 2375 (number, divisor))
1169 DEFUN ("fround", Ffround, 1, 1, 0, /* 2376 {
2377 ROUNDING_CONVERT(floor, 1);
2378 }
2379
2380 DEFUN ("fround", Ffround, 1, 2, 0, /*
1170 Return the nearest integer to NUMBER, as a float. 2381 Return the nearest integer to NUMBER, as a float.
1171 */ 2382 If NUMBER is exactly halfway between two integers, return the one that is
1172 (number)) 2383 even.
1173 { 2384
1174 double d = extract_float (number); 2385 With optional argument DIVISOR, return the nearest integer to the quotient
1175 IN_FLOAT (d = emacs_rint (d), "fround", number); 2386 of NUMBER and DIVISOR, as a float.
1176 return make_float (d); 2387
1177 } 2388 This function returns multiple values; the second value is the remainder in
1178 2389 the calculation.
1179 DEFUN ("ftruncate", Fftruncate, 1, 1, 0, /* 2390 */
2391 (number, divisor))
2392 {
2393 ROUNDING_CONVERT(round, 1);
2394 }
2395
2396 DEFUN ("ftruncate", Fftruncate, 1, 2, 0, /*
1180 Truncate a floating point number to an integral float value. 2397 Truncate a floating point number to an integral float value.
1181 Rounds the value toward zero. 2398 Rounds the value toward zero.
1182 */ 2399
1183 (number)) 2400 With optional argument DIVISOR, truncate the quotient of NUMBER and DIVISOR,
1184 { 2401 to an integral float value.
1185 double d = extract_float (number); 2402
1186 if (d >= 0.0) 2403 This function returns multiple values; the second value is the remainder in
1187 IN_FLOAT (d = floor (d), "ftruncate", number); 2404 the calculation.
1188 else 2405 */
1189 IN_FLOAT (d = ceil (d), "ftruncate", number); 2406 (number, divisor))
1190 return make_float (d); 2407 {
2408 ROUNDING_CONVERT(truncate, 1);
1191 } 2409 }
1192 2410
1193 #ifdef FLOAT_CATCH_SIGILL 2411 #ifdef FLOAT_CATCH_SIGILL
1194 static SIGTYPE 2412 static SIGTYPE
1195 float_error (int signo) 2413 float_error (int signo)