annotate src/number.c @ 5127:a9c41067dd88 ben-lisp-object

more cleanups, terminology clarification, lots of doc work -------------------- ChangeLog entries follow: -------------------- man/ChangeLog addition: 2010-03-05 Ben Wing <ben@xemacs.org> * internals/internals.texi (Introduction to Allocation): * internals/internals.texi (Integers and Characters): * internals/internals.texi (Allocation from Frob Blocks): * internals/internals.texi (lrecords): * internals/internals.texi (Low-level allocation): Rewrite section on allocation of Lisp objects to reflect the new reality. Remove references to nonexistent XSETINT and XSETCHAR. modules/ChangeLog addition: 2010-03-05 Ben Wing <ben@xemacs.org> * postgresql/postgresql.c (allocate_pgconn): * postgresql/postgresql.c (allocate_pgresult): * postgresql/postgresql.h (struct Lisp_PGconn): * postgresql/postgresql.h (struct Lisp_PGresult): * ldap/eldap.c (allocate_ldap): * ldap/eldap.h (struct Lisp_LDAP): Same changes as in src/ dir. See large log there in ChangeLog, but basically: ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER ../hlo/src/ChangeLog addition: 2010-03-05 Ben Wing <ben@xemacs.org> * alloc.c: * alloc.c (old_alloc_sized_lcrecord): * alloc.c (very_old_free_lcrecord): * alloc.c (copy_lisp_object): * alloc.c (zero_sized_lisp_object): * alloc.c (zero_nonsized_lisp_object): * alloc.c (lisp_object_storage_size): * alloc.c (free_normal_lisp_object): * alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC): * alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT): * alloc.c (Fcons): * alloc.c (noseeum_cons): * alloc.c (make_float): * alloc.c (make_bignum): * alloc.c (make_bignum_bg): * alloc.c (make_ratio): * alloc.c (make_ratio_bg): * alloc.c (make_ratio_rt): * alloc.c (make_bigfloat): * alloc.c (make_bigfloat_bf): * alloc.c (size_vector): * alloc.c (make_compiled_function): * alloc.c (Fmake_symbol): * alloc.c (allocate_extent): * alloc.c (allocate_event): * alloc.c (make_key_data): * alloc.c (make_button_data): * alloc.c (make_motion_data): * alloc.c (make_process_data): * alloc.c (make_timeout_data): * alloc.c (make_magic_data): * alloc.c (make_magic_eval_data): * alloc.c (make_eval_data): * alloc.c (make_misc_user_data): * alloc.c (Fmake_marker): * alloc.c (noseeum_make_marker): * alloc.c (size_string_direct_data): * alloc.c (make_uninit_string): * alloc.c (make_string_nocopy): * alloc.c (mark_lcrecord_list): * alloc.c (alloc_managed_lcrecord): * alloc.c (free_managed_lcrecord): * alloc.c (sweep_lcrecords_1): * alloc.c (malloced_storage_size): * buffer.c (allocate_buffer): * buffer.c (compute_buffer_usage): * buffer.c (DEFVAR_BUFFER_LOCAL_1): * buffer.c (nuke_all_buffer_slots): * buffer.c (common_init_complex_vars_of_buffer): * buffer.h (struct buffer_text): * buffer.h (struct buffer): * bytecode.c: * bytecode.c (make_compiled_function_args): * bytecode.c (size_compiled_function_args): * bytecode.h (struct compiled_function_args): * casetab.c (allocate_case_table): * casetab.h (struct Lisp_Case_Table): * charset.h (struct Lisp_Charset): * chartab.c (fill_char_table): * chartab.c (Fmake_char_table): * chartab.c (make_char_table_entry): * chartab.c (copy_char_table_entry): * chartab.c (Fcopy_char_table): * chartab.c (put_char_table): * chartab.h (struct Lisp_Char_Table_Entry): * chartab.h (struct Lisp_Char_Table): * console-gtk-impl.h (struct gtk_device): * console-gtk-impl.h (struct gtk_frame): * console-impl.h (struct console): * console-msw-impl.h (struct Lisp_Devmode): * console-msw-impl.h (struct mswindows_device): * console-msw-impl.h (struct msprinter_device): * console-msw-impl.h (struct mswindows_frame): * console-msw-impl.h (struct mswindows_dialog_id): * console-stream-impl.h (struct stream_console): * console-stream.c (stream_init_console): * console-tty-impl.h (struct tty_console): * console-tty-impl.h (struct tty_device): * console-tty.c (allocate_tty_console_struct): * console-x-impl.h (struct x_device): * console-x-impl.h (struct x_frame): * console.c (allocate_console): * console.c (nuke_all_console_slots): * console.c (DEFVAR_CONSOLE_LOCAL_1): * console.c (common_init_complex_vars_of_console): * data.c (make_weak_list): * data.c (make_weak_box): * data.c (make_ephemeron): * database.c: * database.c (struct Lisp_Database): * database.c (allocate_database): * database.c (finalize_database): * device-gtk.c (allocate_gtk_device_struct): * device-impl.h (struct device): * device-msw.c: * device-msw.c (mswindows_init_device): * device-msw.c (msprinter_init_device): * device-msw.c (finalize_devmode): * device-msw.c (allocate_devmode): * device-tty.c (allocate_tty_device_struct): * device-x.c (allocate_x_device_struct): * device.c: * device.c (nuke_all_device_slots): * device.c (allocate_device): * dialog-msw.c (handle_question_dialog_box): * elhash.c: * elhash.c (struct Lisp_Hash_Table): * elhash.c (finalize_hash_table): * elhash.c (make_general_lisp_hash_table): * elhash.c (Fcopy_hash_table): * elhash.h (htentry): * emacs.c (main_1): * eval.c: * eval.c (size_multiple_value): * event-stream.c (finalize_command_builder): * event-stream.c (allocate_command_builder): * event-stream.c (free_command_builder): * event-stream.c (event_stream_generate_wakeup): * event-stream.c (event_stream_resignal_wakeup): * event-stream.c (event_stream_disable_wakeup): * event-stream.c (event_stream_wakeup_pending_p): * events.h (struct Lisp_Timeout): * events.h (struct command_builder): * extents-impl.h: * extents-impl.h (struct extent_auxiliary): * extents-impl.h (struct extent_info): * extents-impl.h (set_extent_no_chase_aux_field): * extents-impl.h (set_extent_no_chase_normal_field): * extents.c: * extents.c (gap_array_marker): * extents.c (gap_array): * extents.c (extent_list_marker): * extents.c (extent_list): * extents.c (stack_of_extents): * extents.c (gap_array_make_marker): * extents.c (extent_list_make_marker): * extents.c (allocate_extent_list): * extents.c (SLOT): * extents.c (mark_extent_auxiliary): * extents.c (allocate_extent_auxiliary): * extents.c (attach_extent_auxiliary): * extents.c (size_gap_array): * extents.c (finalize_extent_info): * extents.c (allocate_extent_info): * extents.c (uninit_buffer_extents): * extents.c (allocate_soe): * extents.c (copy_extent): * extents.c (vars_of_extents): * extents.h: * faces.c (allocate_face): * faces.h (struct Lisp_Face): * faces.h (struct face_cachel): * file-coding.c: * file-coding.c (finalize_coding_system): * file-coding.c (sizeof_coding_system): * file-coding.c (Fcopy_coding_system): * file-coding.h (struct Lisp_Coding_System): * file-coding.h (MARKED_SLOT): * fns.c (size_bit_vector): * font-mgr.c: * font-mgr.c (finalize_fc_pattern): * font-mgr.c (print_fc_pattern): * font-mgr.c (Ffc_pattern_p): * font-mgr.c (Ffc_pattern_create): * font-mgr.c (Ffc_name_parse): * font-mgr.c (Ffc_name_unparse): * font-mgr.c (Ffc_pattern_duplicate): * font-mgr.c (Ffc_pattern_add): * font-mgr.c (Ffc_pattern_del): * font-mgr.c (Ffc_pattern_get): * font-mgr.c (fc_config_create_using): * font-mgr.c (fc_strlist_to_lisp_using): * font-mgr.c (fontset_to_list): * font-mgr.c (Ffc_config_p): * font-mgr.c (Ffc_config_up_to_date): * font-mgr.c (Ffc_config_build_fonts): * font-mgr.c (Ffc_config_get_cache): * font-mgr.c (Ffc_config_get_fonts): * font-mgr.c (Ffc_config_set_current): * font-mgr.c (Ffc_config_get_blanks): * font-mgr.c (Ffc_config_get_rescan_interval): * font-mgr.c (Ffc_config_set_rescan_interval): * font-mgr.c (Ffc_config_app_font_add_file): * font-mgr.c (Ffc_config_app_font_add_dir): * font-mgr.c (Ffc_config_app_font_clear): * font-mgr.c (size): * font-mgr.c (Ffc_config_substitute): * font-mgr.c (Ffc_font_render_prepare): * font-mgr.c (Ffc_font_match): * font-mgr.c (Ffc_font_sort): * font-mgr.c (finalize_fc_config): * font-mgr.c (print_fc_config): * font-mgr.h: * font-mgr.h (struct fc_pattern): * font-mgr.h (XFC_PATTERN): * font-mgr.h (struct fc_config): * font-mgr.h (XFC_CONFIG): * frame-gtk.c (allocate_gtk_frame_struct): * frame-impl.h (struct frame): * frame-msw.c (mswindows_init_frame_1): * frame-x.c (allocate_x_frame_struct): * frame.c (nuke_all_frame_slots): * frame.c (allocate_frame_core): * gc.c: * gc.c (GC_CHECK_NOT_FREE): * glyphs.c (finalize_image_instance): * glyphs.c (allocate_image_instance): * glyphs.c (Fcolorize_image_instance): * glyphs.c (allocate_glyph): * glyphs.c (unmap_subwindow_instance_cache_mapper): * glyphs.c (register_ignored_expose): * glyphs.h (struct Lisp_Image_Instance): * glyphs.h (struct Lisp_Glyph): * glyphs.h (struct glyph_cachel): * glyphs.h (struct expose_ignore): * gui.c (allocate_gui_item): * gui.h (struct Lisp_Gui_Item): * keymap.c (struct Lisp_Keymap): * keymap.c (make_keymap): * lisp.h: * lisp.h (struct Lisp_String_Direct_Data): * lisp.h (struct Lisp_String_Indirect_Data): * lisp.h (struct Lisp_Vector): * lisp.h (struct Lisp_Bit_Vector): * lisp.h (DECLARE_INLINE_LISP_BIT_VECTOR): * lisp.h (struct weak_box): * lisp.h (struct ephemeron): * lisp.h (struct weak_list): * lrecord.h: * lrecord.h (struct lrecord_implementation): * lrecord.h (MC_ALLOC_CALL_FINALIZER): * lrecord.h (struct lcrecord_list): * lstream.c (finalize_lstream): * lstream.c (sizeof_lstream): * lstream.c (Lstream_new): * lstream.c (Lstream_delete): * lstream.h (struct lstream): * marker.c: * marker.c (finalize_marker): * marker.c (compute_buffer_marker_usage): * mule-charset.c: * mule-charset.c (make_charset): * mule-charset.c (compute_charset_usage): * objects-impl.h (struct Lisp_Color_Instance): * objects-impl.h (struct Lisp_Font_Instance): * objects-tty-impl.h (struct tty_color_instance_data): * objects-tty-impl.h (struct tty_font_instance_data): * objects-tty.c (tty_initialize_color_instance): * objects-tty.c (tty_initialize_font_instance): * objects.c (finalize_color_instance): * objects.c (Fmake_color_instance): * objects.c (finalize_font_instance): * objects.c (Fmake_font_instance): * objects.c (reinit_vars_of_objects): * opaque.c: * opaque.c (sizeof_opaque): * opaque.c (make_opaque_ptr): * opaque.c (free_opaque_ptr): * opaque.h: * opaque.h (Lisp_Opaque): * opaque.h (Lisp_Opaque_Ptr): * print.c (printing_unreadable_lcrecord): * print.c (external_object_printer): * print.c (debug_p4): * process.c (finalize_process): * process.c (make_process_internal): * procimpl.h (struct Lisp_Process): * rangetab.c (Fmake_range_table): * rangetab.c (Fcopy_range_table): * rangetab.h (struct Lisp_Range_Table): * scrollbar.c: * scrollbar.c (create_scrollbar_instance): * scrollbar.c (compute_scrollbar_instance_usage): * scrollbar.h (struct scrollbar_instance): * specifier.c (finalize_specifier): * specifier.c (sizeof_specifier): * specifier.c (set_specifier_caching): * specifier.h (struct Lisp_Specifier): * specifier.h (struct specifier_caching): * symeval.h: * symeval.h (SYMBOL_VALUE_MAGIC_P): * symeval.h (DEFVAR_SYMVAL_FWD): * symsinit.h: * syntax.c (init_buffer_syntax_cache): * syntax.h (struct syntax_cache): * toolbar.c: * toolbar.c (allocate_toolbar_button): * toolbar.c (update_toolbar_button): * toolbar.h (struct toolbar_button): * tooltalk.c (struct Lisp_Tooltalk_Message): * tooltalk.c (make_tooltalk_message): * tooltalk.c (struct Lisp_Tooltalk_Pattern): * tooltalk.c (make_tooltalk_pattern): * ui-gtk.c: * ui-gtk.c (allocate_ffi_data): * ui-gtk.c (emacs_gtk_object_finalizer): * ui-gtk.c (allocate_emacs_gtk_object_data): * ui-gtk.c (allocate_emacs_gtk_boxed_data): * ui-gtk.h: * window-impl.h (struct window): * window-impl.h (struct window_mirror): * window.c (finalize_window): * window.c (allocate_window): * window.c (new_window_mirror): * window.c (mark_window_as_deleted): * window.c (make_dummy_parent): * window.c (compute_window_mirror_usage): * window.c (compute_window_usage): Overall point of this change and previous ones in this repository: (1) Introduce new, clearer terminology: everything other than int or char is a "record" object, which comes in two types: "normal objects" and "frob-block objects". Fix up all places that referred to frob-block objects as "simple", "basic", etc. (2) Provide an advertised interface for doing operations on Lisp objects, including creating new types, that is clean and consistent in its naming, uses the above-referenced terms and avoids referencing "lrecords", "old lcrecords", etc., which should hide under the surface. (3) Make the size_in_bytes and finalizer methods take a Lisp_Object rather than a void * for consistency with other methods. (4) Separate finalizer method into finalizer and disksaver, so that normal finalize methods don't have to worry about disksaving. Other specifics: (1) Renaming: LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT implementation->basic_p -> implementation->frob_block_p ALLOCATE_FIXED_TYPE_AND_SET_IMPL -> ALLOC_FROB_BLOCK_LISP_OBJECT *FCCONFIG*, wrap_fcconfig -> *FC_CONFIG*, wrap_fc_config *FCPATTERN*, wrap_fcpattern -> *FC_PATTERN*, wrap_fc_pattern (the last two changes make the naming of these macros consistent with the naming of all other macros, since the objects are named fc-config and fc-pattern with a hyphen) (2) Lots of documentation fixes in lrecord.h. (3) Eliminate macros for copying, freeing, zeroing objects, getting their storage size. Instead, new functions: zero_sized_lisp_object() zero_nonsized_lisp_object() lisp_object_storage_size() free_normal_lisp_object() (copy_lisp_object() already exists) LISP_OBJECT_FROB_BLOCK_P() (actually a macro) Eliminated: free_lrecord() zero_lrecord() copy_lrecord() copy_sized_lrecord() old_copy_lcrecord() old_copy_sized_lcrecord() old_zero_lcrecord() old_zero_sized_lcrecord() LISP_OBJECT_STORAGE_SIZE() COPY_SIZED_LISP_OBJECT() COPY_SIZED_LCRECORD() COPY_LISP_OBJECT() ZERO_LISP_OBJECT() FREE_LISP_OBJECT() (4) Catch the remaining places where lrecord stuff was used directly and use the advertised interface, e.g. alloc_sized_lrecord() -> ALLOC_SIZED_LISP_OBJECT(). (5) Make certain statically-declared pseudo-objects (buffer_local_flags, console_local_flags) have their lheader initialized correctly, so things like copy_lisp_object() can work on them. Make extent_auxiliary_defaults a proper heap object Vextent_auxiliary_defaults, and make extent auxiliaries dumpable so that this object can be dumped. allocate_extent_auxiliary() now just creates the object, and attach_extent_auxiliary() creates an extent auxiliary and attaches to an extent, like the old allocate_extent_auxiliary(). (6) Create EXTENT_AUXILIARY_SLOTS macro, similar to the foo-slots.h files but in a macro instead of a file. The purpose is to avoid duplication when iterating over all the slots in an extent auxiliary. Use it. (7) In lstream.c, don't zero out object after allocation because allocation routines take care of this. (8) In marker.c, fix a mistake in computing marker overhead. (9) In print.c, clean up printing_unreadable_lcrecord(), external_object_printer() to avoid lots of ifdef NEW_GC's. (10) Separate toolbar-button allocation into a separate allocate_toolbar_button() function for use in the example code in lrecord.h.
author Ben Wing <ben@xemacs.org>
date Fri, 05 Mar 2010 04:08:17 -0600
parents b5df3737028a
children 0dcd22290039
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
1 /* Numeric types for XEmacs.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
2 Copyright (C) 2004 Jerry James.
5125
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
3 Copyright (C) 2010 Ben Wing.
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
4
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
5 This file is part of XEmacs.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
6
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
10 later version.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
11
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
15 for more details.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
16
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
19 the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor,
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
20 Boston, MA 02111-1301, USA. */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
21
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
22 /* Synched up with: Not in FSF. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
23
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
24 #include <config.h>
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
25 #include <limits.h>
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
26 #include "lisp.h"
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
27
2595
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
28 #ifdef HAVE_BIGFLOAT
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
29 #define USED_IF_BIGFLOAT(decl) decl
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
30 #else
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
31 #define USED_IF_BIGFLOAT(decl) UNUSED (decl)
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
32 #endif
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
33
2001
cc5b615380f8 [xemacs-hg @ 2004-04-08 15:23:07 by james]
james
parents: 1996
diff changeset
34 Lisp_Object Qrationalp, Qfloatingp, Qrealp;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
35 Lisp_Object Vdefault_float_precision;
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
36
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
37 static Lisp_Object Qunsupported_type;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
38 static Lisp_Object Vbigfloat_max_prec;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
39 static int number_initialized;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
40
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
41 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
42 bignum scratch_bignum, scratch_bignum2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
43 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
44 #ifdef HAVE_RATIO
4678
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
45 ratio scratch_ratio, scratch_ratio2;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
46 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
47 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
48 bigfloat scratch_bigfloat, scratch_bigfloat2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
49 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
50
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
51 /********************************* Bignums **********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
52 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
53 static void
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
54 bignum_print (Lisp_Object obj, Lisp_Object printcharfun,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
55 int UNUSED (escapeflag))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
56 {
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4883
diff changeset
57 Ascbyte *bstr = bignum_to_string (XBIGNUM_DATA (obj), 10);
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4883
diff changeset
58 write_ascstring (printcharfun, bstr);
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4962
diff changeset
59 xfree (bstr);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
60 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
61
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
62 #ifdef NEW_GC
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
63 static void
5125
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
64 bignum_finalize (void *header)
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
65 {
5125
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
66 struct Lisp_Bignum *num = (struct Lisp_Bignum *) header;
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
67 /* #### WARNING: It would be better to put some sort of check to make
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
68 sure this doesn't happen more than once, just in case ---
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
69 e.g. checking if it's zero before finalizing and then setting it to
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
70 zero after finalizing. */
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
71 bignum_fini (num->data);
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
72 }
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
73 #define BIGNUM_FINALIZE bignum_finalize
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
74 #else
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
75 #define BIGNUM_FINALIZE 0
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
76 #endif
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
77
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
78 static int
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4892
diff changeset
79 bignum_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth),
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4892
diff changeset
80 int UNUSED (foldcase))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
81 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
82 return bignum_eql (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
83 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
84
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
85 static Hashcode
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
86 bignum_hash (Lisp_Object obj, int UNUSED (depth))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
87 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
88 return bignum_hashcode (XBIGNUM_DATA (obj));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
89 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
90
2551
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
91 static void
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
92 bignum_convert (const void *object, void **data, Bytecount *size)
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
93 {
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
94 CIbyte *bstr = bignum_to_string (*(bignum *)object, 10);
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
95 *data = bstr;
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
96 *size = strlen(bstr)+1;
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
97 }
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
98
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
99 static void
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
100 bignum_convfree (const void * UNUSED (object), void *data,
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
101 Bytecount UNUSED (size))
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
102 {
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4962
diff changeset
103 xfree (data);
2551
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
104 }
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
105
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
106 static void *
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
107 bignum_deconvert (void *object, void *data, Bytecount UNUSED (size))
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
108 {
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
109 bignum *b = (bignum *) object;
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
110 bignum_init(*b);
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
111 bignum_set_string(*b, (const char *) data, 10);
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
112 return object;
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
113 }
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
114
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
115 static const struct opaque_convert_functions bignum_opc = {
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
116 bignum_convert,
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
117 bignum_convfree,
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
118 bignum_deconvert
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
119 };
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
120
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
121 static const struct memory_description bignum_description[] = {
2551
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
122 { XD_OPAQUE_DATA_CONVERTIBLE, offsetof (Lisp_Bignum, data),
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
123 0, { &bignum_opc }, XD_FLAG_NO_KKCC },
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
124 { XD_END }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
125 };
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
126
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4678
diff changeset
127 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("bignum", bignum, 0, bignum_print,
5125
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
128 BIGNUM_FINALIZE, bignum_equal,
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
129 bignum_hash, bignum_description,
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
130 Lisp_Bignum);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
131
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
132 #endif /* HAVE_BIGNUM */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
133
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
134 Lisp_Object Qbignump;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
135
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
136 DEFUN ("bignump", Fbignump, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
137 Return t if OBJECT is a bignum, nil otherwise.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
138 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
139 (object))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
140 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
141 return BIGNUMP (object) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
142 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
143
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
144
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
145 /********************************** Ratios **********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
146 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
147 static void
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
148 ratio_print (Lisp_Object obj, Lisp_Object printcharfun,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
149 int UNUSED (escapeflag))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
150 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
151 CIbyte *rstr = ratio_to_string (XRATIO_DATA (obj), 10);
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4883
diff changeset
152 write_ascstring (printcharfun, rstr);
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4962
diff changeset
153 xfree (rstr);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
154 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
155
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
156 #ifdef NEW_GC
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
157 static void
5125
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
158 ratio_finalize (void *header)
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
159 {
5125
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
160 struct Lisp_Ratio *num = (struct Lisp_Ratio *) header;
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
161 /* #### WARNING: It would be better to put some sort of check to make
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
162 sure this doesn't happen more than once, just in case ---
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
163 e.g. checking if it's zero before finalizing and then setting it to
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
164 zero after finalizing. */
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
165 ratio_fini (num->data);
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
166 }
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
167 #define RATIO_FINALIZE ratio_finalize
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
168 #else
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
169 #define RATIO_FINALIZE 0
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
170 #endif
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
171
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
172 static int
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4892
diff changeset
173 ratio_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth),
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4892
diff changeset
174 int UNUSED (foldcase))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
175 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
176 return ratio_eql (XRATIO_DATA (obj1), XRATIO_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
177 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
178
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
179 static Hashcode
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
180 ratio_hash (Lisp_Object obj, int UNUSED (depth))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
181 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
182 return ratio_hashcode (XRATIO_DATA (obj));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
183 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
184
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
185 static const struct memory_description ratio_description[] = {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
186 { XD_OPAQUE_PTR, offsetof (Lisp_Ratio, data) },
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
187 { XD_END }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
188 };
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
189
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4678
diff changeset
190 DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("ratio", ratio, 0, ratio_print,
5125
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
191 RATIO_FINALIZE, ratio_equal, ratio_hash,
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4678
diff changeset
192 ratio_description, Lisp_Ratio);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
193
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
194 #endif /* HAVE_RATIO */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
195
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
196 Lisp_Object Qratiop;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
197
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
198 DEFUN ("ratiop", Fratiop, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
199 Return t if OBJECT is a ratio, nil otherwise.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
200 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
201 (object))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
202 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
203 return RATIOP (object) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
204 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
205
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
206
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
207 /******************************** Rationals *********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
208 DEFUN ("rationalp", Frationalp, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
209 Return t if OBJECT is a rational, nil otherwise.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
210 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
211 (object))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
212 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
213 return RATIONALP (object) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
214 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
215
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
216 DEFUN ("numerator", Fnumerator, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
217 Return the numerator of the canonical form of RATIONAL.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
218 If RATIONAL is an integer, RATIONAL is returned.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
219 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
220 (rational))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
221 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
222 CONCHECK_RATIONAL (rational);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
223 #ifdef HAVE_RATIO
4883
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
224 if (RATIOP (rational))
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
225 {
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
226 return
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
227 Fcanonicalize_number (make_bignum_bg (XRATIO_NUMERATOR (rational)));
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
228 }
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
229 #endif
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
230 return rational;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
231 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
232
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
233 DEFUN ("denominator", Fdenominator, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
234 Return the denominator of the canonical form of RATIONAL.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
235 If RATIONAL is an integer, 1 is returned.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
236 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
237 (rational))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
238 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
239 CONCHECK_RATIONAL (rational);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
240 #ifdef HAVE_RATIO
4883
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
241 if (RATIOP (rational))
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
242 {
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
243 return Fcanonicalize_number (make_bignum_bg
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
244 (XRATIO_DENOMINATOR (rational)));
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
245 }
4892
d1d4ce10c7b4 Fix the build problem in number.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 4886
diff changeset
246 #endif
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
247 return make_int (1);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
248 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
249
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
250
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
251 /******************************** Bigfloats *********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
252 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
253 static void
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
254 bigfloat_print (Lisp_Object obj, Lisp_Object printcharfun,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
255 int UNUSED (escapeflag))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
256 {
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4883
diff changeset
257 Ascbyte *fstr = bigfloat_to_string (XBIGFLOAT_DATA (obj), 10);
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4883
diff changeset
258 write_ascstring (printcharfun, fstr);
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4962
diff changeset
259 xfree (fstr);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
260 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
261
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
262 #ifdef NEW_GC
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
263 static void
5125
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
264 bigfloat_finalize (void *header)
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
265 {
5125
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
266 struct Lisp_Bigfloat *num = (struct Lisp_Bigfloat *) header;
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
267 /* #### WARNING: It would be better to put some sort of check to make
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
268 sure this doesn't happen more than once, just in case ---
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
269 e.g. checking if it's zero before finalizing and then setting it to
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
270 zero after finalizing. */
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
271 bigfloat_fini (num->bf);
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
272 }
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
273 #define BIGFLOAT_FINALIZE bigfloat_finalize
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
274 #else
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
275 #define BIGFLOAT_FINALIZE 0
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
276 #endif
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
277
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
278 static int
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4892
diff changeset
279 bigfloat_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth),
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4892
diff changeset
280 int UNUSED (foldcase))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
281 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
282 return bigfloat_eql (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
283 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
284
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
285 static Hashcode
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
286 bigfloat_hash (Lisp_Object obj, int UNUSED (depth))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
287 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
288 return bigfloat_hashcode (XBIGFLOAT_DATA (obj));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
289 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
290
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
291 static const struct memory_description bigfloat_description[] = {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
292 { XD_OPAQUE_PTR, offsetof (Lisp_Bigfloat, bf) },
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
293 { XD_END }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
294 };
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
295
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4678
diff changeset
296 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("bigfloat", bigfloat, 0,
5125
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
297 bigfloat_print, BIGFLOAT_FINALIZE,
5124
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5118
diff changeset
298 bigfloat_equal, bigfloat_hash,
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5118
diff changeset
299 bigfloat_description, Lisp_Bigfloat);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
300
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
301 #endif /* HAVE_BIGFLOAT */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
302
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
303 Lisp_Object Qbigfloatp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
304
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
305 DEFUN ("bigfloatp", Fbigfloatp, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
306 Return t if OBJECT is a bigfloat, nil otherwise.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
307 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
308 (object))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
309 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
310 return BIGFLOATP (object) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
311 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
312
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
313 DEFUN ("bigfloat-get-precision", Fbigfloat_get_precision, 1, 1, 0, /*
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
314 Return the precision of bigfloat F as an integer.
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
315 */
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
316 (f))
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
317 {
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
318 CHECK_BIGFLOAT (f);
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
319 #ifdef HAVE_BIGNUM
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
320 bignum_set_ulong (scratch_bignum, XBIGFLOAT_GET_PREC (f));
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
321 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
322 #else
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
323 return make_int ((int) XBIGFLOAT_GET_PREC (f));
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
324 #endif
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
325 }
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
326
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
327 DEFUN ("bigfloat-set-precision", Fbigfloat_set_precision, 2, 2, 0, /*
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
328 Set the precision of F, a bigfloat, to PRECISION, a nonnegative integer.
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
329 The new precision of F is returned. Note that the return value may differ
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
330 from PRECISION if the underlying library is unable to support exactly
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
331 PRECISION bits of precision.
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
332 */
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
333 (f, precision))
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
334 {
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
335 unsigned long prec;
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
336
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
337 CHECK_BIGFLOAT (f);
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
338 if (INTP (precision))
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
339 {
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
340 prec = (XINT (precision) <= 0) ? 1UL : (unsigned long) XINT (precision);
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
341 }
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
342 #ifdef HAVE_BIGNUM
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
343 else if (BIGNUMP (precision))
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
344 {
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
345 prec = bignum_fits_ulong_p (XBIGNUM_DATA (precision))
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
346 ? bignum_to_ulong (XBIGNUM_DATA (precision))
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
347 : UINT_MAX;
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
348 }
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
349 #endif
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
350 else
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
351 {
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
352 dead_wrong_type_argument (Qintegerp, f);
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
353 return Qnil;
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
354 }
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
355
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
356 XBIGFLOAT_SET_PREC (f, prec);
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
357 return Fbigfloat_get_precision (f);
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
358 }
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
359
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
360 static int
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
361 default_float_precision_changed (Lisp_Object UNUSED (sym), Lisp_Object *val,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
362 Lisp_Object UNUSED (in_object),
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
363 int UNUSED (flags))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
364 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
365 unsigned long prec;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
366
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
367 CONCHECK_INTEGER (*val);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
368 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
369 if (INTP (*val))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
370 prec = XINT (*val);
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
371 else
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
372 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
373 if (!bignum_fits_ulong_p (XBIGNUM_DATA (*val)))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
374 args_out_of_range_3 (*val, Qzero, Vbigfloat_max_prec);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
375 prec = bignum_to_ulong (XBIGNUM_DATA (*val));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
376 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
377 if (prec != 0UL)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
378 bigfloat_set_default_prec (prec);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
379 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
380 return 0;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
381 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
382
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
383
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
384 /********************************* Floating *********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
385 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
386 make_floating (double d)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
387 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
388 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
389 if (ZEROP (Vdefault_float_precision))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
390 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
391 return make_float (d);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
392 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
393 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
394 return make_bigfloat (d, 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
395 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
396 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
397
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
398 DEFUN ("floatingp", Ffloatingp, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
399 Return t if OBJECT is a floating point number of any kind, nil otherwise.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
400 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
401 (object))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
402 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
403 return FLOATINGP (object) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
404 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
405
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
406
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
407 /********************************** Reals ***********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
408 DEFUN ("realp", Frealp, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
409 Return t if OBJECT is a real, nil otherwise.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
410 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
411 (object))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
412 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
413 return REALP (object) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
414 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
415
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
416
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
417 /********************************* Numbers **********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
418 DEFUN ("canonicalize-number", Fcanonicalize_number, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
419 Return the canonical form of NUMBER.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
420 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
421 (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
422 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
423 /* The tests should go in order from larger, more expressive, or more
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
424 complex types to smaller, less expressive, or simpler types so that a
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
425 number can cascade all the way down to the simplest type if
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
426 appropriate. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
427 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
428 if (RATIOP (number) &&
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
429 bignum_fits_long_p (XRATIO_DENOMINATOR (number)) &&
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
430 bignum_to_long (XRATIO_DENOMINATOR (number)) == 1L)
4883
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
431 number = Fcanonicalize_number (make_bignum_bg (XRATIO_NUMERATOR (number)));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
432 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
433 #ifdef HAVE_BIGNUM
3391
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 3025
diff changeset
434 if (BIGNUMP (number) && bignum_fits_emacs_int_p (XBIGNUM_DATA (number)))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
435 {
3391
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 3025
diff changeset
436 EMACS_INT n = bignum_to_emacs_int (XBIGNUM_DATA (number));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
437 if (NUMBER_FITS_IN_AN_EMACS_INT (n))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
438 number = make_int (n);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
439 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
440 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
441 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
442 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
443
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
444 enum number_type
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
445 get_number_type (Lisp_Object arg)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
446 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
447 if (INTP (arg))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
448 return FIXNUM_T;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
449 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
450 if (BIGNUMP (arg))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
451 return BIGNUM_T;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
452 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
453 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
454 if (RATIOP (arg))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
455 return RATIO_T;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
456 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
457 if (FLOATP (arg))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
458 return FLOAT_T;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
459 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
460 if (BIGFLOATP (arg))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
461 return BIGFLOAT_T;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
462 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
463 /* Catch unintentional bad uses of this function */
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
464 ABORT ();
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
465 /* NOTREACHED */
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
466 return FIXNUM_T;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
467 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
468
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
469 /* Convert NUMBER to type TYPE. If TYPE is BIGFLOAT_T then use the indicated
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
470 PRECISION; otherwise, PRECISION is ignored. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
471 static Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
472 internal_coerce_number (Lisp_Object number, enum number_type type,
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
473 #ifdef HAVE_BIGFLOAT
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
474 unsigned long precision
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
475 #else
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
476 unsigned long UNUSED (precision)
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
477 #endif
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
478 )
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
479 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
480 enum number_type current_type;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
481
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
482 if (CHARP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
483 number = make_int (XCHAR (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
484 else if (MARKERP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
485 number = make_int (marker_position (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
486
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
487 /* Note that CHECK_NUMBER ensures that NUMBER is a supported type. Hence,
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
488 we ABORT() in the #else sections below, because it shouldn't be possible
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
489 to arrive there. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
490 CHECK_NUMBER (number);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
491 current_type = get_number_type (number);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
492 switch (current_type)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
493 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
494 case FIXNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
495 switch (type)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
496 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
497 case FIXNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
498 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
499 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
500 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
501 return make_bignum (XREALINT (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
502 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
503 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
504 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
505 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
506 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
507 return make_ratio (XREALINT (number), 1UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
508 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
509 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
510 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
511 case FLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
512 return make_float (XREALINT (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
513 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
514 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
515 return make_bigfloat (XREALINT (number), precision);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
516 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
517 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
518 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
519 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
520 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
521 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
522 switch (type)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
523 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
524 case FIXNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
525 return make_int (bignum_to_long (XBIGNUM_DATA (number)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
526 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
527 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
528 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
529 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
530 bignum_set_long (scratch_bignum, 1L);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
531 return make_ratio_bg (XBIGNUM_DATA (number), scratch_bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
532 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
533 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
534 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
535 case FLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
536 return make_float (bignum_to_double (XBIGNUM_DATA (number)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
537 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
538 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
539 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
540 Lisp_Object temp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
541 temp = make_bigfloat (0.0, precision);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
542 bigfloat_set_bignum (XBIGFLOAT_DATA (temp), XBIGNUM_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
543 return temp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
544 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
545 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
546 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
547 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
548 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
549 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
550 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
551 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
552 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
553 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
554 switch (type)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
555 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
556 case FIXNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
557 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
558 XRATIO_DENOMINATOR (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
559 return make_int (bignum_to_long (scratch_bignum));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
560 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
561 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
562 XRATIO_DENOMINATOR (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
563 return make_bignum_bg (scratch_bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
564 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
565 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
566 case FLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
567 return make_float (ratio_to_double (XRATIO_DATA (number)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
568 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
569 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
570 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
571 Lisp_Object temp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
572 temp = make_bigfloat (0.0, precision);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
573 bigfloat_set_ratio (XBIGFLOAT_DATA (temp), XRATIO_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
574 return temp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
575 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
576 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
577 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
578 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
579 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
580 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
581 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
582 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
583 case FLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
584 switch (type)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
585 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
586 case FIXNUM_T:
4678
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
587 return Ftruncate (number, Qnil);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
588 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
589 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
590 bignum_set_double (scratch_bignum, XFLOAT_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
591 return make_bignum_bg (scratch_bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
592 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
593 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
594 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
595 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
596 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
597 ratio_set_double (scratch_ratio, XFLOAT_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
598 return make_ratio_rt (scratch_ratio);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
599 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
600 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
601 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
602 case FLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
603 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
604 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
605 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
606 bigfloat_set_prec (scratch_bigfloat, precision);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
607 bigfloat_set_double (scratch_bigfloat, XFLOAT_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
608 return make_bigfloat_bf (scratch_bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
609 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
610 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
611 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
612 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
613 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
614 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
615 switch (type)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
616 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
617 case FIXNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
618 return make_int (bigfloat_to_long (XBIGFLOAT_DATA (number)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
619 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
620 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
621 bignum_set_bigfloat (scratch_bignum, XBIGFLOAT_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
622 return make_bignum_bg (scratch_bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
623 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
624 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
625 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
626 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
627 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
628 ratio_set_bigfloat (scratch_ratio, XBIGFLOAT_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
629 return make_ratio_rt (scratch_ratio);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
630 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
631 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
632 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
633 case FLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
634 return make_float (bigfloat_to_double (XBIGFLOAT_DATA (number)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
635 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
636 /* FIXME: Do we need to change the precision? */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
637 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
638 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
639 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
640 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
641 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
642 }
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
643 ABORT ();
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
644 /* NOTREACHED */
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
645 return Qzero;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
646 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
647
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
648 /* This function promotes its arguments as necessary to make them both the
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
649 same type. It destructively modifies its arguments to do so. Characters
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
650 and markers are ALWAYS converted to integers. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
651 enum number_type
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
652 promote_args (Lisp_Object *arg1, Lisp_Object *arg2)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
653 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
654 enum number_type type1, type2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
655
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
656 if (CHARP (*arg1))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
657 *arg1 = make_int (XCHAR (*arg1));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
658 else if (MARKERP (*arg1))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
659 *arg1 = make_int (marker_position (*arg1));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
660 if (CHARP (*arg2))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
661 *arg2 = make_int (XCHAR (*arg2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
662 else if (MARKERP (*arg2))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
663 *arg2 = make_int (marker_position (*arg2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
664
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
665 CHECK_NUMBER (*arg1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
666 CHECK_NUMBER (*arg2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
667
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
668 type1 = get_number_type (*arg1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
669 type2 = get_number_type (*arg2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
670
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
671 if (type1 < type2)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
672 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
673 *arg1 = internal_coerce_number (*arg1, type2,
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
674 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
675 type2 == BIGFLOAT_T
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
676 ? XBIGFLOAT_GET_PREC (*arg2) :
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
677 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
678 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
679 return type2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
680 }
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
681
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
682 if (type2 < type1)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
683 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
684 *arg2 = internal_coerce_number (*arg2, type1,
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
685 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
686 type1 == BIGFLOAT_T
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
687 ? XBIGFLOAT_GET_PREC (*arg1) :
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
688 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
689 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
690 return type1;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
691 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
692
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
693 /* No conversion necessary */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
694 return type1;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
695 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
696
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
697 DEFUN ("coerce-number", Fcoerce_number, 2, 3, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
698 Convert NUMBER to the indicated type, possibly losing information.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
699 Do not call this function. Use `coerce' instead.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
700
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2595
diff changeset
701 TYPE is one of the symbols `fixnum', `integer', `ratio', `float', or
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2595
diff changeset
702 `bigfloat'. Not all of these types may be supported.
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
703
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
704 PRECISION is the number of bits of precision to use when converting to
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
705 bigfloat; it is ignored otherwise. If nil, the default precision is used.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
706
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
707 Note that some conversions lose information. No error is signaled in such
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
708 cases; the information is silently lost.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
709 */
2595
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
710 (number, type, USED_IF_BIGFLOAT (precision)))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
711 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
712 CHECK_SYMBOL (type);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
713 if (EQ (type, Qfixnum))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
714 return internal_coerce_number (number, FIXNUM_T, 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
715 else if (EQ (type, Qinteger))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
716 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
717 /* If bignums are available, we always convert to one first, then
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
718 downgrade to a fixnum if possible. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
719 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
720 return Fcanonicalize_number
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
721 (internal_coerce_number (number, BIGNUM_T, 0UL));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
722 #else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
723 return internal_coerce_number (number, FIXNUM_T, 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
724 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
725 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
726 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
727 else if (EQ (type, Qratio))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
728 return internal_coerce_number (number, RATIO_T, 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
729 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
730 else if (EQ (type, Qfloat))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
731 return internal_coerce_number (number, FLOAT_T, 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
732 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
733 else if (EQ (type, Qbigfloat))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
734 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
735 unsigned long prec;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
736
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
737 if (NILP (precision))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
738 prec = bigfloat_get_default_prec ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
739 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
740 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
741 CHECK_INTEGER (precision);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
742 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
743 if (INTP (precision))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
744 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
745 prec = (unsigned long) XREALINT (precision);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
746 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
747 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
748 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
749 if (!bignum_fits_ulong_p (XBIGNUM_DATA (precision)))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
750 args_out_of_range (precision, Vbigfloat_max_prec);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
751 prec = bignum_to_ulong (XBIGNUM_DATA (precision));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
752 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
753 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
754 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
755 return internal_coerce_number (number, BIGFLOAT_T, prec);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
756 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
757 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
758
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
759 Fsignal (Qunsupported_type, type);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
760 /* NOTREACHED */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
761 return Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
762 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
763
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
764
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
765 void
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
766 syms_of_number (void)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
767 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
768 #ifdef HAVE_BIGNUM
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3025
diff changeset
769 INIT_LISP_OBJECT (bignum);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
770 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
771 #ifdef HAVE_RATIO
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3025
diff changeset
772 INIT_LISP_OBJECT (ratio);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
773 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
774 #ifdef HAVE_BIGFLOAT
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3025
diff changeset
775 INIT_LISP_OBJECT (bigfloat);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
776 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
777
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
778 /* Type predicates */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
779 DEFSYMBOL (Qrationalp);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
780 DEFSYMBOL (Qfloatingp);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
781 DEFSYMBOL (Qrealp);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
782 DEFSYMBOL (Qbignump);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
783 DEFSYMBOL (Qratiop);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
784 DEFSYMBOL (Qbigfloatp);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
785
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
786 /* Functions */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
787 DEFSUBR (Fbignump);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
788 DEFSUBR (Fratiop);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
789 DEFSUBR (Frationalp);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
790 DEFSUBR (Fnumerator);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
791 DEFSUBR (Fdenominator);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
792 DEFSUBR (Fbigfloatp);
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
793 DEFSUBR (Fbigfloat_get_precision);
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
794 DEFSUBR (Fbigfloat_set_precision);
2001
cc5b615380f8 [xemacs-hg @ 2004-04-08 15:23:07 by james]
james
parents: 1996
diff changeset
795 DEFSUBR (Ffloatingp);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
796 DEFSUBR (Frealp);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
797 DEFSUBR (Fcanonicalize_number);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
798 DEFSUBR (Fcoerce_number);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
799
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
800 /* Errors */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
801 DEFERROR_STANDARD (Qunsupported_type, Qwrong_type_argument);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
802 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
803
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
804 void
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
805 vars_of_number (void)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
806 {
2051
a7dd0aed0fe6 [xemacs-hg @ 2004-04-30 18:59:11 by james]
james
parents: 2019
diff changeset
807 /* These variables are Lisp variables rather than number variables so that
a7dd0aed0fe6 [xemacs-hg @ 2004-04-30 18:59:11 by james]
james
parents: 2019
diff changeset
808 we can put bignums in them. */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
809 DEFVAR_LISP_MAGIC ("default-float-precision", &Vdefault_float_precision, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
810 The default floating-point precision for newly created floating point values.
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
811 This should be 0 to create Lisp float types, or an unsigned integer no greater
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
812 than `bigfloat-maximum-precision' to create Lisp bigfloat types with the
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
813 indicated precision.
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
814 */ default_float_precision_changed);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
815 Vdefault_float_precision = make_int (0);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
816
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
817 DEFVAR_CONST_LISP ("bigfloat-maximum-precision", &Vbigfloat_max_prec /*
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
818 The maximum number of bits of precision a bigfloat can have.
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
819 This is determined by the underlying library used to implement bigfloats.
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
820 */);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
821
2061
b75af0ab66f3 [xemacs-hg @ 2004-05-05 22:09:14 by james]
james
parents: 2057
diff changeset
822 #ifdef HAVE_BIGFLOAT
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
823 /* Don't create a bignum here. Otherwise, we lose with NEW_GC + pdump.
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
824 See reinit_vars_of_number(). */
2061
b75af0ab66f3 [xemacs-hg @ 2004-05-05 22:09:14 by james]
james
parents: 2057
diff changeset
825 Vbigfloat_max_prec = make_int (EMACS_INT_MAX);
b75af0ab66f3 [xemacs-hg @ 2004-05-05 22:09:14 by james]
james
parents: 2057
diff changeset
826 #else
2051
a7dd0aed0fe6 [xemacs-hg @ 2004-04-30 18:59:11 by james]
james
parents: 2019
diff changeset
827 Vbigfloat_max_prec = make_int (0);
a7dd0aed0fe6 [xemacs-hg @ 2004-04-30 18:59:11 by james]
james
parents: 2019
diff changeset
828 #endif /* HAVE_BIGFLOAT */
a7dd0aed0fe6 [xemacs-hg @ 2004-04-30 18:59:11 by james]
james
parents: 2019
diff changeset
829
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
830 Fprovide (intern ("number-types"));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
831 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
832 Fprovide (intern ("bignum"));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
833 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
834 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
835 Fprovide (intern ("ratio"));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
836 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
837 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
838 Fprovide (intern ("bigfloat"));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
839 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
840 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
841
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
842 void
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
843 reinit_vars_of_number (void)
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
844 {
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
845 #if defined(HAVE_BIGFLOAT) && defined(HAVE_BIGNUM)
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
846 Vbigfloat_max_prec = make_bignum (0L);
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
847 bignum_set_ulong (XBIGNUM_DATA (Vbigfloat_max_prec), ULONG_MAX);
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
848 #endif
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
849 }
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
850
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
851 void
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
852 init_number (void)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
853 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
854 if (!number_initialized)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
855 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
856 number_initialized = 1;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
857
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
858 #ifdef WITH_GMP
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
859 init_number_gmp ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
860 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
861 #ifdef WITH_MP
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
862 init_number_mp ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
863 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
864
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
865 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
866 bignum_init (scratch_bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
867 bignum_init (scratch_bignum2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
868 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
869
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
870 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
871 ratio_init (scratch_ratio);
4678
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
872 ratio_init (scratch_ratio2);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
873 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
874
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
875 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
876 bigfloat_init (scratch_bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
877 bigfloat_init (scratch_bigfloat2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
878 #endif
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
879
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
880 #ifndef PDUMP
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
881 reinit_vars_of_number ();
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
882 #endif
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
883 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
884 }