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