Mercurial > hg > xemacs-beta

comparison src/floatfns.c @ 4678:b5e1d4f6b66f

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