Mercurial > hg > xemacs-beta
annotate src/floatfns.c @ 5408:9fc91aa3a927
Converted tooltalk to GPLv3 according to GPLv3 source survey analysis.
| author | Mats Lidell <matsl@xemacs.org> |
|---|---|
| date | Tue, 19 Oct 2010 23:34:53 +0200 |
| parents | 308d34e9f07d |
| children | 6506fcb40fcf |
| rev | line source |
|---|---|
| 428 | 1 /* Primitive operations on floating point for XEmacs Lisp interpreter. |
| 2 Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc. | |
| 3 | |
| 4 This file is part of XEmacs. | |
| 5 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5252
diff
changeset
|
6 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 7 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5252
diff
changeset
|
8 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5252
diff
changeset
|
9 option) any later version. |
| 428 | 10 |
| 11 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 14 for more details. | |
| 15 | |
| 16 You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5252
diff
changeset
|
17 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 18 |
| 19 /* Synched up with: FSF 19.30. */ | |
| 20 | |
| 21 /* ANSI C requires only these float functions: | |
| 22 acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod, | |
| 23 frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh. | |
| 24 | |
| 25 Define HAVE_INVERSE_HYPERBOLIC if you have acosh, asinh, and atanh. | |
| 26 Define HAVE_CBRT if you have cbrt(). | |
| 27 If you don't define these, then the appropriate routines will be simulated. | |
| 28 | |
| 29 Define HAVE_MATHERR if on a system supporting the SysV matherr() callback. | |
| 30 (This should happen automatically.) | |
| 31 | |
| 32 Define FLOAT_CHECK_ERRNO if the float library routines set errno. | |
| 33 This has no effect if HAVE_MATHERR is defined. | |
| 34 | |
| 35 Define FLOAT_CATCH_SIGILL if the float library routines signal SIGILL. | |
| 36 (What systems actually do this? Let me know. -jwz) | |
| 37 | |
| 38 Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by | |
| 39 either setting errno, or signalling SIGFPE/SIGILL. Otherwise, domain and | |
| 40 range checking will happen before calling the float routines. This has | |
| 41 no effect if HAVE_MATHERR is defined (since matherr will be called when | |
| 42 a domain error occurs). | |
| 43 */ | |
| 44 | |
| 45 #include <config.h> | |
| 46 #include "lisp.h" | |
| 47 #include "syssignal.h" | |
| 48 #include "sysfloat.h" | |
| 49 | |
|
4865
6c0bb4d2c23a
Always use our rint(), for rounding consistency with the bignum code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4828
diff
changeset
|
50 /* An implementation of rint that always rounds towards the even number in |
|
6c0bb4d2c23a
Always use our rint(), for rounding consistency with the bignum code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4828
diff
changeset
|
51 the case of ambiguity. */ |
| 428 | 52 static double |
| 430 | 53 emacs_rint (double x) |
| 428 | 54 { |
| 55 double r = floor (x + 0.5); | |
| 56 double diff = fabs (r - x); | |
| 57 /* Round to even and correct for any roundoff errors. */ | |
| 58 if (diff >= 0.5 && (diff > 0.5 || r != 2.0 * floor (r / 2.0))) | |
| 59 r += r < x ? 1.0 : -1.0; | |
| 60 return r; | |
| 61 } | |
| 62 | |
| 63 /* Nonzero while executing in floating point. | |
| 64 This tells float_error what to do. */ | |
| 65 static int in_float; | |
| 66 | |
| 67 /* If an argument is out of range for a mathematical function, | |
| 68 here is the actual argument value to use in the error message. */ | |
| 69 static Lisp_Object float_error_arg, float_error_arg2; | |
| 442 | 70 static const char *float_error_fn_name; |
| 428 | 71 |
| 72 /* Evaluate the floating point expression D, recording NUM | |
| 73 as the original argument for error messages. | |
| 74 D is normally an assignment expression. | |
| 75 Handle errors which may result in signals or may set errno. | |
| 76 | |
| 77 Note that float_error may be declared to return void, so you can't | |
| 78 just cast the zero after the colon to (SIGTYPE) to make the types | |
| 79 check properly. */ | |
| 80 #ifdef FLOAT_CHECK_ERRNO | |
| 81 #define IN_FLOAT(d, name, num) \ | |
| 82 do { \ | |
| 83 float_error_arg = num; \ | |
| 84 float_error_fn_name = name; \ | |
| 85 in_float = 1; errno = 0; (d); in_float = 0; \ | |
| 86 if (errno != 0) in_float_error (); \ | |
| 87 } while (0) | |
| 88 #define IN_FLOAT2(d, name, num, num2) \ | |
| 89 do { \ | |
| 90 float_error_arg = num; \ | |
| 91 float_error_arg2 = num2; \ | |
| 92 float_error_fn_name = name; \ | |
| 93 in_float = 2; errno = 0; (d); in_float = 0; \ | |
| 94 if (errno != 0) in_float_error (); \ | |
| 95 } while (0) | |
| 96 #else | |
| 97 #define IN_FLOAT(d, name, num) (in_float = 1, (d), in_float = 0) | |
| 98 #define IN_FLOAT2(d, name, num, num2) (in_float = 2, (d), in_float = 0) | |
| 99 #endif | |
| 100 | |
| 101 | |
| 102 #define arith_error(op,arg) \ | |
| 771 | 103 Fsignal (Qarith_error, list2 (build_msg_string (op), arg)) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
104 #define arith_error2(op,a1,a2) \ |
|
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
105 Fsignal (Qarith_error, list3 (build_msg_string (op), a1, a2)) |
| 428 | 106 #define range_error(op,arg) \ |
| 771 | 107 Fsignal (Qrange_error, list2 (build_msg_string (op), arg)) |
| 428 | 108 #define range_error2(op,a1,a2) \ |
| 771 | 109 Fsignal (Qrange_error, list3 (build_msg_string (op), a1, a2)) |
| 428 | 110 #define domain_error(op,arg) \ |
| 771 | 111 Fsignal (Qdomain_error, list2 (build_msg_string (op), arg)) |
| 428 | 112 #define domain_error2(op,a1,a2) \ |
| 771 | 113 Fsignal (Qdomain_error, list3 (build_msg_string (op), a1, a2)) |
| 428 | 114 |
| 115 | |
| 116 /* Convert float to Lisp Integer if it fits, else signal a range | |
| 1983 | 117 error using the given arguments. If bignums are available, range errors |
| 118 are never signaled. */ | |
| 428 | 119 static Lisp_Object |
| 2286 | 120 float_to_int (double x, |
| 121 #ifdef HAVE_BIGNUM | |
| 122 const char *UNUSED (name), Lisp_Object UNUSED (num), | |
| 123 Lisp_Object UNUSED (num2) | |
| 124 #else | |
| 125 const char *name, Lisp_Object num, Lisp_Object num2 | |
| 126 #endif | |
| 127 ) | |
| 428 | 128 { |
| 1983 | 129 #ifdef HAVE_BIGNUM |
| 130 bignum_set_double (scratch_bignum, x); | |
| 131 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); | |
| 132 #else | |
| 2039 | 133 REGISTER EMACS_INT result = (EMACS_INT) x; |
| 134 | |
| 135 if (result > EMACS_INT_MAX || result < EMACS_INT_MIN) | |
| 136 { | |
| 137 if (!UNBOUNDP (num2)) | |
| 138 range_error2 (name, num, num2); | |
| 139 else | |
| 140 range_error (name, num); | |
| 141 } | |
| 142 return make_int (result); | |
| 1983 | 143 #endif /* HAVE_BIGNUM */ |
| 428 | 144 } |
| 145 | |
| 146 | |
| 147 static void | |
| 148 in_float_error (void) | |
| 149 { | |
| 150 switch (errno) | |
| 151 { | |
| 152 case 0: | |
| 153 break; | |
| 154 case EDOM: | |
| 155 if (in_float == 2) | |
| 156 domain_error2 (float_error_fn_name, float_error_arg, float_error_arg2); | |
| 157 else | |
| 158 domain_error (float_error_fn_name, float_error_arg); | |
| 159 break; | |
| 160 case ERANGE: | |
| 161 range_error (float_error_fn_name, float_error_arg); | |
| 162 break; | |
| 163 default: | |
| 164 arith_error (float_error_fn_name, float_error_arg); | |
| 165 break; | |
| 166 } | |
| 167 } | |
| 168 | |
| 169 | |
| 170 static Lisp_Object | |
| 2286 | 171 mark_float (Lisp_Object UNUSED (obj)) |
| 428 | 172 { |
| 173 return Qnil; | |
| 174 } | |
| 175 | |
| 176 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4865
diff
changeset
|
177 float_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth), |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4865
diff
changeset
|
178 int UNUSED (foldcase)) |
| 428 | 179 { |
| 180 return (extract_float (obj1) == extract_float (obj2)); | |
| 181 } | |
| 182 | |
| 665 | 183 static Hashcode |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5125
diff
changeset
|
184 float_hash (Lisp_Object obj, int UNUSED (depth), Boolint UNUSED (equalp)) |
| 428 | 185 { |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5125
diff
changeset
|
186 return FLOAT_HASHCODE_FROM_DOUBLE (extract_float (obj)); |
| 428 | 187 } |
| 188 | |
| 1204 | 189 static const struct memory_description float_description[] = { |
| 428 | 190 { XD_END } |
| 191 }; | |
| 192 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
193 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("float", float, |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
194 mark_float, print_float, 0, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
195 float_equal, float_hash, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
196 float_description, Lisp_Float); |
| 428 | 197 |
| 198 /* Extract a Lisp number as a `double', or signal an error. */ | |
| 199 | |
| 200 double | |
| 201 extract_float (Lisp_Object num) | |
| 202 { | |
| 203 if (FLOATP (num)) | |
| 204 return XFLOAT_DATA (num); | |
| 205 | |
| 206 if (INTP (num)) | |
| 207 return (double) XINT (num); | |
| 208 | |
| 1983 | 209 #ifdef HAVE_BIGNUM |
| 210 if (BIGNUMP (num)) | |
| 211 return bignum_to_double (XBIGNUM_DATA (num)); | |
| 212 #endif | |
| 213 | |
| 214 #ifdef HAVE_RATIO | |
| 215 if (RATIOP (num)) | |
| 216 return ratio_to_double (XRATIO_DATA (num)); | |
| 217 #endif | |
| 218 | |
| 219 #ifdef HAVE_BIGFLOAT | |
| 220 if (BIGFLOATP (num)) | |
| 221 return bigfloat_to_double (XBIGFLOAT_DATA (num)); | |
| 222 #endif | |
| 223 | |
| 428 | 224 return extract_float (wrong_type_argument (Qnumberp, num)); |
| 225 } | |
| 226 | |
| 227 /* Trig functions. */ | |
| 228 | |
| 229 DEFUN ("acos", Facos, 1, 1, 0, /* | |
| 444 | 230 Return the inverse cosine of NUMBER. |
| 428 | 231 */ |
| 444 | 232 (number)) |
| 428 | 233 { |
| 444 | 234 double d = extract_float (number); |
| 428 | 235 #ifdef FLOAT_CHECK_DOMAIN |
| 236 if (d > 1.0 || d < -1.0) | |
| 444 | 237 domain_error ("acos", number); |
| 428 | 238 #endif |
| 444 | 239 IN_FLOAT (d = acos (d), "acos", number); |
| 428 | 240 return make_float (d); |
| 241 } | |
| 242 | |
| 243 DEFUN ("asin", Fasin, 1, 1, 0, /* | |
| 444 | 244 Return the inverse sine of NUMBER. |
| 428 | 245 */ |
| 444 | 246 (number)) |
| 428 | 247 { |
| 444 | 248 double d = extract_float (number); |
| 428 | 249 #ifdef FLOAT_CHECK_DOMAIN |
| 250 if (d > 1.0 || d < -1.0) | |
| 444 | 251 domain_error ("asin", number); |
| 428 | 252 #endif |
| 444 | 253 IN_FLOAT (d = asin (d), "asin", number); |
| 428 | 254 return make_float (d); |
| 255 } | |
| 256 | |
| 257 DEFUN ("atan", Fatan, 1, 2, 0, /* | |
| 444 | 258 Return the inverse tangent of NUMBER. |
| 259 If optional second argument NUMBER2 is provided, | |
| 260 return atan2 (NUMBER, NUMBER2). | |
| 428 | 261 */ |
| 444 | 262 (number, number2)) |
| 428 | 263 { |
| 444 | 264 double d = extract_float (number); |
| 428 | 265 |
| 444 | 266 if (NILP (number2)) |
| 267 IN_FLOAT (d = atan (d), "atan", number); | |
| 428 | 268 else |
| 269 { | |
| 444 | 270 double d2 = extract_float (number2); |
| 428 | 271 #ifdef FLOAT_CHECK_DOMAIN |
| 272 if (d == 0.0 && d2 == 0.0) | |
| 444 | 273 domain_error2 ("atan", number, number2); |
| 428 | 274 #endif |
| 444 | 275 IN_FLOAT2 (d = atan2 (d, d2), "atan", number, number2); |
| 428 | 276 } |
| 277 return make_float (d); | |
| 278 } | |
| 279 | |
| 280 DEFUN ("cos", Fcos, 1, 1, 0, /* | |
| 444 | 281 Return the cosine of NUMBER. |
| 428 | 282 */ |
| 444 | 283 (number)) |
| 428 | 284 { |
| 444 | 285 double d = extract_float (number); |
| 286 IN_FLOAT (d = cos (d), "cos", number); | |
| 428 | 287 return make_float (d); |
| 288 } | |
| 289 | |
| 290 DEFUN ("sin", Fsin, 1, 1, 0, /* | |
| 444 | 291 Return the sine of NUMBER. |
| 428 | 292 */ |
| 444 | 293 (number)) |
| 428 | 294 { |
| 444 | 295 double d = extract_float (number); |
| 296 IN_FLOAT (d = sin (d), "sin", number); | |
| 428 | 297 return make_float (d); |
| 298 } | |
| 299 | |
| 300 DEFUN ("tan", Ftan, 1, 1, 0, /* | |
| 444 | 301 Return the tangent of NUMBER. |
| 428 | 302 */ |
| 444 | 303 (number)) |
| 428 | 304 { |
| 444 | 305 double d = extract_float (number); |
| 428 | 306 double c = cos (d); |
| 307 #ifdef FLOAT_CHECK_DOMAIN | |
| 308 if (c == 0.0) | |
| 444 | 309 domain_error ("tan", number); |
| 428 | 310 #endif |
| 444 | 311 IN_FLOAT (d = (sin (d) / c), "tan", number); |
| 428 | 312 return make_float (d); |
| 313 } | |
| 314 | |
| 315 /* Bessel functions */ | |
| 316 #if 0 /* Leave these out unless we find there's a reason for them. */ | |
| 317 | |
| 318 DEFUN ("bessel-j0", Fbessel_j0, 1, 1, 0, /* | |
| 444 | 319 Return the bessel function j0 of NUMBER. |
| 428 | 320 */ |
| 444 | 321 (number)) |
| 428 | 322 { |
| 444 | 323 double d = extract_float (number); |
| 324 IN_FLOAT (d = j0 (d), "bessel-j0", number); | |
| 428 | 325 return make_float (d); |
| 326 } | |
| 327 | |
| 328 DEFUN ("bessel-j1", Fbessel_j1, 1, 1, 0, /* | |
| 444 | 329 Return the bessel function j1 of NUMBER. |
| 428 | 330 */ |
| 444 | 331 (number)) |
| 428 | 332 { |
| 444 | 333 double d = extract_float (number); |
| 334 IN_FLOAT (d = j1 (d), "bessel-j1", number); | |
| 428 | 335 return make_float (d); |
| 336 } | |
| 337 | |
| 338 DEFUN ("bessel-jn", Fbessel_jn, 2, 2, 0, /* | |
| 444 | 339 Return the order N bessel function output jn of NUMBER. |
| 340 The first number (the order) is truncated to an integer. | |
| 428 | 341 */ |
| 444 | 342 (number1, number2)) |
| 428 | 343 { |
| 444 | 344 int i1 = extract_float (number1); |
| 345 double f2 = extract_float (number2); | |
| 428 | 346 |
| 444 | 347 IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", number1); |
| 428 | 348 return make_float (f2); |
| 349 } | |
| 350 | |
| 351 DEFUN ("bessel-y0", Fbessel_y0, 1, 1, 0, /* | |
| 444 | 352 Return the bessel function y0 of NUMBER. |
| 428 | 353 */ |
| 444 | 354 (number)) |
| 428 | 355 { |
| 444 | 356 double d = extract_float (number); |
| 357 IN_FLOAT (d = y0 (d), "bessel-y0", number); | |
| 428 | 358 return make_float (d); |
| 359 } | |
| 360 | |
| 361 DEFUN ("bessel-y1", Fbessel_y1, 1, 1, 0, /* | |
| 444 | 362 Return the bessel function y1 of NUMBER. |
| 428 | 363 */ |
| 444 | 364 (number)) |
| 428 | 365 { |
| 444 | 366 double d = extract_float (number); |
| 367 IN_FLOAT (d = y1 (d), "bessel-y0", number); | |
| 428 | 368 return make_float (d); |
| 369 } | |
| 370 | |
| 371 DEFUN ("bessel-yn", Fbessel_yn, 2, 2, 0, /* | |
| 444 | 372 Return the order N bessel function output yn of NUMBER. |
| 373 The first number (the order) is truncated to an integer. | |
| 428 | 374 */ |
| 444 | 375 (number1, number2)) |
| 428 | 376 { |
| 444 | 377 int i1 = extract_float (number1); |
| 378 double f2 = extract_float (number2); | |
| 428 | 379 |
| 444 | 380 IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", number1); |
| 428 | 381 return make_float (f2); |
| 382 } | |
| 383 | |
| 384 #endif /* 0 (bessel functions) */ | |
| 385 | |
| 386 /* Error functions. */ | |
| 387 #if 0 /* Leave these out unless we see they are worth having. */ | |
| 388 | |
| 389 DEFUN ("erf", Ferf, 1, 1, 0, /* | |
| 444 | 390 Return the mathematical error function of NUMBER. |
| 428 | 391 */ |
| 444 | 392 (number)) |
| 428 | 393 { |
| 444 | 394 double d = extract_float (number); |
| 395 IN_FLOAT (d = erf (d), "erf", number); | |
| 428 | 396 return make_float (d); |
| 397 } | |
| 398 | |
| 399 DEFUN ("erfc", Ferfc, 1, 1, 0, /* | |
| 444 | 400 Return the complementary error function of NUMBER. |
| 428 | 401 */ |
| 444 | 402 (number)) |
| 428 | 403 { |
| 444 | 404 double d = extract_float (number); |
| 405 IN_FLOAT (d = erfc (d), "erfc", number); | |
| 428 | 406 return make_float (d); |
| 407 } | |
| 408 | |
| 409 DEFUN ("log-gamma", Flog_gamma, 1, 1, 0, /* | |
| 444 | 410 Return the log gamma of NUMBER. |
| 428 | 411 */ |
| 444 | 412 (number)) |
| 428 | 413 { |
| 444 | 414 double d = extract_float (number); |
| 415 IN_FLOAT (d = lgamma (d), "log-gamma", number); | |
| 428 | 416 return make_float (d); |
| 417 } | |
| 418 | |
| 419 #endif /* 0 (error functions) */ | |
| 420 | |
| 421 | |
| 422 /* Root and Log functions. */ | |
| 423 | |
| 424 DEFUN ("exp", Fexp, 1, 1, 0, /* | |
| 444 | 425 Return the exponential base e of NUMBER. |
| 428 | 426 */ |
| 444 | 427 (number)) |
| 428 | 428 { |
| 444 | 429 double d = extract_float (number); |
| 428 | 430 #ifdef FLOAT_CHECK_DOMAIN |
| 431 if (d > 709.7827) /* Assume IEEE doubles here */ | |
| 444 | 432 range_error ("exp", number); |
| 428 | 433 else if (d < -709.0) |
| 434 return make_float (0.0); | |
| 435 else | |
| 436 #endif | |
| 444 | 437 IN_FLOAT (d = exp (d), "exp", number); |
| 428 | 438 return make_float (d); |
| 439 } | |
| 440 | |
| 441 DEFUN ("expt", Fexpt, 2, 2, 0, /* | |
| 444 | 442 Return the exponential NUMBER1 ** NUMBER2. |
| 428 | 443 */ |
| 444 | 444 (number1, number2)) |
| 428 | 445 { |
| 1983 | 446 #ifdef HAVE_BIGNUM |
| 447 if (INTEGERP (number1) && INTP (number2)) | |
| 448 { | |
| 449 if (INTP (number1)) | |
| 450 { | |
| 451 bignum_set_long (scratch_bignum2, XREALINT (number1)); | |
| 452 bignum_pow (scratch_bignum, scratch_bignum2, XREALINT (number2)); | |
| 453 } | |
| 454 else | |
| 455 bignum_pow (scratch_bignum, XBIGNUM_DATA (number1), | |
| 456 XREALINT (number2)); | |
| 457 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); | |
| 458 } | |
| 459 #endif | |
| 460 | |
| 444 | 461 if (INTP (number1) && /* common lisp spec */ |
| 462 INTP (number2)) /* don't promote, if both are ints */ | |
| 428 | 463 { |
| 464 EMACS_INT retval; | |
| 444 | 465 EMACS_INT x = XINT (number1); |
| 466 EMACS_INT y = XINT (number2); | |
| 428 | 467 |
| 468 if (y < 0) | |
| 469 { | |
| 470 if (x == 1) | |
| 471 retval = 1; | |
| 472 else if (x == -1) | |
| 473 retval = (y & 1) ? -1 : 1; | |
| 474 else | |
| 475 retval = 0; | |
| 476 } | |
| 477 else | |
| 478 { | |
| 479 retval = 1; | |
| 480 while (y > 0) | |
| 481 { | |
| 482 if (y & 1) | |
| 483 retval *= x; | |
| 484 x *= x; | |
| 485 y = (EMACS_UINT) y >> 1; | |
| 486 } | |
| 487 } | |
| 488 return make_int (retval); | |
| 489 } | |
| 490 | |
| 1983 | 491 #if defined(HAVE_BIGFLOAT) && defined(bigfloat_pow) |
| 492 if (BIGFLOATP (number1) && INTEGERP (number2)) | |
| 493 { | |
| 2057 | 494 unsigned long exponent; |
| 1983 | 495 |
| 496 #ifdef HAVE_BIGNUM | |
| 497 if (BIGNUMP (number2)) | |
| 2057 | 498 exponent = bignum_to_ulong (XBIGNUM_DATA (number2)); |
| 1983 | 499 else |
| 500 #endif | |
| 2057 | 501 exponent = XUINT (number2); |
| 1983 | 502 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number1)); |
| 2057 | 503 bigfloat_pow (scratch_bigfloat, XBIGFLOAT_DATA (number1), exponent); |
| 1983 | 504 return make_bigfloat_bf (scratch_bigfloat); |
| 505 } | |
| 506 #endif | |
| 507 | |
| 428 | 508 { |
| 444 | 509 double f1 = extract_float (number1); |
| 510 double f2 = extract_float (number2); | |
| 428 | 511 /* Really should check for overflow, too */ |
| 512 if (f1 == 0.0 && f2 == 0.0) | |
| 513 f1 = 1.0; | |
| 514 # ifdef FLOAT_CHECK_DOMAIN | |
| 515 else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor(f2))) | |
| 444 | 516 domain_error2 ("expt", number1, number2); |
| 428 | 517 # endif /* FLOAT_CHECK_DOMAIN */ |
| 444 | 518 IN_FLOAT2 (f1 = pow (f1, f2), "expt", number1, number2); |
| 428 | 519 return make_float (f1); |
| 520 } | |
| 521 } | |
| 522 | |
| 523 DEFUN ("log", Flog, 1, 2, 0, /* | |
| 444 | 524 Return the natural logarithm of NUMBER. |
| 525 If second optional argument BASE is given, return the logarithm of | |
| 526 NUMBER using that base. | |
| 428 | 527 */ |
| 444 | 528 (number, base)) |
| 428 | 529 { |
| 444 | 530 double d = extract_float (number); |
| 428 | 531 #ifdef FLOAT_CHECK_DOMAIN |
| 532 if (d <= 0.0) | |
| 444 | 533 domain_error2 ("log", number, base); |
| 428 | 534 #endif |
| 535 if (NILP (base)) | |
| 444 | 536 IN_FLOAT (d = log (d), "log", number); |
| 428 | 537 else |
| 538 { | |
| 539 double b = extract_float (base); | |
| 540 #ifdef FLOAT_CHECK_DOMAIN | |
| 541 if (b <= 0.0 || b == 1.0) | |
| 444 | 542 domain_error2 ("log", number, base); |
| 428 | 543 #endif |
| 544 if (b == 10.0) | |
| 444 | 545 IN_FLOAT2 (d = log10 (d), "log", number, base); |
| 428 | 546 else |
| 444 | 547 IN_FLOAT2 (d = (log (d) / log (b)), "log", number, base); |
| 428 | 548 } |
| 549 return make_float (d); | |
| 550 } | |
| 551 | |
| 552 | |
| 553 DEFUN ("log10", Flog10, 1, 1, 0, /* | |
| 444 | 554 Return the logarithm base 10 of NUMBER. |
| 428 | 555 */ |
| 444 | 556 (number)) |
| 428 | 557 { |
| 444 | 558 double d = extract_float (number); |
| 428 | 559 #ifdef FLOAT_CHECK_DOMAIN |
| 560 if (d <= 0.0) | |
| 444 | 561 domain_error ("log10", number); |
| 428 | 562 #endif |
| 444 | 563 IN_FLOAT (d = log10 (d), "log10", number); |
| 428 | 564 return make_float (d); |
| 565 } | |
| 566 | |
| 567 | |
| 568 DEFUN ("sqrt", Fsqrt, 1, 1, 0, /* | |
| 444 | 569 Return the square root of NUMBER. |
| 428 | 570 */ |
| 444 | 571 (number)) |
| 428 | 572 { |
| 1983 | 573 double d; |
| 574 | |
| 575 #if defined(HAVE_BIGFLOAT) && defined(bigfloat_sqrt) | |
| 576 if (BIGFLOATP (number)) | |
| 577 { | |
| 578 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); | |
| 579 bigfloat_sqrt (scratch_bigfloat, XBIGFLOAT_DATA (number)); | |
| 580 return make_bigfloat_bf (scratch_bigfloat); | |
| 581 } | |
| 582 #endif /* HAVE_BIGFLOAT */ | |
| 583 d = extract_float (number); | |
| 428 | 584 #ifdef FLOAT_CHECK_DOMAIN |
| 585 if (d < 0.0) | |
| 444 | 586 domain_error ("sqrt", number); |
| 428 | 587 #endif |
| 444 | 588 IN_FLOAT (d = sqrt (d), "sqrt", number); |
| 428 | 589 return make_float (d); |
| 590 } | |
| 591 | |
| 592 | |
| 593 DEFUN ("cube-root", Fcube_root, 1, 1, 0, /* | |
| 444 | 594 Return the cube root of NUMBER. |
| 428 | 595 */ |
| 444 | 596 (number)) |
| 428 | 597 { |
| 444 | 598 double d = extract_float (number); |
| 428 | 599 #ifdef HAVE_CBRT |
| 444 | 600 IN_FLOAT (d = cbrt (d), "cube-root", number); |
| 428 | 601 #else |
| 602 if (d >= 0.0) | |
| 444 | 603 IN_FLOAT (d = pow (d, 1.0/3.0), "cube-root", number); |
| 428 | 604 else |
| 444 | 605 IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", number); |
| 428 | 606 #endif |
| 607 return make_float (d); | |
| 608 } | |
| 609 | |
| 610 /* Inverse trig functions. */ | |
| 611 | |
| 612 DEFUN ("acosh", Facosh, 1, 1, 0, /* | |
| 444 | 613 Return the inverse hyperbolic cosine of NUMBER. |
| 428 | 614 */ |
| 444 | 615 (number)) |
| 428 | 616 { |
| 444 | 617 double d = extract_float (number); |
| 428 | 618 #ifdef FLOAT_CHECK_DOMAIN |
| 619 if (d < 1.0) | |
| 444 | 620 domain_error ("acosh", number); |
| 428 | 621 #endif |
| 622 #ifdef HAVE_INVERSE_HYPERBOLIC | |
| 444 | 623 IN_FLOAT (d = acosh (d), "acosh", number); |
| 428 | 624 #else |
| 444 | 625 IN_FLOAT (d = log (d + sqrt (d*d - 1.0)), "acosh", number); |
| 428 | 626 #endif |
| 627 return make_float (d); | |
| 628 } | |
| 629 | |
| 630 DEFUN ("asinh", Fasinh, 1, 1, 0, /* | |
| 444 | 631 Return the inverse hyperbolic sine of NUMBER. |
| 428 | 632 */ |
| 444 | 633 (number)) |
| 428 | 634 { |
| 444 | 635 double d = extract_float (number); |
| 428 | 636 #ifdef HAVE_INVERSE_HYPERBOLIC |
| 444 | 637 IN_FLOAT (d = asinh (d), "asinh", number); |
| 428 | 638 #else |
| 444 | 639 IN_FLOAT (d = log (d + sqrt (d*d + 1.0)), "asinh", number); |
| 428 | 640 #endif |
| 641 return make_float (d); | |
| 642 } | |
| 643 | |
| 644 DEFUN ("atanh", Fatanh, 1, 1, 0, /* | |
| 444 | 645 Return the inverse hyperbolic tangent of NUMBER. |
| 428 | 646 */ |
| 444 | 647 (number)) |
| 428 | 648 { |
| 444 | 649 double d = extract_float (number); |
| 428 | 650 #ifdef FLOAT_CHECK_DOMAIN |
| 651 if (d >= 1.0 || d <= -1.0) | |
| 444 | 652 domain_error ("atanh", number); |
| 428 | 653 #endif |
| 654 #ifdef HAVE_INVERSE_HYPERBOLIC | |
| 444 | 655 IN_FLOAT (d = atanh (d), "atanh", number); |
| 428 | 656 #else |
| 444 | 657 IN_FLOAT (d = 0.5 * log ((1.0 + d) / (1.0 - d)), "atanh", number); |
| 428 | 658 #endif |
| 659 return make_float (d); | |
| 660 } | |
| 661 | |
| 662 DEFUN ("cosh", Fcosh, 1, 1, 0, /* | |
| 444 | 663 Return the hyperbolic cosine of NUMBER. |
| 428 | 664 */ |
| 444 | 665 (number)) |
| 428 | 666 { |
| 444 | 667 double d = extract_float (number); |
| 428 | 668 #ifdef FLOAT_CHECK_DOMAIN |
| 669 if (d > 710.0 || d < -710.0) | |
| 444 | 670 range_error ("cosh", number); |
| 428 | 671 #endif |
| 444 | 672 IN_FLOAT (d = cosh (d), "cosh", number); |
| 428 | 673 return make_float (d); |
| 674 } | |
| 675 | |
| 676 DEFUN ("sinh", Fsinh, 1, 1, 0, /* | |
| 444 | 677 Return the hyperbolic sine of NUMBER. |
| 428 | 678 */ |
| 444 | 679 (number)) |
| 428 | 680 { |
| 444 | 681 double d = extract_float (number); |
| 428 | 682 #ifdef FLOAT_CHECK_DOMAIN |
| 683 if (d > 710.0 || d < -710.0) | |
| 444 | 684 range_error ("sinh", number); |
| 428 | 685 #endif |
| 444 | 686 IN_FLOAT (d = sinh (d), "sinh", number); |
| 428 | 687 return make_float (d); |
| 688 } | |
| 689 | |
| 690 DEFUN ("tanh", Ftanh, 1, 1, 0, /* | |
| 444 | 691 Return the hyperbolic tangent of NUMBER. |
| 428 | 692 */ |
| 444 | 693 (number)) |
| 428 | 694 { |
| 444 | 695 double d = extract_float (number); |
| 696 IN_FLOAT (d = tanh (d), "tanh", number); | |
| 428 | 697 return make_float (d); |
| 698 } | |
| 699 | |
| 700 /* Rounding functions */ | |
| 701 | |
| 702 DEFUN ("abs", Fabs, 1, 1, 0, /* | |
| 444 | 703 Return the absolute value of NUMBER. |
| 428 | 704 */ |
| 444 | 705 (number)) |
| 428 | 706 { |
| 444 | 707 if (FLOATP (number)) |
| 428 | 708 { |
| 444 | 709 IN_FLOAT (number = make_float (fabs (XFLOAT_DATA (number))), |
| 710 "abs", number); | |
| 711 return number; | |
| 428 | 712 } |
| 713 | |
| 444 | 714 if (INTP (number)) |
| 1983 | 715 #ifdef HAVE_BIGNUM |
| 716 /* The most negative Lisp fixnum will overflow */ | |
| 717 return (XINT (number) >= 0) ? number : make_integer (- XINT (number)); | |
| 718 #else | |
| 444 | 719 return (XINT (number) >= 0) ? number : make_int (- XINT (number)); |
| 1983 | 720 #endif |
| 721 | |
| 722 #ifdef HAVE_BIGNUM | |
| 723 if (BIGNUMP (number)) | |
| 724 { | |
| 725 if (bignum_sign (XBIGNUM_DATA (number)) >= 0) | |
| 726 return number; | |
| 727 bignum_abs (scratch_bignum, XBIGNUM_DATA (number)); | |
| 728 return make_bignum_bg (scratch_bignum); | |
| 729 } | |
| 730 #endif | |
| 731 | |
| 732 #ifdef HAVE_RATIO | |
| 733 if (RATIOP (number)) | |
| 734 { | |
| 735 if (ratio_sign (XRATIO_DATA (number)) >= 0) | |
| 736 return number; | |
| 737 ratio_abs (scratch_ratio, XRATIO_DATA (number)); | |
| 738 return make_ratio_rt (scratch_ratio); | |
| 739 } | |
| 740 #endif | |
| 741 | |
| 742 #ifdef HAVE_BIGFLOAT | |
| 743 if (BIGFLOATP (number)) | |
| 744 { | |
| 745 if (bigfloat_sign (XBIGFLOAT_DATA (number)) >= 0) | |
| 746 return number; | |
| 747 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); | |
| 748 bigfloat_abs (scratch_bigfloat, XBIGFLOAT_DATA (number)); | |
| 749 return make_bigfloat_bf (scratch_bigfloat); | |
| 750 } | |
| 751 #endif | |
| 428 | 752 |
| 444 | 753 return Fabs (wrong_type_argument (Qnumberp, number)); |
| 428 | 754 } |
| 755 | |
| 756 DEFUN ("float", Ffloat, 1, 1, 0, /* | |
| 444 | 757 Return the floating point number numerically equal to NUMBER. |
| 428 | 758 */ |
| 444 | 759 (number)) |
| 428 | 760 { |
| 444 | 761 if (INTP (number)) |
| 762 return make_float ((double) XINT (number)); | |
| 428 | 763 |
| 1983 | 764 #ifdef HAVE_BIGNUM |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
765 if (BIGNUMP (number)) |
| 1983 | 766 { |
| 767 #ifdef HAVE_BIGFLOAT | |
| 768 if (ZEROP (Vdefault_float_precision)) | |
| 769 #endif | |
| 770 return make_float (bignum_to_double (XBIGNUM_DATA (number))); | |
| 771 #ifdef HAVE_BIGFLOAT | |
| 772 else | |
| 773 { | |
| 774 bigfloat_set_prec (scratch_bigfloat, bigfloat_get_default_prec ()); | |
| 775 bigfloat_set_bignum (scratch_bigfloat, XBIGNUM_DATA (number)); | |
| 776 return make_bigfloat_bf (scratch_bigfloat); | |
| 777 } | |
| 778 #endif /* HAVE_BIGFLOAT */ | |
| 779 } | |
| 780 #endif /* HAVE_BIGNUM */ | |
| 781 | |
| 782 #ifdef HAVE_RATIO | |
| 783 if (RATIOP (number)) | |
| 2092 | 784 return make_float (ratio_to_double (XRATIO_DATA (number))); |
| 1983 | 785 #endif |
| 786 | |
| 444 | 787 if (FLOATP (number)) /* give 'em the same float back */ |
| 788 return number; | |
| 428 | 789 |
| 444 | 790 return Ffloat (wrong_type_argument (Qnumberp, number)); |
| 428 | 791 } |
| 792 | |
| 793 DEFUN ("logb", Flogb, 1, 1, 0, /* | |
| 444 | 794 Return largest integer <= the base 2 log of the magnitude of NUMBER. |
| 428 | 795 This is the same as the exponent of a float. |
| 796 */ | |
| 444 | 797 (number)) |
| 428 | 798 { |
| 444 | 799 double f = extract_float (number); |
| 428 | 800 |
| 801 if (f == 0.0) | |
| 2039 | 802 return make_int (EMACS_INT_MIN); |
| 428 | 803 #ifdef HAVE_LOGB |
| 804 { | |
| 805 Lisp_Object val; | |
| 444 | 806 IN_FLOAT (val = make_int ((EMACS_INT) logb (f)), "logb", number); |
| 434 | 807 return val; |
| 428 | 808 } |
| 809 #else | |
| 810 #ifdef HAVE_FREXP | |
| 811 { | |
| 812 int exqp; | |
| 444 | 813 IN_FLOAT (frexp (f, &exqp), "logb", number); |
| 434 | 814 return make_int (exqp - 1); |
| 428 | 815 } |
| 816 #else | |
| 817 { | |
| 818 int i; | |
| 819 double d; | |
| 820 EMACS_INT val; | |
| 821 if (f < 0.0) | |
| 822 f = -f; | |
| 823 val = -1; | |
| 824 while (f < 0.5) | |
| 825 { | |
| 826 for (i = 1, d = 0.5; d * d >= f; i += i) | |
| 827 d *= d; | |
| 828 f /= d; | |
| 829 val -= i; | |
| 830 } | |
| 831 while (f >= 1.0) | |
| 832 { | |
| 833 for (i = 1, d = 2.0; d * d <= f; i += i) | |
| 834 d *= d; | |
| 835 f /= d; | |
| 836 val += i; | |
| 837 } | |
| 434 | 838 return make_int (val); |
| 428 | 839 } |
| 840 #endif /* ! HAVE_FREXP */ | |
| 841 #endif /* ! HAVE_LOGB */ | |
| 842 } | |
| 843 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
844 #ifdef WITH_NUMBER_TYPES |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
845 #define ROUNDING_CONVERT(conversion, return_float) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
846 CONVERT_WITH_NUMBER_TYPES(conversion, return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
847 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
848 #define ROUNDING_CONVERT(conversion, return_float) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
849 CONVERT_WITHOUT_NUMBER_TYPES(conversion, return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
850 #endif |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
851 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
852 #define CONVERT_WITH_NUMBER_TYPES(conversion, return_float) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
853 if (!NILP (divisor)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
854 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
855 switch (promote_args (&number, &divisor)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
856 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
857 case FIXNUM_T: \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
858 return conversion##_two_fixnum (number, divisor, \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
859 return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
860 MAYBE_TWO_ARGS_WITH_NUMBER_TYPES (conversion, \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
861 BIGNUM, \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
862 return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
863 MAYBE_TWO_ARGS_WITH_NUMBER_TYPES (conversion, \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
864 RATIO, \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
865 return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
866 MAYBE_TWO_ARGS_WITH_NUMBER_TYPES (conversion, \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
867 BIGFLOAT, \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
868 return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
869 default: /* FLOAT_T */ \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
870 return conversion##_two_float (number,divisor, \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
871 return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
872 } \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
873 } \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
874 \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
875 /* Try this first, the arg is probably a float: */ \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
876 if (FLOATP (number)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
877 return conversion##_one_float (number, return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
878 \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
879 MAYBE_ONE_ARG_WITH_NUMBER_TYPES (conversion, \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
880 RATIO, return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
881 MAYBE_ONE_ARG_WITH_NUMBER_TYPES (conversion, \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
882 BIGFLOAT, return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
883 return conversion##_one_mundane_arg (number, divisor, \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
884 return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
885 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
886 #define CONVERT_WITHOUT_NUMBER_TYPES(conversion, return_float) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
887 if (!NILP (divisor)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
888 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
889 /* The promote_args call if number types are available \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
890 does these conversions, we do them too for symmetry: */\ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
891 if (CHARP (number)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
892 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
893 number = make_int (XCHAR (number)); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
894 } \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
895 else if (MARKERP (number)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
896 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
897 number = make_int (marker_position (number)); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
898 } \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
899 \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
900 if (CHARP (divisor)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
901 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
902 divisor = make_int (XCHAR (divisor)); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
903 } \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
904 else if (MARKERP (divisor)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
905 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
906 divisor = make_int (marker_position (divisor)); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
907 } \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
908 \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
909 CHECK_INT_OR_FLOAT (divisor); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
910 if (INTP (number) && INTP (divisor)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
911 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
912 return conversion##_two_fixnum (number, divisor, \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
913 return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
914 } \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
915 else \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
916 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
917 return conversion##_two_float (number, divisor, \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
918 return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
919 } \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
920 } \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
921 \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
922 /* Try this first, the arg is probably a float: */ \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
923 if (FLOATP (number)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
924 return conversion##_one_float (number, return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
925 \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
926 return conversion##_one_mundane_arg (number, divisor, \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
927 return_float) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
928 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
929 #ifdef WITH_NUMBER_TYPES |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
930 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
931 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
932 #define MAYBE_TWO_ARGS_BIGNUM(conversion, return_float) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
933 case BIGNUM_T: \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
934 return conversion##_two_bignum (number, divisor, return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
935 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
936 #define MAYBE_ONE_ARG_BIGNUM(converse, return_float) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
937 if (BIGNUM_P (number)) \ |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
938 return conversion##_one_bignum (number, divisor, return_float) |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
939 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
940 #define MAYBE_TWO_ARGS_BIGNUM(conversion, return_float) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
941 #define MAYBE_ONE_ARG_BIGNUM(converse, return_float) |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
942 #endif |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
943 |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
944 #ifdef HAVE_RATIO |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
945 #define MAYBE_TWO_ARGS_RATIO(conversion, return_float) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
946 case RATIO_T: \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
947 return conversion##_two_ratio (number, divisor, return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
948 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
949 #define MAYBE_ONE_ARG_RATIO(conversion, return_float) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
950 if (RATIOP (number)) \ |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
951 return conversion##_one_ratio (number, divisor, return_float) |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
952 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
953 #define MAYBE_TWO_ARGS_RATIO(conversion, return_float) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
954 #define MAYBE_ONE_ARG_RATIO(converse, return_float) |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
955 #endif |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
956 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
957 #ifdef HAVE_BIGFLOAT |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
958 #define MAYBE_TWO_ARGS_BIGFLOAT(conversion, return_float) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
959 case BIGFLOAT_T: \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
960 return conversion##_two_bigfloat (number, divisor, return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
961 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
962 #define MAYBE_ONE_ARG_BIGFLOAT(conversion, return_float) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
963 if (BIGFLOATP (number)) \ |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
964 return conversion##_one_bigfloat (number, divisor, return_float) |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
965 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
966 #define MAYBE_TWO_ARGS_BIGFLOAT(conversion, return_float) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
967 #define MAYBE_ONE_ARG_BIGFLOAT(converse, return_float) |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
968 #endif |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
969 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
970 #define MAYBE_TWO_ARGS_WITH_NUMBER_TYPES(convers, upcase, return_float) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
971 MAYBE_TWO_ARGS_##upcase(convers, return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
972 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
973 #define MAYBE_ONE_ARG_WITH_NUMBER_TYPES(convers, upcase, return_float) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
974 MAYBE_ONE_ARG_##upcase(convers, return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
975 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
976 #endif /* WITH_NUMBER_TYPES */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
977 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
978 #define MAYBE_EFF(str) (return_float ? "f" str : str) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
979 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
980 /* The WITH_NUMBER_TYPES code calls promote_args, which accepts chars and |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
981 markers as equivalent to ints. This block does the same for |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
982 single-argument calls. */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
983 #define MAYBE_CHAR_OR_MARKER(conversion) do { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
984 if (CHARP (number)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
985 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
986 return conversion##_one_mundane_arg (make_int (XCHAR (number)), \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
987 divisor, return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
988 } \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
989 \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
990 if (MARKERP (number)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
991 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
992 return conversion##_one_mundane_arg (make_int \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
993 (marker_position(number)), \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
994 divisor, return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
995 } \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
996 } while (0) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
997 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
998 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
999 /* The guts of the implementations of the various rounding functions: */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1000 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1001 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1002 ceiling_two_fixnum (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1003 int return_float) |
| 428 | 1004 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1005 EMACS_INT i1 = XREALINT (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1006 EMACS_INT i2 = XREALINT (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1007 EMACS_INT i3 = 0, i4 = 0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1008 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1009 if (i2 == 0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1010 return arith_error2 ("ceiling", number, divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1011 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1012 /* With C89's integer /, the result is implementation-defined if either |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1013 operand is negative, so use only nonnegative operands. Here we do |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1014 basically the opposite of what floor_two_fixnum does, we add one in the |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1015 non-negative case: */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1016 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1017 /* Make sure we use the same signs for the modulus calculation as for the |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1018 quotient calculation: */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1019 if (i2 < 0) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1020 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1021 if (i1 <= 0) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1022 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1023 i3 = -i1 / -i2; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1024 /* Quotient is positive; add one to give the figure for |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1025 ceiling. */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1026 if (0 != (-i1 % -i2)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1027 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1028 ++i3; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1029 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1030 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1031 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1032 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1033 /* Quotient is negative; no need to add one. */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1034 i3 = -(i1 / -i2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1035 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1036 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1037 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1038 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1039 if (i1 < 0) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1040 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1041 /* Quotient is negative; no need to add one. */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1042 i3 = -(-i1 / i2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1043 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1044 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1045 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1046 i3 = i1 / i2; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1047 /* Quotient is positive; add one to give the figure for |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1048 ceiling. */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1049 if (0 != (i1 % i2)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1050 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1051 ++i3; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1052 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1053 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1054 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1055 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1056 i4 = i1 - (i3 * i2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1057 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1058 if (!return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1059 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1060 return values2 (make_int (i3), make_int (i4)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1061 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1062 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1063 return values2 (make_float ((double)i3), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1064 make_int (i4)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1065 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1066 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1067 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1068 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1069 ceiling_two_bignum (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1070 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1071 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1072 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1073 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1074 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1075 return arith_error2 ("ceiling", number, divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1076 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1077 bignum_ceil (scratch_bignum, XBIGNUM_DATA (number), XBIGNUM_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1078 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1079 res0 = return_float ? make_float (bignum_to_double (scratch_bignum)) : |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1080 Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1081 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1082 if (bignum_divisible_p (XBIGNUM_DATA (number), XBIGNUM_DATA (divisor))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1083 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1084 res1 = Qzero; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1085 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1086 else |
| 428 | 1087 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1088 bignum_mul (scratch_bignum, scratch_bignum, XBIGNUM_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1089 bignum_sub (scratch_bignum, XBIGNUM_DATA (number), scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1090 res1 = Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1091 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1092 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1093 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1094 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1095 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1096 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1097 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1098 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1099 ceiling_two_ratio (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1100 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1101 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1102 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1103 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1104 if (ratio_sign (XRATIO_DATA (divisor)) == 0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1105 return arith_error2 ("ceiling", number, divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1106 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1107 ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1108 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1109 bignum_ceil (scratch_bignum, ratio_numerator (scratch_ratio), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1110 ratio_denominator (scratch_ratio)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1111 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1112 res0 = return_float ? make_float (bignum_to_double (scratch_bignum)) : |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1113 Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1114 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1115 if (bignum_divisible_p (ratio_numerator (scratch_ratio), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1116 ratio_denominator (scratch_ratio))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1117 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1118 res1 = Qzero; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1119 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1120 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1121 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1122 ratio_set_bignum (scratch_ratio, scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1123 ratio_mul (scratch_ratio2, scratch_ratio, XRATIO_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1124 ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1125 res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1126 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1127 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1128 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1129 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1130 #endif /* HAVE_RATIO */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1131 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1132 #ifdef HAVE_BIGFLOAT |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1133 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1134 ceiling_two_bigfloat (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1135 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1136 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1137 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1138 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1139 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1140 return arith_error2 ("ceiling", number, divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1141 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1142 bigfloat_set_prec (scratch_bigfloat, max (XBIGFLOAT_GET_PREC (number), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1143 XBIGFLOAT_GET_PREC (divisor))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1144 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1145 XBIGFLOAT_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1146 bigfloat_ceil (scratch_bigfloat, scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1147 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1148 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1149 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1150 res0 = make_bigfloat_bf (scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1151 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1152 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1153 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1154 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1155 bignum_set_bigfloat (scratch_bignum, scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1156 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1157 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1158 res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1159 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1160 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1161 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1162 bigfloat_mul (scratch_bigfloat, scratch_bigfloat, XBIGFLOAT_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1163 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number), scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1164 return values2 (res0, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1165 Fcanonicalize_number (make_bigfloat_bf (scratch_bigfloat))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1166 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1167 #endif /* HAVE_BIGFLOAT */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1168 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1169 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1170 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1171 ceiling_one_ratio (Lisp_Object number, Lisp_Object UNUSED (divisor), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1172 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1173 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1174 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1175 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1176 bignum_ceil (scratch_bignum, XRATIO_NUMERATOR (number), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1177 XRATIO_DENOMINATOR (number)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1178 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1179 res0 = return_float ? make_float (bignum_to_double (scratch_bignum)) : |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1180 Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1181 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1182 if (bignum_divisible_p (XRATIO_NUMERATOR (number), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1183 XRATIO_DENOMINATOR (number))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1184 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1185 res1 = Qzero; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1186 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1187 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1188 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1189 ratio_set_bignum (scratch_ratio2, scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1190 ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1191 res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio)); |
| 428 | 1192 } |
| 1193 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1194 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1195 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1196 #endif /* HAVE_RATIO */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1197 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1198 #ifdef HAVE_BIGFLOAT |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1199 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1200 ceiling_one_bigfloat (Lisp_Object number, Lisp_Object UNUSED (divisor), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1201 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1202 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1203 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1204 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1205 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1206 bigfloat_ceil (scratch_bigfloat, XBIGFLOAT_DATA (number)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1207 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1208 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1209 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1210 res0 = make_bigfloat_bf (scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1211 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1212 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1213 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1214 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1215 bignum_set_bigfloat (scratch_bignum, scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1216 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1217 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1218 res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1219 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1220 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1221 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1222 bigfloat_sub (scratch_bigfloat2, XBIGFLOAT_DATA (number), scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1223 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1224 res1 = make_bigfloat_bf (scratch_bigfloat2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1225 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1226 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1227 #endif /* HAVE_BIGFLOAT */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1228 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1229 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1230 ceiling_two_float (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1231 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1232 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1233 double f1 = extract_float (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1234 double f2 = extract_float (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1235 double f0, remain; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1236 Lisp_Object res0; |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1237 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1238 if (f2 == 0.0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1239 return arith_error2 ("ceiling", number, divisor); |
|
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1240 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1241 IN_FLOAT2 (f0 = ceil (f1 / f2), MAYBE_EFF("ceiling"), number, divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1242 IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF("ceiling"), number, divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1243 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1244 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1245 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1246 res0 = make_float(f0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1247 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1248 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1249 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1250 res0 = float_to_int (f0, MAYBE_EFF("ceiling"), number, divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1251 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1252 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1253 return values2 (res0, make_float (remain)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1254 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1255 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1256 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1257 ceiling_one_float (Lisp_Object number, int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1258 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1259 double d, remain; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1260 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1261 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1262 IN_FLOAT ((d = ceil (XFLOAT_DATA (number))), MAYBE_EFF("ceiling"), number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1263 IN_FLOAT ((remain = XFLOAT_DATA (number) - d), MAYBE_EFF("ceiling"), number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1264 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1265 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1266 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1267 res0 = make_float (d); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1268 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1269 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1270 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1271 res0 = float_to_int (d, MAYBE_EFF("ceiling"), number, Qunbound); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1272 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1273 return values2 (res0, make_float (remain)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1274 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1275 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1276 EXFUN (Fceiling, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1277 EXFUN (Ffceiling, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1278 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1279 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1280 ceiling_one_mundane_arg (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1281 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1282 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1283 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1284 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1285 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1286 if (INTP (number)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1287 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1288 return values2 (make_float ((double) XINT (number)), Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1289 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1290 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1291 else if (BIGNUMP (number)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1292 { |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1293 return values2 (make_float |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1294 (bignum_to_double (XBIGNUM_DATA (number))), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1295 Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1296 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1297 #endif |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1298 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1299 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1300 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1301 if (INTEGERP (number)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1302 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1303 return values2 (number, Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1304 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1305 } |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1306 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1307 MAYBE_CHAR_OR_MARKER (ceiling); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1308 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1309 return Ffceiling (wrong_type_argument (Qnumberp, number), divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1310 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1311 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1312 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1313 floor_two_fixnum (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1314 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1315 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1316 EMACS_INT i1 = XREALINT (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1317 EMACS_INT i2 = XREALINT (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1318 EMACS_INT i3 = 0, i4 = 0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1319 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1320 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1321 if (i2 == 0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1322 return arith_error2 ("floor", number, divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1323 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1324 /* With C89's integer /, the result is implementation-defined if either |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1325 operand is negative, so use only nonnegative operands. Notice also that |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1326 we're forcing the quotient of any negative numbers towards minus |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1327 infinity. */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1328 i3 = (i2 < 0 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1329 ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1330 : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1331 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1332 i4 = i1 - (i3 * i2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1333 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1334 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1335 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1336 res0 = make_float ((double)i3); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1337 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1338 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1339 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1340 res0 = make_int (i3); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1341 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1342 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1343 return values2 (res0, make_int (i4)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1344 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1345 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1346 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1347 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1348 floor_two_bignum (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1349 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1350 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1351 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1352 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1353 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1354 return arith_error2 ("floor", number, divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1355 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1356 bignum_floor (scratch_bignum, XBIGNUM_DATA (number), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1357 XBIGNUM_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1358 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1359 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1360 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1361 res0 = make_float (bignum_to_double (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1362 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1363 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1364 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1365 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1366 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1367 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1368 if (bignum_divisible_p (XBIGNUM_DATA (number), XBIGNUM_DATA (divisor))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1369 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1370 res1 = Qzero; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1371 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1372 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1373 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1374 bignum_mul (scratch_bignum, scratch_bignum, XBIGNUM_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1375 bignum_sub (scratch_bignum, XBIGNUM_DATA (number), scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1376 res1 = Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1377 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1378 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1379 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1380 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1381 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1382 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1383 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1384 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1385 floor_two_ratio (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1386 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1387 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1388 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1389 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1390 if (ratio_sign (XRATIO_DATA (divisor)) == 0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1391 return arith_error2 ("floor", number, divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1392 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1393 ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1394 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1395 bignum_floor (scratch_bignum, ratio_numerator (scratch_ratio), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1396 ratio_denominator (scratch_ratio)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1397 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1398 res0 = return_float ? make_float (bignum_to_double (scratch_bignum)) : |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1399 Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1400 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1401 if (bignum_divisible_p (ratio_numerator (scratch_ratio), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1402 ratio_denominator (scratch_ratio))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1403 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1404 res1 = Qzero; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1405 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1406 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1407 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1408 ratio_set_bignum (scratch_ratio, scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1409 ratio_mul (scratch_ratio, scratch_ratio, XRATIO_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1410 ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1411 res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1412 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1413 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1414 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1415 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1416 #endif /* HAVE_RATIO */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1417 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1418 #ifdef HAVE_BIGFLOAT |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1419 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1420 floor_two_bigfloat (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1421 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1422 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1423 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1424 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1425 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1426 return arith_error2 ("floor", number, divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1427 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1428 bigfloat_set_prec (scratch_bigfloat, max (XBIGFLOAT_GET_PREC (number), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1429 XBIGFLOAT_GET_PREC (divisor))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1430 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1431 XBIGFLOAT_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1432 bigfloat_floor (scratch_bigfloat, scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1433 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1434 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1435 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1436 res0 = make_bigfloat_bf (scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1437 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1438 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1439 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1440 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1441 bignum_set_bigfloat (scratch_bignum, scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1442 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1443 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1444 res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1445 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1446 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1447 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1448 bigfloat_mul (scratch_bigfloat2, scratch_bigfloat, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1449 XBIGFLOAT_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1450 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number), scratch_bigfloat2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1451 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1452 return values2 (res0, make_bigfloat_bf (scratch_bigfloat)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1453 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1454 #endif /* HAVE_BIGFLOAT */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1455 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1456 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1457 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1458 floor_one_ratio (Lisp_Object number, Lisp_Object UNUSED (divisor), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1459 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1460 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1461 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1462 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1463 bignum_floor (scratch_bignum, XRATIO_NUMERATOR (number), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1464 XRATIO_DENOMINATOR (number)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1465 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1466 res0 = return_float ? make_float (bignum_to_double (scratch_bignum)) : |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1467 Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1468 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1469 if (bignum_divisible_p (XRATIO_NUMERATOR (number), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1470 XRATIO_DENOMINATOR (number))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1471 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1472 res1 = Qzero; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1473 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1474 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1475 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1476 ratio_set_bignum (scratch_ratio2, scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1477 ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1478 res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1479 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1480 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1481 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1482 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1483 #endif /* HAVE_RATIO */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1484 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1485 #ifdef HAVE_BIGFLOAT |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1486 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1487 floor_one_bigfloat (Lisp_Object number, Lisp_Object UNUSED (divisor), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1488 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1489 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1490 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1491 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1492 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1493 bigfloat_floor (scratch_bigfloat, XBIGFLOAT_DATA (number)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1494 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1495 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1496 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1497 res0 = make_bigfloat_bf (scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1498 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1499 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1500 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1501 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1502 bignum_set_bigfloat (scratch_bignum, scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1503 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1504 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1505 res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1506 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1507 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1508 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1509 bigfloat_sub (scratch_bigfloat2, XBIGFLOAT_DATA (number), scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1510 return values2 (res0, make_bigfloat_bf (scratch_bigfloat2)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1511 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1512 #endif /* HAVE_BIGFLOAT */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1513 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1514 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1515 floor_two_float (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1516 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1517 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1518 double f1 = extract_float (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1519 double f2 = extract_float (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1520 double f0, remain; |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1521 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1522 if (f2 == 0.0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1523 return arith_error2 ("floor", number, divisor); |
|
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1524 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1525 IN_FLOAT2 (f0 = floor (f1 / f2), MAYBE_EFF ("floor"), number, divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1526 IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF ("floor"), number, divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1527 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1528 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1529 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1530 return values2 (make_float (f0), make_float (remain)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1531 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1532 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1533 return values2 (float_to_int (f0, MAYBE_EFF ("floor"), number, divisor), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1534 make_float (remain)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1535 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1536 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1537 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1538 floor_one_float (Lisp_Object number, int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1539 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1540 double d, d1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1541 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1542 IN_FLOAT ((d = floor (XFLOAT_DATA (number))), MAYBE_EFF ("floor"), number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1543 IN_FLOAT ((d1 = XFLOAT_DATA (number) - d), MAYBE_EFF ("floor"), number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1544 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1545 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1546 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1547 return values2 (make_float (d), make_float (d1)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1548 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1549 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1550 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1551 return values2 (float_to_int (d, MAYBE_EFF ("floor"), number, Qunbound), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1552 make_float (d1)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1553 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1554 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1555 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1556 EXFUN (Ffloor, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1557 EXFUN (Fffloor, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1558 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1559 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1560 floor_one_mundane_arg (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1561 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1562 { |
| 1983 | 1563 if (INTEGERP (number)) |
| 1564 { | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1565 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1566 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1567 return values2 (make_float (extract_float (number)), Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1568 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1569 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1570 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1571 return values2 (number, Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1572 } |
| 1983 | 1573 } |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1574 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1575 MAYBE_CHAR_OR_MARKER (floor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1576 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1577 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1578 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1579 return Fffloor (wrong_type_argument (Qnumberp, number), divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1580 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1581 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1582 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1583 return Ffloor (wrong_type_argument (Qnumberp, number), divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1584 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1585 } |
| 1983 | 1586 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1587 /* Algorithm taken from cl-extra.el, now to be found as cl-round in |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1588 tests/automated/lisp-tests.el. */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1589 static Lisp_Object |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1590 round_two_fixnum (Lisp_Object number, Lisp_Object divisor, int return_float) |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1591 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1592 EMACS_INT i1 = XREALINT (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1593 EMACS_INT i2 = XREALINT (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1594 EMACS_INT i0, hi2, flooring, floored, flsecond; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1595 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1596 if (i2 == 0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1597 return arith_error2 ("round", number, divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1598 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1599 hi2 = i2 < 0 ? -( -i2 / 2) : i2 / 2; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1600 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1601 flooring = hi2 + i1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1602 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1603 floored = (i2 < 0 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1604 ? (flooring <= 0 ? -flooring / -i2 : -1 - ((flooring - 1) / -i2)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1605 : (flooring < 0 ? -1 - ((-1 - flooring) / i2) : flooring / i2)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1606 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1607 flsecond = flooring - (floored * i2); |
| 1983 | 1608 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1609 if (0 == flsecond |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1610 && (i2 == (hi2 + hi2)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1611 && (0 != (floored % 2))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1612 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1613 i0 = floored - 1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1614 return values2 (return_float ? make_float ((double)i0) : |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1615 make_int (i0), make_int (hi2)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1616 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1617 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1618 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1619 return values2 (return_float ? make_float ((double)floored) : |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1620 make_int (floored), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1621 make_int (flsecond - hi2)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1622 } |
| 428 | 1623 } |
| 1624 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1625 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1626 static void |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1627 round_two_bignum_1 (bignum number, bignum divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1628 Lisp_Object *res, Lisp_Object *remain) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1629 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1630 bignum flooring, floored, hi2, flsecond; |
| 428 | 1631 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1632 if (bignum_divisible_p (number, divisor)) |
| 1983 | 1633 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1634 bignum_div (scratch_bignum, number, divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1635 *res = make_bignum_bg (scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1636 *remain = Qzero; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1637 return; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1638 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1639 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1640 bignum_set_long (scratch_bignum, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1641 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1642 bignum_div (scratch_bignum2, divisor, scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1643 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1644 bignum_init (hi2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1645 bignum_set (hi2, scratch_bignum2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1646 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1647 bignum_add (scratch_bignum, scratch_bignum2, number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1648 bignum_init (flooring); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1649 bignum_set (flooring, scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1650 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1651 bignum_floor (scratch_bignum, flooring, divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1652 bignum_init (floored); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1653 bignum_set (floored, scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1654 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1655 bignum_mul (scratch_bignum2, scratch_bignum, divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1656 bignum_sub (scratch_bignum, flooring, scratch_bignum2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1657 bignum_init (flsecond); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1658 bignum_set (flsecond, scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1659 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1660 bignum_set_long (scratch_bignum, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1661 bignum_mul (scratch_bignum2, scratch_bignum, hi2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1662 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1663 if (bignum_sign (flsecond) == 0 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1664 && bignum_eql (divisor, scratch_bignum2) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1665 && (1 == bignum_testbit (floored, 0))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1666 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1667 bignum_set_long (scratch_bignum, 1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1668 bignum_sub (floored, floored, scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1669 *res = make_bignum_bg (floored); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1670 *remain = make_bignum_bg (hi2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1671 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1672 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1673 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1674 bignum_sub (scratch_bignum, flsecond, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1675 hi2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1676 *res = make_bignum_bg (floored); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1677 *remain = make_bignum_bg (scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1678 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1679 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1680 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1681 static Lisp_Object |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1682 round_two_bignum (Lisp_Object number, Lisp_Object divisor, int return_float) |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1683 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1684 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1685 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1686 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1687 return arith_error2 ("round", number, divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1688 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1689 round_two_bignum_1 (XBIGNUM_DATA (number), XBIGNUM_DATA (divisor), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1690 &res0, &res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1691 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1692 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1693 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1694 res0 = make_float (bignum_to_double (XBIGNUM_DATA (res0))); |
| 1983 | 1695 } |
| 1696 else | |
| 1697 { | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1698 res0 = Fcanonicalize_number (res0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1699 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1700 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1701 return values2 (res0, Fcanonicalize_number (res1)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1702 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1703 #endif /* HAVE_BIGNUM */ |
| 1983 | 1704 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1705 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1706 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1707 round_two_ratio (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1708 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1709 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1710 Lisp_Object res0, res1; |
| 1983 | 1711 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1712 if (ratio_sign (XRATIO_DATA (divisor)) == 0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1713 return arith_error2 ("round", number, divisor); |
| 1983 | 1714 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1715 ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor)); |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1716 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1717 round_two_bignum_1 (ratio_numerator (scratch_ratio), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1718 ratio_denominator (scratch_ratio), &res0, &res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1719 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1720 if (!ZEROP (res1)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1721 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1722 /* The numerator and denominator don't round exactly, calculate a |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1723 ratio remainder: */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1724 ratio_set_bignum (scratch_ratio2, XBIGNUM_DATA (res0)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1725 ratio_mul (scratch_ratio, scratch_ratio2, XRATIO_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1726 ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio); |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1727 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1728 res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1729 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1730 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1731 res0 = return_float ? |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1732 make_float ((double)bignum_to_double(XBIGNUM_DATA (res0))) : |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1733 Fcanonicalize_number (res0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1734 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1735 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1736 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1737 #endif /* HAVE_RATIO */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1738 |
| 1983 | 1739 #ifdef HAVE_BIGFLOAT |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1740 /* This is the logic of emacs_rint above, no more and no less. */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1741 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1742 round_one_bigfloat_1 (bigfloat number) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1743 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1744 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1745 unsigned long prec = bigfloat_get_prec (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1746 |
| 4828 | 1747 #if 0 |
| 1748 /* This causes the following GCC warning: | |
| 1749 | |
| 1750 /xemacs/latest-fix/src/floatfns.c:1764: warning: dereferencing type-punned pointer will break strict-aliasing rules | |
| 1751 | |
| 1752 and furthermore, it's a useless assert, since `number' is stored on | |
| 1753 the stack and so its address can never be the same as `scratch_bigfloat' | |
| 1754 or `scratch_bigfloat2', which are stored in the data segment. | |
| 1755 | |
| 1756 -- ben */ | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1757 assert ((bigfloat *)(&number) != (bigfloat *)&scratch_bigfloat |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1758 && (bigfloat *)(&number) != (bigfloat *)(&scratch_bigfloat2)); |
| 4828 | 1759 #endif |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1760 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1761 bigfloat_set_prec (scratch_bigfloat, prec); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1762 bigfloat_set_prec (scratch_bigfloat2, prec); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1763 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1764 bigfloat_set_double (scratch_bigfloat, 0.5); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1765 bigfloat_add (scratch_bigfloat2, scratch_bigfloat, number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1766 bigfloat_floor (scratch_bigfloat, scratch_bigfloat2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1767 res0 = make_bigfloat_bf (scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1768 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1769 bigfloat_sub (scratch_bigfloat2, scratch_bigfloat, number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1770 bigfloat_abs (scratch_bigfloat, scratch_bigfloat2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1771 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1772 bigfloat_set_double (scratch_bigfloat2, 0.5); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1773 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1774 do { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1775 if (!bigfloat_ge (scratch_bigfloat, scratch_bigfloat2)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1776 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1777 break; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1778 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1779 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1780 if (!bigfloat_gt (scratch_bigfloat, scratch_bigfloat2)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1781 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1782 bigfloat_set_double (scratch_bigfloat2, 2.0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1783 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (res0), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1784 scratch_bigfloat2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1785 bigfloat_floor (scratch_bigfloat2, scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1786 bigfloat_set_double (scratch_bigfloat, 2.0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1787 bigfloat_mul (scratch_bigfloat2, scratch_bigfloat2, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1788 scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1789 if (bigfloat_eql (scratch_bigfloat2, XBIGFLOAT_DATA (res0))) |
| 1995 | 1790 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1791 break; |
| 1995 | 1792 } |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1793 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1794 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1795 if (bigfloat_lt (XBIGFLOAT_DATA (res0), number)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1796 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1797 bigfloat_set_double (scratch_bigfloat2, 1.0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1798 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1799 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1800 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1801 bigfloat_set_double (scratch_bigfloat2, -1.0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1802 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1803 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1804 bigfloat_set (scratch_bigfloat, XBIGFLOAT_DATA (res0)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1805 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1806 bigfloat_add (XBIGFLOAT_DATA (res0), scratch_bigfloat2, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1807 scratch_bigfloat); |
| 428 | 1808 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1809 } while (0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1810 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1811 return res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1812 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1813 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1814 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1815 round_two_bigfloat (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1816 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1817 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1818 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1819 bigfloat divided; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1820 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1821 unsigned long prec = max (XBIGFLOAT_GET_PREC (number), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1822 XBIGFLOAT_GET_PREC (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1823 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1824 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1825 return arith_error2 ("round", number, divisor); |
| 428 | 1826 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1827 bigfloat_init (divided); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1828 bigfloat_set_prec (divided, prec); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1829 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1830 bigfloat_div (divided, XBIGFLOAT_DATA (number), XBIGFLOAT_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1831 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1832 res0 = round_one_bigfloat_1 (divided); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1833 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1834 bigfloat_set_prec (scratch_bigfloat, prec); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1835 bigfloat_set_prec (scratch_bigfloat2, prec); |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1836 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1837 bigfloat_mul (scratch_bigfloat, XBIGFLOAT_DATA (res0), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1838 XBIGFLOAT_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1839 bigfloat_sub (scratch_bigfloat2, XBIGFLOAT_DATA (number), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1840 scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1841 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1842 res1 = make_bigfloat_bf (scratch_bigfloat2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1843 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1844 if (!return_float) |
| 428 | 1845 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1846 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1847 bignum_set_bigfloat (scratch_bignum, XBIGFLOAT_DATA (res0)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1848 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1849 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1850 res0 = make_int ((EMACS_INT) bigfloat_to_long (XBIGFLOAT_DATA (res0))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1851 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1852 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1853 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1854 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1855 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1856 #endif /* HAVE_BIGFLOAT */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1857 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1858 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1859 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1860 round_one_ratio (Lisp_Object number, Lisp_Object UNUSED (divisor), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1861 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1862 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1863 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1864 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1865 round_two_bignum_1 (XRATIO_NUMERATOR (number), XRATIO_DENOMINATOR (number), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1866 &res0, &res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1867 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1868 if (!ZEROP (res1)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1869 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1870 ratio_set_bignum (scratch_ratio2, XBIGNUM_DATA (res0)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1871 ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1872 res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio)); |
| 428 | 1873 } |
| 1874 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1875 res0 = return_float ? |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1876 make_float ((double)bignum_to_double(XBIGNUM_DATA (res0))) : |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1877 Fcanonicalize_number (res0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1878 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1879 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1880 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1881 #endif /* HAVE_RATIO */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1882 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1883 #ifdef HAVE_BIGFLOAT |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1884 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1885 round_one_bigfloat (Lisp_Object number, Lisp_Object UNUSED (divisor), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1886 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1887 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1888 Lisp_Object res0 = round_one_bigfloat_1 (XBIGFLOAT_DATA (number)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1889 Lisp_Object res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1890 |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1891 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number), |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1892 XBIGFLOAT_DATA (res0)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1893 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1894 res1 = make_bigfloat_bf (scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1895 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1896 if (!return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1897 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1898 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1899 bignum_set_bigfloat (scratch_bignum, XBIGFLOAT_DATA (res0)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1900 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1901 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1902 res0 = make_int ((EMACS_INT) bigfloat_to_long |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1903 (XBIGFLOAT_DATA (res0))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1904 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1905 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1906 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1907 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1908 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1909 #endif /* HAVE_BIGFLOAT */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1910 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1911 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1912 round_two_float (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1913 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1914 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1915 double f1 = extract_float (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1916 double f2 = extract_float (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1917 double f0, remain; |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1918 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1919 if (f2 == 0.0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1920 return arith_error2 ("round", number, divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1921 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1922 IN_FLOAT2 ((f0 = emacs_rint (f1 / f2)), MAYBE_EFF ("round"), number, |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1923 divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1924 IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF ("round"), number, divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1925 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1926 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1927 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1928 return values2 (make_float (f0), make_float (remain)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1929 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1930 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1931 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1932 return values2 (float_to_int (f0, MAYBE_EFF("round"), number, divisor), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1933 make_float (remain)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1934 } |
| 428 | 1935 } |
| 1936 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1937 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1938 round_one_float (Lisp_Object number, int return_float) |
| 428 | 1939 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1940 double d; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1941 /* Screw the prevailing rounding mode. */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1942 IN_FLOAT ((d = emacs_rint (XFLOAT_DATA (number))), MAYBE_EFF ("round"), |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1943 number); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1944 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1945 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1946 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1947 return values2 (make_float (d), make_float (XFLOAT_DATA (number) - d)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1948 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1949 else |
| 428 | 1950 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1951 return values2 ((float_to_int (d, MAYBE_EFF ("round"), number, |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1952 Qunbound)), |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1953 make_float (XFLOAT_DATA (number) - d)); |
| 428 | 1954 } |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1955 } |
| 428 | 1956 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1957 EXFUN (Fround, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1958 EXFUN (Ffround, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1959 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1960 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1961 round_one_mundane_arg (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1962 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1963 { |
| 1983 | 1964 if (INTEGERP (number)) |
| 1965 { | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1966 if (return_float) |
| 1983 | 1967 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1968 return values2 (make_float (extract_float (number)), Qzero); |
| 1983 | 1969 } |
| 1970 else | |
| 1971 { | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1972 return values2 (number, Qzero); |
| 1983 | 1973 } |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1974 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1975 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1976 MAYBE_CHAR_OR_MARKER (round); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1977 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1978 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1979 { |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1980 return Ffround (wrong_type_argument (Qnumberp, number), divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1981 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1982 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1983 { |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1984 return Fround (wrong_type_argument (Qnumberp, number), divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1985 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1986 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1987 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1988 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1989 truncate_two_fixnum (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1990 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1991 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1992 EMACS_INT i1 = XREALINT (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1993 EMACS_INT i2 = XREALINT (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1994 EMACS_INT i0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1995 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1996 if (i2 == 0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1997 return arith_error2 ("truncate", number, divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1998 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1999 /* We're truncating towards zero, so apart from avoiding the C89 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2000 implementation-defined behaviour with truncation and negative numbers, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2001 we don't need to do anything further: */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2002 i0 = (i2 < 0 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2003 ? (i1 <= 0 ? -i1 / -i2 : -(i1 / -i2)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2004 : (i1 < 0 ? -(-i1 / i2) : i1 / i2)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2005 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2006 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2007 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2008 return values2 (make_float ((double)i0), make_int (i1 - (i0 * i2))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2009 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2010 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2011 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2012 return values2 (make_int (i0), make_int (i1 - (i0 * i2))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2013 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2014 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2015 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2016 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2017 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2018 truncate_two_bignum (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2019 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2020 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2021 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2022 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2023 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
2024 return arith_error2 ("truncate", number, divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2025 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2026 bignum_div (scratch_bignum, XBIGNUM_DATA (number), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2027 XBIGNUM_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2028 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2029 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2030 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2031 res0 = make_float (bignum_to_double (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2032 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2033 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2034 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2035 res0 = make_bignum_bg (scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2036 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2037 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2038 if (bignum_divisible_p (XBIGNUM_DATA (number), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2039 XBIGNUM_DATA (divisor))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2040 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2041 return values2 (Fcanonicalize_number (res0), Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2042 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2043 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2044 bignum_mul (scratch_bignum2, scratch_bignum, XBIGNUM_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2045 bignum_sub (scratch_bignum, XBIGNUM_DATA (number), scratch_bignum2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2046 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2047 return values2 (Fcanonicalize_number (res0), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2048 Fcanonicalize_number (make_bignum_bg (scratch_bignum))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2049 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2050 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2051 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2052 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2053 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2054 truncate_two_ratio (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2055 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2056 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2057 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2058 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2059 if (ratio_sign (XRATIO_DATA (divisor)) == 0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
2060 return arith_error2 ("truncate", number, divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2061 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2062 ratio_div (scratch_ratio, XRATIO_DATA (number), XRATIO_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2063 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2064 bignum_div (scratch_bignum, ratio_numerator (scratch_ratio), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2065 ratio_denominator (scratch_ratio)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2066 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2067 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2068 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2069 res0 = make_float (bignum_to_double (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2070 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2071 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2072 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2073 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2074 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2075 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2076 if (bignum_divisible_p (ratio_numerator (scratch_ratio), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2077 ratio_denominator (scratch_ratio))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2078 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2079 return values2 (res0, Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2080 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2081 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2082 ratio_set_bignum (scratch_ratio2, scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2083 ratio_mul (scratch_ratio, scratch_ratio2, XRATIO_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2084 ratio_sub (scratch_ratio2, XRATIO_DATA (number), scratch_ratio); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2085 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2086 return values2 (res0, Fcanonicalize_number (make_ratio_rt(scratch_ratio2))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2087 } |
| 1983 | 2088 #endif |
| 2089 | |
| 2090 #ifdef HAVE_BIGFLOAT | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2091 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2092 truncate_two_bigfloat (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2093 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2094 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2095 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2096 unsigned long prec = max (XBIGFLOAT_GET_PREC (number), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2097 XBIGFLOAT_GET_PREC (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2098 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2099 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
2100 return arith_error2 ("truncate", number, divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2101 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2102 bigfloat_set_prec (scratch_bigfloat, prec); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2103 bigfloat_set_prec (scratch_bigfloat2, prec); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2104 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2105 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (number), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2106 XBIGFLOAT_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2107 bigfloat_trunc (scratch_bigfloat, scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2108 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2109 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2110 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2111 res0 = make_bigfloat_bf (scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2112 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2113 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2114 { |
| 1983 | 2115 #ifdef HAVE_BIGNUM |
| 2116 bignum_set_bigfloat (scratch_bignum, scratch_bigfloat); | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2117 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
| 1983 | 2118 #else |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2119 res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat)); |
| 1983 | 2120 #endif /* HAVE_BIGNUM */ |
| 2121 } | |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
2122 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2123 bigfloat_mul (scratch_bigfloat2, scratch_bigfloat, XBIGFLOAT_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2124 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number), scratch_bigfloat2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2125 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2126 return values2 (res0, make_bigfloat_bf (scratch_bigfloat)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2127 } |
| 1983 | 2128 #endif /* HAVE_BIGFLOAT */ |
| 2129 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2130 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2131 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2132 truncate_one_ratio (Lisp_Object number, Lisp_Object UNUSED (divisor), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2133 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2134 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2135 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2136 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2137 if (ratio_sign (XRATIO_DATA (number)) == 0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
2138 return Qzero; |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2139 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2140 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2141 XRATIO_DENOMINATOR (number)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2142 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2143 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2144 res0 = make_float (bignum_to_double (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2145 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2146 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2147 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2148 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2149 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2150 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2151 if (bignum_divisible_p (XRATIO_NUMERATOR (number), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2152 XRATIO_DENOMINATOR (number))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2153 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2154 return values2 (res0, Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2155 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2156 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2157 ratio_set_bignum (scratch_ratio2, scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2158 ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2159 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2160 return values2 (res0, Fcanonicalize_number (make_ratio_rt (scratch_ratio))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2161 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2162 #endif /* HAVE_RATIO */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2163 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2164 #ifdef HAVE_BIGFLOAT |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2165 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2166 truncate_one_bigfloat (Lisp_Object number, Lisp_Object UNUSED (divisor), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2167 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2168 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2169 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2170 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2171 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2172 bigfloat_set_prec (scratch_bigfloat2, XBIGFLOAT_GET_PREC (number)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2173 bigfloat_trunc (scratch_bigfloat, XBIGFLOAT_DATA (number)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2174 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2175 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2176 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2177 res0 = make_bigfloat_bf (scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2178 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2179 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2180 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2181 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2182 bignum_set_bigfloat (scratch_bignum, scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2183 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2184 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2185 res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2186 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2187 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2188 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2189 bigfloat_sub (scratch_bigfloat2, XBIGFLOAT_DATA (number), scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2190 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2191 return |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
2192 values2 (res0, |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2193 Fcanonicalize_number (make_bigfloat_bf (scratch_bigfloat2))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2194 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2195 #endif /* HAVE_BIGFLOAT */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2196 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2197 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2198 truncate_two_float (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2199 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2200 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2201 double f1 = extract_float (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2202 double f2 = extract_float (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2203 double f0, remain; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2204 Lisp_Object res0; |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
2205 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2206 if (f2 == 0.0) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
2207 return arith_error2 ("truncate", number, divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2208 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2209 res0 = float_to_int (f1 / f2, MAYBE_EFF ("truncate"), number, Qunbound); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2210 f0 = extract_float (res0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2211 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2212 IN_FLOAT2 (remain = f1 - (f0 * f2), MAYBE_EFF ("truncate"), number, divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2213 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2214 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2215 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2216 res0 = make_float (f0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2217 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2218 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2219 return values2 (res0, make_float (remain)); |
| 428 | 2220 } |
| 2221 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2222 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2223 truncate_one_float (Lisp_Object number, int return_float) |
| 428 | 2224 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2225 Lisp_Object res0 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2226 = float_to_int (XFLOAT_DATA (number), MAYBE_EFF ("truncate"), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2227 number, Qunbound); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2228 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2229 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2230 res0 = make_float ((double)XINT(res0)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2231 return values2 (res0, make_float ((XFLOAT_DATA (number) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2232 - XFLOAT_DATA (res0)))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2233 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2234 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2235 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2236 return values2 (res0, make_float (XFLOAT_DATA (number) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2237 - XREALINT (res0))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2238 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2239 } |
| 428 | 2240 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2241 EXFUN (Fftruncate, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2242 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2243 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2244 truncate_one_mundane_arg (Lisp_Object number, Lisp_Object divisor, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2245 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2246 { |
| 1983 | 2247 if (INTEGERP (number)) |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2248 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2249 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2250 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2251 return values2 (make_float (extract_float (number)), Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2252 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2253 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2254 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2255 return values2 (number, Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2256 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2257 } |
| 428 | 2258 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2259 MAYBE_CHAR_OR_MARKER (truncate); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2260 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2261 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2262 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2263 return Fftruncate (wrong_type_argument (Qnumberp, number), divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2264 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2265 else |
| 1983 | 2266 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2267 return Ftruncate (wrong_type_argument (Qnumberp, number), divisor); |
| 1983 | 2268 } |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2269 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2270 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2271 /* Rounding functions that will not necessarily return floats: */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2272 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2273 DEFUN ("ceiling", Fceiling, 1, 2, 0, /* |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2274 Return the smallest integer no less than NUMBER. (Round toward +inf.) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2275 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2276 With optional argument DIVISOR, return the smallest integer no less than |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
2277 the quotient of NUMBER and DIVISOR. |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2278 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2279 This function returns multiple values; see `multiple-value-bind' and |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2280 `multiple-value-call'. The second returned value is the remainder in the |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2281 calculation, which will be one minus the fractional part of NUMBER if DIVISOR |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2282 is omitted or one. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2283 */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2284 (number, divisor)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2285 { |
|
5252
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2286 ROUNDING_CONVERT (ceiling, 0); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2287 } |
| 1983 | 2288 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2289 DEFUN ("floor", Ffloor, 1, 2, 0, /* |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2290 Return the largest integer no greater than NUMBER. (Round towards -inf.) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2291 With optional second argument DIVISOR, return the largest integer no |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2292 greater than the quotient of NUMBER and DIVISOR. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2293 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2294 This function returns multiple values; see `multiple-value-call' and |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2295 `multiple-value-bind'. The second returned value is the remainder in the |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2296 calculation, which will just be the fractional part if DIVISOR is omitted or |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2297 one. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2298 */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2299 (number, divisor)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2300 { |
|
5252
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2301 ROUNDING_CONVERT (floor, 0); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2302 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2303 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2304 DEFUN ("round", Fround, 1, 2, 0, /* |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2305 Return the nearest integer to NUMBER. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2306 If NUMBER is exactly halfway between two integers, return the one that |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2307 is even. |
| 1983 | 2308 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2309 Optional argument DIVISOR means return the nearest integer to NUMBER |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2310 divided by DIVISOR. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2311 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2312 This function returns multiple values; see `multiple-value-call' and |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2313 `multiple-value-bind'. The second returned value is the remainder |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2314 in the calculation. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2315 */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2316 (number, divisor)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2317 { |
|
5252
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2318 ROUNDING_CONVERT (round, 0); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2319 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2320 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2321 DEFUN ("truncate", Ftruncate, 1, 2, 0, /* |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2322 Truncate a floating point number to an integer. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2323 Rounds the value toward zero. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2324 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2325 Optional argument DIVISOR means truncate NUMBER divided by DIVISOR. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2326 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2327 This function returns multiple values; see `multiple-value-call' and |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2328 `multiple-value-bind'. The second returned value is the remainder. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2329 */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2330 (number, divisor)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2331 { |
|
5252
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2332 ROUNDING_CONVERT (truncate, 0); |
| 428 | 2333 } |
| 2334 | |
| 2335 /* Float-rounding functions. */ | |
| 2336 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2337 DEFUN ("fceiling", Ffceiling, 1, 2, 0, /* |
| 444 | 2338 Return the smallest integer no less than NUMBER, as a float. |
| 428 | 2339 \(Round toward +inf.\) |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2340 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2341 With optional argument DIVISOR, return the smallest integer no less than the |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2342 quotient of NUMBER and DIVISOR, as a float. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2343 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2344 This function returns multiple values; the second value is the remainder in |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2345 the calculation. |
| 428 | 2346 */ |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2347 (number, divisor)) |
| 428 | 2348 { |
|
5252
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2349 ROUNDING_CONVERT (ceiling, 1); |
| 428 | 2350 } |
| 2351 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2352 DEFUN ("ffloor", Fffloor, 1, 2, 0, /* |
| 444 | 2353 Return the largest integer no greater than NUMBER, as a float. |
| 428 | 2354 \(Round towards -inf.\) |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2355 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2356 With optional argument DIVISOR, return the largest integer no greater than |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2357 the quotient of NUMBER and DIVISOR, as a float. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2358 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2359 This function returns multiple values; the second value is the remainder in |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2360 the calculation. |
| 428 | 2361 */ |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2362 (number, divisor)) |
| 428 | 2363 { |
|
5252
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2364 ROUNDING_CONVERT (floor, 1); |
| 428 | 2365 } |
| 2366 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2367 DEFUN ("fround", Ffround, 1, 2, 0, /* |
| 444 | 2368 Return the nearest integer to NUMBER, as a float. |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2369 If NUMBER is exactly halfway between two integers, return the one that is |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2370 even. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2371 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2372 With optional argument DIVISOR, return the nearest integer to the quotient |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2373 of NUMBER and DIVISOR, as a float. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2374 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2375 This function returns multiple values; the second value is the remainder in |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2376 the calculation. |
| 428 | 2377 */ |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2378 (number, divisor)) |
| 428 | 2379 { |
|
5252
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2380 ROUNDING_CONVERT (round, 1); |
| 428 | 2381 } |
| 2382 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2383 DEFUN ("ftruncate", Fftruncate, 1, 2, 0, /* |
| 428 | 2384 Truncate a floating point number to an integral float value. |
| 2385 Rounds the value toward zero. | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2386 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2387 With optional argument DIVISOR, truncate the quotient of NUMBER and DIVISOR, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2388 to an integral float value. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2389 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2390 This function returns multiple values; the second value is the remainder in |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2391 the calculation. |
| 428 | 2392 */ |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2393 (number, divisor)) |
| 428 | 2394 { |
|
5252
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2395 ROUNDING_CONVERT (truncate, 1); |
| 428 | 2396 } |
| 2397 | |
| 2398 #ifdef FLOAT_CATCH_SIGILL | |
| 2399 static SIGTYPE | |
| 2400 float_error (int signo) | |
| 2401 { | |
| 2402 if (! in_float) | |
| 2403 fatal_error_signal (signo); | |
| 2404 | |
| 2405 EMACS_REESTABLISH_SIGNAL (signo, arith_error); | |
| 2406 EMACS_UNBLOCK_SIGNAL (signo); | |
| 2407 | |
| 2408 in_float = 0; | |
| 2409 | |
| 2410 /* Was Fsignal(), but it just doesn't make sense for an error | |
| 2411 occurring inside a signal handler to be restartable, considering | |
| 2412 that anything could happen when the error is signaled and trapped | |
| 2413 and considering the asynchronous nature of signal handlers. */ | |
| 563 | 2414 signal_error (Qarith_error, 0, float_error_arg); |
| 428 | 2415 } |
| 2416 | |
| 2417 /* Another idea was to replace the library function `infnan' | |
| 2418 where SIGILL is signaled. */ | |
| 2419 | |
| 2420 #endif /* FLOAT_CATCH_SIGILL */ | |
| 2421 | |
| 2422 /* In C++, it is impossible to determine what type matherr expects | |
| 2423 without some more configure magic. | |
| 2424 We shouldn't be using matherr anyways - it's a non-standard SYSVism. */ | |
| 2425 #if defined (HAVE_MATHERR) && !defined(__cplusplus) | |
| 2426 int | |
| 2427 matherr (struct exception *x) | |
| 2428 { | |
| 2429 Lisp_Object args; | |
| 2430 if (! in_float) | |
| 2431 /* Not called from emacs-lisp float routines; do the default thing. */ | |
| 2432 return 0; | |
| 2433 | |
| 2434 /* if (!strcmp (x->name, "pow")) x->name = "expt"; */ | |
| 2435 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2436 args = Fcons (build_extstring (x->name, Qerror_message_encoding), |
| 428 | 2437 Fcons (make_float (x->arg1), |
| 2438 ((in_float == 2) | |
| 2439 ? Fcons (make_float (x->arg2), Qnil) | |
| 2440 : Qnil))); | |
| 2441 switch (x->type) | |
| 2442 { | |
| 2443 case DOMAIN: Fsignal (Qdomain_error, args); break; | |
| 2444 case SING: Fsignal (Qsingularity_error, args); break; | |
| 2445 case OVERFLOW: Fsignal (Qoverflow_error, args); break; | |
| 2446 case UNDERFLOW: Fsignal (Qunderflow_error, args); break; | |
| 2447 default: Fsignal (Qarith_error, args); break; | |
| 2448 } | |
| 2449 return 1; /* don't set errno or print a message */ | |
| 2450 } | |
| 2451 #endif /* HAVE_MATHERR */ | |
| 2452 | |
| 2453 void | |
| 2454 init_floatfns_very_early (void) | |
| 2455 { | |
| 2456 # ifdef FLOAT_CATCH_SIGILL | |
| 613 | 2457 EMACS_SIGNAL (SIGILL, float_error); |
| 428 | 2458 # endif |
| 2459 in_float = 0; | |
| 2460 } | |
| 2461 | |
| 2462 void | |
| 2463 syms_of_floatfns (void) | |
| 2464 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
2286
diff
changeset
|
2465 INIT_LISP_OBJECT (float); |
| 428 | 2466 |
| 2467 /* Trig functions. */ | |
| 2468 | |
| 2469 DEFSUBR (Facos); | |
| 2470 DEFSUBR (Fasin); | |
| 2471 DEFSUBR (Fatan); | |
| 2472 DEFSUBR (Fcos); | |
| 2473 DEFSUBR (Fsin); | |
| 2474 DEFSUBR (Ftan); | |
| 2475 | |
| 2476 /* Bessel functions */ | |
| 2477 | |
| 2478 #if 0 | |
| 2479 DEFSUBR (Fbessel_y0); | |
| 2480 DEFSUBR (Fbessel_y1); | |
| 2481 DEFSUBR (Fbessel_yn); | |
| 2482 DEFSUBR (Fbessel_j0); | |
| 2483 DEFSUBR (Fbessel_j1); | |
| 2484 DEFSUBR (Fbessel_jn); | |
| 2485 #endif /* 0 */ | |
| 2486 | |
| 2487 /* Error functions. */ | |
| 2488 | |
| 2489 #if 0 | |
| 2490 DEFSUBR (Ferf); | |
| 2491 DEFSUBR (Ferfc); | |
| 2492 DEFSUBR (Flog_gamma); | |
| 2493 #endif /* 0 */ | |
| 2494 | |
| 2495 /* Root and Log functions. */ | |
| 2496 | |
| 2497 DEFSUBR (Fexp); | |
| 2498 DEFSUBR (Fexpt); | |
| 2499 DEFSUBR (Flog); | |
| 2500 DEFSUBR (Flog10); | |
| 2501 DEFSUBR (Fsqrt); | |
| 2502 DEFSUBR (Fcube_root); | |
| 2503 | |
| 2504 /* Inverse trig functions. */ | |
| 2505 | |
| 2506 DEFSUBR (Facosh); | |
| 2507 DEFSUBR (Fasinh); | |
| 2508 DEFSUBR (Fatanh); | |
| 2509 DEFSUBR (Fcosh); | |
| 2510 DEFSUBR (Fsinh); | |
| 2511 DEFSUBR (Ftanh); | |
| 2512 | |
| 2513 /* Rounding functions */ | |
| 2514 | |
| 2515 DEFSUBR (Fabs); | |
| 2516 DEFSUBR (Ffloat); | |
| 2517 DEFSUBR (Flogb); | |
| 2518 DEFSUBR (Fceiling); | |
| 2519 DEFSUBR (Ffloor); | |
| 2520 DEFSUBR (Fround); | |
| 2521 DEFSUBR (Ftruncate); | |
| 2522 | |
| 2523 /* Float-rounding functions. */ | |
| 2524 | |
| 2525 DEFSUBR (Ffceiling); | |
| 2526 DEFSUBR (Fffloor); | |
| 2527 DEFSUBR (Ffround); | |
| 2528 DEFSUBR (Fftruncate); | |
| 2529 } | |
| 2530 | |
| 2531 void | |
| 2532 vars_of_floatfns (void) | |
| 2533 { | |
| 2534 Fprovide (intern ("lisp-float-type")); | |
| 2535 } |