Mercurial > hg > xemacs-beta
annotate src/floatfns.c @ 4952:19a72041c5ed
Mule-izing, various fixes related to char * arguments
-------------------- ChangeLog entries follow: --------------------
modules/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c:
* postgresql/postgresql.c (CHECK_LIVE_CONNECTION):
* postgresql/postgresql.c (print_pgresult):
* postgresql/postgresql.c (Fpq_conn_defaults):
* postgresql/postgresql.c (Fpq_connectdb):
* postgresql/postgresql.c (Fpq_connect_start):
* postgresql/postgresql.c (Fpq_result_status):
* postgresql/postgresql.c (Fpq_res_status):
Mule-ize large parts of it.
2010-01-26 Ben Wing <ben@xemacs.org>
* ldap/eldap.c (print_ldap):
* ldap/eldap.c (allocate_ldap):
Use write_ascstring().
src/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (build_ascstring):
* alloc.c (build_msg_cistring):
* alloc.c (staticpro_1):
* alloc.c (staticpro_name):
* alloc.c (staticpro_nodump_1):
* alloc.c (staticpro_nodump_name):
* alloc.c (unstaticpro_nodump_1):
* alloc.c (mcpro_1):
* alloc.c (mcpro_name):
* alloc.c (object_memory_usage_stats):
* alloc.c (common_init_alloc_early):
* alloc.c (init_alloc_once_early):
* buffer.c (print_buffer):
* buffer.c (vars_of_buffer):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.c (init_initial_directory):
* bytecode.c (invalid_byte_code):
* bytecode.c (print_compiled_function):
* bytecode.c (mark_compiled_function):
* chartab.c (print_table_entry):
* chartab.c (print_char_table):
* config.h.in:
* console-gtk.c:
* console-gtk.c (gtk_device_to_console_connection):
* console-gtk.c (gtk_semi_canonicalize_console_connection):
* console-gtk.c (gtk_canonicalize_console_connection):
* console-gtk.c (gtk_semi_canonicalize_device_connection):
* console-gtk.c (gtk_canonicalize_device_connection):
* console-stream.c (stream_init_frame_1):
* console-stream.c (vars_of_console_stream):
* console-stream.c (init_console_stream):
* console-x.c (x_semi_canonicalize_console_connection):
* console-x.c (x_semi_canonicalize_device_connection):
* console-x.c (x_canonicalize_device_connection):
* console-x.h:
* data.c (eq_with_ebola_notice):
* data.c (Fsubr_interactive):
* data.c (Fnumber_to_string):
* data.c (digit_to_number):
* device-gtk.c (gtk_init_device):
* device-msw.c (print_devmode):
* device-x.c (x_event_name):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-msw.c (handle_file_dialog_box):
* dialog-msw.c (vars_of_dialog_mswindows):
* doc.c (weird_doc):
* doc.c (Fsnarf_documentation):
* doc.c (vars_of_doc):
* dumper.c (pdump):
* dynarr.c:
* dynarr.c (Dynarr_realloc):
* editfns.c (Fuser_real_login_name):
* editfns.c (get_home_directory):
* elhash.c (print_hash_table_data):
* elhash.c (print_hash_table):
* emacs.c (main_1):
* emacs.c (vars_of_emacs):
* emodules.c:
* emodules.c (_emodules_list):
* emodules.c (Fload_module):
* emodules.c (Funload_module):
* emodules.c (Flist_modules):
* emodules.c (find_make_module):
* emodules.c (attempt_module_delete):
* emodules.c (emodules_load):
* emodules.c (emodules_doc_subr):
* emodules.c (emodules_doc_sym):
* emodules.c (syms_of_module):
* emodules.c (vars_of_module):
* emodules.h:
* eval.c (print_subr):
* eval.c (signal_call_debugger):
* eval.c (build_error_data):
* eval.c (signal_error):
* eval.c (maybe_signal_error):
* eval.c (signal_continuable_error):
* eval.c (maybe_signal_continuable_error):
* eval.c (signal_error_2):
* eval.c (maybe_signal_error_2):
* eval.c (signal_continuable_error_2):
* eval.c (maybe_signal_continuable_error_2):
* eval.c (signal_ferror):
* eval.c (maybe_signal_ferror):
* eval.c (signal_continuable_ferror):
* eval.c (maybe_signal_continuable_ferror):
* eval.c (signal_ferror_with_frob):
* eval.c (maybe_signal_ferror_with_frob):
* eval.c (signal_continuable_ferror_with_frob):
* eval.c (maybe_signal_continuable_ferror_with_frob):
* eval.c (syntax_error):
* eval.c (syntax_error_2):
* eval.c (maybe_syntax_error):
* eval.c (sferror):
* eval.c (sferror_2):
* eval.c (maybe_sferror):
* eval.c (invalid_argument):
* eval.c (invalid_argument_2):
* eval.c (maybe_invalid_argument):
* eval.c (invalid_constant):
* eval.c (invalid_constant_2):
* eval.c (maybe_invalid_constant):
* eval.c (invalid_operation):
* eval.c (invalid_operation_2):
* eval.c (maybe_invalid_operation):
* eval.c (invalid_change):
* eval.c (invalid_change_2):
* eval.c (maybe_invalid_change):
* eval.c (invalid_state):
* eval.c (invalid_state_2):
* eval.c (maybe_invalid_state):
* eval.c (wtaerror):
* eval.c (stack_overflow):
* eval.c (out_of_memory):
* eval.c (print_multiple_value):
* eval.c (issue_call_trapping_problems_warning):
* eval.c (backtrace_specials):
* eval.c (backtrace_unevalled_args):
* eval.c (Fbacktrace):
* eval.c (warn_when_safe):
* event-Xt.c (modwarn):
* event-Xt.c (modbarf):
* event-Xt.c (check_modifier):
* event-Xt.c (store_modifier):
* event-Xt.c (emacs_Xt_format_magic_event):
* event-Xt.c (describe_event):
* event-gtk.c (dragndrop_data_received):
* event-gtk.c (store_modifier):
* event-gtk.c (gtk_reset_modifier_mapping):
* event-msw.c (dde_eval_string):
* event-msw.c (Fdde_alloc_advise_item):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (FROB):
* event-msw.c (emacs_mswindows_format_magic_event):
* event-stream.c (external_debugging_print_event):
* event-stream.c (execute_help_form):
* event-stream.c (vars_of_event_stream):
* events.c (print_event_1):
* events.c (print_event):
* events.c (event_equal):
* extents.c (print_extent_1):
* extents.c (print_extent):
* extents.c (vars_of_extents):
* faces.c (print_face):
* faces.c (complex_vars_of_faces):
* file-coding.c:
* file-coding.c (print_coding_system):
* file-coding.c (print_coding_system_in_print_method):
* file-coding.c (default_query_method):
* file-coding.c (find_coding_system):
* file-coding.c (make_coding_system_1):
* file-coding.c (chain_print):
* file-coding.c (undecided_print):
* file-coding.c (gzip_print):
* file-coding.c (vars_of_file_coding):
* file-coding.c (complex_vars_of_file_coding):
* fileio.c:
* fileio.c (report_file_type_error):
* fileio.c (report_error_with_errno):
* fileio.c (report_file_error):
* fileio.c (barf_or_query_if_file_exists):
* fileio.c (vars_of_fileio):
* floatfns.c (matherr):
* fns.c (print_bit_vector):
* fns.c (Fmapconcat):
* fns.c (add_suffix_to_symbol):
* fns.c (add_prefix_to_symbol):
* frame-gtk.c:
* frame-gtk.c (Fgtk_window_id):
* frame-x.c (def):
* frame-x.c (x_cde_transfer_callback):
* frame.c:
* frame.c (Fmake_frame):
* gc.c (show_gc_cursor_and_message):
* gc.c (vars_of_gc):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate):
* glyphs-gtk.c (gtk_print_image_instance):
* glyphs-msw.c (mswindows_print_image_instance):
* glyphs-x.c (x_print_image_instance):
* glyphs-x.c (update_widget_face):
* glyphs.c (make_string_from_file):
* glyphs.c (print_image_instance):
* glyphs.c (signal_image_error):
* glyphs.c (signal_image_error_2):
* glyphs.c (signal_double_image_error):
* glyphs.c (signal_double_image_error_2):
* glyphs.c (xbm_mask_file_munging):
* glyphs.c (pixmap_to_lisp_data):
* glyphs.h:
* gui.c (gui_item_display_flush_left):
* hpplay.c (player_error_internal):
* hpplay.c (myHandler):
* intl-win32.c:
* intl-win32.c (langcode_to_lang):
* intl-win32.c (sublangcode_to_lang):
* intl-win32.c (Fmswindows_get_locale_info):
* intl-win32.c (lcid_to_locale_mule_or_no):
* intl-win32.c (mswindows_multibyte_to_unicode_print):
* intl-win32.c (complex_vars_of_intl_win32):
* keymap.c:
* keymap.c (print_keymap):
* keymap.c (ensure_meta_prefix_char_keymapp):
* keymap.c (Fkey_description):
* keymap.c (Ftext_char_description):
* lisp.h:
* lisp.h (struct):
* lisp.h (DECLARE_INLINE_HEADER):
* lread.c (Fload_internal):
* lread.c (locate_file):
* lread.c (read_escape):
* lread.c (read_raw_string):
* lread.c (read1):
* lread.c (read_list):
* lread.c (read_compiled_function):
* lread.c (init_lread):
* lrecord.h:
* marker.c (print_marker):
* marker.c (marker_equal):
* menubar-msw.c (displayable_menu_item):
* menubar-x.c (command_builder_operate_menu_accelerator):
* menubar.c (vars_of_menubar):
* minibuf.c (reinit_complex_vars_of_minibuf):
* minibuf.c (complex_vars_of_minibuf):
* mule-charset.c (Fmake_charset):
* mule-charset.c (complex_vars_of_mule_charset):
* mule-coding.c (iso2022_print):
* mule-coding.c (fixed_width_query):
* number.c (bignum_print):
* number.c (ratio_print):
* number.c (bigfloat_print):
* number.c (bigfloat_finalize):
* objects-msw.c:
* objects-msw.c (mswindows_color_to_string):
* objects-msw.c (mswindows_color_list):
* objects-tty.c:
* objects-tty.c (tty_font_list):
* objects-tty.c (tty_find_charset_font):
* objects-xlike-inc.c (xft_find_charset_font):
* objects-xlike-inc.c (endif):
* print.c:
* print.c (write_istring):
* print.c (write_ascstring):
* print.c (Fterpri):
* print.c (Fprint):
* print.c (print_error_message):
* print.c (print_vector_internal):
* print.c (print_cons):
* print.c (print_string):
* print.c (printing_unreadable_object):
* print.c (print_internal):
* print.c (print_float):
* print.c (print_symbol):
* process-nt.c (mswindows_report_winsock_error):
* process-nt.c (nt_canonicalize_host_name):
* process-unix.c (unix_canonicalize_host_name):
* process.c (print_process):
* process.c (report_process_error):
* process.c (report_network_error):
* process.c (make_process_internal):
* process.c (Fstart_process_internal):
* process.c (status_message):
* process.c (putenv_internal):
* process.c (vars_of_process):
* process.h:
* profile.c (vars_of_profile):
* rangetab.c (print_range_table):
* realpath.c (vars_of_realpath):
* redisplay.c (vars_of_redisplay):
* search.c (wordify):
* search.c (Freplace_match):
* sheap.c (sheap_adjust_h):
* sound.c (report_sound_error):
* sound.c (Fplay_sound_file):
* specifier.c (print_specifier):
* symbols.c (Fsubr_name):
* symbols.c (do_symval_forwarding):
* symbols.c (set_default_buffer_slot_variable):
* symbols.c (set_default_console_slot_variable):
* symbols.c (store_symval_forwarding):
* symbols.c (default_value):
* symbols.c (defsymbol_massage_name_1):
* symbols.c (defsymbol_massage_name_nodump):
* symbols.c (defsymbol_massage_name):
* symbols.c (defsymbol_massage_multiword_predicate_nodump):
* symbols.c (defsymbol_massage_multiword_predicate):
* symbols.c (defsymbol_nodump):
* symbols.c (defsymbol):
* symbols.c (defkeyword):
* symbols.c (defkeyword_massage_name):
* symbols.c (check_module_subr):
* symbols.c (deferror_1):
* symbols.c (deferror):
* symbols.c (deferror_massage_name):
* symbols.c (deferror_massage_name_and_message):
* symbols.c (defvar_magic):
* symeval.h:
* symeval.h (DEFVAR_SYMVAL_FWD):
* sysdep.c:
* sysdep.c (init_system_name):
* sysdll.c:
* sysdll.c (MAYBE_PREPEND_UNDERSCORE):
* sysdll.c (dll_function):
* sysdll.c (dll_variable):
* sysdll.c (dll_error):
* sysdll.c (dll_open):
* sysdll.c (dll_close):
* sysdll.c (image_for_address):
* sysdll.c (my_find_image):
* sysdll.c (search_linked_libs):
* sysdll.h:
* sysfile.h:
* sysfile.h (DEFAULT_DIRECTORY_FALLBACK):
* syswindows.h:
* tests.c (DFC_CHECK_LENGTH):
* tests.c (DFC_CHECK_CONTENT):
* tests.c (Ftest_hash_tables):
* text.c (vars_of_text):
* text.h:
* tooltalk.c (tt_opnum_string):
* tooltalk.c (tt_message_arg_ival_string):
* tooltalk.c (Ftooltalk_default_procid):
* tooltalk.c (Ftooltalk_default_session):
* tooltalk.c (init_tooltalk):
* tooltalk.c (vars_of_tooltalk):
* ui-gtk.c (Fdll_load):
* ui-gtk.c (type_to_marshaller_type):
* ui-gtk.c (Fgtk_import_function_internal):
* ui-gtk.c (emacs_gtk_object_printer):
* ui-gtk.c (emacs_gtk_boxed_printer):
* unicode.c (unicode_to_ichar):
* unicode.c (unicode_print):
* unicode.c (unicode_query):
* unicode.c (vars_of_unicode):
* unicode.c (complex_vars_of_unicode):
* win32.c:
* win32.c (mswindows_report_process_error):
* window.c (print_window):
* xemacs.def.in.in:
BASIC IDEA: Further fixing up uses of char * and CIbyte *
to reflect their actual semantics; Mule-izing some code;
redoing of the not-yet-working code to handle message translation.
Clean up code to handle message-translation (not yet working).
Create separate versions of build_msg_string() for working with
Ibyte *, CIbyte *, and Ascbyte * arguments. Assert that Ascbyte *
arguments are pure-ASCII. Make build_msg_string() be the same
as build_msg_ascstring(). Create same three versions of GETTEXT()
and DEFER_GETTEXT(). Also create build_defer_string() and
variants for the equivalent of DEFER_GETTEXT() when building a
string. Remove old CGETTEXT(). Clean up code where GETTEXT(),
DEFER_GETTEXT(), build_msg_string(), etc. was being called and
introduce some new calls to build_msg_string(), etc. Remove
GETTEXT() from calls to weird_doc() -- we assume that the
message snarfer knows about weird_doc(). Remove uses of
DEFER_GETTEXT() from error messages in sysdep.c and instead use
special comments /* @@@begin-snarf@@@ */ and /* @@@end-snarf@@@ */
that the message snarfer presumably knows about.
Create build_ascstring() and use it in many instances in place
of build_string(). The purpose of having Ascbyte * variants is
to make the code more self-documenting in terms of what sort of
semantics is expected for char * strings. In fact in the process
of looking for uses of build_string(), much improperly Mule-ized
was discovered.
Mule-ize a lot of code as described in previous paragraph,
e.g. in sysdep.c.
Make the error functions take Ascbyte * strings and fix up a
couple of places where non-pure-ASCII strings were being passed in
(file-coding.c, mule-coding.c, unicode.c). (It's debatable whether
we really need to make the error functions work this way. It
helps catch places where code is written in a way that message
translation won't work, but we may well never implement message
translation.)
Make staticpro() and friends take Ascbyte * strings instead of
raw char * strings. Create a const_Ascbyte_ptr dynarr type
to describe what's held by staticpro_names[] and friends,
create pdump descriptions for const_Ascbyte_ptr dynarrs, and
use them in place of specially-crafted staticpro descriptions.
Mule-ize certain other functions (e.g. x_event_name) by correcting
raw use of char * to Ascbyte *, Rawbyte * or another such type,
and raw use of char[] buffers to another type (usually Ascbyte[]).
Change many uses of write_c_string() to write_msg_string(),
write_ascstring(), etc.
Mule-ize emodules.c, emodules.h, sysdll.h.
Fix some un-Mule-ized code in intl-win32.c.
A comment in event-Xt.c and the limitations of the message
snarfer (make-msgfile or whatever) is presumably incorrect --
it should be smart enough to handle function calls spread over
more than one line. Clean up code in event-Xt.c that was
written awkwardly for this reason.
In config.h.in, instead of NEED_ERROR_CHECK_TYPES_INLINES,
create a more general XEMACS_DEFS_NEEDS_INLINE_DECLS to
indicate when inlined functions need to be declared in
xemacs.defs.in.in, and make use of it in xemacs.defs.in.in.
We need to do this because postgresql.c now calls qxestrdup(),
which is an inline function.
Make nconc2() and other such functions MODULE_API and put
them in xemacs.defs.in.in since postgresql.c now uses them.
Clean up indentation in lread.c and a few other places.
In text.h, document ASSERT_ASCTEXT_ASCII() and
ASSERT_ASCTEXT_ASCII_LEN(), group together the stand-in
encodings and add some more for DLL symbols, function and
variable names, etc.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Tue, 26 Jan 2010 23:22:30 -0600 |
| parents | 6c0bb4d2c23a |
| children | 304aebb79cd3 |
| 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 | |
| 2286 | 179 float_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth)) |
| 428 | 180 { |
| 181 return (extract_float (obj1) == extract_float (obj2)); | |
| 182 } | |
| 183 | |
| 665 | 184 static Hashcode |
| 2286 | 185 float_hash (Lisp_Object obj, int UNUSED (depth)) |
| 428 | 186 { |
| 187 /* mod the value down to 32-bit range */ | |
| 188 /* #### change for 64-bit machines */ | |
| 189 return (unsigned long) fmod (extract_float (obj), 4e9); | |
| 190 } | |
| 191 | |
| 1204 | 192 static const struct memory_description float_description[] = { |
| 428 | 193 { XD_END } |
| 194 }; | |
| 195 | |
| 934 | 196 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("float", float, |
| 197 1, /*dumpable-flag*/ | |
| 198 mark_float, print_float, 0, float_equal, | |
| 199 float_hash, float_description, | |
| 200 Lisp_Float); | |
| 428 | 201 |
| 202 /* Extract a Lisp number as a `double', or signal an error. */ | |
| 203 | |
| 204 double | |
| 205 extract_float (Lisp_Object num) | |
| 206 { | |
| 207 if (FLOATP (num)) | |
| 208 return XFLOAT_DATA (num); | |
| 209 | |
| 210 if (INTP (num)) | |
| 211 return (double) XINT (num); | |
| 212 | |
| 1983 | 213 #ifdef HAVE_BIGNUM |
| 214 if (BIGNUMP (num)) | |
| 215 return bignum_to_double (XBIGNUM_DATA (num)); | |
| 216 #endif | |
| 217 | |
| 218 #ifdef HAVE_RATIO | |
| 219 if (RATIOP (num)) | |
| 220 return ratio_to_double (XRATIO_DATA (num)); | |
| 221 #endif | |
| 222 | |
| 223 #ifdef HAVE_BIGFLOAT | |
| 224 if (BIGFLOATP (num)) | |
| 225 return bigfloat_to_double (XBIGFLOAT_DATA (num)); | |
| 226 #endif | |
| 227 | |
| 428 | 228 return extract_float (wrong_type_argument (Qnumberp, num)); |
| 229 } | |
| 230 | |
| 231 /* Trig functions. */ | |
| 232 | |
| 233 DEFUN ("acos", Facos, 1, 1, 0, /* | |
| 444 | 234 Return the inverse cosine of NUMBER. |
| 428 | 235 */ |
| 444 | 236 (number)) |
| 428 | 237 { |
| 444 | 238 double d = extract_float (number); |
| 428 | 239 #ifdef FLOAT_CHECK_DOMAIN |
| 240 if (d > 1.0 || d < -1.0) | |
| 444 | 241 domain_error ("acos", number); |
| 428 | 242 #endif |
| 444 | 243 IN_FLOAT (d = acos (d), "acos", number); |
| 428 | 244 return make_float (d); |
| 245 } | |
| 246 | |
| 247 DEFUN ("asin", Fasin, 1, 1, 0, /* | |
| 444 | 248 Return the inverse sine of NUMBER. |
| 428 | 249 */ |
| 444 | 250 (number)) |
| 428 | 251 { |
| 444 | 252 double d = extract_float (number); |
| 428 | 253 #ifdef FLOAT_CHECK_DOMAIN |
| 254 if (d > 1.0 || d < -1.0) | |
| 444 | 255 domain_error ("asin", number); |
| 428 | 256 #endif |
| 444 | 257 IN_FLOAT (d = asin (d), "asin", number); |
| 428 | 258 return make_float (d); |
| 259 } | |
| 260 | |
| 261 DEFUN ("atan", Fatan, 1, 2, 0, /* | |
| 444 | 262 Return the inverse tangent of NUMBER. |
| 263 If optional second argument NUMBER2 is provided, | |
| 264 return atan2 (NUMBER, NUMBER2). | |
| 428 | 265 */ |
| 444 | 266 (number, number2)) |
| 428 | 267 { |
| 444 | 268 double d = extract_float (number); |
| 428 | 269 |
| 444 | 270 if (NILP (number2)) |
| 271 IN_FLOAT (d = atan (d), "atan", number); | |
| 428 | 272 else |
| 273 { | |
| 444 | 274 double d2 = extract_float (number2); |
| 428 | 275 #ifdef FLOAT_CHECK_DOMAIN |
| 276 if (d == 0.0 && d2 == 0.0) | |
| 444 | 277 domain_error2 ("atan", number, number2); |
| 428 | 278 #endif |
| 444 | 279 IN_FLOAT2 (d = atan2 (d, d2), "atan", number, number2); |
| 428 | 280 } |
| 281 return make_float (d); | |
| 282 } | |
| 283 | |
| 284 DEFUN ("cos", Fcos, 1, 1, 0, /* | |
| 444 | 285 Return the cosine of NUMBER. |
| 428 | 286 */ |
| 444 | 287 (number)) |
| 428 | 288 { |
| 444 | 289 double d = extract_float (number); |
| 290 IN_FLOAT (d = cos (d), "cos", number); | |
| 428 | 291 return make_float (d); |
| 292 } | |
| 293 | |
| 294 DEFUN ("sin", Fsin, 1, 1, 0, /* | |
| 444 | 295 Return the sine of NUMBER. |
| 428 | 296 */ |
| 444 | 297 (number)) |
| 428 | 298 { |
| 444 | 299 double d = extract_float (number); |
| 300 IN_FLOAT (d = sin (d), "sin", number); | |
| 428 | 301 return make_float (d); |
| 302 } | |
| 303 | |
| 304 DEFUN ("tan", Ftan, 1, 1, 0, /* | |
| 444 | 305 Return the tangent of NUMBER. |
| 428 | 306 */ |
| 444 | 307 (number)) |
| 428 | 308 { |
| 444 | 309 double d = extract_float (number); |
| 428 | 310 double c = cos (d); |
| 311 #ifdef FLOAT_CHECK_DOMAIN | |
| 312 if (c == 0.0) | |
| 444 | 313 domain_error ("tan", number); |
| 428 | 314 #endif |
| 444 | 315 IN_FLOAT (d = (sin (d) / c), "tan", number); |
| 428 | 316 return make_float (d); |
| 317 } | |
| 318 | |
| 319 /* Bessel functions */ | |
| 320 #if 0 /* Leave these out unless we find there's a reason for them. */ | |
| 321 | |
| 322 DEFUN ("bessel-j0", Fbessel_j0, 1, 1, 0, /* | |
| 444 | 323 Return the bessel function j0 of NUMBER. |
| 428 | 324 */ |
| 444 | 325 (number)) |
| 428 | 326 { |
| 444 | 327 double d = extract_float (number); |
| 328 IN_FLOAT (d = j0 (d), "bessel-j0", number); | |
| 428 | 329 return make_float (d); |
| 330 } | |
| 331 | |
| 332 DEFUN ("bessel-j1", Fbessel_j1, 1, 1, 0, /* | |
| 444 | 333 Return the bessel function j1 of NUMBER. |
| 428 | 334 */ |
| 444 | 335 (number)) |
| 428 | 336 { |
| 444 | 337 double d = extract_float (number); |
| 338 IN_FLOAT (d = j1 (d), "bessel-j1", number); | |
| 428 | 339 return make_float (d); |
| 340 } | |
| 341 | |
| 342 DEFUN ("bessel-jn", Fbessel_jn, 2, 2, 0, /* | |
| 444 | 343 Return the order N bessel function output jn of NUMBER. |
| 344 The first number (the order) is truncated to an integer. | |
| 428 | 345 */ |
| 444 | 346 (number1, number2)) |
| 428 | 347 { |
| 444 | 348 int i1 = extract_float (number1); |
| 349 double f2 = extract_float (number2); | |
| 428 | 350 |
| 444 | 351 IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", number1); |
| 428 | 352 return make_float (f2); |
| 353 } | |
| 354 | |
| 355 DEFUN ("bessel-y0", Fbessel_y0, 1, 1, 0, /* | |
| 444 | 356 Return the bessel function y0 of NUMBER. |
| 428 | 357 */ |
| 444 | 358 (number)) |
| 428 | 359 { |
| 444 | 360 double d = extract_float (number); |
| 361 IN_FLOAT (d = y0 (d), "bessel-y0", number); | |
| 428 | 362 return make_float (d); |
| 363 } | |
| 364 | |
| 365 DEFUN ("bessel-y1", Fbessel_y1, 1, 1, 0, /* | |
| 444 | 366 Return the bessel function y1 of NUMBER. |
| 428 | 367 */ |
| 444 | 368 (number)) |
| 428 | 369 { |
| 444 | 370 double d = extract_float (number); |
| 371 IN_FLOAT (d = y1 (d), "bessel-y0", number); | |
| 428 | 372 return make_float (d); |
| 373 } | |
| 374 | |
| 375 DEFUN ("bessel-yn", Fbessel_yn, 2, 2, 0, /* | |
| 444 | 376 Return the order N bessel function output yn of NUMBER. |
| 377 The first number (the order) is truncated to an integer. | |
| 428 | 378 */ |
| 444 | 379 (number1, number2)) |
| 428 | 380 { |
| 444 | 381 int i1 = extract_float (number1); |
| 382 double f2 = extract_float (number2); | |
| 428 | 383 |
| 444 | 384 IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", number1); |
| 428 | 385 return make_float (f2); |
| 386 } | |
| 387 | |
| 388 #endif /* 0 (bessel functions) */ | |
| 389 | |
| 390 /* Error functions. */ | |
| 391 #if 0 /* Leave these out unless we see they are worth having. */ | |
| 392 | |
| 393 DEFUN ("erf", Ferf, 1, 1, 0, /* | |
| 444 | 394 Return the mathematical error function of NUMBER. |
| 428 | 395 */ |
| 444 | 396 (number)) |
| 428 | 397 { |
| 444 | 398 double d = extract_float (number); |
| 399 IN_FLOAT (d = erf (d), "erf", number); | |
| 428 | 400 return make_float (d); |
| 401 } | |
| 402 | |
| 403 DEFUN ("erfc", Ferfc, 1, 1, 0, /* | |
| 444 | 404 Return the complementary error function of NUMBER. |
| 428 | 405 */ |
| 444 | 406 (number)) |
| 428 | 407 { |
| 444 | 408 double d = extract_float (number); |
| 409 IN_FLOAT (d = erfc (d), "erfc", number); | |
| 428 | 410 return make_float (d); |
| 411 } | |
| 412 | |
| 413 DEFUN ("log-gamma", Flog_gamma, 1, 1, 0, /* | |
| 444 | 414 Return the log gamma of NUMBER. |
| 428 | 415 */ |
| 444 | 416 (number)) |
| 428 | 417 { |
| 444 | 418 double d = extract_float (number); |
| 419 IN_FLOAT (d = lgamma (d), "log-gamma", number); | |
| 428 | 420 return make_float (d); |
| 421 } | |
| 422 | |
| 423 #endif /* 0 (error functions) */ | |
| 424 | |
| 425 | |
| 426 /* Root and Log functions. */ | |
| 427 | |
| 428 DEFUN ("exp", Fexp, 1, 1, 0, /* | |
| 444 | 429 Return the exponential base e of NUMBER. |
| 428 | 430 */ |
| 444 | 431 (number)) |
| 428 | 432 { |
| 444 | 433 double d = extract_float (number); |
| 428 | 434 #ifdef FLOAT_CHECK_DOMAIN |
| 435 if (d > 709.7827) /* Assume IEEE doubles here */ | |
| 444 | 436 range_error ("exp", number); |
| 428 | 437 else if (d < -709.0) |
| 438 return make_float (0.0); | |
| 439 else | |
| 440 #endif | |
| 444 | 441 IN_FLOAT (d = exp (d), "exp", number); |
| 428 | 442 return make_float (d); |
| 443 } | |
| 444 | |
| 445 DEFUN ("expt", Fexpt, 2, 2, 0, /* | |
| 444 | 446 Return the exponential NUMBER1 ** NUMBER2. |
| 428 | 447 */ |
| 444 | 448 (number1, number2)) |
| 428 | 449 { |
| 1983 | 450 #ifdef HAVE_BIGNUM |
| 451 if (INTEGERP (number1) && INTP (number2)) | |
| 452 { | |
| 453 if (INTP (number1)) | |
| 454 { | |
| 455 bignum_set_long (scratch_bignum2, XREALINT (number1)); | |
| 456 bignum_pow (scratch_bignum, scratch_bignum2, XREALINT (number2)); | |
| 457 } | |
| 458 else | |
| 459 bignum_pow (scratch_bignum, XBIGNUM_DATA (number1), | |
| 460 XREALINT (number2)); | |
| 461 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); | |
| 462 } | |
| 463 #endif | |
| 464 | |
| 444 | 465 if (INTP (number1) && /* common lisp spec */ |
| 466 INTP (number2)) /* don't promote, if both are ints */ | |
| 428 | 467 { |
| 468 EMACS_INT retval; | |
| 444 | 469 EMACS_INT x = XINT (number1); |
| 470 EMACS_INT y = XINT (number2); | |
| 428 | 471 |
| 472 if (y < 0) | |
| 473 { | |
| 474 if (x == 1) | |
| 475 retval = 1; | |
| 476 else if (x == -1) | |
| 477 retval = (y & 1) ? -1 : 1; | |
| 478 else | |
| 479 retval = 0; | |
| 480 } | |
| 481 else | |
| 482 { | |
| 483 retval = 1; | |
| 484 while (y > 0) | |
| 485 { | |
| 486 if (y & 1) | |
| 487 retval *= x; | |
| 488 x *= x; | |
| 489 y = (EMACS_UINT) y >> 1; | |
| 490 } | |
| 491 } | |
| 492 return make_int (retval); | |
| 493 } | |
| 494 | |
| 1983 | 495 #if defined(HAVE_BIGFLOAT) && defined(bigfloat_pow) |
| 496 if (BIGFLOATP (number1) && INTEGERP (number2)) | |
| 497 { | |
| 2057 | 498 unsigned long exponent; |
| 1983 | 499 |
| 500 #ifdef HAVE_BIGNUM | |
| 501 if (BIGNUMP (number2)) | |
| 2057 | 502 exponent = bignum_to_ulong (XBIGNUM_DATA (number2)); |
| 1983 | 503 else |
| 504 #endif | |
| 2057 | 505 exponent = XUINT (number2); |
| 1983 | 506 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number1)); |
| 2057 | 507 bigfloat_pow (scratch_bigfloat, XBIGFLOAT_DATA (number1), exponent); |
| 1983 | 508 return make_bigfloat_bf (scratch_bigfloat); |
| 509 } | |
| 510 #endif | |
| 511 | |
| 428 | 512 { |
| 444 | 513 double f1 = extract_float (number1); |
| 514 double f2 = extract_float (number2); | |
| 428 | 515 /* Really should check for overflow, too */ |
| 516 if (f1 == 0.0 && f2 == 0.0) | |
| 517 f1 = 1.0; | |
| 518 # ifdef FLOAT_CHECK_DOMAIN | |
| 519 else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor(f2))) | |
| 444 | 520 domain_error2 ("expt", number1, number2); |
| 428 | 521 # endif /* FLOAT_CHECK_DOMAIN */ |
| 444 | 522 IN_FLOAT2 (f1 = pow (f1, f2), "expt", number1, number2); |
| 428 | 523 return make_float (f1); |
| 524 } | |
| 525 } | |
| 526 | |
| 527 DEFUN ("log", Flog, 1, 2, 0, /* | |
| 444 | 528 Return the natural logarithm of NUMBER. |
| 529 If second optional argument BASE is given, return the logarithm of | |
| 530 NUMBER using that base. | |
| 428 | 531 */ |
| 444 | 532 (number, base)) |
| 428 | 533 { |
| 444 | 534 double d = extract_float (number); |
| 428 | 535 #ifdef FLOAT_CHECK_DOMAIN |
| 536 if (d <= 0.0) | |
| 444 | 537 domain_error2 ("log", number, base); |
| 428 | 538 #endif |
| 539 if (NILP (base)) | |
| 444 | 540 IN_FLOAT (d = log (d), "log", number); |
| 428 | 541 else |
| 542 { | |
| 543 double b = extract_float (base); | |
| 544 #ifdef FLOAT_CHECK_DOMAIN | |
| 545 if (b <= 0.0 || b == 1.0) | |
| 444 | 546 domain_error2 ("log", number, base); |
| 428 | 547 #endif |
| 548 if (b == 10.0) | |
| 444 | 549 IN_FLOAT2 (d = log10 (d), "log", number, base); |
| 428 | 550 else |
| 444 | 551 IN_FLOAT2 (d = (log (d) / log (b)), "log", number, base); |
| 428 | 552 } |
| 553 return make_float (d); | |
| 554 } | |
| 555 | |
| 556 | |
| 557 DEFUN ("log10", Flog10, 1, 1, 0, /* | |
| 444 | 558 Return the logarithm base 10 of NUMBER. |
| 428 | 559 */ |
| 444 | 560 (number)) |
| 428 | 561 { |
| 444 | 562 double d = extract_float (number); |
| 428 | 563 #ifdef FLOAT_CHECK_DOMAIN |
| 564 if (d <= 0.0) | |
| 444 | 565 domain_error ("log10", number); |
| 428 | 566 #endif |
| 444 | 567 IN_FLOAT (d = log10 (d), "log10", number); |
| 428 | 568 return make_float (d); |
| 569 } | |
| 570 | |
| 571 | |
| 572 DEFUN ("sqrt", Fsqrt, 1, 1, 0, /* | |
| 444 | 573 Return the square root of NUMBER. |
| 428 | 574 */ |
| 444 | 575 (number)) |
| 428 | 576 { |
| 1983 | 577 double d; |
| 578 | |
| 579 #if defined(HAVE_BIGFLOAT) && defined(bigfloat_sqrt) | |
| 580 if (BIGFLOATP (number)) | |
| 581 { | |
| 582 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); | |
| 583 bigfloat_sqrt (scratch_bigfloat, XBIGFLOAT_DATA (number)); | |
| 584 return make_bigfloat_bf (scratch_bigfloat); | |
| 585 } | |
| 586 #endif /* HAVE_BIGFLOAT */ | |
| 587 d = extract_float (number); | |
| 428 | 588 #ifdef FLOAT_CHECK_DOMAIN |
| 589 if (d < 0.0) | |
| 444 | 590 domain_error ("sqrt", number); |
| 428 | 591 #endif |
| 444 | 592 IN_FLOAT (d = sqrt (d), "sqrt", number); |
| 428 | 593 return make_float (d); |
| 594 } | |
| 595 | |
| 596 | |
| 597 DEFUN ("cube-root", Fcube_root, 1, 1, 0, /* | |
| 444 | 598 Return the cube root of NUMBER. |
| 428 | 599 */ |
| 444 | 600 (number)) |
| 428 | 601 { |
| 444 | 602 double d = extract_float (number); |
| 428 | 603 #ifdef HAVE_CBRT |
| 444 | 604 IN_FLOAT (d = cbrt (d), "cube-root", number); |
| 428 | 605 #else |
| 606 if (d >= 0.0) | |
| 444 | 607 IN_FLOAT (d = pow (d, 1.0/3.0), "cube-root", number); |
| 428 | 608 else |
| 444 | 609 IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", number); |
| 428 | 610 #endif |
| 611 return make_float (d); | |
| 612 } | |
| 613 | |
| 614 /* Inverse trig functions. */ | |
| 615 | |
| 616 DEFUN ("acosh", Facosh, 1, 1, 0, /* | |
| 444 | 617 Return the inverse hyperbolic cosine of NUMBER. |
| 428 | 618 */ |
| 444 | 619 (number)) |
| 428 | 620 { |
| 444 | 621 double d = extract_float (number); |
| 428 | 622 #ifdef FLOAT_CHECK_DOMAIN |
| 623 if (d < 1.0) | |
| 444 | 624 domain_error ("acosh", number); |
| 428 | 625 #endif |
| 626 #ifdef HAVE_INVERSE_HYPERBOLIC | |
| 444 | 627 IN_FLOAT (d = acosh (d), "acosh", number); |
| 428 | 628 #else |
| 444 | 629 IN_FLOAT (d = log (d + sqrt (d*d - 1.0)), "acosh", number); |
| 428 | 630 #endif |
| 631 return make_float (d); | |
| 632 } | |
| 633 | |
| 634 DEFUN ("asinh", Fasinh, 1, 1, 0, /* | |
| 444 | 635 Return the inverse hyperbolic sine of NUMBER. |
| 428 | 636 */ |
| 444 | 637 (number)) |
| 428 | 638 { |
| 444 | 639 double d = extract_float (number); |
| 428 | 640 #ifdef HAVE_INVERSE_HYPERBOLIC |
| 444 | 641 IN_FLOAT (d = asinh (d), "asinh", number); |
| 428 | 642 #else |
| 444 | 643 IN_FLOAT (d = log (d + sqrt (d*d + 1.0)), "asinh", number); |
| 428 | 644 #endif |
| 645 return make_float (d); | |
| 646 } | |
| 647 | |
| 648 DEFUN ("atanh", Fatanh, 1, 1, 0, /* | |
| 444 | 649 Return the inverse hyperbolic tangent of NUMBER. |
| 428 | 650 */ |
| 444 | 651 (number)) |
| 428 | 652 { |
| 444 | 653 double d = extract_float (number); |
| 428 | 654 #ifdef FLOAT_CHECK_DOMAIN |
| 655 if (d >= 1.0 || d <= -1.0) | |
| 444 | 656 domain_error ("atanh", number); |
| 428 | 657 #endif |
| 658 #ifdef HAVE_INVERSE_HYPERBOLIC | |
| 444 | 659 IN_FLOAT (d = atanh (d), "atanh", number); |
| 428 | 660 #else |
| 444 | 661 IN_FLOAT (d = 0.5 * log ((1.0 + d) / (1.0 - d)), "atanh", number); |
| 428 | 662 #endif |
| 663 return make_float (d); | |
| 664 } | |
| 665 | |
| 666 DEFUN ("cosh", Fcosh, 1, 1, 0, /* | |
| 444 | 667 Return the hyperbolic cosine of NUMBER. |
| 428 | 668 */ |
| 444 | 669 (number)) |
| 428 | 670 { |
| 444 | 671 double d = extract_float (number); |
| 428 | 672 #ifdef FLOAT_CHECK_DOMAIN |
| 673 if (d > 710.0 || d < -710.0) | |
| 444 | 674 range_error ("cosh", number); |
| 428 | 675 #endif |
| 444 | 676 IN_FLOAT (d = cosh (d), "cosh", number); |
| 428 | 677 return make_float (d); |
| 678 } | |
| 679 | |
| 680 DEFUN ("sinh", Fsinh, 1, 1, 0, /* | |
| 444 | 681 Return the hyperbolic sine of NUMBER. |
| 428 | 682 */ |
| 444 | 683 (number)) |
| 428 | 684 { |
| 444 | 685 double d = extract_float (number); |
| 428 | 686 #ifdef FLOAT_CHECK_DOMAIN |
| 687 if (d > 710.0 || d < -710.0) | |
| 444 | 688 range_error ("sinh", number); |
| 428 | 689 #endif |
| 444 | 690 IN_FLOAT (d = sinh (d), "sinh", number); |
| 428 | 691 return make_float (d); |
| 692 } | |
| 693 | |
| 694 DEFUN ("tanh", Ftanh, 1, 1, 0, /* | |
| 444 | 695 Return the hyperbolic tangent of NUMBER. |
| 428 | 696 */ |
| 444 | 697 (number)) |
| 428 | 698 { |
| 444 | 699 double d = extract_float (number); |
| 700 IN_FLOAT (d = tanh (d), "tanh", number); | |
| 428 | 701 return make_float (d); |
| 702 } | |
| 703 | |
| 704 /* Rounding functions */ | |
| 705 | |
| 706 DEFUN ("abs", Fabs, 1, 1, 0, /* | |
| 444 | 707 Return the absolute value of NUMBER. |
| 428 | 708 */ |
| 444 | 709 (number)) |
| 428 | 710 { |
| 444 | 711 if (FLOATP (number)) |
| 428 | 712 { |
| 444 | 713 IN_FLOAT (number = make_float (fabs (XFLOAT_DATA (number))), |
| 714 "abs", number); | |
| 715 return number; | |
| 428 | 716 } |
| 717 | |
| 444 | 718 if (INTP (number)) |
| 1983 | 719 #ifdef HAVE_BIGNUM |
| 720 /* The most negative Lisp fixnum will overflow */ | |
| 721 return (XINT (number) >= 0) ? number : make_integer (- XINT (number)); | |
| 722 #else | |
| 444 | 723 return (XINT (number) >= 0) ? number : make_int (- XINT (number)); |
| 1983 | 724 #endif |
| 725 | |
| 726 #ifdef HAVE_BIGNUM | |
| 727 if (BIGNUMP (number)) | |
| 728 { | |
| 729 if (bignum_sign (XBIGNUM_DATA (number)) >= 0) | |
| 730 return number; | |
| 731 bignum_abs (scratch_bignum, XBIGNUM_DATA (number)); | |
| 732 return make_bignum_bg (scratch_bignum); | |
| 733 } | |
| 734 #endif | |
| 735 | |
| 736 #ifdef HAVE_RATIO | |
| 737 if (RATIOP (number)) | |
| 738 { | |
| 739 if (ratio_sign (XRATIO_DATA (number)) >= 0) | |
| 740 return number; | |
| 741 ratio_abs (scratch_ratio, XRATIO_DATA (number)); | |
| 742 return make_ratio_rt (scratch_ratio); | |
| 743 } | |
| 744 #endif | |
| 745 | |
| 746 #ifdef HAVE_BIGFLOAT | |
| 747 if (BIGFLOATP (number)) | |
| 748 { | |
| 749 if (bigfloat_sign (XBIGFLOAT_DATA (number)) >= 0) | |
| 750 return number; | |
| 751 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); | |
| 752 bigfloat_abs (scratch_bigfloat, XBIGFLOAT_DATA (number)); | |
| 753 return make_bigfloat_bf (scratch_bigfloat); | |
| 754 } | |
| 755 #endif | |
| 428 | 756 |
| 444 | 757 return Fabs (wrong_type_argument (Qnumberp, number)); |
| 428 | 758 } |
| 759 | |
| 760 DEFUN ("float", Ffloat, 1, 1, 0, /* | |
| 444 | 761 Return the floating point number numerically equal to NUMBER. |
| 428 | 762 */ |
| 444 | 763 (number)) |
| 428 | 764 { |
| 444 | 765 if (INTP (number)) |
| 766 return make_float ((double) XINT (number)); | |
| 428 | 767 |
| 1983 | 768 #ifdef HAVE_BIGNUM |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
769 if (BIGNUMP (number)) |
| 1983 | 770 { |
| 771 #ifdef HAVE_BIGFLOAT | |
| 772 if (ZEROP (Vdefault_float_precision)) | |
| 773 #endif | |
| 774 return make_float (bignum_to_double (XBIGNUM_DATA (number))); | |
| 775 #ifdef HAVE_BIGFLOAT | |
| 776 else | |
| 777 { | |
| 778 bigfloat_set_prec (scratch_bigfloat, bigfloat_get_default_prec ()); | |
| 779 bigfloat_set_bignum (scratch_bigfloat, XBIGNUM_DATA (number)); | |
| 780 return make_bigfloat_bf (scratch_bigfloat); | |
| 781 } | |
| 782 #endif /* HAVE_BIGFLOAT */ | |
| 783 } | |
| 784 #endif /* HAVE_BIGNUM */ | |
| 785 | |
| 786 #ifdef HAVE_RATIO | |
| 787 if (RATIOP (number)) | |
| 2092 | 788 return make_float (ratio_to_double (XRATIO_DATA (number))); |
| 1983 | 789 #endif |
| 790 | |
| 444 | 791 if (FLOATP (number)) /* give 'em the same float back */ |
| 792 return number; | |
| 428 | 793 |
| 444 | 794 return Ffloat (wrong_type_argument (Qnumberp, number)); |
| 428 | 795 } |
| 796 | |
| 797 DEFUN ("logb", Flogb, 1, 1, 0, /* | |
| 444 | 798 Return largest integer <= the base 2 log of the magnitude of NUMBER. |
| 428 | 799 This is the same as the exponent of a float. |
| 800 */ | |
| 444 | 801 (number)) |
| 428 | 802 { |
| 444 | 803 double f = extract_float (number); |
| 428 | 804 |
| 805 if (f == 0.0) | |
| 2039 | 806 return make_int (EMACS_INT_MIN); |
| 428 | 807 #ifdef HAVE_LOGB |
| 808 { | |
| 809 Lisp_Object val; | |
| 444 | 810 IN_FLOAT (val = make_int ((EMACS_INT) logb (f)), "logb", number); |
| 434 | 811 return val; |
| 428 | 812 } |
| 813 #else | |
| 814 #ifdef HAVE_FREXP | |
| 815 { | |
| 816 int exqp; | |
| 444 | 817 IN_FLOAT (frexp (f, &exqp), "logb", number); |
| 434 | 818 return make_int (exqp - 1); |
| 428 | 819 } |
| 820 #else | |
| 821 { | |
| 822 int i; | |
| 823 double d; | |
| 824 EMACS_INT val; | |
| 825 if (f < 0.0) | |
| 826 f = -f; | |
| 827 val = -1; | |
| 828 while (f < 0.5) | |
| 829 { | |
| 830 for (i = 1, d = 0.5; d * d >= f; i += i) | |
| 831 d *= d; | |
| 832 f /= d; | |
| 833 val -= i; | |
| 834 } | |
| 835 while (f >= 1.0) | |
| 836 { | |
| 837 for (i = 1, d = 2.0; d * d <= f; i += i) | |
| 838 d *= d; | |
| 839 f /= d; | |
| 840 val += i; | |
| 841 } | |
| 434 | 842 return make_int (val); |
| 428 | 843 } |
| 844 #endif /* ! HAVE_FREXP */ | |
| 845 #endif /* ! HAVE_LOGB */ | |
| 846 } | |
| 847 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
848 #ifdef WITH_NUMBER_TYPES |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
849 #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
|
850 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
|
851 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
852 #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
|
853 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
|
854 #endif |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
855 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
856 #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
|
857 if (!NILP (divisor)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
858 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
859 switch (promote_args (&number, &divisor)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
860 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
861 case FIXNUM_T: \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
862 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
|
863 return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
864 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
|
865 BIGNUM, \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
866 return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
867 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
|
868 RATIO, \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
869 return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
870 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
|
871 BIGFLOAT, \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
872 return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
873 default: /* FLOAT_T */ \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
874 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
|
875 return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
876 } \ |
|
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 /* 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
|
880 if (FLOATP (number)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
881 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
|
882 \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
883 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
|
884 RATIO, return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
885 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
|
886 BIGFLOAT, return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
887 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
|
888 return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
889 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
890 #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
|
891 if (!NILP (divisor)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
892 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
893 /* 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
|
894 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
|
895 if (CHARP (number)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
896 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
897 number = make_int (XCHAR (number)); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
898 } \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
899 else if (MARKERP (number)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
900 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
901 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
|
902 } \ |
|
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 if (CHARP (divisor)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
905 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
906 divisor = make_int (XCHAR (divisor)); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
907 } \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
908 else if (MARKERP (divisor)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
909 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
910 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
|
911 } \ |
|
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 CHECK_INT_OR_FLOAT (divisor); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
914 if (INTP (number) && INTP (divisor)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
915 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
916 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
|
917 return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
918 } \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
919 else \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
920 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
921 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
|
922 return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
923 } \ |
|
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 /* 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
|
927 if (FLOATP (number)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
928 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
|
929 \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
930 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
|
931 return_float) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
932 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
933 #ifdef WITH_NUMBER_TYPES |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
934 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
935 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
936 #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
|
937 case BIGNUM_T: \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
938 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
|
939 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
940 #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
|
941 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
|
942 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
|
943 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
944 #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
|
945 #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
|
946 #endif |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
947 |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
948 #ifdef HAVE_RATIO |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
949 #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
|
950 case RATIO_T: \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
951 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
|
952 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
953 #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
|
954 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
|
955 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
|
956 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
957 #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
|
958 #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
|
959 #endif |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
960 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
961 #ifdef HAVE_BIGFLOAT |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
962 #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
|
963 case BIGFLOAT_T: \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
964 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
|
965 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
966 #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
|
967 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
|
968 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
|
969 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
970 #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
|
971 #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
|
972 #endif |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
973 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
974 #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
|
975 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
|
976 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
977 #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
|
978 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
|
979 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
980 #endif /* WITH_NUMBER_TYPES */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
981 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
982 #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
|
983 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
984 /* 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
|
985 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
|
986 single-argument calls. */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
987 #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
|
988 if (CHARP (number)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
989 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
990 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
|
991 divisor, return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
992 } \ |
|
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 if (MARKERP (number)) \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
995 { \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
996 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
|
997 (marker_position(number)), \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
998 divisor, return_float); \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
999 } \ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1000 } while (0) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1001 |
|
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 /* 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
|
1004 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1005 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1006 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
|
1007 int return_float) |
| 428 | 1008 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1009 EMACS_INT i1 = XREALINT (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1010 EMACS_INT i2 = XREALINT (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1011 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
|
1012 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1013 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
|
1014 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
|
1015 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1016 /* 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
|
1017 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
|
1018 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
|
1019 non-negative case: */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1020 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1021 /* 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
|
1022 quotient calculation: */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1023 if (i2 < 0) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1024 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1025 if (i1 <= 0) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1026 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1027 i3 = -i1 / -i2; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1028 /* 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
|
1029 ceiling. */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1030 if (0 != (-i1 % -i2)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1031 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1032 ++i3; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1033 } |
|
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 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1036 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1037 /* 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
|
1038 i3 = -(i1 / -i2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1039 } |
|
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 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1042 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1043 if (i1 < 0) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1044 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1045 /* 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
|
1046 i3 = -(-i1 / i2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1047 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1048 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1049 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1050 i3 = i1 / i2; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1051 /* 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
|
1052 ceiling. */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1053 if (0 != (i1 % i2)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1054 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1055 ++i3; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1056 } |
|
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 i4 = i1 - (i3 * i2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1061 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1062 if (!return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1063 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1064 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
|
1065 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1066 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1067 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
|
1068 make_int (i4)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1069 } |
|
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 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1072 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1073 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
|
1074 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1075 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1076 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1077 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1078 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
|
1079 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
|
1080 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1081 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
|
1082 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1083 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
|
1084 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
|
1085 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1086 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
|
1087 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1088 res1 = Qzero; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1089 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1090 else |
| 428 | 1091 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1092 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
|
1093 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
|
1094 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
|
1095 } |
|
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 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1098 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1099 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1100 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1101 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1102 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1103 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
|
1104 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1105 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1106 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1107 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1108 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
|
1109 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
|
1110 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1111 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
|
1112 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1113 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
|
1114 ratio_denominator (scratch_ratio)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1115 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1116 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
|
1117 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
|
1118 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1119 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
|
1120 ratio_denominator (scratch_ratio))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1121 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1122 res1 = Qzero; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1123 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1124 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1125 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1126 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
|
1127 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
|
1128 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
|
1129 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
|
1130 } |
|
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 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1133 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1134 #endif /* HAVE_RATIO */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1135 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1136 #ifdef HAVE_BIGFLOAT |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1137 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1138 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
|
1139 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1140 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1141 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1142 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1143 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
|
1144 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
|
1145 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1146 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
|
1147 XBIGFLOAT_GET_PREC (divisor))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1148 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
|
1149 XBIGFLOAT_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1150 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
|
1151 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1152 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1153 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1154 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
|
1155 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1156 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1157 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1158 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1159 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
|
1160 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
|
1161 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1162 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
|
1163 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1164 } |
|
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 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
|
1167 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
|
1168 return values2 (res0, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1169 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
|
1170 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1171 #endif /* HAVE_BIGFLOAT */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1172 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1173 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1174 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1175 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
|
1176 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1177 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1178 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1179 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1180 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
|
1181 XRATIO_DENOMINATOR (number)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1182 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1183 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
|
1184 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
|
1185 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1186 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
|
1187 XRATIO_DENOMINATOR (number))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1188 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1189 res1 = Qzero; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1190 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1191 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1192 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1193 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
|
1194 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
|
1195 res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio)); |
| 428 | 1196 } |
| 1197 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1198 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1199 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1200 #endif /* HAVE_RATIO */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1201 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1202 #ifdef HAVE_BIGFLOAT |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1203 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1204 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
|
1205 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1206 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1207 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1208 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1209 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
|
1210 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
|
1211 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1212 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1213 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1214 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
|
1215 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1216 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1217 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1218 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1219 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
|
1220 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
|
1221 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1222 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
|
1223 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1224 } |
|
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 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
|
1227 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1228 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
|
1229 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1230 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1231 #endif /* HAVE_BIGFLOAT */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1232 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1233 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1234 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
|
1235 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1236 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1237 double f1 = extract_float (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1238 double f2 = extract_float (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1239 double f0, remain; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1240 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
|
1241 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1242 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
|
1243 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
|
1244 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1245 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
|
1246 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
|
1247 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1248 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1249 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1250 res0 = make_float(f0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1251 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1252 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1253 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1254 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
|
1255 } |
|
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 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
|
1258 } |
|
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 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1261 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
|
1262 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1263 double d, remain; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1264 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1265 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1266 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
|
1267 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
|
1268 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1269 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1270 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1271 res0 = make_float (d); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1272 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1273 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1274 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1275 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
|
1276 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1277 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
|
1278 } |
|
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 EXFUN (Fceiling, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1281 EXFUN (Ffceiling, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1282 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1283 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1284 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
|
1285 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1286 { |
|
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 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1289 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1290 if (INTP (number)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1291 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1292 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
|
1293 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1294 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1295 else if (BIGNUMP (number)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1296 { |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1297 return values2 (make_float |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1298 (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
|
1299 Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1300 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1301 #endif |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1302 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1303 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1304 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1305 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1306 if (INTEGERP (number)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1307 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1308 if (INTP (number)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1309 #endif |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1310 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1311 return values2 (number, Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1312 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1313 } |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1314 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1315 MAYBE_CHAR_OR_MARKER (ceiling); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1316 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1317 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
|
1318 } |
|
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 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1321 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
|
1322 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1323 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1324 EMACS_INT i1 = XREALINT (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1325 EMACS_INT i2 = XREALINT (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1326 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
|
1327 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1328 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1329 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
|
1330 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
|
1331 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1332 /* 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
|
1333 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
|
1334 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
|
1335 infinity. */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1336 i3 = (i2 < 0 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1337 ? (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
|
1338 : (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
|
1339 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1340 i4 = i1 - (i3 * i2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1341 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1342 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1343 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1344 res0 = make_float ((double)i3); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1345 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1346 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1347 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1348 res0 = make_int (i3); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1349 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1350 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1351 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
|
1352 } |
|
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 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1355 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1356 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
|
1357 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1358 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1359 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1360 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1361 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
|
1362 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
|
1363 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1364 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
|
1365 XBIGNUM_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1366 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1367 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1368 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1369 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
|
1370 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1371 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1372 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1373 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
|
1374 } |
|
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 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
|
1377 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1378 res1 = Qzero; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1379 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1380 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1381 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1382 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
|
1383 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
|
1384 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
|
1385 } |
|
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 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1388 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1389 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1390 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1391 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1392 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1393 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
|
1394 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1395 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1396 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1397 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1398 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
|
1399 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
|
1400 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1401 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
|
1402 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1403 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
|
1404 ratio_denominator (scratch_ratio)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1405 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1406 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
|
1407 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
|
1408 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1409 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
|
1410 ratio_denominator (scratch_ratio))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1411 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1412 res1 = Qzero; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1413 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1414 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1415 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1416 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
|
1417 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
|
1418 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
|
1419 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
|
1420 } |
|
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 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1423 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1424 #endif /* HAVE_RATIO */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1425 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1426 #ifdef HAVE_BIGFLOAT |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1427 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1428 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
|
1429 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1430 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1431 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1432 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1433 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
|
1434 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
|
1435 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1436 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
|
1437 XBIGFLOAT_GET_PREC (divisor))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1438 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
|
1439 XBIGFLOAT_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1440 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
|
1441 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1442 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1443 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1444 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
|
1445 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1446 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1447 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1448 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1449 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
|
1450 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
|
1451 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1452 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
|
1453 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1454 } |
|
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 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
|
1457 XBIGFLOAT_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1458 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
|
1459 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1460 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
|
1461 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1462 #endif /* HAVE_BIGFLOAT */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1463 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1464 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1465 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1466 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
|
1467 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1468 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1469 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1470 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1471 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
|
1472 XRATIO_DENOMINATOR (number)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1473 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1474 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
|
1475 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
|
1476 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1477 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
|
1478 XRATIO_DENOMINATOR (number))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1479 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1480 res1 = Qzero; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1481 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1482 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1483 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1484 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
|
1485 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
|
1486 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
|
1487 } |
|
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 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1490 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1491 #endif /* HAVE_RATIO */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1492 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1493 #ifdef HAVE_BIGFLOAT |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1494 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1495 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
|
1496 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1497 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1498 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1499 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1500 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
|
1501 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
|
1502 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1503 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1504 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1505 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
|
1506 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1507 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1508 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1509 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1510 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
|
1511 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
|
1512 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1513 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
|
1514 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1515 } |
|
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 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
|
1518 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
|
1519 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1520 #endif /* HAVE_BIGFLOAT */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1521 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1522 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1523 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
|
1524 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1525 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1526 double f1 = extract_float (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1527 double f2 = extract_float (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1528 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
|
1529 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1530 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
|
1531 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
|
1532 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1533 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
|
1534 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
|
1535 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1536 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1537 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1538 return values2 (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
|
1539 } |
|
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 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
|
1542 make_float (remain)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1543 } |
|
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 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1546 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
|
1547 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1548 double d, d1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1549 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1550 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
|
1551 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
|
1552 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1553 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1554 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1555 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
|
1556 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1557 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1558 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1559 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
|
1560 make_float (d1)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1561 } |
|
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 EXFUN (Ffloor, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1565 EXFUN (Fffloor, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1566 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1567 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1568 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
|
1569 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1570 { |
| 1983 | 1571 #ifdef HAVE_BIGNUM |
| 1572 if (INTEGERP (number)) | |
| 1573 #else | |
| 444 | 1574 if (INTP (number)) |
| 1983 | 1575 #endif |
| 1576 { | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1577 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1578 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1579 return 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
|
1580 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1581 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1582 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1583 return values2 (number, Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1584 } |
| 1983 | 1585 } |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1586 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1587 MAYBE_CHAR_OR_MARKER (floor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1588 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1589 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1590 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1591 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
|
1592 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1593 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1594 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1595 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
|
1596 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1597 } |
| 1983 | 1598 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1599 /* 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
|
1600 tests/automated/lisp-tests.el. */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1601 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
|
1602 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
|
1603 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1604 EMACS_INT i1 = XREALINT (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1605 EMACS_INT i2 = XREALINT (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1606 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
|
1607 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1608 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
|
1609 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
|
1610 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1611 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
|
1612 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1613 flooring = hi2 + i1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1614 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1615 floored = (i2 < 0 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1616 ? (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
|
1617 : (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
|
1618 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1619 flsecond = flooring - (floored * i2); |
| 1983 | 1620 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1621 if (0 == flsecond |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1622 && (i2 == (hi2 + hi2)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1623 && (0 != (floored % 2))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1624 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1625 i0 = floored - 1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1626 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
|
1627 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
|
1628 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1629 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1630 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1631 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
|
1632 make_int (floored), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1633 make_int (flsecond - hi2)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1634 } |
| 428 | 1635 } |
| 1636 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1637 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1638 static void |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1639 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
|
1640 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
|
1641 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1642 bignum flooring, floored, hi2, flsecond; |
| 428 | 1643 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1644 if (bignum_divisible_p (number, divisor)) |
| 1983 | 1645 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1646 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
|
1647 *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
|
1648 *remain = Qzero; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1649 return; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1650 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1651 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1652 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
|
1653 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1654 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
|
1655 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1656 bignum_init (hi2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1657 bignum_set (hi2, scratch_bignum2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1658 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1659 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
|
1660 bignum_init (flooring); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1661 bignum_set (flooring, scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1662 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1663 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
|
1664 bignum_init (floored); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1665 bignum_set (floored, scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1666 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1667 bignum_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
|
1668 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
|
1669 bignum_init (flsecond); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1670 bignum_set (flsecond, scratch_bignum); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1671 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1672 bignum_set_long (scratch_bignum, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1673 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
|
1674 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1675 if (bignum_sign (flsecond) == 0 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1676 && bignum_eql (divisor, scratch_bignum2) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1677 && (1 == bignum_testbit (floored, 0))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1678 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1679 bignum_set_long (scratch_bignum, 1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1680 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
|
1681 *res = make_bignum_bg (floored); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1682 *remain = make_bignum_bg (hi2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1683 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1684 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1685 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1686 bignum_sub (scratch_bignum, flsecond, |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1687 hi2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1688 *res = make_bignum_bg (floored); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1689 *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
|
1690 } |
|
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 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
|
1694 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
|
1695 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1696 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1697 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1698 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
|
1699 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
|
1700 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1701 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
|
1702 &res0, &res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1703 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1704 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1705 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1706 res0 = make_float (bignum_to_double (XBIGNUM_DATA (res0))); |
| 1983 | 1707 } |
| 1708 else | |
| 1709 { | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1710 res0 = Fcanonicalize_number (res0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1711 } |
|
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 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
|
1714 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1715 #endif /* HAVE_BIGNUM */ |
| 1983 | 1716 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1717 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1718 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1719 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
|
1720 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1721 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1722 Lisp_Object res0, res1; |
| 1983 | 1723 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1724 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
|
1725 return arith_error2 ("round", number, divisor); |
| 1983 | 1726 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1727 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
|
1728 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1729 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
|
1730 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
|
1731 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1732 if (!ZEROP (res1)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1733 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1734 /* 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
|
1735 ratio remainder: */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1736 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
|
1737 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
|
1738 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
|
1739 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1740 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
|
1741 } |
|
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 res0 = return_float ? |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1744 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
|
1745 Fcanonicalize_number (res0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1746 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1747 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1748 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1749 #endif /* HAVE_RATIO */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1750 |
| 1983 | 1751 #ifdef HAVE_BIGFLOAT |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1752 /* 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
|
1753 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1754 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
|
1755 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1756 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1757 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
|
1758 |
| 4828 | 1759 #if 0 |
| 1760 /* This causes the following GCC warning: | |
| 1761 | |
| 1762 /xemacs/latest-fix/src/floatfns.c:1764: warning: dereferencing type-punned pointer will break strict-aliasing rules | |
| 1763 | |
| 1764 and furthermore, it's a useless assert, since `number' is stored on | |
| 1765 the stack and so its address can never be the same as `scratch_bigfloat' | |
| 1766 or `scratch_bigfloat2', which are stored in the data segment. | |
| 1767 | |
| 1768 -- ben */ | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1769 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
|
1770 && (bigfloat *)(&number) != (bigfloat *)(&scratch_bigfloat2)); |
| 4828 | 1771 #endif |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1772 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1773 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
|
1774 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
|
1775 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1776 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
|
1777 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
|
1778 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
|
1779 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
|
1780 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1781 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
|
1782 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
|
1783 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1784 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
|
1785 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1786 do { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1787 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
|
1788 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1789 break; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1790 } |
|
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 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
|
1793 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1794 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
|
1795 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
|
1796 scratch_bigfloat2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1797 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
|
1798 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
|
1799 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
|
1800 scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1801 if (bigfloat_eql (scratch_bigfloat2, XBIGFLOAT_DATA (res0))) |
| 1995 | 1802 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1803 break; |
| 1995 | 1804 } |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1805 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1806 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1807 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
|
1808 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1809 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
|
1810 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1811 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1812 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1813 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
|
1814 } |
|
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 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
|
1817 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1818 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
|
1819 scratch_bigfloat); |
| 428 | 1820 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1821 } while (0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1822 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1823 return res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1824 } |
|
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 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1827 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
|
1828 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1829 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1830 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1831 bigfloat divided; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1832 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1833 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
|
1834 XBIGFLOAT_GET_PREC (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1835 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1836 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
|
1837 return arith_error2 ("round", number, divisor); |
| 428 | 1838 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1839 bigfloat_init (divided); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1840 bigfloat_set_prec (divided, prec); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1841 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1842 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
|
1843 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1844 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
|
1845 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1846 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
|
1847 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
|
1848 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1849 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
|
1850 XBIGFLOAT_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1851 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
|
1852 scratch_bigfloat); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1853 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1854 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
|
1855 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1856 if (!return_float) |
| 428 | 1857 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1858 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1859 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
|
1860 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
|
1861 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1862 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
|
1863 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1864 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1865 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1866 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1867 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1868 #endif /* HAVE_BIGFLOAT */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1869 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1870 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1871 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1872 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
|
1873 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1874 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1875 Lisp_Object res0, res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1876 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1877 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
|
1878 &res0, &res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1879 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1880 if (!ZEROP (res1)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1881 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1882 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
|
1883 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
|
1884 res1 = Fcanonicalize_number (make_ratio_rt (scratch_ratio)); |
| 428 | 1885 } |
| 1886 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1887 res0 = return_float ? |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1888 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
|
1889 Fcanonicalize_number (res0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1890 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1891 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1892 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1893 #endif /* HAVE_RATIO */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1894 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1895 #ifdef HAVE_BIGFLOAT |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1896 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1897 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
|
1898 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1899 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1900 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
|
1901 Lisp_Object res1; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1902 |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1903 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
|
1904 XBIGFLOAT_DATA (res0)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1905 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1906 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
|
1907 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1908 if (!return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1909 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1910 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1911 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
|
1912 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
|
1913 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1914 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
|
1915 (XBIGFLOAT_DATA (res0))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1916 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1917 } |
|
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 return values2 (res0, res1); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1920 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1921 #endif /* HAVE_BIGFLOAT */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1922 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1923 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1924 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
|
1925 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1926 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1927 double f1 = extract_float (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1928 double f2 = extract_float (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1929 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
|
1930 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1931 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
|
1932 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
|
1933 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1934 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
|
1935 divisor); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1936 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
|
1937 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1938 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1939 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1940 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
|
1941 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1942 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1943 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1944 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
|
1945 make_float (remain)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1946 } |
| 428 | 1947 } |
| 1948 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1949 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1950 round_one_float (Lisp_Object number, int return_float) |
| 428 | 1951 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1952 double d; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1953 /* Screw the prevailing rounding mode. */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1954 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
|
1955 number); |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1956 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1957 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1958 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1959 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
|
1960 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1961 else |
| 428 | 1962 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1963 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
|
1964 Qunbound)), |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1965 make_float (XFLOAT_DATA (number) - d)); |
| 428 | 1966 } |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1967 } |
| 428 | 1968 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1969 EXFUN (Fround, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1970 EXFUN (Ffround, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1971 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1972 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1973 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
|
1974 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1975 { |
| 1983 | 1976 #ifdef HAVE_BIGNUM |
| 1977 if (INTEGERP (number)) | |
| 1978 #else | |
| 444 | 1979 if (INTP (number)) |
| 1983 | 1980 #endif |
| 1981 { | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1982 if (return_float) |
| 1983 | 1983 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1984 return values2 (make_float (extract_float (number)), Qzero); |
| 1983 | 1985 } |
| 1986 else | |
| 1987 { | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1988 return values2 (number, Qzero); |
| 1983 | 1989 } |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1990 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1991 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1992 MAYBE_CHAR_OR_MARKER (round); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1993 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1994 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1995 { |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
1996 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
|
1997 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1998 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
1999 { |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
2000 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
|
2001 } |
|
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 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2005 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
|
2006 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2007 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2008 EMACS_INT i1 = XREALINT (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2009 EMACS_INT i2 = XREALINT (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2010 EMACS_INT i0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2011 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2012 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
|
2013 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
|
2014 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2015 /* 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
|
2016 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
|
2017 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
|
2018 i0 = (i2 < 0 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2019 ? (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
|
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 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2022 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2023 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2024 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
|
2025 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2026 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2027 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2028 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
|
2029 } |
|
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 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2033 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2034 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
|
2035 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2036 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2037 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2038 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2039 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
|
2040 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
|
2041 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2042 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
|
2043 XBIGNUM_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2044 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2045 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2046 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2047 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
|
2048 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2049 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2050 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2051 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
|
2052 } |
|
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 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
|
2055 XBIGNUM_DATA (divisor))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2056 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2057 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
|
2058 } |
|
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 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
|
2061 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
|
2062 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2063 return values2 (Fcanonicalize_number (res0), |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2064 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
|
2065 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2066 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2067 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2068 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2069 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2070 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
|
2071 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2072 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2073 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2074 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2075 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
|
2076 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
|
2077 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2078 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
|
2079 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2080 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
|
2081 ratio_denominator (scratch_ratio)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2082 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2083 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2084 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2085 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
|
2086 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2087 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2088 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2089 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
|
2090 } |
|
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 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
|
2093 ratio_denominator (scratch_ratio))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2094 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2095 return values2 (res0, Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2096 } |
|
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 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
|
2099 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
|
2100 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
|
2101 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2102 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
|
2103 } |
| 1983 | 2104 #endif |
| 2105 | |
| 2106 #ifdef HAVE_BIGFLOAT | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2107 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2108 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
|
2109 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2110 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2111 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2112 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
|
2113 XBIGFLOAT_GET_PREC (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2114 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2115 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
|
2116 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
|
2117 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2118 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
|
2119 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
|
2120 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2121 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
|
2122 XBIGFLOAT_DATA (divisor)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2123 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
|
2124 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2125 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2126 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2127 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
|
2128 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2129 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2130 { |
| 1983 | 2131 #ifdef HAVE_BIGNUM |
| 2132 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
|
2133 res0 = Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
| 1983 | 2134 #else |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2135 res0 = make_int ((EMACS_INT) bigfloat_to_long (scratch_bigfloat)); |
| 1983 | 2136 #endif /* HAVE_BIGNUM */ |
| 2137 } | |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
2138 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2139 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
|
2140 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
|
2141 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2142 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
|
2143 } |
| 1983 | 2144 #endif /* HAVE_BIGFLOAT */ |
| 2145 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2146 #ifdef HAVE_RATIO |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2147 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2148 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
|
2149 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2150 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2151 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2152 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2153 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
|
2154 return Qzero; |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2155 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2156 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
|
2157 XRATIO_DENOMINATOR (number)); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2158 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2159 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2160 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
|
2161 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2162 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2163 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2164 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
|
2165 } |
|
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 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
|
2168 XRATIO_DENOMINATOR (number))) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2169 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2170 return values2 (res0, Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2171 } |
|
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 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
|
2174 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
|
2175 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2176 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
|
2177 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2178 #endif /* HAVE_RATIO */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2179 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2180 #ifdef HAVE_BIGFLOAT |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2181 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2182 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
|
2183 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2184 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2185 Lisp_Object res0; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2186 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2187 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
|
2188 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
|
2189 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
|
2190 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2191 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2192 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2193 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
|
2194 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2195 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2196 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2197 #ifdef HAVE_BIGNUM |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2198 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
|
2199 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
|
2200 #else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2201 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
|
2202 #endif /* HAVE_BIGNUM */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2203 } |
|
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 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
|
2206 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2207 return |
|
4717
fcc7e89d5e68
Properly handle continuable divide-by-zero errors. Fix truncation of a
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
2208 values2 (res0, |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2209 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
|
2210 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2211 #endif /* HAVE_BIGFLOAT */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2212 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2213 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2214 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
|
2215 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2216 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2217 double f1 = extract_float (number); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2218 double f2 = extract_float (divisor); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2219 double f0, remain; |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2220 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
|
2221 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2222 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
|
2223 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
|
2224 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2225 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
|
2226 f0 = extract_float (res0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2227 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2228 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
|
2229 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2230 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2231 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2232 res0 = make_float (f0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2233 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2234 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2235 return values2 (res0, make_float (remain)); |
| 428 | 2236 } |
| 2237 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2238 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2239 truncate_one_float (Lisp_Object number, int return_float) |
| 428 | 2240 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2241 Lisp_Object res0 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2242 = 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
|
2243 number, Qunbound); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2244 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2245 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2246 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
|
2247 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
|
2248 - XFLOAT_DATA (res0)))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2249 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2250 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2251 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2252 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
|
2253 - XREALINT (res0))); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2254 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2255 } |
| 428 | 2256 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2257 EXFUN (Fftruncate, 2); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2258 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2259 static Lisp_Object |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2260 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
|
2261 int return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2262 { |
| 1983 | 2263 #ifdef HAVE_BIGNUM |
| 2264 if (INTEGERP (number)) | |
| 2265 #else | |
| 444 | 2266 if (INTP (number)) |
| 1983 | 2267 #endif |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2268 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2269 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2270 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2271 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
|
2272 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2273 else |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2274 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2275 return values2 (number, Qzero); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2276 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2277 } |
| 428 | 2278 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2279 MAYBE_CHAR_OR_MARKER (truncate); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2280 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2281 if (return_float) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2282 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2283 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
|
2284 } |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2285 else |
| 1983 | 2286 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2287 return Ftruncate (wrong_type_argument (Qnumberp, number), divisor); |
| 1983 | 2288 } |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2289 } |
|
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 /* 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
|
2292 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2293 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
|
2294 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
|
2295 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2296 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
|
2297 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
|
2298 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2299 This function returns multiple values; see `multiple-value-bind' and |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2300 `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
|
2301 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
|
2302 is omitted or one. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2303 */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2304 (number, divisor)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2305 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2306 ROUNDING_CONVERT(ceiling, 0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2307 } |
| 1983 | 2308 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2309 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
|
2310 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
|
2311 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
|
2312 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
|
2313 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2314 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
|
2315 `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
|
2316 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
|
2317 one. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2318 */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2319 (number, divisor)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2320 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2321 ROUNDING_CONVERT(floor, 0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2322 } |
|
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 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
|
2325 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
|
2326 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
|
2327 is even. |
| 1983 | 2328 |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2329 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
|
2330 divided by DIVISOR. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2331 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2332 This function returns multiple values; see `multiple-value-call' and |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2333 `multiple-value-bind'. The second returned value is the remainder |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2334 in the calculation. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2335 */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2336 (number, divisor)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2337 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2338 ROUNDING_CONVERT(round, 0); |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2339 } |
|
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 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
|
2342 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
|
2343 Rounds the value toward zero. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2344 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2345 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
|
2346 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2347 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
|
2348 `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
|
2349 */ |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2350 (number, divisor)) |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2351 { |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2352 ROUNDING_CONVERT(truncate, 0); |
| 428 | 2353 } |
| 2354 | |
| 2355 /* Float-rounding functions. */ | |
| 2356 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2357 DEFUN ("fceiling", Ffceiling, 1, 2, 0, /* |
| 444 | 2358 Return the smallest integer no less than NUMBER, as a float. |
| 428 | 2359 \(Round toward +inf.\) |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2360 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2361 With optional argument DIVISOR, return the 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
|
2362 quotient of NUMBER and DIVISOR, as a float. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2363 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2364 This function returns multiple values; the second value is the remainder in |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2365 the calculation. |
| 428 | 2366 */ |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2367 (number, divisor)) |
| 428 | 2368 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2369 ROUNDING_CONVERT(ceiling, 1); |
| 428 | 2370 } |
| 2371 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2372 DEFUN ("ffloor", Fffloor, 1, 2, 0, /* |
| 444 | 2373 Return the largest integer no greater than NUMBER, as a float. |
| 428 | 2374 \(Round towards -inf.\) |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2375 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2376 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
|
2377 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
|
2378 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2379 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
|
2380 the calculation. |
| 428 | 2381 */ |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2382 (number, divisor)) |
| 428 | 2383 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2384 ROUNDING_CONVERT(floor, 1); |
| 428 | 2385 } |
| 2386 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2387 DEFUN ("fround", Ffround, 1, 2, 0, /* |
| 444 | 2388 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
|
2389 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
|
2390 even. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2391 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2392 With optional argument DIVISOR, 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
|
2393 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
|
2394 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2395 This function returns multiple values; the second value is the remainder in |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2396 the calculation. |
| 428 | 2397 */ |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2398 (number, divisor)) |
| 428 | 2399 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2400 ROUNDING_CONVERT(round, 1); |
| 428 | 2401 } |
| 2402 | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2403 DEFUN ("ftruncate", Fftruncate, 1, 2, 0, /* |
| 428 | 2404 Truncate a floating point number to an integral float value. |
| 2405 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
|
2406 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2407 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
|
2408 to an integral float value. |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2409 |
|
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2410 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
|
2411 the calculation. |
| 428 | 2412 */ |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2413 (number, divisor)) |
| 428 | 2414 { |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2286
diff
changeset
|
2415 ROUNDING_CONVERT(truncate, 1); |
| 428 | 2416 } |
| 2417 | |
| 2418 #ifdef FLOAT_CATCH_SIGILL | |
| 2419 static SIGTYPE | |
| 2420 float_error (int signo) | |
| 2421 { | |
| 2422 if (! in_float) | |
| 2423 fatal_error_signal (signo); | |
| 2424 | |
| 2425 EMACS_REESTABLISH_SIGNAL (signo, arith_error); | |
| 2426 EMACS_UNBLOCK_SIGNAL (signo); | |
| 2427 | |
| 2428 in_float = 0; | |
| 2429 | |
| 2430 /* Was Fsignal(), but it just doesn't make sense for an error | |
| 2431 occurring inside a signal handler to be restartable, considering | |
| 2432 that anything could happen when the error is signaled and trapped | |
| 2433 and considering the asynchronous nature of signal handlers. */ | |
| 563 | 2434 signal_error (Qarith_error, 0, float_error_arg); |
| 428 | 2435 } |
| 2436 | |
| 2437 /* Another idea was to replace the library function `infnan' | |
| 2438 where SIGILL is signaled. */ | |
| 2439 | |
| 2440 #endif /* FLOAT_CATCH_SIGILL */ | |
| 2441 | |
| 2442 /* In C++, it is impossible to determine what type matherr expects | |
| 2443 without some more configure magic. | |
| 2444 We shouldn't be using matherr anyways - it's a non-standard SYSVism. */ | |
| 2445 #if defined (HAVE_MATHERR) && !defined(__cplusplus) | |
| 2446 int | |
| 2447 matherr (struct exception *x) | |
| 2448 { | |
| 2449 Lisp_Object args; | |
| 2450 if (! in_float) | |
| 2451 /* Not called from emacs-lisp float routines; do the default thing. */ | |
| 2452 return 0; | |
| 2453 | |
| 2454 /* if (!strcmp (x->name, "pow")) x->name = "expt"; */ | |
| 2455 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4865
diff
changeset
|
2456 args = Fcons (build_ext_string (x->name, Qerror_message_encoding), |
| 428 | 2457 Fcons (make_float (x->arg1), |
| 2458 ((in_float == 2) | |
| 2459 ? Fcons (make_float (x->arg2), Qnil) | |
| 2460 : Qnil))); | |
| 2461 switch (x->type) | |
| 2462 { | |
| 2463 case DOMAIN: Fsignal (Qdomain_error, args); break; | |
| 2464 case SING: Fsignal (Qsingularity_error, args); break; | |
| 2465 case OVERFLOW: Fsignal (Qoverflow_error, args); break; | |
| 2466 case UNDERFLOW: Fsignal (Qunderflow_error, args); break; | |
| 2467 default: Fsignal (Qarith_error, args); break; | |
| 2468 } | |
| 2469 return 1; /* don't set errno or print a message */ | |
| 2470 } | |
| 2471 #endif /* HAVE_MATHERR */ | |
| 2472 | |
| 2473 void | |
| 2474 init_floatfns_very_early (void) | |
| 2475 { | |
| 2476 # ifdef FLOAT_CATCH_SIGILL | |
| 613 | 2477 EMACS_SIGNAL (SIGILL, float_error); |
| 428 | 2478 # endif |
| 2479 in_float = 0; | |
| 2480 } | |
| 2481 | |
| 2482 void | |
| 2483 syms_of_floatfns (void) | |
| 2484 { | |
| 442 | 2485 INIT_LRECORD_IMPLEMENTATION (float); |
| 428 | 2486 |
| 2487 /* Trig functions. */ | |
| 2488 | |
| 2489 DEFSUBR (Facos); | |
| 2490 DEFSUBR (Fasin); | |
| 2491 DEFSUBR (Fatan); | |
| 2492 DEFSUBR (Fcos); | |
| 2493 DEFSUBR (Fsin); | |
| 2494 DEFSUBR (Ftan); | |
| 2495 | |
| 2496 /* Bessel functions */ | |
| 2497 | |
| 2498 #if 0 | |
| 2499 DEFSUBR (Fbessel_y0); | |
| 2500 DEFSUBR (Fbessel_y1); | |
| 2501 DEFSUBR (Fbessel_yn); | |
| 2502 DEFSUBR (Fbessel_j0); | |
| 2503 DEFSUBR (Fbessel_j1); | |
| 2504 DEFSUBR (Fbessel_jn); | |
| 2505 #endif /* 0 */ | |
| 2506 | |
| 2507 /* Error functions. */ | |
| 2508 | |
| 2509 #if 0 | |
| 2510 DEFSUBR (Ferf); | |
| 2511 DEFSUBR (Ferfc); | |
| 2512 DEFSUBR (Flog_gamma); | |
| 2513 #endif /* 0 */ | |
| 2514 | |
| 2515 /* Root and Log functions. */ | |
| 2516 | |
| 2517 DEFSUBR (Fexp); | |
| 2518 DEFSUBR (Fexpt); | |
| 2519 DEFSUBR (Flog); | |
| 2520 DEFSUBR (Flog10); | |
| 2521 DEFSUBR (Fsqrt); | |
| 2522 DEFSUBR (Fcube_root); | |
| 2523 | |
| 2524 /* Inverse trig functions. */ | |
| 2525 | |
| 2526 DEFSUBR (Facosh); | |
| 2527 DEFSUBR (Fasinh); | |
| 2528 DEFSUBR (Fatanh); | |
| 2529 DEFSUBR (Fcosh); | |
| 2530 DEFSUBR (Fsinh); | |
| 2531 DEFSUBR (Ftanh); | |
| 2532 | |
| 2533 /* Rounding functions */ | |
| 2534 | |
| 2535 DEFSUBR (Fabs); | |
| 2536 DEFSUBR (Ffloat); | |
| 2537 DEFSUBR (Flogb); | |
| 2538 DEFSUBR (Fceiling); | |
| 2539 DEFSUBR (Ffloor); | |
| 2540 DEFSUBR (Fround); | |
| 2541 DEFSUBR (Ftruncate); | |
| 2542 | |
| 2543 /* Float-rounding functions. */ | |
| 2544 | |
| 2545 DEFSUBR (Ffceiling); | |
| 2546 DEFSUBR (Fffloor); | |
| 2547 DEFSUBR (Ffround); | |
| 2548 DEFSUBR (Fftruncate); | |
| 2549 } | |
| 2550 | |
| 2551 void | |
| 2552 vars_of_floatfns (void) | |
| 2553 { | |
| 2554 Fprovide (intern ("lisp-float-type")); | |
| 2555 } |