Mercurial > hg > xemacs-beta
annotate src/floatfns.c @ 5750:66d2f63df75f
Correct some spelling and formatting in behavior.el.
Mentioned in tracker issue 826, the third thing mentioned there (the file
name at the bottom of the file) had already been fixed.
lisp/ChangeLog addition:
2013-08-05 Aidan Kehoe <kehoea@parhasard.net>
* behavior.el:
(override-behavior):
Correct some spelling and formatting here, thank you Steven
Mitchell in tracker issue 826.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 05 Aug 2013 10:05:32 +0100 |
| parents | 56144c8593a8 |
| children | be31f7878b0d |
| rev | line source |
|---|---|
| 428 | 1 /* Primitive operations on floating point for XEmacs Lisp interpreter. |
| 2 Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc. | |
| 3 | |
| 4 This file is part of XEmacs. | |
| 5 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5252
diff
changeset
|
6 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 7 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5252
diff
changeset
|
8 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5252
diff
changeset
|
9 option) any later version. |
| 428 | 10 |
| 11 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 14 for more details. | |
| 15 | |
| 16 You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5252
diff
changeset
|
17 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 18 |
| 19 /* Synched up with: FSF 19.30. */ | |
| 20 | |
| 21 /* ANSI C requires only these float functions: | |
| 22 acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod, | |
| 23 frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh. | |
| 24 | |
| 25 Define HAVE_INVERSE_HYPERBOLIC if you have acosh, asinh, and atanh. | |
| 26 Define HAVE_CBRT if you have cbrt(). | |
| 27 If you don't define these, then the appropriate routines will be simulated. | |
| 28 | |
| 29 Define HAVE_MATHERR if on a system supporting the SysV matherr() callback. | |
| 30 (This should happen automatically.) | |
| 31 | |
| 32 Define FLOAT_CHECK_ERRNO if the float library routines set errno. | |
| 33 This has no effect if HAVE_MATHERR is defined. | |
| 34 | |
| 35 Define FLOAT_CATCH_SIGILL if the float library routines signal SIGILL. | |
| 36 (What systems actually do this? Let me know. -jwz) | |
| 37 | |
| 38 Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by | |
| 39 either setting errno, or signalling SIGFPE/SIGILL. Otherwise, domain and | |
| 40 range checking will happen before calling the float routines. This has | |
| 41 no effect if HAVE_MATHERR is defined (since matherr will be called when | |
| 42 a domain error occurs). | |
| 43 */ | |
| 44 | |
| 45 #include <config.h> | |
| 46 #include "lisp.h" | |
| 47 #include "syssignal.h" | |
| 48 #include "sysfloat.h" | |
| 49 | |
|
4865
6c0bb4d2c23a
Always use our rint(), for rounding consistency with the bignum code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4828
diff
changeset
|
50 /* An implementation of rint that always rounds towards the even number in |
|
6c0bb4d2c23a
Always use our rint(), for rounding consistency with the bignum code.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4828
diff
changeset
|
51 the case of ambiguity. */ |
| 428 | 52 static double |
| 430 | 53 emacs_rint (double x) |
| 428 | 54 { |
| 55 double r = floor (x + 0.5); | |
| 56 double diff = fabs (r - x); | |
| 57 /* Round to even and correct for any roundoff errors. */ | |
| 58 if (diff >= 0.5 && (diff > 0.5 || r != 2.0 * floor (r / 2.0))) | |
| 59 r += r < x ? 1.0 : -1.0; | |
| 60 return r; | |
| 61 } | |
| 62 | |
| 63 /* Nonzero while executing in floating point. | |
| 64 This tells float_error what to do. */ | |
| 65 static int in_float; | |
| 66 | |
| 67 /* If an argument is out of range for a mathematical function, | |
| 68 here is the actual argument value to use in the error message. */ | |
| 69 static Lisp_Object float_error_arg, float_error_arg2; | |
| 442 | 70 static const char *float_error_fn_name; |
| 428 | 71 |
| 72 /* Evaluate the floating point expression D, recording NUM | |
| 73 as the original argument for error messages. | |
| 74 D is normally an assignment expression. | |
| 75 Handle errors which may result in signals or may set errno. | |
| 76 | |
| 77 Note that float_error may be declared to return void, so you can't | |
| 78 just cast the zero after the colon to (SIGTYPE) to make the types | |
| 79 check properly. */ | |
| 80 #ifdef FLOAT_CHECK_ERRNO | |
| 81 #define IN_FLOAT(d, name, num) \ | |
| 82 do { \ | |
| 83 float_error_arg = num; \ | |
| 84 float_error_fn_name = name; \ | |
| 85 in_float = 1; errno = 0; (d); in_float = 0; \ | |
| 86 if (errno != 0) in_float_error (); \ | |
| 87 } while (0) | |
| 88 #define IN_FLOAT2(d, name, num, num2) \ | |
| 89 do { \ | |
| 90 float_error_arg = num; \ | |
| 91 float_error_arg2 = num2; \ | |
| 92 float_error_fn_name = name; \ | |
| 93 in_float = 2; errno = 0; (d); in_float = 0; \ | |
| 94 if (errno != 0) in_float_error (); \ | |
| 95 } while (0) | |
| 96 #else | |
| 97 #define IN_FLOAT(d, name, num) (in_float = 1, (d), in_float = 0) | |
| 98 #define IN_FLOAT2(d, name, num, num2) (in_float = 2, (d), in_float = 0) | |
| 99 #endif | |
| 100 | |
| 101 | |
| 102 #define arith_error(op,arg) \ | |
| 771 | 103 Fsignal (Qarith_error, list2 (build_msg_string (op), arg)) |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
104 #define arith_error2(op,a1,a2) \ |
|
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
105 Fsignal (Qarith_error, list3 (build_msg_string (op), a1, a2)) |
| 428 | 106 #define range_error(op,arg) \ |
| 771 | 107 Fsignal (Qrange_error, list2 (build_msg_string (op), arg)) |
| 428 | 108 #define range_error2(op,a1,a2) \ |
| 771 | 109 Fsignal (Qrange_error, list3 (build_msg_string (op), a1, a2)) |
| 428 | 110 #define domain_error(op,arg) \ |
| 771 | 111 Fsignal (Qdomain_error, list2 (build_msg_string (op), arg)) |
| 428 | 112 #define domain_error2(op,a1,a2) \ |
| 771 | 113 Fsignal (Qdomain_error, list3 (build_msg_string (op), a1, a2)) |
| 428 | 114 |
| 115 | |
| 116 /* Convert float to Lisp Integer if it fits, else signal a range | |
| 1983 | 117 error using the given arguments. If bignums are available, range errors |
| 118 are never signaled. */ | |
| 428 | 119 static Lisp_Object |
| 2286 | 120 float_to_int (double x, |
| 121 #ifdef HAVE_BIGNUM | |
| 122 const char *UNUSED (name), Lisp_Object UNUSED (num), | |
| 123 Lisp_Object UNUSED (num2) | |
| 124 #else | |
| 125 const char *name, Lisp_Object num, Lisp_Object num2 | |
| 126 #endif | |
| 127 ) | |
| 428 | 128 { |
| 1983 | 129 #ifdef HAVE_BIGNUM |
| 130 bignum_set_double (scratch_bignum, x); | |
| 131 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); | |
| 132 #else | |
| 2039 | 133 REGISTER EMACS_INT result = (EMACS_INT) x; |
| 134 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
135 if (result > MOST_POSITIVE_FIXNUM || result < MOST_NEGATIVE_FIXNUM) |
| 2039 | 136 { |
| 137 if (!UNBOUNDP (num2)) | |
| 138 range_error2 (name, num, num2); | |
| 139 else | |
| 140 range_error (name, num); | |
| 141 } | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
142 return make_fixnum (result); |
| 1983 | 143 #endif /* HAVE_BIGNUM */ |
| 428 | 144 } |
| 145 | |
| 146 | |
| 147 static void | |
| 148 in_float_error (void) | |
| 149 { | |
| 150 switch (errno) | |
| 151 { | |
| 152 case 0: | |
| 153 break; | |
| 154 case EDOM: | |
| 155 if (in_float == 2) | |
| 156 domain_error2 (float_error_fn_name, float_error_arg, float_error_arg2); | |
| 157 else | |
| 158 domain_error (float_error_fn_name, float_error_arg); | |
| 159 break; | |
| 160 case ERANGE: | |
| 161 range_error (float_error_fn_name, float_error_arg); | |
| 162 break; | |
| 163 default: | |
| 164 arith_error (float_error_fn_name, float_error_arg); | |
| 165 break; | |
| 166 } | |
| 167 } | |
| 168 | |
| 169 | |
| 170 static Lisp_Object | |
| 2286 | 171 mark_float (Lisp_Object UNUSED (obj)) |
| 428 | 172 { |
| 173 return Qnil; | |
| 174 } | |
| 175 | |
| 176 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4865
diff
changeset
|
177 float_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth), |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4865
diff
changeset
|
178 int UNUSED (foldcase)) |
| 428 | 179 { |
| 180 return (extract_float (obj1) == extract_float (obj2)); | |
| 181 } | |
| 182 | |
| 665 | 183 static Hashcode |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5125
diff
changeset
|
184 float_hash (Lisp_Object obj, int UNUSED (depth), Boolint UNUSED (equalp)) |
| 428 | 185 { |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5125
diff
changeset
|
186 return FLOAT_HASHCODE_FROM_DOUBLE (extract_float (obj)); |
| 428 | 187 } |
| 188 | |
| 1204 | 189 static const struct memory_description float_description[] = { |
| 428 | 190 { XD_END } |
| 191 }; | |
| 192 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
193 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("float", float, |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
194 mark_float, print_float, 0, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
195 float_equal, float_hash, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
196 float_description, Lisp_Float); |
| 428 | 197 |
| 198 /* Extract a Lisp number as a `double', or signal an error. */ | |
| 199 | |
| 200 double | |
| 201 extract_float (Lisp_Object num) | |
| 202 { | |
| 203 if (FLOATP (num)) | |
| 204 return XFLOAT_DATA (num); | |
| 205 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
206 if (FIXNUMP (num)) |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
207 return (double) XFIXNUM (num); |
| 428 | 208 |
| 1983 | 209 #ifdef HAVE_BIGNUM |
| 210 if (BIGNUMP (num)) | |
| 211 return bignum_to_double (XBIGNUM_DATA (num)); | |
| 212 #endif | |
| 213 | |
| 214 #ifdef HAVE_RATIO | |
| 215 if (RATIOP (num)) | |
| 216 return ratio_to_double (XRATIO_DATA (num)); | |
| 217 #endif | |
| 218 | |
| 219 #ifdef HAVE_BIGFLOAT | |
| 220 if (BIGFLOATP (num)) | |
| 221 return bigfloat_to_double (XBIGFLOAT_DATA (num)); | |
| 222 #endif | |
| 223 | |
| 428 | 224 return extract_float (wrong_type_argument (Qnumberp, num)); |
| 225 } | |
| 226 | |
| 227 /* Trig functions. */ | |
| 228 | |
| 229 DEFUN ("acos", Facos, 1, 1, 0, /* | |
| 444 | 230 Return the inverse cosine of NUMBER. |
| 428 | 231 */ |
| 444 | 232 (number)) |
| 428 | 233 { |
| 444 | 234 double d = extract_float (number); |
| 428 | 235 #ifdef FLOAT_CHECK_DOMAIN |
| 236 if (d > 1.0 || d < -1.0) | |
| 444 | 237 domain_error ("acos", number); |
| 428 | 238 #endif |
| 444 | 239 IN_FLOAT (d = acos (d), "acos", number); |
| 428 | 240 return make_float (d); |
| 241 } | |
| 242 | |
| 243 DEFUN ("asin", Fasin, 1, 1, 0, /* | |
| 444 | 244 Return the inverse sine of NUMBER. |
| 428 | 245 */ |
| 444 | 246 (number)) |
| 428 | 247 { |
| 444 | 248 double d = extract_float (number); |
| 428 | 249 #ifdef FLOAT_CHECK_DOMAIN |
| 250 if (d > 1.0 || d < -1.0) | |
| 444 | 251 domain_error ("asin", number); |
| 428 | 252 #endif |
| 444 | 253 IN_FLOAT (d = asin (d), "asin", number); |
| 428 | 254 return make_float (d); |
| 255 } | |
| 256 | |
| 257 DEFUN ("atan", Fatan, 1, 2, 0, /* | |
| 444 | 258 Return the inverse tangent of NUMBER. |
| 259 If optional second argument NUMBER2 is provided, | |
| 260 return atan2 (NUMBER, NUMBER2). | |
| 428 | 261 */ |
| 444 | 262 (number, number2)) |
| 428 | 263 { |
| 444 | 264 double d = extract_float (number); |
| 428 | 265 |
| 444 | 266 if (NILP (number2)) |
| 267 IN_FLOAT (d = atan (d), "atan", number); | |
| 428 | 268 else |
| 269 { | |
| 444 | 270 double d2 = extract_float (number2); |
| 428 | 271 #ifdef FLOAT_CHECK_DOMAIN |
| 272 if (d == 0.0 && d2 == 0.0) | |
| 444 | 273 domain_error2 ("atan", number, number2); |
| 428 | 274 #endif |
| 444 | 275 IN_FLOAT2 (d = atan2 (d, d2), "atan", number, number2); |
| 428 | 276 } |
| 277 return make_float (d); | |
| 278 } | |
| 279 | |
| 280 DEFUN ("cos", Fcos, 1, 1, 0, /* | |
| 444 | 281 Return the cosine of NUMBER. |
| 428 | 282 */ |
| 444 | 283 (number)) |
| 428 | 284 { |
| 444 | 285 double d = extract_float (number); |
| 286 IN_FLOAT (d = cos (d), "cos", number); | |
| 428 | 287 return make_float (d); |
| 288 } | |
| 289 | |
| 290 DEFUN ("sin", Fsin, 1, 1, 0, /* | |
| 444 | 291 Return the sine of NUMBER. |
| 428 | 292 */ |
| 444 | 293 (number)) |
| 428 | 294 { |
| 444 | 295 double d = extract_float (number); |
| 296 IN_FLOAT (d = sin (d), "sin", number); | |
| 428 | 297 return make_float (d); |
| 298 } | |
| 299 | |
| 300 DEFUN ("tan", Ftan, 1, 1, 0, /* | |
| 444 | 301 Return the tangent of NUMBER. |
| 428 | 302 */ |
| 444 | 303 (number)) |
| 428 | 304 { |
| 444 | 305 double d = extract_float (number); |
| 428 | 306 double c = cos (d); |
| 307 #ifdef FLOAT_CHECK_DOMAIN | |
| 308 if (c == 0.0) | |
| 444 | 309 domain_error ("tan", number); |
| 428 | 310 #endif |
| 444 | 311 IN_FLOAT (d = (sin (d) / c), "tan", number); |
| 428 | 312 return make_float (d); |
| 313 } | |
| 314 | |
| 315 /* Bessel functions */ | |
| 316 #if 0 /* Leave these out unless we find there's a reason for them. */ | |
| 317 | |
| 318 DEFUN ("bessel-j0", Fbessel_j0, 1, 1, 0, /* | |
| 444 | 319 Return the bessel function j0 of NUMBER. |
| 428 | 320 */ |
| 444 | 321 (number)) |
| 428 | 322 { |
| 444 | 323 double d = extract_float (number); |
| 324 IN_FLOAT (d = j0 (d), "bessel-j0", number); | |
| 428 | 325 return make_float (d); |
| 326 } | |
| 327 | |
| 328 DEFUN ("bessel-j1", Fbessel_j1, 1, 1, 0, /* | |
| 444 | 329 Return the bessel function j1 of NUMBER. |
| 428 | 330 */ |
| 444 | 331 (number)) |
| 428 | 332 { |
| 444 | 333 double d = extract_float (number); |
| 334 IN_FLOAT (d = j1 (d), "bessel-j1", number); | |
| 428 | 335 return make_float (d); |
| 336 } | |
| 337 | |
| 338 DEFUN ("bessel-jn", Fbessel_jn, 2, 2, 0, /* | |
| 444 | 339 Return the order N bessel function output jn of NUMBER. |
| 340 The first number (the order) is truncated to an integer. | |
| 428 | 341 */ |
| 444 | 342 (number1, number2)) |
| 428 | 343 { |
| 444 | 344 int i1 = extract_float (number1); |
| 345 double f2 = extract_float (number2); | |
| 428 | 346 |
| 444 | 347 IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", number1); |
| 428 | 348 return make_float (f2); |
| 349 } | |
| 350 | |
| 351 DEFUN ("bessel-y0", Fbessel_y0, 1, 1, 0, /* | |
| 444 | 352 Return the bessel function y0 of NUMBER. |
| 428 | 353 */ |
| 444 | 354 (number)) |
| 428 | 355 { |
| 444 | 356 double d = extract_float (number); |
| 357 IN_FLOAT (d = y0 (d), "bessel-y0", number); | |
| 428 | 358 return make_float (d); |
| 359 } | |
| 360 | |
| 361 DEFUN ("bessel-y1", Fbessel_y1, 1, 1, 0, /* | |
| 444 | 362 Return the bessel function y1 of NUMBER. |
| 428 | 363 */ |
| 444 | 364 (number)) |
| 428 | 365 { |
| 444 | 366 double d = extract_float (number); |
| 367 IN_FLOAT (d = y1 (d), "bessel-y0", number); | |
| 428 | 368 return make_float (d); |
| 369 } | |
| 370 | |
| 371 DEFUN ("bessel-yn", Fbessel_yn, 2, 2, 0, /* | |
| 444 | 372 Return the order N bessel function output yn of NUMBER. |
| 373 The first number (the order) is truncated to an integer. | |
| 428 | 374 */ |
| 444 | 375 (number1, number2)) |
| 428 | 376 { |
| 444 | 377 int i1 = extract_float (number1); |
| 378 double f2 = extract_float (number2); | |
| 428 | 379 |
| 444 | 380 IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", number1); |
| 428 | 381 return make_float (f2); |
| 382 } | |
| 383 | |
| 384 #endif /* 0 (bessel functions) */ | |
| 385 | |
| 386 /* Error functions. */ | |
| 387 #if 0 /* Leave these out unless we see they are worth having. */ | |
| 388 | |
| 389 DEFUN ("erf", Ferf, 1, 1, 0, /* | |
| 444 | 390 Return the mathematical error function of NUMBER. |
| 428 | 391 */ |
| 444 | 392 (number)) |
| 428 | 393 { |
| 444 | 394 double d = extract_float (number); |
| 395 IN_FLOAT (d = erf (d), "erf", number); | |
| 428 | 396 return make_float (d); |
| 397 } | |
| 398 | |
| 399 DEFUN ("erfc", Ferfc, 1, 1, 0, /* | |
| 444 | 400 Return the complementary error function of NUMBER. |
| 428 | 401 */ |
| 444 | 402 (number)) |
| 428 | 403 { |
| 444 | 404 double d = extract_float (number); |
| 405 IN_FLOAT (d = erfc (d), "erfc", number); | |
| 428 | 406 return make_float (d); |
| 407 } | |
| 408 | |
| 409 DEFUN ("log-gamma", Flog_gamma, 1, 1, 0, /* | |
| 444 | 410 Return the log gamma of NUMBER. |
| 428 | 411 */ |
| 444 | 412 (number)) |
| 428 | 413 { |
| 444 | 414 double d = extract_float (number); |
| 415 IN_FLOAT (d = lgamma (d), "log-gamma", number); | |
| 428 | 416 return make_float (d); |
| 417 } | |
| 418 | |
| 419 #endif /* 0 (error functions) */ | |
| 420 | |
| 421 | |
| 422 /* Root and Log functions. */ | |
| 423 | |
| 424 DEFUN ("exp", Fexp, 1, 1, 0, /* | |
| 444 | 425 Return the exponential base e of NUMBER. |
| 428 | 426 */ |
| 444 | 427 (number)) |
| 428 | 428 { |
| 444 | 429 double d = extract_float (number); |
| 428 | 430 #ifdef FLOAT_CHECK_DOMAIN |
| 431 if (d > 709.7827) /* Assume IEEE doubles here */ | |
| 444 | 432 range_error ("exp", number); |
| 428 | 433 else if (d < -709.0) |
| 434 return make_float (0.0); | |
| 435 else | |
| 436 #endif | |
| 444 | 437 IN_FLOAT (d = exp (d), "exp", number); |
| 428 | 438 return make_float (d); |
| 439 } | |
| 440 | |
| 441 DEFUN ("expt", Fexpt, 2, 2, 0, /* | |
| 444 | 442 Return the exponential NUMBER1 ** NUMBER2. |
| 428 | 443 */ |
| 444 | 444 (number1, number2)) |
| 428 | 445 { |
| 1983 | 446 #ifdef HAVE_BIGNUM |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
447 if (INTEGERP (number1) && FIXNUMP (number2)) |
| 1983 | 448 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
449 if (FIXNUMP (number1)) |
| 1983 | 450 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
451 bignum_set_long (scratch_bignum2, XREALFIXNUM (number1)); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
452 bignum_pow (scratch_bignum, scratch_bignum2, XREALFIXNUM (number2)); |
| 1983 | 453 } |
| 454 else | |
| 455 bignum_pow (scratch_bignum, XBIGNUM_DATA (number1), | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
456 XREALFIXNUM (number2)); |
| 1983 | 457 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
| 458 } | |
| 459 #endif | |
| 460 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
461 if (FIXNUMP (number1) && /* common lisp spec */ |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
462 FIXNUMP (number2)) /* don't promote, if both are ints */ |
| 428 | 463 { |
| 464 EMACS_INT retval; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
465 EMACS_INT x = XFIXNUM (number1); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
466 EMACS_INT y = XFIXNUM (number2); |
| 428 | 467 |
| 468 if (y < 0) | |
| 469 { | |
| 470 if (x == 1) | |
| 471 retval = 1; | |
| 472 else if (x == -1) | |
| 473 retval = (y & 1) ? -1 : 1; | |
| 474 else | |
| 475 retval = 0; | |
| 476 } | |
| 477 else | |
| 478 { | |
| 479 retval = 1; | |
| 480 while (y > 0) | |
| 481 { | |
| 482 if (y & 1) | |
| 483 retval *= x; | |
| 484 x *= x; | |
| 485 y = (EMACS_UINT) y >> 1; | |
| 486 } | |
| 487 } | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
488 return make_fixnum (retval); |
| 428 | 489 } |
| 490 | |
| 1983 | 491 #if defined(HAVE_BIGFLOAT) && defined(bigfloat_pow) |
| 492 if (BIGFLOATP (number1) && INTEGERP (number2)) | |
| 493 { | |
| 2057 | 494 unsigned long exponent; |
| 1983 | 495 |
| 496 #ifdef HAVE_BIGNUM | |
| 497 if (BIGNUMP (number2)) | |
| 2057 | 498 exponent = bignum_to_ulong (XBIGNUM_DATA (number2)); |
| 1983 | 499 else |
| 500 #endif | |
| 2057 | 501 exponent = XUINT (number2); |
| 1983 | 502 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number1)); |
| 2057 | 503 bigfloat_pow (scratch_bigfloat, XBIGFLOAT_DATA (number1), exponent); |
| 1983 | 504 return make_bigfloat_bf (scratch_bigfloat); |
| 505 } | |
| 506 #endif | |
| 507 | |
| 428 | 508 { |
| 444 | 509 double f1 = extract_float (number1); |
| 510 double f2 = extract_float (number2); | |
| 428 | 511 /* Really should check for overflow, too */ |
| 512 if (f1 == 0.0 && f2 == 0.0) | |
| 513 f1 = 1.0; | |
| 514 # ifdef FLOAT_CHECK_DOMAIN | |
| 515 else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor(f2))) | |
| 444 | 516 domain_error2 ("expt", number1, number2); |
| 428 | 517 # endif /* FLOAT_CHECK_DOMAIN */ |
| 444 | 518 IN_FLOAT2 (f1 = pow (f1, f2), "expt", number1, number2); |
| 428 | 519 return make_float (f1); |
| 520 } | |
| 521 } | |
| 522 | |
| 523 DEFUN ("log", Flog, 1, 2, 0, /* | |
| 444 | 524 Return the natural logarithm of NUMBER. |
| 525 If second optional argument BASE is given, return the logarithm of | |
| 526 NUMBER using that base. | |
| 428 | 527 */ |
| 444 | 528 (number, base)) |
| 428 | 529 { |
| 444 | 530 double d = extract_float (number); |
| 428 | 531 #ifdef FLOAT_CHECK_DOMAIN |
| 532 if (d <= 0.0) | |
| 444 | 533 domain_error2 ("log", number, base); |
| 428 | 534 #endif |
| 535 if (NILP (base)) | |
| 444 | 536 IN_FLOAT (d = log (d), "log", number); |
| 428 | 537 else |
| 538 { | |
| 539 double b = extract_float (base); | |
| 540 #ifdef FLOAT_CHECK_DOMAIN | |
| 541 if (b <= 0.0 || b == 1.0) | |
| 444 | 542 domain_error2 ("log", number, base); |
| 428 | 543 #endif |
| 544 if (b == 10.0) | |
| 444 | 545 IN_FLOAT2 (d = log10 (d), "log", number, base); |
| 428 | 546 else |
| 444 | 547 IN_FLOAT2 (d = (log (d) / log (b)), "log", number, base); |
| 428 | 548 } |
| 549 return make_float (d); | |
| 550 } | |
| 551 | |
| 552 | |
| 553 DEFUN ("log10", Flog10, 1, 1, 0, /* | |
| 444 | 554 Return the logarithm base 10 of NUMBER. |
| 428 | 555 */ |
| 444 | 556 (number)) |
| 428 | 557 { |
| 444 | 558 double d = extract_float (number); |
| 428 | 559 #ifdef FLOAT_CHECK_DOMAIN |
| 560 if (d <= 0.0) | |
| 444 | 561 domain_error ("log10", number); |
| 428 | 562 #endif |
| 444 | 563 IN_FLOAT (d = log10 (d), "log10", number); |
| 428 | 564 return make_float (d); |
| 565 } | |
| 566 | |
| 567 | |
| 568 DEFUN ("sqrt", Fsqrt, 1, 1, 0, /* | |
| 444 | 569 Return the square root of NUMBER. |
| 428 | 570 */ |
| 444 | 571 (number)) |
| 428 | 572 { |
| 1983 | 573 double d; |
| 574 | |
| 575 #if defined(HAVE_BIGFLOAT) && defined(bigfloat_sqrt) | |
| 576 if (BIGFLOATP (number)) | |
| 577 { | |
| 578 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); | |
| 579 bigfloat_sqrt (scratch_bigfloat, XBIGFLOAT_DATA (number)); | |
| 580 return make_bigfloat_bf (scratch_bigfloat); | |
| 581 } | |
| 582 #endif /* HAVE_BIGFLOAT */ | |
| 583 d = extract_float (number); | |
| 428 | 584 #ifdef FLOAT_CHECK_DOMAIN |
| 585 if (d < 0.0) | |
| 444 | 586 domain_error ("sqrt", number); |
| 428 | 587 #endif |
| 444 | 588 IN_FLOAT (d = sqrt (d), "sqrt", number); |
| 428 | 589 return make_float (d); |
| 590 } | |
| 591 | |
| 592 | |
| 593 DEFUN ("cube-root", Fcube_root, 1, 1, 0, /* | |
| 444 | 594 Return the cube root of NUMBER. |
| 428 | 595 */ |
| 444 | 596 (number)) |
| 428 | 597 { |
| 444 | 598 double d = extract_float (number); |
| 428 | 599 #ifdef HAVE_CBRT |
| 444 | 600 IN_FLOAT (d = cbrt (d), "cube-root", number); |
| 428 | 601 #else |
| 602 if (d >= 0.0) | |
| 444 | 603 IN_FLOAT (d = pow (d, 1.0/3.0), "cube-root", number); |
| 428 | 604 else |
| 444 | 605 IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", number); |
| 428 | 606 #endif |
| 607 return make_float (d); | |
| 608 } | |
| 609 | |
| 610 /* Inverse trig functions. */ | |
| 611 | |
| 612 DEFUN ("acosh", Facosh, 1, 1, 0, /* | |
| 444 | 613 Return the inverse hyperbolic cosine of NUMBER. |
| 428 | 614 */ |
| 444 | 615 (number)) |
| 428 | 616 { |
| 444 | 617 double d = extract_float (number); |
| 428 | 618 #ifdef FLOAT_CHECK_DOMAIN |
| 619 if (d < 1.0) | |
| 444 | 620 domain_error ("acosh", number); |
| 428 | 621 #endif |
| 622 #ifdef HAVE_INVERSE_HYPERBOLIC | |
| 444 | 623 IN_FLOAT (d = acosh (d), "acosh", number); |
| 428 | 624 #else |
| 444 | 625 IN_FLOAT (d = log (d + sqrt (d*d - 1.0)), "acosh", number); |
| 428 | 626 #endif |
| 627 return make_float (d); | |
| 628 } | |
| 629 | |
| 630 DEFUN ("asinh", Fasinh, 1, 1, 0, /* | |
| 444 | 631 Return the inverse hyperbolic sine of NUMBER. |
| 428 | 632 */ |
| 444 | 633 (number)) |
| 428 | 634 { |
| 444 | 635 double d = extract_float (number); |
| 428 | 636 #ifdef HAVE_INVERSE_HYPERBOLIC |
| 444 | 637 IN_FLOAT (d = asinh (d), "asinh", number); |
| 428 | 638 #else |
| 444 | 639 IN_FLOAT (d = log (d + sqrt (d*d + 1.0)), "asinh", number); |
| 428 | 640 #endif |
| 641 return make_float (d); | |
| 642 } | |
| 643 | |
| 644 DEFUN ("atanh", Fatanh, 1, 1, 0, /* | |
| 444 | 645 Return the inverse hyperbolic tangent of NUMBER. |
| 428 | 646 */ |
| 444 | 647 (number)) |
| 428 | 648 { |
| 444 | 649 double d = extract_float (number); |
| 428 | 650 #ifdef FLOAT_CHECK_DOMAIN |
| 651 if (d >= 1.0 || d <= -1.0) | |
| 444 | 652 domain_error ("atanh", number); |
| 428 | 653 #endif |
| 654 #ifdef HAVE_INVERSE_HYPERBOLIC | |
| 444 | 655 IN_FLOAT (d = atanh (d), "atanh", number); |
| 428 | 656 #else |
| 444 | 657 IN_FLOAT (d = 0.5 * log ((1.0 + d) / (1.0 - d)), "atanh", number); |
| 428 | 658 #endif |
| 659 return make_float (d); | |
| 660 } | |
| 661 | |
| 662 DEFUN ("cosh", Fcosh, 1, 1, 0, /* | |
| 444 | 663 Return the hyperbolic cosine of NUMBER. |
| 428 | 664 */ |
| 444 | 665 (number)) |
| 428 | 666 { |
| 444 | 667 double d = extract_float (number); |
| 428 | 668 #ifdef FLOAT_CHECK_DOMAIN |
| 669 if (d > 710.0 || d < -710.0) | |
| 444 | 670 range_error ("cosh", number); |
| 428 | 671 #endif |
| 444 | 672 IN_FLOAT (d = cosh (d), "cosh", number); |
| 428 | 673 return make_float (d); |
| 674 } | |
| 675 | |
| 676 DEFUN ("sinh", Fsinh, 1, 1, 0, /* | |
| 444 | 677 Return the hyperbolic sine of NUMBER. |
| 428 | 678 */ |
| 444 | 679 (number)) |
| 428 | 680 { |
| 444 | 681 double d = extract_float (number); |
| 428 | 682 #ifdef FLOAT_CHECK_DOMAIN |
| 683 if (d > 710.0 || d < -710.0) | |
| 444 | 684 range_error ("sinh", number); |
| 428 | 685 #endif |
| 444 | 686 IN_FLOAT (d = sinh (d), "sinh", number); |
| 428 | 687 return make_float (d); |
| 688 } | |
| 689 | |
| 690 DEFUN ("tanh", Ftanh, 1, 1, 0, /* | |
| 444 | 691 Return the hyperbolic tangent of NUMBER. |
| 428 | 692 */ |
| 444 | 693 (number)) |
| 428 | 694 { |
| 444 | 695 double d = extract_float (number); |
| 696 IN_FLOAT (d = tanh (d), "tanh", number); | |
| 428 | 697 return make_float (d); |
| 698 } | |
| 699 | |
| 700 /* Rounding functions */ | |
| 701 | |
| 702 DEFUN ("abs", Fabs, 1, 1, 0, /* | |
| 444 | 703 Return the absolute value of NUMBER. |
| 428 | 704 */ |
| 444 | 705 (number)) |
| 428 | 706 { |
| 444 | 707 if (FLOATP (number)) |
| 428 | 708 { |
| 444 | 709 IN_FLOAT (number = make_float (fabs (XFLOAT_DATA (number))), |
| 710 "abs", number); | |
| 711 return number; | |
| 428 | 712 } |
| 713 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
714 if (FIXNUMP (number)) |
| 1983 | 715 #ifdef HAVE_BIGNUM |
| 716 /* The most negative Lisp fixnum will overflow */ | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
717 return (XFIXNUM (number) >= 0) ? number : make_integer (- XFIXNUM (number)); |
| 1983 | 718 #else |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
719 return (XFIXNUM (number) >= 0) ? number : make_fixnum (- XFIXNUM (number)); |
| 1983 | 720 #endif |
| 721 | |
| 722 #ifdef HAVE_BIGNUM | |
| 723 if (BIGNUMP (number)) | |
| 724 { | |
| 725 if (bignum_sign (XBIGNUM_DATA (number)) >= 0) | |
| 726 return number; | |
| 727 bignum_abs (scratch_bignum, XBIGNUM_DATA (number)); | |
| 728 return make_bignum_bg (scratch_bignum); | |
| 729 } | |
| 730 #endif | |
| 731 | |
| 732 #ifdef HAVE_RATIO | |
| 733 if (RATIOP (number)) | |
| 734 { | |
| 735 if (ratio_sign (XRATIO_DATA (number)) >= 0) | |
| 736 return number; | |
| 737 ratio_abs (scratch_ratio, XRATIO_DATA (number)); | |
| 738 return make_ratio_rt (scratch_ratio); | |
| 739 } | |
| 740 #endif | |
| 741 | |
| 742 #ifdef HAVE_BIGFLOAT | |
| 743 if (BIGFLOATP (number)) | |
| 744 { | |
| 745 if (bigfloat_sign (XBIGFLOAT_DATA (number)) >= 0) | |
| 746 return number; | |
| 747 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); | |
| 748 bigfloat_abs (scratch_bigfloat, XBIGFLOAT_DATA (number)); | |
| 749 return make_bigfloat_bf (scratch_bigfloat); | |
| 750 } | |
| 751 #endif | |
| 428 | 752 |
| 444 | 753 return Fabs (wrong_type_argument (Qnumberp, number)); |
| 428 | 754 } |
| 755 | |
| 756 DEFUN ("float", Ffloat, 1, 1, 0, /* | |
| 444 | 757 Return the floating point number numerically equal to NUMBER. |
| 428 | 758 */ |
| 444 | 759 (number)) |
| 428 | 760 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
761 if (FIXNUMP (number)) |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
762 return make_float ((double) XFIXNUM (number)); |
| 428 | 763 |
| 1983 | 764 #ifdef HAVE_BIGNUM |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
765 if (BIGNUMP (number)) |
| 1983 | 766 { |
| 767 #ifdef HAVE_BIGFLOAT | |
| 768 if (ZEROP (Vdefault_float_precision)) | |
| 769 #endif | |
| 770 return make_float (bignum_to_double (XBIGNUM_DATA (number))); | |
| 771 #ifdef HAVE_BIGFLOAT | |
| 772 else | |
| 773 { | |
| 774 bigfloat_set_prec (scratch_bigfloat, bigfloat_get_default_prec ()); | |
| 775 bigfloat_set_bignum (scratch_bigfloat, XBIGNUM_DATA (number)); | |
| 776 return make_bigfloat_bf (scratch_bigfloat); | |
| 777 } | |
| 778 #endif /* HAVE_BIGFLOAT */ | |
| 779 } | |
| 780 #endif /* HAVE_BIGNUM */ | |
| 781 | |
| 782 #ifdef HAVE_RATIO | |
| 783 if (RATIOP (number)) | |
| 2092 | 784 return make_float (ratio_to_double (XRATIO_DATA (number))); |
| 1983 | 785 #endif |
| 786 | |
| 444 | 787 if (FLOATP (number)) /* give 'em the same float back */ |
| 788 return number; | |
| 428 | 789 |
|
5315
2a7b6ddb8063
#'float: if handed a bigfloat, give the same bigfloat back.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5252
diff
changeset
|
790 if (BIGFLOATP (number)) |
|
2a7b6ddb8063
#'float: if handed a bigfloat, give the same bigfloat back.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5252
diff
changeset
|
791 { |
|
2a7b6ddb8063
#'float: if handed a bigfloat, give the same bigfloat back.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5252
diff
changeset
|
792 return number; |
|
2a7b6ddb8063
#'float: if handed a bigfloat, give the same bigfloat back.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5252
diff
changeset
|
793 } |
|
2a7b6ddb8063
#'float: if handed a bigfloat, give the same bigfloat back.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5252
diff
changeset
|
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) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
807 return make_fixnum (MOST_NEGATIVE_FIXNUM); |
| 428 | 808 #ifdef HAVE_LOGB |
| 809 { | |
| 810 Lisp_Object val; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
811 IN_FLOAT (val = make_fixnum ((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); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
819 return make_fixnum (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 } | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
843 return make_fixnum (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 { \ |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
898 number = make_fixnum (XCHAR (number)); \ |
|
4678
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 { \ |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
902 number = make_fixnum (marker_position (number)); \ |
|
4678
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 { \ |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
907 divisor = make_fixnum (XCHAR (divisor)); \ |
|
4678
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 { \ |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
911 divisor = make_fixnum (marker_position (divisor)); \ |
|
4678
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 \ |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
914 CHECK_FIXNUM_OR_FLOAT (divisor); \ |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
915 if (FIXNUMP (number) && FIXNUMP (divisor)) \ |
|
4678
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 { \ |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
991 return conversion##_one_mundane_arg (make_fixnum (XCHAR (number)), \ |
|
4678
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 { \ |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
997 return conversion##_one_mundane_arg (make_fixnum \ |
|
4678
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 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1010 EMACS_INT i1 = XREALFIXNUM (number); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1011 EMACS_INT i2 = XREALFIXNUM (divisor); |
|
4678
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 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1065 return values2 (make_fixnum (i3), make_fixnum (i4)); |
|
4678
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), |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1069 make_fixnum (i4)); |
|
4678
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 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1163 res0 = make_fixnum ((EMACS_INT) bigfloat_to_long (scratch_bigfloat)); |
|
4678
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 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1223 res0 = make_fixnum ((EMACS_INT) bigfloat_to_long (scratch_bigfloat)); |
|
4678
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 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1291 if (FIXNUMP (number)) |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1292 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1293 return values2 (make_float ((double) XFIXNUM (number)), Qzero); |
|
4678
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 if (INTEGERP (number)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1307 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1308 return values2 (number, Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1309 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1310 } |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1311 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1312 MAYBE_CHAR_OR_MARKER (ceiling); |
|
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 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
|
1315 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1316 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1317 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1318 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
|
1319 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1320 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1321 EMACS_INT i1 = XREALFIXNUM (number); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1322 EMACS_INT i2 = XREALFIXNUM (divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1323 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
|
1324 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1325 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1326 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
|
1327 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
|
1328 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1329 /* 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
|
1330 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
|
1331 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
|
1332 infinity. */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1333 i3 = (i2 < 0 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1334 ? (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
|
1335 : (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
|
1336 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1337 i4 = i1 - (i3 * i2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1338 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1339 if (return_float) |
|
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 res0 = make_float ((double)i3); |
|
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 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1344 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1345 res0 = make_fixnum (i3); |
|
4678
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 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1348 return values2 (res0, make_fixnum (i4)); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1349 } |
|
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 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1352 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1353 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
|
1354 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1355 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1356 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1357 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1358 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
|
1359 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
|
1360 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1361 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
|
1362 XBIGNUM_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1363 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1364 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1365 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1366 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
|
1367 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1368 else |
|
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 = 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
|
1371 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1372 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1373 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
|
1374 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1375 res1 = Qzero; |
|
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 else |
|
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 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
|
1380 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
|
1381 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
|
1382 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1383 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1384 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1385 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1386 #endif /* HAVE_BIGNUM */ |
|
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 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1389 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1390 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
|
1391 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1392 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1393 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1394 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1395 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
|
1396 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
|
1397 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1398 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
|
1399 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1400 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
|
1401 ratio_denominator (scratch_ratio)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1402 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1403 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
|
1404 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
|
1405 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1406 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
|
1407 ratio_denominator (scratch_ratio))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1408 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1409 res1 = Qzero; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1410 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1411 else |
|
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 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
|
1414 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
|
1415 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
|
1416 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
|
1417 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1418 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1419 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1420 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1421 #endif /* HAVE_RATIO */ |
|
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 #ifdef HAVE_BIGFLOAT |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1424 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1425 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
|
1426 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1427 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1428 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1429 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1430 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
|
1431 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
|
1432 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1433 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
|
1434 XBIGFLOAT_GET_PREC (divisor))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1435 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
|
1436 XBIGFLOAT_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1437 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
|
1438 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1439 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1440 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1441 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
|
1442 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1443 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1444 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1445 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1446 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
|
1447 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
|
1448 #else |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1449 res0 = make_fixnum ((EMACS_INT) bigfloat_to_long (scratch_bigfloat)); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1450 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1451 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1452 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1453 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
|
1454 XBIGFLOAT_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1455 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
|
1456 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1457 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
|
1458 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1459 #endif /* HAVE_BIGFLOAT */ |
|
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 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1462 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1463 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
|
1464 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1465 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1466 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1467 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1468 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
|
1469 XRATIO_DENOMINATOR (number)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1470 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1471 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
|
1472 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
|
1473 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1474 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
|
1475 XRATIO_DENOMINATOR (number))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1476 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1477 res1 = Qzero; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1478 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1479 else |
|
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 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
|
1482 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
|
1483 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
|
1484 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1485 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1486 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1487 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1488 #endif /* HAVE_RATIO */ |
|
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 #ifdef HAVE_BIGFLOAT |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1491 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1492 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
|
1493 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1494 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1495 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1496 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1497 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
|
1498 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
|
1499 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1500 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1501 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1502 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
|
1503 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1504 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1505 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1506 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1507 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
|
1508 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
|
1509 #else |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1510 res0 = make_fixnum ((EMACS_INT) bigfloat_to_long (scratch_bigfloat)); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1511 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1512 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1513 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1514 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
|
1515 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
|
1516 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1517 #endif /* HAVE_BIGFLOAT */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1518 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1519 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1520 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
|
1521 int return_float) |
|
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 double f1 = extract_float (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1524 double f2 = extract_float (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1525 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
|
1526 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1527 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
|
1528 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
|
1529 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1530 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
|
1531 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
|
1532 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1533 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1534 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1535 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
|
1536 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1537 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1538 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
|
1539 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 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1543 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
|
1544 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1545 double d, d1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1546 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1547 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
|
1548 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
|
1549 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1550 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1551 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1552 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
|
1553 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1554 else |
|
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 (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
|
1557 make_float (d1)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1558 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1559 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1560 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1561 EXFUN (Ffloor, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1562 EXFUN (Fffloor, 2); |
|
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 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1565 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
|
1566 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1567 { |
| 1983 | 1568 if (INTEGERP (number)) |
| 1569 { | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1570 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1571 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1572 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
|
1573 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1574 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1575 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1576 return values2 (number, Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1577 } |
| 1983 | 1578 } |
|
4678
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 MAYBE_CHAR_OR_MARKER (floor); |
|
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 if (return_float) |
|
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 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
|
1585 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1586 else |
|
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 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
|
1589 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1590 } |
| 1983 | 1591 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1592 /* 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
|
1593 tests/automated/lisp-tests.el. */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1594 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
|
1595 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
|
1596 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1597 EMACS_INT i1 = XREALFIXNUM (number); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1598 EMACS_INT i2 = XREALFIXNUM (divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1599 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
|
1600 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1601 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
|
1602 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
|
1603 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1604 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
|
1605 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1606 flooring = hi2 + i1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1607 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1608 floored = (i2 < 0 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1609 ? (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
|
1610 : (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
|
1611 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1612 flsecond = flooring - (floored * i2); |
| 1983 | 1613 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1614 if (0 == flsecond |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1615 && (i2 == (hi2 + hi2)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1616 && (0 != (floored % 2))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1617 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1618 i0 = floored - 1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1619 return values2 (return_float ? make_float ((double)i0) : |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1620 make_fixnum (i0), make_fixnum (hi2)); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1621 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1622 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1623 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1624 return values2 (return_float ? make_float ((double)floored) : |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1625 make_fixnum (floored), |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1626 make_fixnum (flsecond - hi2)); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1627 } |
| 428 | 1628 } |
| 1629 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1630 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1631 static void |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1632 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
|
1633 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
|
1634 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1635 bignum flooring, floored, hi2, flsecond; |
| 428 | 1636 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1637 if (bignum_divisible_p (number, divisor)) |
| 1983 | 1638 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1639 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
|
1640 *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
|
1641 *remain = Qzero; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1642 return; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1643 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1644 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1645 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
|
1646 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1647 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
|
1648 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1649 bignum_init (hi2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1650 bignum_set (hi2, scratch_bignum2); |
|
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 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
|
1653 bignum_init (flooring); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1654 bignum_set (flooring, scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1655 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1656 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
|
1657 bignum_init (floored); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1658 bignum_set (floored, scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1659 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1660 bignum_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
|
1661 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
|
1662 bignum_init (flsecond); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1663 bignum_set (flsecond, scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1664 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1665 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
|
1666 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
|
1667 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1668 if (bignum_sign (flsecond) == 0 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1669 && bignum_eql (divisor, scratch_bignum2) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1670 && (1 == bignum_testbit (floored, 0))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1671 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1672 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
|
1673 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
|
1674 *res = make_bignum_bg (floored); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1675 *remain = make_bignum_bg (hi2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1676 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1677 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1678 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1679 bignum_sub (scratch_bignum, flsecond, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1680 hi2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1681 *res = make_bignum_bg (floored); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1682 *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
|
1683 } |
|
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 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1686 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
|
1687 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
|
1688 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1689 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1690 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1691 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
|
1692 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
|
1693 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1694 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
|
1695 &res0, &res1); |
|
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 if (return_float) |
|
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 res0 = make_float (bignum_to_double (XBIGNUM_DATA (res0))); |
| 1983 | 1700 } |
| 1701 else | |
| 1702 { | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1703 res0 = Fcanonicalize_number (res0); |
|
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 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1706 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
|
1707 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1708 #endif /* HAVE_BIGNUM */ |
| 1983 | 1709 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1710 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1711 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1712 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
|
1713 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1714 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1715 Lisp_Object res0, res1; |
| 1983 | 1716 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1717 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
|
1718 return arith_error2 ("round", number, divisor); |
| 1983 | 1719 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1720 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
|
1721 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1722 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
|
1723 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
|
1724 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1725 if (!ZEROP (res1)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1726 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1727 /* 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
|
1728 ratio remainder: */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1729 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
|
1730 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
|
1731 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
|
1732 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1733 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
|
1734 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1735 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1736 res0 = return_float ? |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1737 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
|
1738 Fcanonicalize_number (res0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1739 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1740 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1741 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1742 #endif /* HAVE_RATIO */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1743 |
| 1983 | 1744 #ifdef HAVE_BIGFLOAT |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1745 /* 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
|
1746 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1747 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
|
1748 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1749 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1750 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
|
1751 |
| 4828 | 1752 #if 0 |
| 1753 /* This causes the following GCC warning: | |
| 1754 | |
| 1755 /xemacs/latest-fix/src/floatfns.c:1764: warning: dereferencing type-punned pointer will break strict-aliasing rules | |
| 1756 | |
| 1757 and furthermore, it's a useless assert, since `number' is stored on | |
| 1758 the stack and so its address can never be the same as `scratch_bigfloat' | |
| 1759 or `scratch_bigfloat2', which are stored in the data segment. | |
| 1760 | |
| 1761 -- ben */ | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1762 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
|
1763 && (bigfloat *)(&number) != (bigfloat *)(&scratch_bigfloat2)); |
| 4828 | 1764 #endif |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1765 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1766 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
|
1767 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
|
1768 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1769 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
|
1770 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
|
1771 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
|
1772 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
|
1773 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1774 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
|
1775 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
|
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_bigfloat2, 0.5); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1778 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1779 do { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1780 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
|
1781 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1782 break; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1783 } |
|
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 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
|
1786 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1787 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
|
1788 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
|
1789 scratch_bigfloat2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1790 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
|
1791 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
|
1792 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
|
1793 scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1794 if (bigfloat_eql (scratch_bigfloat2, XBIGFLOAT_DATA (res0))) |
| 1995 | 1795 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1796 break; |
| 1995 | 1797 } |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1798 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1799 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1800 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
|
1801 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1802 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
|
1803 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1804 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1805 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1806 bigfloat_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
|
1807 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1808 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1809 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
|
1810 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1811 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
|
1812 scratch_bigfloat); |
| 428 | 1813 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1814 } while (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 return res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1817 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1818 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1819 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1820 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
|
1821 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1822 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1823 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1824 bigfloat divided; |
|
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 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
|
1827 XBIGFLOAT_GET_PREC (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1828 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1829 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
|
1830 return arith_error2 ("round", number, divisor); |
| 428 | 1831 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1832 bigfloat_init (divided); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1833 bigfloat_set_prec (divided, prec); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1834 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1835 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
|
1836 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1837 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
|
1838 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1839 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
|
1840 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
|
1841 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1842 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
|
1843 XBIGFLOAT_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1844 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
|
1845 scratch_bigfloat); |
|
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 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
|
1848 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1849 if (!return_float) |
| 428 | 1850 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1851 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1852 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
|
1853 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
|
1854 #else |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1855 res0 = make_fixnum ((EMACS_INT) bigfloat_to_long (XBIGFLOAT_DATA (res0))); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1856 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1857 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1858 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1859 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1860 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1861 #endif /* HAVE_BIGFLOAT */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1862 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1863 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1864 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1865 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
|
1866 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1867 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1868 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1869 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1870 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
|
1871 &res0, &res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1872 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1873 if (!ZEROP (res1)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1874 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1875 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
|
1876 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
|
1877 res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio)); |
| 428 | 1878 } |
| 1879 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1880 res0 = return_float ? |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1881 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
|
1882 Fcanonicalize_number (res0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1883 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1884 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1885 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1886 #endif /* HAVE_RATIO */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1887 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1888 #ifdef HAVE_BIGFLOAT |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1889 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1890 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
|
1891 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1892 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1893 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
|
1894 Lisp_Object res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1895 |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1896 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
|
1897 XBIGFLOAT_DATA (res0)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1898 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1899 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
|
1900 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1901 if (!return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1902 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1903 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1904 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
|
1905 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
|
1906 #else |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1907 res0 = make_fixnum ((EMACS_INT) bigfloat_to_long |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1908 (XBIGFLOAT_DATA (res0))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1909 #endif /* HAVE_BIGNUM */ |
|
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 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1912 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1913 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1914 #endif /* HAVE_BIGFLOAT */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1915 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1916 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1917 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
|
1918 int return_float) |
|
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 double f1 = extract_float (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1921 double f2 = extract_float (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1922 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
|
1923 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1924 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
|
1925 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
|
1926 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1927 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
|
1928 divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1929 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
|
1930 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1931 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1932 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1933 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
|
1934 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1935 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1936 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1937 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
|
1938 make_float (remain)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1939 } |
| 428 | 1940 } |
| 1941 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1942 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1943 round_one_float (Lisp_Object number, int return_float) |
| 428 | 1944 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1945 double d; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1946 /* Screw the prevailing rounding mode. */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1947 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
|
1948 number); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1949 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1950 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1951 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1952 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
|
1953 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1954 else |
| 428 | 1955 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1956 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
|
1957 Qunbound)), |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1958 make_float (XFLOAT_DATA (number) - d)); |
| 428 | 1959 } |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1960 } |
| 428 | 1961 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1962 EXFUN (Fround, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1963 EXFUN (Ffround, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1964 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1965 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1966 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
|
1967 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1968 { |
| 1983 | 1969 if (INTEGERP (number)) |
| 1970 { | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1971 if (return_float) |
| 1983 | 1972 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1973 return values2 (make_float (extract_float (number)), Qzero); |
| 1983 | 1974 } |
| 1975 else | |
| 1976 { | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1977 return values2 (number, Qzero); |
| 1983 | 1978 } |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1979 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1980 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1981 MAYBE_CHAR_OR_MARKER (round); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1982 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1983 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1984 { |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1985 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
|
1986 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1987 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1988 { |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1989 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
|
1990 } |
|
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 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1994 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
|
1995 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1996 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1997 EMACS_INT i1 = XREALFIXNUM (number); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
1998 EMACS_INT i2 = XREALFIXNUM (divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1999 EMACS_INT i0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2000 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2001 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
|
2002 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
|
2003 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2004 /* 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
|
2005 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
|
2006 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
|
2007 i0 = (i2 < 0 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2008 ? (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
|
2009 : (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
|
2010 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2011 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2012 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
2013 return values2 (make_float ((double)i0), make_fixnum (i1 - (i0 * i2))); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2014 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2015 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2016 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
2017 return values2 (make_fixnum (i0), make_fixnum (i1 - (i0 * i2))); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2018 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2019 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2020 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2021 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2022 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2023 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
|
2024 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2025 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2026 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2027 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2028 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
|
2029 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
|
2030 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2031 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
|
2032 XBIGNUM_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2033 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2034 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2035 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2036 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
|
2037 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2038 else |
|
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 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
|
2041 } |
|
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 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
|
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 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
|
2047 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2048 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2049 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
|
2050 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
|
2051 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2052 return values2 (Fcanonicalize_number (res0), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2053 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
|
2054 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2055 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2056 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2057 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2058 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2059 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
|
2060 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2061 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2062 Lisp_Object res0; |
|
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 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
|
2065 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
|
2066 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2067 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
|
2068 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2069 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
|
2070 ratio_denominator (scratch_ratio)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2071 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2072 if (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 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
|
2075 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2076 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2077 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2078 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
|
2079 } |
|
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 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
|
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 return values2 (res0, Qzero); |
|
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 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2087 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
|
2088 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
|
2089 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
|
2090 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2091 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
|
2092 } |
| 1983 | 2093 #endif |
| 2094 | |
| 2095 #ifdef HAVE_BIGFLOAT | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2096 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2097 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
|
2098 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2099 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2100 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2101 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
|
2102 XBIGFLOAT_GET_PREC (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2103 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2104 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
|
2105 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
|
2106 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2107 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
|
2108 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
|
2109 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2110 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
|
2111 XBIGFLOAT_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2112 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
|
2113 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2114 if (return_float) |
|
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 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
|
2117 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2118 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2119 { |
| 1983 | 2120 #ifdef HAVE_BIGNUM |
| 2121 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
|
2122 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
| 1983 | 2123 #else |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
2124 res0 = make_fixnum ((EMACS_INT) bigfloat_to_long (scratch_bigfloat)); |
| 1983 | 2125 #endif /* HAVE_BIGNUM */ |
| 2126 } | |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
2127 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2128 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
|
2129 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
|
2130 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2131 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
|
2132 } |
| 1983 | 2133 #endif /* HAVE_BIGFLOAT */ |
| 2134 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2135 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2136 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2137 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
|
2138 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2139 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2140 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2141 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2142 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
|
2143 return Qzero; |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2144 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2145 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
|
2146 XRATIO_DENOMINATOR (number)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2147 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2148 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2149 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
|
2150 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2151 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2152 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2153 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
|
2154 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2155 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2156 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
|
2157 XRATIO_DENOMINATOR (number))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2158 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2159 return values2 (res0, Qzero); |
|
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 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2162 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
|
2163 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
|
2164 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2165 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
|
2166 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2167 #endif /* HAVE_RATIO */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2168 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2169 #ifdef HAVE_BIGFLOAT |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2170 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2171 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
|
2172 int return_float) |
|
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 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2175 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2176 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
|
2177 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
|
2178 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
|
2179 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2180 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2181 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2182 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
|
2183 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2184 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2185 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2186 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2187 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
|
2188 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
|
2189 #else |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
2190 res0 = make_fixnum ((EMACS_INT) bigfloat_to_long (scratch_bigfloat)); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2191 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2192 } |
|
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 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
|
2195 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2196 return |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
2197 values2 (res0, |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2198 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
|
2199 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2200 #endif /* HAVE_BIGFLOAT */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2201 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2202 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2203 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
|
2204 int return_float) |
|
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 double f1 = extract_float (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2207 double f2 = extract_float (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2208 double f0, remain; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2209 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
|
2210 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2211 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
|
2212 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
|
2213 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2214 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
|
2215 f0 = extract_float (res0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2216 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2217 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
|
2218 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2219 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2220 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2221 res0 = make_float (f0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2222 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2223 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2224 return values2 (res0, make_float (remain)); |
| 428 | 2225 } |
| 2226 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2227 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2228 truncate_one_float (Lisp_Object number, int return_float) |
| 428 | 2229 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2230 Lisp_Object res0 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2231 = 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
|
2232 number, Qunbound); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2233 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2234 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
2235 res0 = make_float ((double)XFIXNUM(res0)); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2236 return values2 (res0, make_float ((XFLOAT_DATA (number) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2237 - XFLOAT_DATA (res0)))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2238 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2239 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2240 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2241 return values2 (res0, make_float (XFLOAT_DATA (number) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
2242 - XREALFIXNUM (res0))); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2243 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2244 } |
| 428 | 2245 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2246 EXFUN (Fftruncate, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2247 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2248 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2249 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
|
2250 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2251 { |
| 1983 | 2252 if (INTEGERP (number)) |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2253 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2254 if (return_float) |
|
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 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
|
2257 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2258 else |
|
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 return values2 (number, Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2261 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2262 } |
| 428 | 2263 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2264 MAYBE_CHAR_OR_MARKER (truncate); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2265 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2266 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2267 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2268 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
|
2269 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2270 else |
| 1983 | 2271 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2272 return Ftruncate (wrong_type_argument (Qnumberp, number), divisor); |
| 1983 | 2273 } |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2274 } |
|
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 /* 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
|
2277 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2278 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
|
2279 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
|
2280 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2281 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
|
2282 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
|
2283 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2284 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
|
2285 `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
|
2286 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
|
2287 is omitted or one. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2288 */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2289 (number, divisor)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2290 { |
|
5252
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2291 ROUNDING_CONVERT (ceiling, 0); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2292 } |
| 1983 | 2293 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2294 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
|
2295 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
|
2296 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
|
2297 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
|
2298 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2299 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
|
2300 `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
|
2301 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
|
2302 one. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2303 */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2304 (number, divisor)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2305 { |
|
5252
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2306 ROUNDING_CONVERT (floor, 0); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2307 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2308 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2309 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
|
2310 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
|
2311 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
|
2312 is even. |
| 1983 | 2313 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2314 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
|
2315 divided by DIVISOR. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2316 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2317 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
|
2318 `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
|
2319 in the calculation. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2320 */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2321 (number, divisor)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2322 { |
|
5252
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2323 ROUNDING_CONVERT (round, 0); |
|
4678
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 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2326 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
|
2327 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
|
2328 Rounds the value toward zero. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2329 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2330 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
|
2331 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2332 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
|
2333 `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
|
2334 */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2335 (number, divisor)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2336 { |
|
5252
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2337 ROUNDING_CONVERT (truncate, 0); |
| 428 | 2338 } |
| 2339 | |
| 2340 /* Float-rounding functions. */ | |
| 2341 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2342 DEFUN ("fceiling", Ffceiling, 1, 2, 0, /* |
| 444 | 2343 Return the smallest integer no less than NUMBER, as a float. |
| 428 | 2344 \(Round toward +inf.\) |
|
4678
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 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
|
2347 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
|
2348 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2349 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
|
2350 the calculation. |
| 428 | 2351 */ |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2352 (number, divisor)) |
| 428 | 2353 { |
|
5252
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2354 ROUNDING_CONVERT (ceiling, 1); |
| 428 | 2355 } |
| 2356 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2357 DEFUN ("ffloor", Fffloor, 1, 2, 0, /* |
| 444 | 2358 Return the largest integer no greater than NUMBER, as a float. |
| 428 | 2359 \(Round towards -inf.\) |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2360 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2361 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
|
2362 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
|
2363 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2364 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
|
2365 the calculation. |
| 428 | 2366 */ |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2367 (number, divisor)) |
| 428 | 2368 { |
|
5252
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2369 ROUNDING_CONVERT (floor, 1); |
| 428 | 2370 } |
| 2371 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2372 DEFUN ("fround", Ffround, 1, 2, 0, /* |
| 444 | 2373 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
|
2374 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
|
2375 even. |
|
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 nearest integer to the quotient |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2378 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 { |
|
5252
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2385 ROUNDING_CONVERT (round, 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 ("ftruncate", Fftruncate, 1, 2, 0, /* |
| 428 | 2389 Truncate a floating point number to an integral float value. |
| 2390 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
|
2391 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2392 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
|
2393 to an integral float value. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2394 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2395 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
|
2396 the calculation. |
| 428 | 2397 */ |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2398 (number, divisor)) |
| 428 | 2399 { |
|
5252
378a34562cbe
Fix style, documentation for rounding functions and multiple values.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2400 ROUNDING_CONVERT (truncate, 1); |
| 428 | 2401 } |
| 2402 | |
| 2403 #ifdef FLOAT_CATCH_SIGILL | |
| 2404 static SIGTYPE | |
| 2405 float_error (int signo) | |
| 2406 { | |
| 2407 if (! in_float) | |
| 2408 fatal_error_signal (signo); | |
| 2409 | |
| 2410 EMACS_REESTABLISH_SIGNAL (signo, arith_error); | |
| 2411 EMACS_UNBLOCK_SIGNAL (signo); | |
| 2412 | |
| 2413 in_float = 0; | |
| 2414 | |
| 2415 /* Was Fsignal(), but it just doesn't make sense for an error | |
| 2416 occurring inside a signal handler to be restartable, considering | |
| 2417 that anything could happen when the error is signaled and trapped | |
| 2418 and considering the asynchronous nature of signal handlers. */ | |
| 563 | 2419 signal_error (Qarith_error, 0, float_error_arg); |
| 428 | 2420 } |
| 2421 | |
| 2422 /* Another idea was to replace the library function `infnan' | |
| 2423 where SIGILL is signaled. */ | |
| 2424 | |
| 2425 #endif /* FLOAT_CATCH_SIGILL */ | |
| 2426 | |
| 2427 /* In C++, it is impossible to determine what type matherr expects | |
| 2428 without some more configure magic. | |
| 2429 We shouldn't be using matherr anyways - it's a non-standard SYSVism. */ | |
| 2430 #if defined (HAVE_MATHERR) && !defined(__cplusplus) | |
| 2431 int | |
| 2432 matherr (struct exception *x) | |
| 2433 { | |
| 2434 Lisp_Object args; | |
| 2435 if (! in_float) | |
| 2436 /* Not called from emacs-lisp float routines; do the default thing. */ | |
| 2437 return 0; | |
| 2438 | |
| 2439 /* if (!strcmp (x->name, "pow")) x->name = "expt"; */ | |
| 2440 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2441 args = Fcons (build_extstring (x->name, Qerror_message_encoding), |
| 428 | 2442 Fcons (make_float (x->arg1), |
| 2443 ((in_float == 2) | |
| 2444 ? Fcons (make_float (x->arg2), Qnil) | |
| 2445 : Qnil))); | |
| 2446 switch (x->type) | |
| 2447 { | |
| 2448 case DOMAIN: Fsignal (Qdomain_error, args); break; | |
| 2449 case SING: Fsignal (Qsingularity_error, args); break; | |
| 2450 case OVERFLOW: Fsignal (Qoverflow_error, args); break; | |
| 2451 case UNDERFLOW: Fsignal (Qunderflow_error, args); break; | |
| 2452 default: Fsignal (Qarith_error, args); break; | |
| 2453 } | |
| 2454 return 1; /* don't set errno or print a message */ | |
| 2455 } | |
| 2456 #endif /* HAVE_MATHERR */ | |
| 2457 | |
| 2458 void | |
| 2459 init_floatfns_very_early (void) | |
| 2460 { | |
| 2461 # ifdef FLOAT_CATCH_SIGILL | |
| 613 | 2462 EMACS_SIGNAL (SIGILL, float_error); |
| 428 | 2463 # endif |
| 2464 in_float = 0; | |
| 2465 } | |
| 2466 | |
| 2467 void | |
| 2468 syms_of_floatfns (void) | |
| 2469 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
2286
diff
changeset
|
2470 INIT_LISP_OBJECT (float); |
| 428 | 2471 |
| 2472 /* Trig functions. */ | |
| 2473 | |
| 2474 DEFSUBR (Facos); | |
| 2475 DEFSUBR (Fasin); | |
| 2476 DEFSUBR (Fatan); | |
| 2477 DEFSUBR (Fcos); | |
| 2478 DEFSUBR (Fsin); | |
| 2479 DEFSUBR (Ftan); | |
| 2480 | |
| 2481 /* Bessel functions */ | |
| 2482 | |
| 2483 #if 0 | |
| 2484 DEFSUBR (Fbessel_y0); | |
| 2485 DEFSUBR (Fbessel_y1); | |
| 2486 DEFSUBR (Fbessel_yn); | |
| 2487 DEFSUBR (Fbessel_j0); | |
| 2488 DEFSUBR (Fbessel_j1); | |
| 2489 DEFSUBR (Fbessel_jn); | |
| 2490 #endif /* 0 */ | |
| 2491 | |
| 2492 /* Error functions. */ | |
| 2493 | |
| 2494 #if 0 | |
| 2495 DEFSUBR (Ferf); | |
| 2496 DEFSUBR (Ferfc); | |
| 2497 DEFSUBR (Flog_gamma); | |
| 2498 #endif /* 0 */ | |
| 2499 | |
| 2500 /* Root and Log functions. */ | |
| 2501 | |
| 2502 DEFSUBR (Fexp); | |
| 2503 DEFSUBR (Fexpt); | |
| 2504 DEFSUBR (Flog); | |
| 2505 DEFSUBR (Flog10); | |
| 2506 DEFSUBR (Fsqrt); | |
| 2507 DEFSUBR (Fcube_root); | |
| 2508 | |
| 2509 /* Inverse trig functions. */ | |
| 2510 | |
| 2511 DEFSUBR (Facosh); | |
| 2512 DEFSUBR (Fasinh); | |
| 2513 DEFSUBR (Fatanh); | |
| 2514 DEFSUBR (Fcosh); | |
| 2515 DEFSUBR (Fsinh); | |
| 2516 DEFSUBR (Ftanh); | |
| 2517 | |
| 2518 /* Rounding functions */ | |
| 2519 | |
| 2520 DEFSUBR (Fabs); | |
| 2521 DEFSUBR (Ffloat); | |
| 2522 DEFSUBR (Flogb); | |
| 2523 DEFSUBR (Fceiling); | |
| 2524 DEFSUBR (Ffloor); | |
| 2525 DEFSUBR (Fround); | |
| 2526 DEFSUBR (Ftruncate); | |
| 2527 | |
| 2528 /* Float-rounding functions. */ | |
| 2529 | |
| 2530 DEFSUBR (Ffceiling); | |
| 2531 DEFSUBR (Fffloor); | |
| 2532 DEFSUBR (Ffround); | |
| 2533 DEFSUBR (Fftruncate); | |
| 2534 } | |
| 2535 | |
| 2536 void | |
| 2537 vars_of_floatfns (void) | |
| 2538 { | |
| 2539 Fprovide (intern ("lisp-float-type")); | |
| 2540 } |