Mercurial > hg > xemacs-beta
annotate src/number.c @ 4976:16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-04 Ben Wing <ben@xemacs.org>
* alloc.c (release_breathing_space):
* alloc.c (resize_string):
* alloc.c (sweep_lcrecords_1):
* alloc.c (SWEEP_FIXED_TYPE_BLOCK_1):
* alloc.c (ADDITIONAL_FREE_compiled_function):
* alloc.c (compact_string_chars):
* alloc.c (ADDITIONAL_FREE_string):
* alloc.c (sweep_strings):
* alloca.c (xemacs_c_alloca):
* alsaplay.c (alsa_play_sound_file):
* buffer.c (init_initial_directory):
* buffer.h:
* buffer.h (BUFFER_FREE):
* console-stream.c (stream_delete_console):
* console-tty.c (free_tty_console_struct):
* data.c (Fnumber_to_string):
* device-gtk.c (gtk_init_device):
* device-gtk.c (free_gtk_device_struct):
* device-gtk.c (gtk_delete_device):
* device-msw.c (mswindows_delete_device):
* device-msw.c (msprinter_delete_device):
* device-tty.c (free_tty_device_struct):
* device-tty.c (tty_delete_device):
* device-x.c (x_init_device):
* device-x.c (free_x_device_struct):
* device-x.c (x_delete_device):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-x.c (dbox_descriptor_to_widget_value):
* dired-msw.c (Fmswindows_insert_directory):
* dired.c (free_user_cache):
* dired.c (user_name_completion_unwind):
* doc.c (unparesseuxify_doc_string):
* doc.c (Fsubstitute_command_keys):
* doprnt.c (emacs_doprnt_1):
* dumper.c (pdump_load_finish):
* dumper.c (pdump_file_free):
* dumper.c (pdump_file_unmap):
* dynarr.c:
* dynarr.c (Dynarr_free):
* editfns.c (uncache_home_directory):
* editfns.c (Fset_time_zone_rule):
* elhash.c:
* elhash.c (pdump_reorganize_hash_table):
* elhash.c (maphash_unwind):
* emacs.c (make_arg_list_1):
* emacs.c (free_argc_argv):
* emacs.c (sort_args):
* emacs.c (Frunning_temacs_p):
* emodules.c (attempt_module_delete):
* eval.c (free_pointer):
* event-Xt.c (unselect_filedesc):
* event-Xt.c (emacs_Xt_select_process):
* event-gtk.c (unselect_filedesc):
* event-gtk.c (dragndrop_data_received):
* event-msw.c (winsock_closer):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (mswindows_wnd_proc):
* event-stream.c (finalize_command_builder):
* event-stream.c (free_command_builder):
* extents.c (free_gap_array):
* extents.c (free_extent_list):
* extents.c (free_soe):
* extents.c (extent_fragment_delete):
* extents.c (extent_priority_sort_function):
* file-coding.c (make_coding_system_1):
* file-coding.c (coding_finalizer):
* file-coding.c (set_coding_stream_coding_system):
* file-coding.c (chain_finalize_coding_stream_1):
* file-coding.c (chain_finalize):
* file-coding.c (free_detection_state):
* file-coding.c (coding_category_symbol_to_id):
* fileio.c:
* fileio.c (Ffile_name_directory):
* fileio.c (if):
* fileio.c (Ffile_symlink_p):
* filelock.c (FREE_LOCK_INFO):
* filelock.c (current_lock_owner):
* font-mgr.c (Ffc_name_unparse):
* font-mgr.c (Ffc_pattern_duplicate):
* frame-gtk.c (gtk_delete_frame):
* frame-msw.c (mswindows_delete_frame):
* frame-msw.c (msprinter_delete_frame):
* frame-x.c (x_cde_destroy_callback):
* frame-x.c (Fcde_start_drag_internal):
* frame-x.c (x_cde_transfer_callback):
* frame-x.c (x_delete_frame):
* frame.c (update_frame_title):
* frame.c (Fset_frame_pointer):
* gc.c (register_for_finalization):
* gccache-gtk.c (free_gc_cache):
* gccache-gtk.c (gc_cache_lookup):
* gccache-x.c (free_gc_cache):
* gccache-x.c (gc_cache_lookup):
* glyphs-eimage.c:
* glyphs-eimage.c (jpeg_instantiate_unwind):
* glyphs-eimage.c (gif_instantiate_unwind):
* glyphs-eimage.c (png_instantiate_unwind):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate_unwind):
* glyphs-gtk.c (convert_EImage_to_GDKImage):
* glyphs-gtk.c (gtk_finalize_image_instance):
* glyphs-gtk.c (gtk_init_image_instance_from_eimage):
* glyphs-gtk.c (gtk_xpm_instantiate):
* glyphs-msw.c (convert_EImage_to_DIBitmap):
* glyphs-msw.c (mswindows_init_image_instance_from_eimage):
* glyphs-msw.c (mswindows_initialize_image_instance_mask):
* glyphs-msw.c (xpm_to_eimage):
* glyphs-msw.c (mswindows_xpm_instantiate):
* glyphs-msw.c (xbm_create_bitmap_from_data):
* glyphs-msw.c (mswindows_finalize_image_instance):
* glyphs-x.c (convert_EImage_to_XImage):
* glyphs-x.c (x_finalize_image_instance):
* glyphs-x.c (x_init_image_instance_from_eimage):
* glyphs-x.c (x_xpm_instantiate):
* gui-x.c (free_popup_widget_value_tree):
* hash.c (free_hash_table):
* hash.c (grow_hash_table):
* hash.c (pregrow_hash_table_if_necessary):
* imgproc.c (build_EImage_quantable):
* insdel.c (uninit_buffer_text):
* intl-win32.c (convert_multibyte_to_internal_malloc):
* intl.c:
* intl.c (Fset_current_locale):
* keymap.c:
* keymap.c (where_is_recursive_mapper):
* keymap.c (where_is_internal):
* lisp.h:
* lisp.h (xfree):
* lstream.c (Lstream_close):
* lstream.c (resizing_buffer_closer):
* mule-coding.c:
* mule-coding.c (iso2022_finalize_detection_state):
* nt.c:
* nt.c (mswindows_get_long_filename):
* nt.c (nt_get_resource):
* nt.c (init_mswindows_environment):
* nt.c (get_cached_volume_information):
* nt.c (mswindows_opendir):
* nt.c (mswindows_closedir):
* nt.c (mswindows_readdir):
* nt.c (mswindows_stat):
* nt.c (mswindows_getdcwd):
* nt.c (Fmswindows_long_file_name):
* ntplay.c (nt_play_sound_file):
* ntplay.c (play_sound_data_1):
* number-gmp.c (gmp_free):
* number-gmp.c (init_number_gmp):
* number-mp.c (bignum_to_string):
* number-mp.c (BIGNUM_TO_TYPE):
* number.c (bignum_print):
* number.c (bignum_convfree):
* number.c (ratio_print):
* number.c (bigfloat_print):
* number.c (bigfloat_finalize):
* objects-gtk.c (gtk_finalize_color_instance):
* objects-gtk.c (gtk_finalize_font_instance):
* objects-msw.c (mswindows_finalize_color_instance):
* objects-msw.c (mswindows_finalize_font_instance):
* objects-tty.c (tty_finalize_color_instance):
* objects-tty.c (tty_finalize_font_instance):
* objects-tty.c (tty_font_list):
* objects-x.c (x_finalize_color_instance):
* objects-x.c (x_finalize_font_instance):
* process.c:
* process.c (finalize_process):
* realpath.c:
* redisplay.c (add_propagation_runes):
* regex.c:
* regex.c (xfree):
* regex.c (REGEX_FREE_STACK):
* regex.c (FREE_STACK_RETURN):
* regex.c (regex_compile):
* regex.c (regexec):
* regex.c (regfree):
* scrollbar-gtk.c (gtk_free_scrollbar_instance):
* scrollbar-gtk.c (gtk_release_scrollbar_instance):
* scrollbar-msw.c (mswindows_free_scrollbar_instance):
* scrollbar-msw.c (unshow_that_mofo):
* scrollbar-x.c (x_free_scrollbar_instance):
* scrollbar-x.c (x_release_scrollbar_instance):
* select-gtk.c (emacs_gtk_selection_handle):
* select-msw.c (mswindows_own_selection):
* select-x.c:
* select-x.c (x_handle_selection_request):
* select-x.c (unexpect_property_change):
* select-x.c (x_handle_property_notify):
* select-x.c (receive_incremental_selection):
* select-x.c (x_get_window_property_as_lisp_data):
* select-x.c (Fx_get_cutbuffer_internal):
* specifier.c (finalize_specifier):
* syntax.c (uninit_buffer_syntax_cache):
* sysdep.c (qxe_allocating_getcwd):
* sysdep.c (qxe_lstat):
* sysdep.c (copy_in_passwd):
* sysdep.c (qxe_ctime):
* sysdep.c (closedir):
* sysdep.c (DIRSIZ):
* termcap.c (tgetent):
* termcap.c (tprint):
* tests.c (Ftest_data_format_conversion):
* text.c (new_dfc_convert_copy_data):
* text.h (eifree):
* text.h (eito_alloca):
* text.h (eito_external):
* toolbar-msw.c (mswindows_output_toolbar):
* ui-gtk.c (CONVERT_RETVAL):
* ui-gtk.c (__allocate_object_storage):
* unicode.c (free_from_unicode_table):
* unicode.c (free_to_unicode_table):
* unicode.c (free_charset_unicode_tables):
* win32.c (mswindows_read_link_1):
Rename: xfree(VAL, TYPE)->xfree(VAL)
Command used:
gr 'xfree *\((.*),.*\);' 'xfree (\1);' *.[ch]
Followed by grepping for 'xfree.*,' and fixing anything left.
Rationale: Having to specify the TYPE argument is annoying and
error-prone. It was originally put in to work around warnings
due to strict aliasing but years and years ago I rewrote it
in a way that doesn't use the TYPE argument at all and no one
has complained since then. (And anyway, XEmacs is far from
ever being in compliance with strict aliasing and would require
far-reaching changes to get that way.)
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Thu, 04 Feb 2010 07:28:14 -0600 |
parents | e813cf16c015 |
children | b5df3737028a |
rev | line source |
---|---|
1983 | 1 /* Numeric types for XEmacs. |
2 Copyright (C) 2004 Jerry James. | |
3 | |
4 This file is part of XEmacs. | |
5 | |
6 XEmacs is free software; you can redistribute it and/or modify it | |
7 under the terms of the GNU General Public License as published by the | |
8 Free Software Foundation; either version 2, or (at your option) any | |
9 later version. | |
10 | |
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
14 for more details. | |
15 | |
16 You should have received a copy of the GNU General Public License | |
17 along with XEmacs; see the file COPYING. If not, write to | |
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
18 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
|
19 Boston, MA 02111-1301, USA. */ |
1983 | 20 |
21 /* Synched up with: Not in FSF. */ | |
22 | |
23 #include <config.h> | |
24 #include <limits.h> | |
25 #include "lisp.h" | |
26 | |
2595 | 27 #ifdef HAVE_BIGFLOAT |
28 #define USED_IF_BIGFLOAT(decl) decl | |
29 #else | |
30 #define USED_IF_BIGFLOAT(decl) UNUSED (decl) | |
31 #endif | |
32 | |
2001 | 33 Lisp_Object Qrationalp, Qfloatingp, Qrealp; |
1983 | 34 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
|
35 |
1983 | 36 static Lisp_Object Qunsupported_type; |
37 static Lisp_Object Vbigfloat_max_prec; | |
38 static int number_initialized; | |
39 | |
40 #ifdef HAVE_BIGNUM | |
41 bignum scratch_bignum, scratch_bignum2; | |
42 #endif | |
43 #ifdef HAVE_RATIO | |
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3391
diff
changeset
|
44 ratio scratch_ratio, scratch_ratio2; |
1983 | 45 #endif |
46 #ifdef HAVE_BIGFLOAT | |
47 bigfloat scratch_bigfloat, scratch_bigfloat2; | |
48 #endif | |
49 | |
50 /********************************* Bignums **********************************/ | |
51 #ifdef HAVE_BIGNUM | |
52 static void | |
2286 | 53 bignum_print (Lisp_Object obj, Lisp_Object printcharfun, |
54 int UNUSED (escapeflag)) | |
1983 | 55 { |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4883
diff
changeset
|
56 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
|
57 write_ascstring (printcharfun, bstr); |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
58 xfree (bstr); |
1983 | 59 } |
60 | |
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
61 #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
|
62 static void |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
63 bignum_finalize (void *header, int for_disksave) |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
64 { |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
65 if (!for_disksave) |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
66 { |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
67 struct Lisp_Bignum *num = (struct Lisp_Bignum *) header; |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
68 bignum_fini (num->data); |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
69 } |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
70 } |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
71 #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
|
72 #else |
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 0 |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
74 #endif |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
75 |
1983 | 76 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
|
77 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
|
78 int UNUSED (foldcase)) |
1983 | 79 { |
80 return bignum_eql (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2)); | |
81 } | |
82 | |
83 static Hashcode | |
2286 | 84 bignum_hash (Lisp_Object obj, int UNUSED (depth)) |
1983 | 85 { |
86 return bignum_hashcode (XBIGNUM_DATA (obj)); | |
87 } | |
88 | |
2551 | 89 static void |
90 bignum_convert (const void *object, void **data, Bytecount *size) | |
91 { | |
92 CIbyte *bstr = bignum_to_string (*(bignum *)object, 10); | |
93 *data = bstr; | |
94 *size = strlen(bstr)+1; | |
95 } | |
96 | |
97 static void | |
98 bignum_convfree (const void * UNUSED (object), void *data, | |
99 Bytecount UNUSED (size)) | |
100 { | |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
101 xfree (data); |
2551 | 102 } |
103 | |
104 static void * | |
105 bignum_deconvert (void *object, void *data, Bytecount UNUSED (size)) | |
106 { | |
107 bignum *b = (bignum *) object; | |
108 bignum_init(*b); | |
109 bignum_set_string(*b, (const char *) data, 10); | |
110 return object; | |
111 } | |
112 | |
113 static const struct opaque_convert_functions bignum_opc = { | |
114 bignum_convert, | |
115 bignum_convfree, | |
116 bignum_deconvert | |
117 }; | |
118 | |
1983 | 119 static const struct memory_description bignum_description[] = { |
2551 | 120 { XD_OPAQUE_DATA_CONVERTIBLE, offsetof (Lisp_Bignum, data), |
121 0, { &bignum_opc }, XD_FLAG_NO_KKCC }, | |
1983 | 122 { XD_END } |
123 }; | |
124 | |
2551 | 125 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bignum", bignum, 1, 0, bignum_print, |
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
126 BIGNUM_FINALIZE, bignum_equal, |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
127 bignum_hash, bignum_description, |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
128 Lisp_Bignum); |
1983 | 129 |
2092 | 130 #endif /* HAVE_BIGNUM */ |
1983 | 131 |
132 Lisp_Object Qbignump; | |
133 | |
134 DEFUN ("bignump", Fbignump, 1, 1, 0, /* | |
135 Return t if OBJECT is a bignum, nil otherwise. | |
136 */ | |
137 (object)) | |
138 { | |
139 return BIGNUMP (object) ? Qt : Qnil; | |
140 } | |
141 | |
142 | |
143 /********************************** Ratios **********************************/ | |
144 #ifdef HAVE_RATIO | |
145 static void | |
2286 | 146 ratio_print (Lisp_Object obj, Lisp_Object printcharfun, |
147 int UNUSED (escapeflag)) | |
1983 | 148 { |
149 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
|
150 write_ascstring (printcharfun, rstr); |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
151 xfree (rstr); |
1983 | 152 } |
153 | |
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
154 #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
|
155 static void |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
156 ratio_finalize (void *header, int for_disksave) |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
157 { |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
158 if (!for_disksave) |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
159 { |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
160 struct Lisp_Ratio *num = (struct Lisp_Ratio *) header; |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
161 ratio_fini (num->data); |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
162 } |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
163 } |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
164 #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
|
165 #else |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
166 #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
|
167 #endif |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
168 |
1983 | 169 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
|
170 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
|
171 int UNUSED (foldcase)) |
1983 | 172 { |
173 return ratio_eql (XRATIO_DATA (obj1), XRATIO_DATA (obj2)); | |
174 } | |
175 | |
176 static Hashcode | |
2286 | 177 ratio_hash (Lisp_Object obj, int UNUSED (depth)) |
1983 | 178 { |
179 return ratio_hashcode (XRATIO_DATA (obj)); | |
180 } | |
181 | |
182 static const struct memory_description ratio_description[] = { | |
183 { XD_OPAQUE_PTR, offsetof (Lisp_Ratio, data) }, | |
184 { XD_END } | |
185 }; | |
186 | |
2061 | 187 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("ratio", ratio, 0, 0, ratio_print, |
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
188 RATIO_FINALIZE, ratio_equal, ratio_hash, |
2061 | 189 ratio_description, Lisp_Ratio); |
1983 | 190 |
2092 | 191 #endif /* HAVE_RATIO */ |
1983 | 192 |
193 Lisp_Object Qratiop; | |
194 | |
195 DEFUN ("ratiop", Fratiop, 1, 1, 0, /* | |
196 Return t if OBJECT is a ratio, nil otherwise. | |
197 */ | |
198 (object)) | |
199 { | |
200 return RATIOP (object) ? Qt : Qnil; | |
201 } | |
202 | |
203 | |
204 /******************************** Rationals *********************************/ | |
205 DEFUN ("rationalp", Frationalp, 1, 1, 0, /* | |
206 Return t if OBJECT is a rational, nil otherwise. | |
207 */ | |
208 (object)) | |
209 { | |
210 return RATIONALP (object) ? Qt : Qnil; | |
211 } | |
212 | |
213 DEFUN ("numerator", Fnumerator, 1, 1, 0, /* | |
214 Return the numerator of the canonical form of RATIONAL. | |
215 If RATIONAL is an integer, RATIONAL is returned. | |
216 */ | |
217 (rational)) | |
218 { | |
219 CONCHECK_RATIONAL (rational); | |
220 #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
|
221 if (RATIOP (rational)) |
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
222 { |
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
223 return |
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
224 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
|
225 } |
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
226 #endif |
1983 | 227 return rational; |
228 } | |
229 | |
230 DEFUN ("denominator", Fdenominator, 1, 1, 0, /* | |
231 Return the denominator of the canonical form of RATIONAL. | |
232 If RATIONAL is an integer, 1 is returned. | |
233 */ | |
234 (rational)) | |
235 { | |
236 CONCHECK_RATIONAL (rational); | |
237 #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
|
238 if (RATIOP (rational)) |
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
239 { |
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
240 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
|
241 (XRATIO_DENOMINATOR (rational))); |
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
242 } |
4892
d1d4ce10c7b4
Fix the build problem in number.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
4886
diff
changeset
|
243 #endif |
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
244 return make_int (1); |
1983 | 245 } |
246 | |
247 | |
248 /******************************** Bigfloats *********************************/ | |
249 #ifdef HAVE_BIGFLOAT | |
250 static void | |
2286 | 251 bigfloat_print (Lisp_Object obj, Lisp_Object printcharfun, |
252 int UNUSED (escapeflag)) | |
1983 | 253 { |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4883
diff
changeset
|
254 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
|
255 write_ascstring (printcharfun, fstr); |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
256 xfree (fstr); |
1983 | 257 } |
258 | |
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
259 #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
|
260 static void |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
261 bigfloat_finalize (void *header, int for_disksave) |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
262 { |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
263 if (!for_disksave) |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
264 { |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
265 struct Lisp_Bigfloat *num = (struct Lisp_Bigfloat *) header; |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
266 bigfloat_fini (num->bf); |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
267 } |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
268 } |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
269 #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
|
270 #else |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
271 #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
|
272 #endif |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
273 |
1983 | 274 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
|
275 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
|
276 int UNUSED (foldcase)) |
1983 | 277 { |
278 return bigfloat_eql (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2)); | |
279 } | |
280 | |
281 static Hashcode | |
2286 | 282 bigfloat_hash (Lisp_Object obj, int UNUSED (depth)) |
1983 | 283 { |
284 return bigfloat_hashcode (XBIGFLOAT_DATA (obj)); | |
285 } | |
286 | |
287 static const struct memory_description bigfloat_description[] = { | |
288 { XD_OPAQUE_PTR, offsetof (Lisp_Bigfloat, bf) }, | |
289 { XD_END } | |
290 }; | |
291 | |
2061 | 292 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bigfloat", bigfloat, 1, 0, |
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
293 bigfloat_print, BIGFLOAT_FINALIZE, |
2061 | 294 bigfloat_equal, bigfloat_hash, |
295 bigfloat_description, Lisp_Bigfloat); | |
1983 | 296 |
2092 | 297 #endif /* HAVE_BIGFLOAT */ |
1983 | 298 |
299 Lisp_Object Qbigfloatp; | |
300 | |
301 DEFUN ("bigfloatp", Fbigfloatp, 1, 1, 0, /* | |
302 Return t if OBJECT is a bigfloat, nil otherwise. | |
303 */ | |
304 (object)) | |
305 { | |
306 return BIGFLOATP (object) ? Qt : Qnil; | |
307 } | |
308 | |
2092 | 309 DEFUN ("bigfloat-get-precision", Fbigfloat_get_precision, 1, 1, 0, /* |
310 Return the precision of bigfloat F as an integer. | |
311 */ | |
312 (f)) | |
313 { | |
314 CHECK_BIGFLOAT (f); | |
315 #ifdef HAVE_BIGNUM | |
316 bignum_set_ulong (scratch_bignum, XBIGFLOAT_GET_PREC (f)); | |
317 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); | |
318 #else | |
319 return make_int ((int) XBIGFLOAT_GET_PREC (f)); | |
320 #endif | |
321 } | |
322 | |
323 DEFUN ("bigfloat-set-precision", Fbigfloat_set_precision, 2, 2, 0, /* | |
324 Set the precision of F, a bigfloat, to PRECISION, a nonnegative integer. | |
325 The new precision of F is returned. Note that the return value may differ | |
326 from PRECISION if the underlying library is unable to support exactly | |
327 PRECISION bits of precision. | |
328 */ | |
329 (f, precision)) | |
330 { | |
331 unsigned long prec; | |
332 | |
333 CHECK_BIGFLOAT (f); | |
334 if (INTP (precision)) | |
335 { | |
336 prec = (XINT (precision) <= 0) ? 1UL : (unsigned long) XINT (precision); | |
337 } | |
338 #ifdef HAVE_BIGNUM | |
339 else if (BIGNUMP (precision)) | |
340 { | |
341 prec = bignum_fits_ulong_p (XBIGNUM_DATA (precision)) | |
342 ? bignum_to_ulong (XBIGNUM_DATA (precision)) | |
343 : UINT_MAX; | |
344 } | |
345 #endif | |
346 else | |
347 { | |
348 dead_wrong_type_argument (Qintegerp, f); | |
349 return Qnil; | |
350 } | |
351 | |
352 XBIGFLOAT_SET_PREC (f, prec); | |
353 return Fbigfloat_get_precision (f); | |
354 } | |
355 | |
1983 | 356 static int |
2286 | 357 default_float_precision_changed (Lisp_Object UNUSED (sym), Lisp_Object *val, |
358 Lisp_Object UNUSED (in_object), | |
359 int UNUSED (flags)) | |
1983 | 360 { |
361 unsigned long prec; | |
362 | |
363 CONCHECK_INTEGER (*val); | |
364 #ifdef HAVE_BIGFLOAT | |
365 if (INTP (*val)) | |
366 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
|
367 else |
1983 | 368 { |
369 if (!bignum_fits_ulong_p (XBIGNUM_DATA (*val))) | |
370 args_out_of_range_3 (*val, Qzero, Vbigfloat_max_prec); | |
371 prec = bignum_to_ulong (XBIGNUM_DATA (*val)); | |
372 } | |
373 if (prec != 0UL) | |
374 bigfloat_set_default_prec (prec); | |
375 #endif | |
376 return 0; | |
377 } | |
378 | |
379 | |
380 /********************************* Floating *********************************/ | |
381 Lisp_Object | |
382 make_floating (double d) | |
383 { | |
384 #ifdef HAVE_BIGFLOAT | |
385 if (ZEROP (Vdefault_float_precision)) | |
386 #endif | |
387 return make_float (d); | |
388 #ifdef HAVE_BIGFLOAT | |
389 else | |
390 return make_bigfloat (d, 0UL); | |
391 #endif | |
392 } | |
393 | |
394 DEFUN ("floatingp", Ffloatingp, 1, 1, 0, /* | |
395 Return t if OBJECT is a floating point number of any kind, nil otherwise. | |
396 */ | |
397 (object)) | |
398 { | |
399 return FLOATINGP (object) ? Qt : Qnil; | |
400 } | |
401 | |
402 | |
403 /********************************** Reals ***********************************/ | |
404 DEFUN ("realp", Frealp, 1, 1, 0, /* | |
405 Return t if OBJECT is a real, nil otherwise. | |
406 */ | |
407 (object)) | |
408 { | |
409 return REALP (object) ? Qt : Qnil; | |
410 } | |
411 | |
412 | |
413 /********************************* Numbers **********************************/ | |
414 DEFUN ("canonicalize-number", Fcanonicalize_number, 1, 1, 0, /* | |
415 Return the canonical form of NUMBER. | |
416 */ | |
417 (number)) | |
418 { | |
419 /* The tests should go in order from larger, more expressive, or more | |
420 complex types to smaller, less expressive, or simpler types so that a | |
421 number can cascade all the way down to the simplest type if | |
422 appropriate. */ | |
423 #ifdef HAVE_RATIO | |
424 if (RATIOP (number) && | |
425 bignum_fits_long_p (XRATIO_DENOMINATOR (number)) && | |
426 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
|
427 number = Fcanonicalize_number (make_bignum_bg (XRATIO_NUMERATOR (number))); |
1983 | 428 #endif |
429 #ifdef HAVE_BIGNUM | |
3391 | 430 if (BIGNUMP (number) && bignum_fits_emacs_int_p (XBIGNUM_DATA (number))) |
1983 | 431 { |
3391 | 432 EMACS_INT n = bignum_to_emacs_int (XBIGNUM_DATA (number)); |
1983 | 433 if (NUMBER_FITS_IN_AN_EMACS_INT (n)) |
434 number = make_int (n); | |
435 } | |
436 #endif | |
437 return number; | |
438 } | |
439 | |
440 enum number_type | |
441 get_number_type (Lisp_Object arg) | |
442 { | |
443 if (INTP (arg)) | |
444 return FIXNUM_T; | |
445 #ifdef HAVE_BIGNUM | |
446 if (BIGNUMP (arg)) | |
447 return BIGNUM_T; | |
448 #endif | |
449 #ifdef HAVE_RATIO | |
450 if (RATIOP (arg)) | |
451 return RATIO_T; | |
452 #endif | |
453 if (FLOATP (arg)) | |
454 return FLOAT_T; | |
455 #ifdef HAVE_BIGFLOAT | |
456 if (BIGFLOATP (arg)) | |
457 return BIGFLOAT_T; | |
458 #endif | |
459 /* Catch unintentional bad uses of this function */ | |
2500 | 460 ABORT (); |
1995 | 461 /* NOTREACHED */ |
462 return FIXNUM_T; | |
1983 | 463 } |
464 | |
465 /* Convert NUMBER to type TYPE. If TYPE is BIGFLOAT_T then use the indicated | |
466 PRECISION; otherwise, PRECISION is ignored. */ | |
467 static Lisp_Object | |
468 internal_coerce_number (Lisp_Object number, enum number_type type, | |
2286 | 469 #ifdef HAVE_BIGFLOAT |
470 unsigned long precision | |
471 #else | |
472 unsigned long UNUSED (precision) | |
473 #endif | |
474 ) | |
1983 | 475 { |
476 enum number_type current_type; | |
477 | |
478 if (CHARP (number)) | |
479 number = make_int (XCHAR (number)); | |
480 else if (MARKERP (number)) | |
481 number = make_int (marker_position (number)); | |
482 | |
483 /* Note that CHECK_NUMBER ensures that NUMBER is a supported type. Hence, | |
2500 | 484 we ABORT() in the #else sections below, because it shouldn't be possible |
1983 | 485 to arrive there. */ |
486 CHECK_NUMBER (number); | |
487 current_type = get_number_type (number); | |
488 switch (current_type) | |
489 { | |
490 case FIXNUM_T: | |
491 switch (type) | |
492 { | |
493 case FIXNUM_T: | |
494 return number; | |
495 case BIGNUM_T: | |
496 #ifdef HAVE_BIGNUM | |
497 return make_bignum (XREALINT (number)); | |
498 #else | |
2500 | 499 ABORT (); |
1983 | 500 #endif /* HAVE_BIGNUM */ |
501 case RATIO_T: | |
502 #ifdef HAVE_RATIO | |
503 return make_ratio (XREALINT (number), 1UL); | |
504 #else | |
2500 | 505 ABORT (); |
1983 | 506 #endif /* HAVE_RATIO */ |
507 case FLOAT_T: | |
508 return make_float (XREALINT (number)); | |
509 case BIGFLOAT_T: | |
510 #ifdef HAVE_BIGFLOAT | |
511 return make_bigfloat (XREALINT (number), precision); | |
512 #else | |
2500 | 513 ABORT (); |
1983 | 514 #endif /* HAVE_BIGFLOAT */ |
515 } | |
516 case BIGNUM_T: | |
517 #ifdef HAVE_BIGNUM | |
518 switch (type) | |
519 { | |
520 case FIXNUM_T: | |
521 return make_int (bignum_to_long (XBIGNUM_DATA (number))); | |
522 case BIGNUM_T: | |
523 return number; | |
524 case RATIO_T: | |
525 #ifdef HAVE_RATIO | |
526 bignum_set_long (scratch_bignum, 1L); | |
527 return make_ratio_bg (XBIGNUM_DATA (number), scratch_bignum); | |
528 #else | |
2500 | 529 ABORT (); |
1983 | 530 #endif /* HAVE_RATIO */ |
531 case FLOAT_T: | |
532 return make_float (bignum_to_double (XBIGNUM_DATA (number))); | |
533 case BIGFLOAT_T: | |
534 #ifdef HAVE_BIGFLOAT | |
535 { | |
536 Lisp_Object temp; | |
537 temp = make_bigfloat (0.0, precision); | |
538 bigfloat_set_bignum (XBIGFLOAT_DATA (temp), XBIGNUM_DATA (number)); | |
539 return temp; | |
540 } | |
541 #else | |
2500 | 542 ABORT (); |
1983 | 543 #endif /* HAVE_BIGFLOAT */ |
544 } | |
545 #else | |
2500 | 546 ABORT (); |
1983 | 547 #endif /* HAVE_BIGNUM */ |
548 case RATIO_T: | |
549 #ifdef HAVE_RATIO | |
550 switch (type) | |
551 { | |
552 case FIXNUM_T: | |
553 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number), | |
554 XRATIO_DENOMINATOR (number)); | |
555 return make_int (bignum_to_long (scratch_bignum)); | |
556 case BIGNUM_T: | |
557 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number), | |
558 XRATIO_DENOMINATOR (number)); | |
559 return make_bignum_bg (scratch_bignum); | |
560 case RATIO_T: | |
561 return number; | |
562 case FLOAT_T: | |
563 return make_float (ratio_to_double (XRATIO_DATA (number))); | |
564 case BIGFLOAT_T: | |
565 #ifdef HAVE_BIGFLOAT | |
566 { | |
567 Lisp_Object temp; | |
568 temp = make_bigfloat (0.0, precision); | |
569 bigfloat_set_ratio (XBIGFLOAT_DATA (temp), XRATIO_DATA (number)); | |
570 return temp; | |
571 } | |
572 #else | |
2500 | 573 ABORT (); |
1983 | 574 #endif /* HAVE_BIGFLOAT */ |
575 } | |
576 #else | |
2500 | 577 ABORT (); |
1983 | 578 #endif /* HAVE_RATIO */ |
579 case FLOAT_T: | |
580 switch (type) | |
581 { | |
582 case FIXNUM_T: | |
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3391
diff
changeset
|
583 return Ftruncate (number, Qnil); |
1983 | 584 case BIGNUM_T: |
585 #ifdef HAVE_BIGNUM | |
586 bignum_set_double (scratch_bignum, XFLOAT_DATA (number)); | |
587 return make_bignum_bg (scratch_bignum); | |
588 #else | |
2500 | 589 ABORT (); |
1983 | 590 #endif /* HAVE_BIGNUM */ |
591 case RATIO_T: | |
592 #ifdef HAVE_RATIO | |
593 ratio_set_double (scratch_ratio, XFLOAT_DATA (number)); | |
594 return make_ratio_rt (scratch_ratio); | |
595 #else | |
2500 | 596 ABORT (); |
1983 | 597 #endif /* HAVE_RATIO */ |
598 case FLOAT_T: | |
599 return number; | |
600 case BIGFLOAT_T: | |
601 #ifdef HAVE_BIGFLOAT | |
602 bigfloat_set_prec (scratch_bigfloat, precision); | |
603 bigfloat_set_double (scratch_bigfloat, XFLOAT_DATA (number)); | |
604 return make_bigfloat_bf (scratch_bigfloat); | |
605 #else | |
2500 | 606 ABORT (); |
1983 | 607 #endif /* HAVE_BIGFLOAT */ |
608 } | |
609 case BIGFLOAT_T: | |
610 #ifdef HAVE_BIGFLOAT | |
611 switch (type) | |
612 { | |
613 case FIXNUM_T: | |
614 return make_int (bigfloat_to_long (XBIGFLOAT_DATA (number))); | |
615 case BIGNUM_T: | |
616 #ifdef HAVE_BIGNUM | |
617 bignum_set_bigfloat (scratch_bignum, XBIGFLOAT_DATA (number)); | |
618 return make_bignum_bg (scratch_bignum); | |
619 #else | |
2500 | 620 ABORT (); |
1983 | 621 #endif /* HAVE_BIGNUM */ |
622 case RATIO_T: | |
623 #ifdef HAVE_RATIO | |
624 ratio_set_bigfloat (scratch_ratio, XBIGFLOAT_DATA (number)); | |
625 return make_ratio_rt (scratch_ratio); | |
626 #else | |
2500 | 627 ABORT (); |
1983 | 628 #endif |
629 case FLOAT_T: | |
630 return make_float (bigfloat_to_double (XBIGFLOAT_DATA (number))); | |
631 case BIGFLOAT_T: | |
632 /* FIXME: Do we need to change the precision? */ | |
633 return number; | |
634 } | |
635 #else | |
2500 | 636 ABORT (); |
1983 | 637 #endif /* HAVE_BIGFLOAT */ |
638 } | |
2500 | 639 ABORT (); |
1995 | 640 /* NOTREACHED */ |
641 return Qzero; | |
1983 | 642 } |
643 | |
644 /* This function promotes its arguments as necessary to make them both the | |
645 same type. It destructively modifies its arguments to do so. Characters | |
646 and markers are ALWAYS converted to integers. */ | |
647 enum number_type | |
648 promote_args (Lisp_Object *arg1, Lisp_Object *arg2) | |
649 { | |
650 enum number_type type1, type2; | |
651 | |
652 if (CHARP (*arg1)) | |
653 *arg1 = make_int (XCHAR (*arg1)); | |
654 else if (MARKERP (*arg1)) | |
655 *arg1 = make_int (marker_position (*arg1)); | |
656 if (CHARP (*arg2)) | |
657 *arg2 = make_int (XCHAR (*arg2)); | |
658 else if (MARKERP (*arg2)) | |
659 *arg2 = make_int (marker_position (*arg2)); | |
660 | |
661 CHECK_NUMBER (*arg1); | |
662 CHECK_NUMBER (*arg2); | |
663 | |
664 type1 = get_number_type (*arg1); | |
665 type2 = get_number_type (*arg2); | |
666 | |
667 if (type1 < type2) | |
668 { | |
669 *arg1 = internal_coerce_number (*arg1, type2, | |
670 #ifdef HAVE_BIGFLOAT | |
671 type2 == BIGFLOAT_T | |
672 ? XBIGFLOAT_GET_PREC (*arg2) : | |
673 #endif | |
674 0UL); | |
675 return type2; | |
676 } | |
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
677 |
1983 | 678 if (type2 < type1) |
679 { | |
680 *arg2 = internal_coerce_number (*arg2, type1, | |
681 #ifdef HAVE_BIGFLOAT | |
682 type1 == BIGFLOAT_T | |
683 ? XBIGFLOAT_GET_PREC (*arg1) : | |
684 #endif | |
685 0UL); | |
686 return type1; | |
687 } | |
688 | |
689 /* No conversion necessary */ | |
690 return type1; | |
691 } | |
692 | |
693 DEFUN ("coerce-number", Fcoerce_number, 2, 3, 0, /* | |
694 Convert NUMBER to the indicated type, possibly losing information. | |
695 Do not call this function. Use `coerce' instead. | |
696 | |
3025 | 697 TYPE is one of the symbols `fixnum', `integer', `ratio', `float', or |
698 `bigfloat'. Not all of these types may be supported. | |
1983 | 699 |
700 PRECISION is the number of bits of precision to use when converting to | |
701 bigfloat; it is ignored otherwise. If nil, the default precision is used. | |
702 | |
703 Note that some conversions lose information. No error is signaled in such | |
704 cases; the information is silently lost. | |
705 */ | |
2595 | 706 (number, type, USED_IF_BIGFLOAT (precision))) |
1983 | 707 { |
708 CHECK_SYMBOL (type); | |
709 if (EQ (type, Qfixnum)) | |
710 return internal_coerce_number (number, FIXNUM_T, 0UL); | |
711 else if (EQ (type, Qinteger)) | |
712 { | |
713 /* If bignums are available, we always convert to one first, then | |
714 downgrade to a fixnum if possible. */ | |
715 #ifdef HAVE_BIGNUM | |
716 return Fcanonicalize_number | |
717 (internal_coerce_number (number, BIGNUM_T, 0UL)); | |
718 #else | |
719 return internal_coerce_number (number, FIXNUM_T, 0UL); | |
720 #endif | |
721 } | |
722 #ifdef HAVE_RATIO | |
723 else if (EQ (type, Qratio)) | |
724 return internal_coerce_number (number, RATIO_T, 0UL); | |
725 #endif | |
726 else if (EQ (type, Qfloat)) | |
727 return internal_coerce_number (number, FLOAT_T, 0UL); | |
728 #ifdef HAVE_BIGFLOAT | |
729 else if (EQ (type, Qbigfloat)) | |
730 { | |
731 unsigned long prec; | |
732 | |
733 if (NILP (precision)) | |
734 prec = bigfloat_get_default_prec (); | |
735 else | |
736 { | |
737 CHECK_INTEGER (precision); | |
738 #ifdef HAVE_BIGNUM | |
739 if (INTP (precision)) | |
740 #endif /* HAVE_BIGNUM */ | |
741 prec = (unsigned long) XREALINT (precision); | |
742 #ifdef HAVE_BIGNUM | |
743 else | |
744 { | |
745 if (!bignum_fits_ulong_p (XBIGNUM_DATA (precision))) | |
746 args_out_of_range (precision, Vbigfloat_max_prec); | |
747 prec = bignum_to_ulong (XBIGNUM_DATA (precision)); | |
748 } | |
749 #endif /* HAVE_BIGNUM */ | |
750 } | |
751 return internal_coerce_number (number, BIGFLOAT_T, prec); | |
752 } | |
753 #endif /* HAVE_BIGFLOAT */ | |
754 | |
755 Fsignal (Qunsupported_type, type); | |
756 /* NOTREACHED */ | |
757 return Qnil; | |
758 } | |
759 | |
760 | |
761 void | |
762 syms_of_number (void) | |
763 { | |
764 #ifdef HAVE_BIGNUM | |
765 INIT_LRECORD_IMPLEMENTATION (bignum); | |
766 #endif | |
767 #ifdef HAVE_RATIO | |
768 INIT_LRECORD_IMPLEMENTATION (ratio); | |
769 #endif | |
770 #ifdef HAVE_BIGFLOAT | |
771 INIT_LRECORD_IMPLEMENTATION (bigfloat); | |
772 #endif | |
773 | |
774 /* Type predicates */ | |
775 DEFSYMBOL (Qrationalp); | |
776 DEFSYMBOL (Qfloatingp); | |
777 DEFSYMBOL (Qrealp); | |
778 DEFSYMBOL (Qbignump); | |
779 DEFSYMBOL (Qratiop); | |
780 DEFSYMBOL (Qbigfloatp); | |
781 | |
782 /* Functions */ | |
783 DEFSUBR (Fbignump); | |
784 DEFSUBR (Fratiop); | |
785 DEFSUBR (Frationalp); | |
786 DEFSUBR (Fnumerator); | |
787 DEFSUBR (Fdenominator); | |
788 DEFSUBR (Fbigfloatp); | |
2092 | 789 DEFSUBR (Fbigfloat_get_precision); |
790 DEFSUBR (Fbigfloat_set_precision); | |
2001 | 791 DEFSUBR (Ffloatingp); |
1983 | 792 DEFSUBR (Frealp); |
793 DEFSUBR (Fcanonicalize_number); | |
794 DEFSUBR (Fcoerce_number); | |
795 | |
796 /* Errors */ | |
797 DEFERROR_STANDARD (Qunsupported_type, Qwrong_type_argument); | |
798 } | |
799 | |
800 void | |
801 vars_of_number (void) | |
802 { | |
2051 | 803 /* These variables are Lisp variables rather than number variables so that |
804 we can put bignums in them. */ | |
1983 | 805 DEFVAR_LISP_MAGIC ("default-float-precision", &Vdefault_float_precision, /* |
806 The default floating-point precision for newly created floating point values. | |
2092 | 807 This should be 0 to create Lisp float types, or an unsigned integer no greater |
808 than `bigfloat-maximum-precision' to create Lisp bigfloat types with the | |
809 indicated precision. | |
1983 | 810 */ default_float_precision_changed); |
811 Vdefault_float_precision = make_int (0); | |
812 | |
2092 | 813 DEFVAR_CONST_LISP ("bigfloat-maximum-precision", &Vbigfloat_max_prec /* |
1983 | 814 The maximum number of bits of precision a bigfloat can have. |
2092 | 815 This is determined by the underlying library used to implement bigfloats. |
1983 | 816 */); |
817 | |
2061 | 818 #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
|
819 /* 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
|
820 See reinit_vars_of_number(). */ |
2061 | 821 Vbigfloat_max_prec = make_int (EMACS_INT_MAX); |
822 #else | |
2051 | 823 Vbigfloat_max_prec = make_int (0); |
824 #endif /* HAVE_BIGFLOAT */ | |
825 | |
1983 | 826 Fprovide (intern ("number-types")); |
827 #ifdef HAVE_BIGNUM | |
828 Fprovide (intern ("bignum")); | |
829 #endif | |
830 #ifdef HAVE_RATIO | |
831 Fprovide (intern ("ratio")); | |
832 #endif | |
833 #ifdef HAVE_BIGFLOAT | |
834 Fprovide (intern ("bigfloat")); | |
835 #endif | |
836 } | |
837 | |
838 void | |
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
839 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
|
840 { |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
841 #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
|
842 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
|
843 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
|
844 #endif |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
845 } |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
846 |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
847 void |
1983 | 848 init_number (void) |
849 { | |
850 if (!number_initialized) | |
851 { | |
852 number_initialized = 1; | |
853 | |
854 #ifdef WITH_GMP | |
855 init_number_gmp (); | |
856 #endif | |
857 #ifdef WITH_MP | |
858 init_number_mp (); | |
859 #endif | |
860 | |
861 #ifdef HAVE_BIGNUM | |
862 bignum_init (scratch_bignum); | |
863 bignum_init (scratch_bignum2); | |
864 #endif | |
865 | |
866 #ifdef HAVE_RATIO | |
867 ratio_init (scratch_ratio); | |
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3391
diff
changeset
|
868 ratio_init (scratch_ratio2); |
1983 | 869 #endif |
870 | |
871 #ifdef HAVE_BIGFLOAT | |
872 bigfloat_init (scratch_bigfloat); | |
873 bigfloat_init (scratch_bigfloat2); | |
874 #endif | |
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
875 |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
876 #ifndef PDUMP |
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
877 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
|
878 #endif |
1983 | 879 } |
880 } |