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