Mercurial > hg > xemacs-beta
annotate src/number.c @ 4952:19a72041c5ed
Mule-izing, various fixes related to char * arguments
-------------------- ChangeLog entries follow: --------------------
modules/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c:
* postgresql/postgresql.c (CHECK_LIVE_CONNECTION):
* postgresql/postgresql.c (print_pgresult):
* postgresql/postgresql.c (Fpq_conn_defaults):
* postgresql/postgresql.c (Fpq_connectdb):
* postgresql/postgresql.c (Fpq_connect_start):
* postgresql/postgresql.c (Fpq_result_status):
* postgresql/postgresql.c (Fpq_res_status):
Mule-ize large parts of it.
2010-01-26 Ben Wing <ben@xemacs.org>
* ldap/eldap.c (print_ldap):
* ldap/eldap.c (allocate_ldap):
Use write_ascstring().
src/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (build_ascstring):
* alloc.c (build_msg_cistring):
* alloc.c (staticpro_1):
* alloc.c (staticpro_name):
* alloc.c (staticpro_nodump_1):
* alloc.c (staticpro_nodump_name):
* alloc.c (unstaticpro_nodump_1):
* alloc.c (mcpro_1):
* alloc.c (mcpro_name):
* alloc.c (object_memory_usage_stats):
* alloc.c (common_init_alloc_early):
* alloc.c (init_alloc_once_early):
* buffer.c (print_buffer):
* buffer.c (vars_of_buffer):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.c (init_initial_directory):
* bytecode.c (invalid_byte_code):
* bytecode.c (print_compiled_function):
* bytecode.c (mark_compiled_function):
* chartab.c (print_table_entry):
* chartab.c (print_char_table):
* config.h.in:
* console-gtk.c:
* console-gtk.c (gtk_device_to_console_connection):
* console-gtk.c (gtk_semi_canonicalize_console_connection):
* console-gtk.c (gtk_canonicalize_console_connection):
* console-gtk.c (gtk_semi_canonicalize_device_connection):
* console-gtk.c (gtk_canonicalize_device_connection):
* console-stream.c (stream_init_frame_1):
* console-stream.c (vars_of_console_stream):
* console-stream.c (init_console_stream):
* console-x.c (x_semi_canonicalize_console_connection):
* console-x.c (x_semi_canonicalize_device_connection):
* console-x.c (x_canonicalize_device_connection):
* console-x.h:
* data.c (eq_with_ebola_notice):
* data.c (Fsubr_interactive):
* data.c (Fnumber_to_string):
* data.c (digit_to_number):
* device-gtk.c (gtk_init_device):
* device-msw.c (print_devmode):
* device-x.c (x_event_name):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-msw.c (handle_file_dialog_box):
* dialog-msw.c (vars_of_dialog_mswindows):
* doc.c (weird_doc):
* doc.c (Fsnarf_documentation):
* doc.c (vars_of_doc):
* dumper.c (pdump):
* dynarr.c:
* dynarr.c (Dynarr_realloc):
* editfns.c (Fuser_real_login_name):
* editfns.c (get_home_directory):
* elhash.c (print_hash_table_data):
* elhash.c (print_hash_table):
* emacs.c (main_1):
* emacs.c (vars_of_emacs):
* emodules.c:
* emodules.c (_emodules_list):
* emodules.c (Fload_module):
* emodules.c (Funload_module):
* emodules.c (Flist_modules):
* emodules.c (find_make_module):
* emodules.c (attempt_module_delete):
* emodules.c (emodules_load):
* emodules.c (emodules_doc_subr):
* emodules.c (emodules_doc_sym):
* emodules.c (syms_of_module):
* emodules.c (vars_of_module):
* emodules.h:
* eval.c (print_subr):
* eval.c (signal_call_debugger):
* eval.c (build_error_data):
* eval.c (signal_error):
* eval.c (maybe_signal_error):
* eval.c (signal_continuable_error):
* eval.c (maybe_signal_continuable_error):
* eval.c (signal_error_2):
* eval.c (maybe_signal_error_2):
* eval.c (signal_continuable_error_2):
* eval.c (maybe_signal_continuable_error_2):
* eval.c (signal_ferror):
* eval.c (maybe_signal_ferror):
* eval.c (signal_continuable_ferror):
* eval.c (maybe_signal_continuable_ferror):
* eval.c (signal_ferror_with_frob):
* eval.c (maybe_signal_ferror_with_frob):
* eval.c (signal_continuable_ferror_with_frob):
* eval.c (maybe_signal_continuable_ferror_with_frob):
* eval.c (syntax_error):
* eval.c (syntax_error_2):
* eval.c (maybe_syntax_error):
* eval.c (sferror):
* eval.c (sferror_2):
* eval.c (maybe_sferror):
* eval.c (invalid_argument):
* eval.c (invalid_argument_2):
* eval.c (maybe_invalid_argument):
* eval.c (invalid_constant):
* eval.c (invalid_constant_2):
* eval.c (maybe_invalid_constant):
* eval.c (invalid_operation):
* eval.c (invalid_operation_2):
* eval.c (maybe_invalid_operation):
* eval.c (invalid_change):
* eval.c (invalid_change_2):
* eval.c (maybe_invalid_change):
* eval.c (invalid_state):
* eval.c (invalid_state_2):
* eval.c (maybe_invalid_state):
* eval.c (wtaerror):
* eval.c (stack_overflow):
* eval.c (out_of_memory):
* eval.c (print_multiple_value):
* eval.c (issue_call_trapping_problems_warning):
* eval.c (backtrace_specials):
* eval.c (backtrace_unevalled_args):
* eval.c (Fbacktrace):
* eval.c (warn_when_safe):
* event-Xt.c (modwarn):
* event-Xt.c (modbarf):
* event-Xt.c (check_modifier):
* event-Xt.c (store_modifier):
* event-Xt.c (emacs_Xt_format_magic_event):
* event-Xt.c (describe_event):
* event-gtk.c (dragndrop_data_received):
* event-gtk.c (store_modifier):
* event-gtk.c (gtk_reset_modifier_mapping):
* event-msw.c (dde_eval_string):
* event-msw.c (Fdde_alloc_advise_item):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (FROB):
* event-msw.c (emacs_mswindows_format_magic_event):
* event-stream.c (external_debugging_print_event):
* event-stream.c (execute_help_form):
* event-stream.c (vars_of_event_stream):
* events.c (print_event_1):
* events.c (print_event):
* events.c (event_equal):
* extents.c (print_extent_1):
* extents.c (print_extent):
* extents.c (vars_of_extents):
* faces.c (print_face):
* faces.c (complex_vars_of_faces):
* file-coding.c:
* file-coding.c (print_coding_system):
* file-coding.c (print_coding_system_in_print_method):
* file-coding.c (default_query_method):
* file-coding.c (find_coding_system):
* file-coding.c (make_coding_system_1):
* file-coding.c (chain_print):
* file-coding.c (undecided_print):
* file-coding.c (gzip_print):
* file-coding.c (vars_of_file_coding):
* file-coding.c (complex_vars_of_file_coding):
* fileio.c:
* fileio.c (report_file_type_error):
* fileio.c (report_error_with_errno):
* fileio.c (report_file_error):
* fileio.c (barf_or_query_if_file_exists):
* fileio.c (vars_of_fileio):
* floatfns.c (matherr):
* fns.c (print_bit_vector):
* fns.c (Fmapconcat):
* fns.c (add_suffix_to_symbol):
* fns.c (add_prefix_to_symbol):
* frame-gtk.c:
* frame-gtk.c (Fgtk_window_id):
* frame-x.c (def):
* frame-x.c (x_cde_transfer_callback):
* frame.c:
* frame.c (Fmake_frame):
* gc.c (show_gc_cursor_and_message):
* gc.c (vars_of_gc):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate):
* glyphs-gtk.c (gtk_print_image_instance):
* glyphs-msw.c (mswindows_print_image_instance):
* glyphs-x.c (x_print_image_instance):
* glyphs-x.c (update_widget_face):
* glyphs.c (make_string_from_file):
* glyphs.c (print_image_instance):
* glyphs.c (signal_image_error):
* glyphs.c (signal_image_error_2):
* glyphs.c (signal_double_image_error):
* glyphs.c (signal_double_image_error_2):
* glyphs.c (xbm_mask_file_munging):
* glyphs.c (pixmap_to_lisp_data):
* glyphs.h:
* gui.c (gui_item_display_flush_left):
* hpplay.c (player_error_internal):
* hpplay.c (myHandler):
* intl-win32.c:
* intl-win32.c (langcode_to_lang):
* intl-win32.c (sublangcode_to_lang):
* intl-win32.c (Fmswindows_get_locale_info):
* intl-win32.c (lcid_to_locale_mule_or_no):
* intl-win32.c (mswindows_multibyte_to_unicode_print):
* intl-win32.c (complex_vars_of_intl_win32):
* keymap.c:
* keymap.c (print_keymap):
* keymap.c (ensure_meta_prefix_char_keymapp):
* keymap.c (Fkey_description):
* keymap.c (Ftext_char_description):
* lisp.h:
* lisp.h (struct):
* lisp.h (DECLARE_INLINE_HEADER):
* lread.c (Fload_internal):
* lread.c (locate_file):
* lread.c (read_escape):
* lread.c (read_raw_string):
* lread.c (read1):
* lread.c (read_list):
* lread.c (read_compiled_function):
* lread.c (init_lread):
* lrecord.h:
* marker.c (print_marker):
* marker.c (marker_equal):
* menubar-msw.c (displayable_menu_item):
* menubar-x.c (command_builder_operate_menu_accelerator):
* menubar.c (vars_of_menubar):
* minibuf.c (reinit_complex_vars_of_minibuf):
* minibuf.c (complex_vars_of_minibuf):
* mule-charset.c (Fmake_charset):
* mule-charset.c (complex_vars_of_mule_charset):
* mule-coding.c (iso2022_print):
* mule-coding.c (fixed_width_query):
* number.c (bignum_print):
* number.c (ratio_print):
* number.c (bigfloat_print):
* number.c (bigfloat_finalize):
* objects-msw.c:
* objects-msw.c (mswindows_color_to_string):
* objects-msw.c (mswindows_color_list):
* objects-tty.c:
* objects-tty.c (tty_font_list):
* objects-tty.c (tty_find_charset_font):
* objects-xlike-inc.c (xft_find_charset_font):
* objects-xlike-inc.c (endif):
* print.c:
* print.c (write_istring):
* print.c (write_ascstring):
* print.c (Fterpri):
* print.c (Fprint):
* print.c (print_error_message):
* print.c (print_vector_internal):
* print.c (print_cons):
* print.c (print_string):
* print.c (printing_unreadable_object):
* print.c (print_internal):
* print.c (print_float):
* print.c (print_symbol):
* process-nt.c (mswindows_report_winsock_error):
* process-nt.c (nt_canonicalize_host_name):
* process-unix.c (unix_canonicalize_host_name):
* process.c (print_process):
* process.c (report_process_error):
* process.c (report_network_error):
* process.c (make_process_internal):
* process.c (Fstart_process_internal):
* process.c (status_message):
* process.c (putenv_internal):
* process.c (vars_of_process):
* process.h:
* profile.c (vars_of_profile):
* rangetab.c (print_range_table):
* realpath.c (vars_of_realpath):
* redisplay.c (vars_of_redisplay):
* search.c (wordify):
* search.c (Freplace_match):
* sheap.c (sheap_adjust_h):
* sound.c (report_sound_error):
* sound.c (Fplay_sound_file):
* specifier.c (print_specifier):
* symbols.c (Fsubr_name):
* symbols.c (do_symval_forwarding):
* symbols.c (set_default_buffer_slot_variable):
* symbols.c (set_default_console_slot_variable):
* symbols.c (store_symval_forwarding):
* symbols.c (default_value):
* symbols.c (defsymbol_massage_name_1):
* symbols.c (defsymbol_massage_name_nodump):
* symbols.c (defsymbol_massage_name):
* symbols.c (defsymbol_massage_multiword_predicate_nodump):
* symbols.c (defsymbol_massage_multiword_predicate):
* symbols.c (defsymbol_nodump):
* symbols.c (defsymbol):
* symbols.c (defkeyword):
* symbols.c (defkeyword_massage_name):
* symbols.c (check_module_subr):
* symbols.c (deferror_1):
* symbols.c (deferror):
* symbols.c (deferror_massage_name):
* symbols.c (deferror_massage_name_and_message):
* symbols.c (defvar_magic):
* symeval.h:
* symeval.h (DEFVAR_SYMVAL_FWD):
* sysdep.c:
* sysdep.c (init_system_name):
* sysdll.c:
* sysdll.c (MAYBE_PREPEND_UNDERSCORE):
* sysdll.c (dll_function):
* sysdll.c (dll_variable):
* sysdll.c (dll_error):
* sysdll.c (dll_open):
* sysdll.c (dll_close):
* sysdll.c (image_for_address):
* sysdll.c (my_find_image):
* sysdll.c (search_linked_libs):
* sysdll.h:
* sysfile.h:
* sysfile.h (DEFAULT_DIRECTORY_FALLBACK):
* syswindows.h:
* tests.c (DFC_CHECK_LENGTH):
* tests.c (DFC_CHECK_CONTENT):
* tests.c (Ftest_hash_tables):
* text.c (vars_of_text):
* text.h:
* tooltalk.c (tt_opnum_string):
* tooltalk.c (tt_message_arg_ival_string):
* tooltalk.c (Ftooltalk_default_procid):
* tooltalk.c (Ftooltalk_default_session):
* tooltalk.c (init_tooltalk):
* tooltalk.c (vars_of_tooltalk):
* ui-gtk.c (Fdll_load):
* ui-gtk.c (type_to_marshaller_type):
* ui-gtk.c (Fgtk_import_function_internal):
* ui-gtk.c (emacs_gtk_object_printer):
* ui-gtk.c (emacs_gtk_boxed_printer):
* unicode.c (unicode_to_ichar):
* unicode.c (unicode_print):
* unicode.c (unicode_query):
* unicode.c (vars_of_unicode):
* unicode.c (complex_vars_of_unicode):
* win32.c:
* win32.c (mswindows_report_process_error):
* window.c (print_window):
* xemacs.def.in.in:
BASIC IDEA: Further fixing up uses of char * and CIbyte *
to reflect their actual semantics; Mule-izing some code;
redoing of the not-yet-working code to handle message translation.
Clean up code to handle message-translation (not yet working).
Create separate versions of build_msg_string() for working with
Ibyte *, CIbyte *, and Ascbyte * arguments. Assert that Ascbyte *
arguments are pure-ASCII. Make build_msg_string() be the same
as build_msg_ascstring(). Create same three versions of GETTEXT()
and DEFER_GETTEXT(). Also create build_defer_string() and
variants for the equivalent of DEFER_GETTEXT() when building a
string. Remove old CGETTEXT(). Clean up code where GETTEXT(),
DEFER_GETTEXT(), build_msg_string(), etc. was being called and
introduce some new calls to build_msg_string(), etc. Remove
GETTEXT() from calls to weird_doc() -- we assume that the
message snarfer knows about weird_doc(). Remove uses of
DEFER_GETTEXT() from error messages in sysdep.c and instead use
special comments /* @@@begin-snarf@@@ */ and /* @@@end-snarf@@@ */
that the message snarfer presumably knows about.
Create build_ascstring() and use it in many instances in place
of build_string(). The purpose of having Ascbyte * variants is
to make the code more self-documenting in terms of what sort of
semantics is expected for char * strings. In fact in the process
of looking for uses of build_string(), much improperly Mule-ized
was discovered.
Mule-ize a lot of code as described in previous paragraph,
e.g. in sysdep.c.
Make the error functions take Ascbyte * strings and fix up a
couple of places where non-pure-ASCII strings were being passed in
(file-coding.c, mule-coding.c, unicode.c). (It's debatable whether
we really need to make the error functions work this way. It
helps catch places where code is written in a way that message
translation won't work, but we may well never implement message
translation.)
Make staticpro() and friends take Ascbyte * strings instead of
raw char * strings. Create a const_Ascbyte_ptr dynarr type
to describe what's held by staticpro_names[] and friends,
create pdump descriptions for const_Ascbyte_ptr dynarrs, and
use them in place of specially-crafted staticpro descriptions.
Mule-ize certain other functions (e.g. x_event_name) by correcting
raw use of char * to Ascbyte *, Rawbyte * or another such type,
and raw use of char[] buffers to another type (usually Ascbyte[]).
Change many uses of write_c_string() to write_msg_string(),
write_ascstring(), etc.
Mule-ize emodules.c, emodules.h, sysdll.h.
Fix some un-Mule-ized code in intl-win32.c.
A comment in event-Xt.c and the limitations of the message
snarfer (make-msgfile or whatever) is presumably incorrect --
it should be smart enough to handle function calls spread over
more than one line. Clean up code in event-Xt.c that was
written awkwardly for this reason.
In config.h.in, instead of NEED_ERROR_CHECK_TYPES_INLINES,
create a more general XEMACS_DEFS_NEEDS_INLINE_DECLS to
indicate when inlined functions need to be declared in
xemacs.defs.in.in, and make use of it in xemacs.defs.in.in.
We need to do this because postgresql.c now calls qxestrdup(),
which is an inline function.
Make nconc2() and other such functions MODULE_API and put
them in xemacs.defs.in.in since postgresql.c now uses them.
Clean up indentation in lread.c and a few other places.
In text.h, document ASSERT_ASCTEXT_ASCII() and
ASSERT_ASCTEXT_ASCII_LEN(), group together the stand-in
encodings and add some more for DLL symbols, function and
variable names, etc.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Tue, 26 Jan 2010 23:22:30 -0600 |
| parents | f730384b8ddf |
| children | db2db229ee82 |
| 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; |
| 35 Fixnum Vmost_negative_fixnum, Vmost_positive_fixnum; | |
| 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); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4883
diff
changeset
|
58 xfree (bstr, Ascbyte *); |
| 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 |
| 2286 | 77 bignum_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth)) |
| 1983 | 78 { |
| 79 return bignum_eql (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2)); | |
| 80 } | |
| 81 | |
| 82 static Hashcode | |
| 2286 | 83 bignum_hash (Lisp_Object obj, int UNUSED (depth)) |
| 1983 | 84 { |
| 85 return bignum_hashcode (XBIGNUM_DATA (obj)); | |
| 86 } | |
| 87 | |
| 2551 | 88 static void |
| 89 bignum_convert (const void *object, void **data, Bytecount *size) | |
| 90 { | |
| 91 CIbyte *bstr = bignum_to_string (*(bignum *)object, 10); | |
| 92 *data = bstr; | |
| 93 *size = strlen(bstr)+1; | |
| 94 } | |
| 95 | |
| 96 static void | |
| 97 bignum_convfree (const void * UNUSED (object), void *data, | |
| 98 Bytecount UNUSED (size)) | |
| 99 { | |
| 100 xfree (data, void *); | |
| 101 } | |
| 102 | |
| 103 static void * | |
| 104 bignum_deconvert (void *object, void *data, Bytecount UNUSED (size)) | |
| 105 { | |
| 106 bignum *b = (bignum *) object; | |
| 107 bignum_init(*b); | |
| 108 bignum_set_string(*b, (const char *) data, 10); | |
| 109 return object; | |
| 110 } | |
| 111 | |
| 112 static const struct opaque_convert_functions bignum_opc = { | |
| 113 bignum_convert, | |
| 114 bignum_convfree, | |
| 115 bignum_deconvert | |
| 116 }; | |
| 117 | |
| 1983 | 118 static const struct memory_description bignum_description[] = { |
| 2551 | 119 { XD_OPAQUE_DATA_CONVERTIBLE, offsetof (Lisp_Bignum, data), |
| 120 0, { &bignum_opc }, XD_FLAG_NO_KKCC }, | |
| 1983 | 121 { XD_END } |
| 122 }; | |
| 123 | |
| 2551 | 124 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
|
125 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
|
126 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
|
127 Lisp_Bignum); |
| 1983 | 128 |
| 2092 | 129 #endif /* HAVE_BIGNUM */ |
| 1983 | 130 |
| 131 Lisp_Object Qbignump; | |
| 132 | |
| 133 DEFUN ("bignump", Fbignump, 1, 1, 0, /* | |
| 134 Return t if OBJECT is a bignum, nil otherwise. | |
| 135 */ | |
| 136 (object)) | |
| 137 { | |
| 138 return BIGNUMP (object) ? Qt : Qnil; | |
| 139 } | |
| 140 | |
| 141 | |
| 142 /********************************* Integers *********************************/ | |
| 143 DEFUN ("integerp", Fintegerp, 1, 1, 0, /* | |
| 144 Return t if OBJECT is an integer, nil otherwise. | |
| 145 */ | |
| 146 (object)) | |
| 147 { | |
| 148 return INTEGERP (object) ? Qt : Qnil; | |
| 149 } | |
| 150 | |
| 151 DEFUN ("evenp", Fevenp, 1, 1, 0, /* | |
| 152 Return t if INTEGER is even, nil otherwise. | |
| 153 */ | |
| 154 (integer)) | |
| 155 { | |
| 156 CONCHECK_INTEGER (integer); | |
| 1996 | 157 return (BIGNUMP (integer) |
| 158 ? bignum_evenp (XBIGNUM_DATA (integer)) | |
| 159 : XTYPE (integer) == Lisp_Type_Int_Even) ? Qt : Qnil; | |
| 1983 | 160 } |
| 161 | |
| 2019 | 162 DEFUN ("oddp", Foddp, 1, 1, 0, /* |
| 1983 | 163 Return t if INTEGER is odd, nil otherwise. |
| 164 */ | |
| 165 (integer)) | |
| 166 { | |
| 167 CONCHECK_INTEGER (integer); | |
| 1996 | 168 return (BIGNUMP (integer) |
| 169 ? bignum_oddp (XBIGNUM_DATA (integer)) | |
| 170 : XTYPE (integer) == Lisp_Type_Int_Odd) ? Qt : Qnil; | |
| 1983 | 171 } |
| 172 | |
| 173 | |
| 174 /********************************** Ratios **********************************/ | |
| 175 #ifdef HAVE_RATIO | |
| 176 static void | |
| 2286 | 177 ratio_print (Lisp_Object obj, Lisp_Object printcharfun, |
| 178 int UNUSED (escapeflag)) | |
| 1983 | 179 { |
| 180 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
|
181 write_ascstring (printcharfun, rstr); |
| 1983 | 182 xfree (rstr, CIbyte *); |
| 183 } | |
| 184 | |
|
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
185 #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
|
186 static void |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
187 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
|
188 { |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
189 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
|
190 { |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
191 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
|
192 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
|
193 } |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
194 } |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
195 #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
|
196 #else |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
197 #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
|
198 #endif |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
199 |
| 1983 | 200 static int |
| 2286 | 201 ratio_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth)) |
| 1983 | 202 { |
| 203 return ratio_eql (XRATIO_DATA (obj1), XRATIO_DATA (obj2)); | |
| 204 } | |
| 205 | |
| 206 static Hashcode | |
| 2286 | 207 ratio_hash (Lisp_Object obj, int UNUSED (depth)) |
| 1983 | 208 { |
| 209 return ratio_hashcode (XRATIO_DATA (obj)); | |
| 210 } | |
| 211 | |
| 212 static const struct memory_description ratio_description[] = { | |
| 213 { XD_OPAQUE_PTR, offsetof (Lisp_Ratio, data) }, | |
| 214 { XD_END } | |
| 215 }; | |
| 216 | |
| 2061 | 217 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
|
218 RATIO_FINALIZE, ratio_equal, ratio_hash, |
| 2061 | 219 ratio_description, Lisp_Ratio); |
| 1983 | 220 |
| 2092 | 221 #endif /* HAVE_RATIO */ |
| 1983 | 222 |
| 223 Lisp_Object Qratiop; | |
| 224 | |
| 225 DEFUN ("ratiop", Fratiop, 1, 1, 0, /* | |
| 226 Return t if OBJECT is a ratio, nil otherwise. | |
| 227 */ | |
| 228 (object)) | |
| 229 { | |
| 230 return RATIOP (object) ? Qt : Qnil; | |
| 231 } | |
| 232 | |
| 233 | |
| 234 /******************************** Rationals *********************************/ | |
| 235 DEFUN ("rationalp", Frationalp, 1, 1, 0, /* | |
| 236 Return t if OBJECT is a rational, nil otherwise. | |
| 237 */ | |
| 238 (object)) | |
| 239 { | |
| 240 return RATIONALP (object) ? Qt : Qnil; | |
| 241 } | |
| 242 | |
| 243 DEFUN ("numerator", Fnumerator, 1, 1, 0, /* | |
| 244 Return the numerator of the canonical form of RATIONAL. | |
| 245 If RATIONAL is an integer, RATIONAL is returned. | |
| 246 */ | |
| 247 (rational)) | |
| 248 { | |
| 249 CONCHECK_RATIONAL (rational); | |
| 250 #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
|
251 if (RATIOP (rational)) |
|
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
252 { |
|
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
253 return |
|
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
254 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
|
255 } |
|
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
256 #endif |
| 1983 | 257 return rational; |
| 258 } | |
| 259 | |
| 260 DEFUN ("denominator", Fdenominator, 1, 1, 0, /* | |
| 261 Return the denominator of the canonical form of RATIONAL. | |
| 262 If RATIONAL is an integer, 1 is returned. | |
| 263 */ | |
| 264 (rational)) | |
| 265 { | |
| 266 CONCHECK_RATIONAL (rational); | |
| 267 #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
|
268 if (RATIOP (rational)) |
|
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
269 { |
|
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
270 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
|
271 (XRATIO_DENOMINATOR (rational))); |
|
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
272 } |
| 1983 | 273 #endif |
|
4883
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
274 return make_int (1); |
| 1983 | 275 } |
| 276 | |
| 277 | |
| 278 /******************************** Bigfloats *********************************/ | |
| 279 #ifdef HAVE_BIGFLOAT | |
| 280 static void | |
| 2286 | 281 bigfloat_print (Lisp_Object obj, Lisp_Object printcharfun, |
| 282 int UNUSED (escapeflag)) | |
| 1983 | 283 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4883
diff
changeset
|
284 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
|
285 write_ascstring (printcharfun, fstr); |
| 1983 | 286 xfree (fstr, CIbyte *); |
| 287 } | |
| 288 | |
|
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
289 #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
|
290 static void |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
291 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
|
292 { |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
293 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
|
294 { |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
295 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
|
296 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
|
297 } |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
298 } |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
299 #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
|
300 #else |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
301 #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
|
302 #endif |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
303 |
| 1983 | 304 static int |
| 2286 | 305 bigfloat_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth)) |
| 1983 | 306 { |
| 307 return bigfloat_eql (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2)); | |
| 308 } | |
| 309 | |
| 310 static Hashcode | |
| 2286 | 311 bigfloat_hash (Lisp_Object obj, int UNUSED (depth)) |
| 1983 | 312 { |
| 313 return bigfloat_hashcode (XBIGFLOAT_DATA (obj)); | |
| 314 } | |
| 315 | |
| 316 static const struct memory_description bigfloat_description[] = { | |
| 317 { XD_OPAQUE_PTR, offsetof (Lisp_Bigfloat, bf) }, | |
| 318 { XD_END } | |
| 319 }; | |
| 320 | |
| 2061 | 321 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
|
322 bigfloat_print, BIGFLOAT_FINALIZE, |
| 2061 | 323 bigfloat_equal, bigfloat_hash, |
| 324 bigfloat_description, Lisp_Bigfloat); | |
| 1983 | 325 |
| 2092 | 326 #endif /* HAVE_BIGFLOAT */ |
| 1983 | 327 |
| 328 Lisp_Object Qbigfloatp; | |
| 329 | |
| 330 DEFUN ("bigfloatp", Fbigfloatp, 1, 1, 0, /* | |
| 331 Return t if OBJECT is a bigfloat, nil otherwise. | |
| 332 */ | |
| 333 (object)) | |
| 334 { | |
| 335 return BIGFLOATP (object) ? Qt : Qnil; | |
| 336 } | |
| 337 | |
| 2092 | 338 DEFUN ("bigfloat-get-precision", Fbigfloat_get_precision, 1, 1, 0, /* |
| 339 Return the precision of bigfloat F as an integer. | |
| 340 */ | |
| 341 (f)) | |
| 342 { | |
| 343 CHECK_BIGFLOAT (f); | |
| 344 #ifdef HAVE_BIGNUM | |
| 345 bignum_set_ulong (scratch_bignum, XBIGFLOAT_GET_PREC (f)); | |
| 346 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); | |
| 347 #else | |
| 348 return make_int ((int) XBIGFLOAT_GET_PREC (f)); | |
| 349 #endif | |
| 350 } | |
| 351 | |
| 352 DEFUN ("bigfloat-set-precision", Fbigfloat_set_precision, 2, 2, 0, /* | |
| 353 Set the precision of F, a bigfloat, to PRECISION, a nonnegative integer. | |
| 354 The new precision of F is returned. Note that the return value may differ | |
| 355 from PRECISION if the underlying library is unable to support exactly | |
| 356 PRECISION bits of precision. | |
| 357 */ | |
| 358 (f, precision)) | |
| 359 { | |
| 360 unsigned long prec; | |
| 361 | |
| 362 CHECK_BIGFLOAT (f); | |
| 363 if (INTP (precision)) | |
| 364 { | |
| 365 prec = (XINT (precision) <= 0) ? 1UL : (unsigned long) XINT (precision); | |
| 366 } | |
| 367 #ifdef HAVE_BIGNUM | |
| 368 else if (BIGNUMP (precision)) | |
| 369 { | |
| 370 prec = bignum_fits_ulong_p (XBIGNUM_DATA (precision)) | |
| 371 ? bignum_to_ulong (XBIGNUM_DATA (precision)) | |
| 372 : UINT_MAX; | |
| 373 } | |
| 374 #endif | |
| 375 else | |
| 376 { | |
| 377 dead_wrong_type_argument (Qintegerp, f); | |
| 378 return Qnil; | |
| 379 } | |
| 380 | |
| 381 XBIGFLOAT_SET_PREC (f, prec); | |
| 382 return Fbigfloat_get_precision (f); | |
| 383 } | |
| 384 | |
| 1983 | 385 static int |
| 2286 | 386 default_float_precision_changed (Lisp_Object UNUSED (sym), Lisp_Object *val, |
| 387 Lisp_Object UNUSED (in_object), | |
| 388 int UNUSED (flags)) | |
| 1983 | 389 { |
| 390 unsigned long prec; | |
| 391 | |
| 392 CONCHECK_INTEGER (*val); | |
| 393 #ifdef HAVE_BIGFLOAT | |
| 394 if (INTP (*val)) | |
| 395 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
|
396 else |
| 1983 | 397 { |
| 398 if (!bignum_fits_ulong_p (XBIGNUM_DATA (*val))) | |
| 399 args_out_of_range_3 (*val, Qzero, Vbigfloat_max_prec); | |
| 400 prec = bignum_to_ulong (XBIGNUM_DATA (*val)); | |
| 401 } | |
| 402 if (prec != 0UL) | |
| 403 bigfloat_set_default_prec (prec); | |
| 404 #endif | |
| 405 return 0; | |
| 406 } | |
| 407 | |
| 408 | |
| 409 /********************************* Floating *********************************/ | |
| 410 Lisp_Object | |
| 411 make_floating (double d) | |
| 412 { | |
| 413 #ifdef HAVE_BIGFLOAT | |
| 414 if (ZEROP (Vdefault_float_precision)) | |
| 415 #endif | |
| 416 return make_float (d); | |
| 417 #ifdef HAVE_BIGFLOAT | |
| 418 else | |
| 419 return make_bigfloat (d, 0UL); | |
| 420 #endif | |
| 421 } | |
| 422 | |
| 423 DEFUN ("floatingp", Ffloatingp, 1, 1, 0, /* | |
| 424 Return t if OBJECT is a floating point number of any kind, nil otherwise. | |
| 425 */ | |
| 426 (object)) | |
| 427 { | |
| 428 return FLOATINGP (object) ? Qt : Qnil; | |
| 429 } | |
| 430 | |
| 431 | |
| 432 /********************************** Reals ***********************************/ | |
| 433 DEFUN ("realp", Frealp, 1, 1, 0, /* | |
| 434 Return t if OBJECT is a real, nil otherwise. | |
| 435 */ | |
| 436 (object)) | |
| 437 { | |
| 438 return REALP (object) ? Qt : Qnil; | |
| 439 } | |
| 440 | |
| 441 | |
| 442 /********************************* Numbers **********************************/ | |
| 443 DEFUN ("canonicalize-number", Fcanonicalize_number, 1, 1, 0, /* | |
| 444 Return the canonical form of NUMBER. | |
| 445 */ | |
| 446 (number)) | |
| 447 { | |
| 448 /* The tests should go in order from larger, more expressive, or more | |
| 449 complex types to smaller, less expressive, or simpler types so that a | |
| 450 number can cascade all the way down to the simplest type if | |
| 451 appropriate. */ | |
| 452 #ifdef HAVE_RATIO | |
| 453 if (RATIOP (number) && | |
| 454 bignum_fits_long_p (XRATIO_DENOMINATOR (number)) && | |
| 455 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
|
456 number = Fcanonicalize_number (make_bignum_bg (XRATIO_NUMERATOR (number))); |
| 1983 | 457 #endif |
| 458 #ifdef HAVE_BIGNUM | |
| 3391 | 459 if (BIGNUMP (number) && bignum_fits_emacs_int_p (XBIGNUM_DATA (number))) |
| 1983 | 460 { |
| 3391 | 461 EMACS_INT n = bignum_to_emacs_int (XBIGNUM_DATA (number)); |
| 1983 | 462 if (NUMBER_FITS_IN_AN_EMACS_INT (n)) |
| 463 number = make_int (n); | |
| 464 } | |
| 465 #endif | |
| 466 return number; | |
| 467 } | |
| 468 | |
| 469 enum number_type | |
| 470 get_number_type (Lisp_Object arg) | |
| 471 { | |
| 472 if (INTP (arg)) | |
| 473 return FIXNUM_T; | |
| 474 #ifdef HAVE_BIGNUM | |
| 475 if (BIGNUMP (arg)) | |
| 476 return BIGNUM_T; | |
| 477 #endif | |
| 478 #ifdef HAVE_RATIO | |
| 479 if (RATIOP (arg)) | |
| 480 return RATIO_T; | |
| 481 #endif | |
| 482 if (FLOATP (arg)) | |
| 483 return FLOAT_T; | |
| 484 #ifdef HAVE_BIGFLOAT | |
| 485 if (BIGFLOATP (arg)) | |
| 486 return BIGFLOAT_T; | |
| 487 #endif | |
| 488 /* Catch unintentional bad uses of this function */ | |
| 2500 | 489 ABORT (); |
| 1995 | 490 /* NOTREACHED */ |
| 491 return FIXNUM_T; | |
| 1983 | 492 } |
| 493 | |
| 494 /* Convert NUMBER to type TYPE. If TYPE is BIGFLOAT_T then use the indicated | |
| 495 PRECISION; otherwise, PRECISION is ignored. */ | |
| 496 static Lisp_Object | |
| 497 internal_coerce_number (Lisp_Object number, enum number_type type, | |
| 2286 | 498 #ifdef HAVE_BIGFLOAT |
| 499 unsigned long precision | |
| 500 #else | |
| 501 unsigned long UNUSED (precision) | |
| 502 #endif | |
| 503 ) | |
| 1983 | 504 { |
| 505 enum number_type current_type; | |
| 506 | |
| 507 if (CHARP (number)) | |
| 508 number = make_int (XCHAR (number)); | |
| 509 else if (MARKERP (number)) | |
| 510 number = make_int (marker_position (number)); | |
| 511 | |
| 512 /* Note that CHECK_NUMBER ensures that NUMBER is a supported type. Hence, | |
| 2500 | 513 we ABORT() in the #else sections below, because it shouldn't be possible |
| 1983 | 514 to arrive there. */ |
| 515 CHECK_NUMBER (number); | |
| 516 current_type = get_number_type (number); | |
| 517 switch (current_type) | |
| 518 { | |
| 519 case FIXNUM_T: | |
| 520 switch (type) | |
| 521 { | |
| 522 case FIXNUM_T: | |
| 523 return number; | |
| 524 case BIGNUM_T: | |
| 525 #ifdef HAVE_BIGNUM | |
| 526 return make_bignum (XREALINT (number)); | |
| 527 #else | |
| 2500 | 528 ABORT (); |
| 1983 | 529 #endif /* HAVE_BIGNUM */ |
| 530 case RATIO_T: | |
| 531 #ifdef HAVE_RATIO | |
| 532 return make_ratio (XREALINT (number), 1UL); | |
| 533 #else | |
| 2500 | 534 ABORT (); |
| 1983 | 535 #endif /* HAVE_RATIO */ |
| 536 case FLOAT_T: | |
| 537 return make_float (XREALINT (number)); | |
| 538 case BIGFLOAT_T: | |
| 539 #ifdef HAVE_BIGFLOAT | |
| 540 return make_bigfloat (XREALINT (number), precision); | |
| 541 #else | |
| 2500 | 542 ABORT (); |
| 1983 | 543 #endif /* HAVE_BIGFLOAT */ |
| 544 } | |
| 545 case BIGNUM_T: | |
| 546 #ifdef HAVE_BIGNUM | |
| 547 switch (type) | |
| 548 { | |
| 549 case FIXNUM_T: | |
| 550 return make_int (bignum_to_long (XBIGNUM_DATA (number))); | |
| 551 case BIGNUM_T: | |
| 552 return number; | |
| 553 case RATIO_T: | |
| 554 #ifdef HAVE_RATIO | |
| 555 bignum_set_long (scratch_bignum, 1L); | |
| 556 return make_ratio_bg (XBIGNUM_DATA (number), scratch_bignum); | |
| 557 #else | |
| 2500 | 558 ABORT (); |
| 1983 | 559 #endif /* HAVE_RATIO */ |
| 560 case FLOAT_T: | |
| 561 return make_float (bignum_to_double (XBIGNUM_DATA (number))); | |
| 562 case BIGFLOAT_T: | |
| 563 #ifdef HAVE_BIGFLOAT | |
| 564 { | |
| 565 Lisp_Object temp; | |
| 566 temp = make_bigfloat (0.0, precision); | |
| 567 bigfloat_set_bignum (XBIGFLOAT_DATA (temp), XBIGNUM_DATA (number)); | |
| 568 return temp; | |
| 569 } | |
| 570 #else | |
| 2500 | 571 ABORT (); |
| 1983 | 572 #endif /* HAVE_BIGFLOAT */ |
| 573 } | |
| 574 #else | |
| 2500 | 575 ABORT (); |
| 1983 | 576 #endif /* HAVE_BIGNUM */ |
| 577 case RATIO_T: | |
| 578 #ifdef HAVE_RATIO | |
| 579 switch (type) | |
| 580 { | |
| 581 case FIXNUM_T: | |
| 582 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number), | |
| 583 XRATIO_DENOMINATOR (number)); | |
| 584 return make_int (bignum_to_long (scratch_bignum)); | |
| 585 case BIGNUM_T: | |
| 586 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number), | |
| 587 XRATIO_DENOMINATOR (number)); | |
| 588 return make_bignum_bg (scratch_bignum); | |
| 589 case RATIO_T: | |
| 590 return number; | |
| 591 case FLOAT_T: | |
| 592 return make_float (ratio_to_double (XRATIO_DATA (number))); | |
| 593 case BIGFLOAT_T: | |
| 594 #ifdef HAVE_BIGFLOAT | |
| 595 { | |
| 596 Lisp_Object temp; | |
| 597 temp = make_bigfloat (0.0, precision); | |
| 598 bigfloat_set_ratio (XBIGFLOAT_DATA (temp), XRATIO_DATA (number)); | |
| 599 return temp; | |
| 600 } | |
| 601 #else | |
| 2500 | 602 ABORT (); |
| 1983 | 603 #endif /* HAVE_BIGFLOAT */ |
| 604 } | |
| 605 #else | |
| 2500 | 606 ABORT (); |
| 1983 | 607 #endif /* HAVE_RATIO */ |
| 608 case FLOAT_T: | |
| 609 switch (type) | |
| 610 { | |
| 611 case FIXNUM_T: | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3391
diff
changeset
|
612 return Ftruncate (number, Qnil); |
| 1983 | 613 case BIGNUM_T: |
| 614 #ifdef HAVE_BIGNUM | |
| 615 bignum_set_double (scratch_bignum, XFLOAT_DATA (number)); | |
| 616 return make_bignum_bg (scratch_bignum); | |
| 617 #else | |
| 2500 | 618 ABORT (); |
| 1983 | 619 #endif /* HAVE_BIGNUM */ |
| 620 case RATIO_T: | |
| 621 #ifdef HAVE_RATIO | |
| 622 ratio_set_double (scratch_ratio, XFLOAT_DATA (number)); | |
| 623 return make_ratio_rt (scratch_ratio); | |
| 624 #else | |
| 2500 | 625 ABORT (); |
| 1983 | 626 #endif /* HAVE_RATIO */ |
| 627 case FLOAT_T: | |
| 628 return number; | |
| 629 case BIGFLOAT_T: | |
| 630 #ifdef HAVE_BIGFLOAT | |
| 631 bigfloat_set_prec (scratch_bigfloat, precision); | |
| 632 bigfloat_set_double (scratch_bigfloat, XFLOAT_DATA (number)); | |
| 633 return make_bigfloat_bf (scratch_bigfloat); | |
| 634 #else | |
| 2500 | 635 ABORT (); |
| 1983 | 636 #endif /* HAVE_BIGFLOAT */ |
| 637 } | |
| 638 case BIGFLOAT_T: | |
| 639 #ifdef HAVE_BIGFLOAT | |
| 640 switch (type) | |
| 641 { | |
| 642 case FIXNUM_T: | |
| 643 return make_int (bigfloat_to_long (XBIGFLOAT_DATA (number))); | |
| 644 case BIGNUM_T: | |
| 645 #ifdef HAVE_BIGNUM | |
| 646 bignum_set_bigfloat (scratch_bignum, XBIGFLOAT_DATA (number)); | |
| 647 return make_bignum_bg (scratch_bignum); | |
| 648 #else | |
| 2500 | 649 ABORT (); |
| 1983 | 650 #endif /* HAVE_BIGNUM */ |
| 651 case RATIO_T: | |
| 652 #ifdef HAVE_RATIO | |
| 653 ratio_set_bigfloat (scratch_ratio, XBIGFLOAT_DATA (number)); | |
| 654 return make_ratio_rt (scratch_ratio); | |
| 655 #else | |
| 2500 | 656 ABORT (); |
| 1983 | 657 #endif |
| 658 case FLOAT_T: | |
| 659 return make_float (bigfloat_to_double (XBIGFLOAT_DATA (number))); | |
| 660 case BIGFLOAT_T: | |
| 661 /* FIXME: Do we need to change the precision? */ | |
| 662 return number; | |
| 663 } | |
| 664 #else | |
| 2500 | 665 ABORT (); |
| 1983 | 666 #endif /* HAVE_BIGFLOAT */ |
| 667 } | |
| 2500 | 668 ABORT (); |
| 1995 | 669 /* NOTREACHED */ |
| 670 return Qzero; | |
| 1983 | 671 } |
| 672 | |
| 673 /* This function promotes its arguments as necessary to make them both the | |
| 674 same type. It destructively modifies its arguments to do so. Characters | |
| 675 and markers are ALWAYS converted to integers. */ | |
| 676 enum number_type | |
| 677 promote_args (Lisp_Object *arg1, Lisp_Object *arg2) | |
| 678 { | |
| 679 enum number_type type1, type2; | |
| 680 | |
| 681 if (CHARP (*arg1)) | |
| 682 *arg1 = make_int (XCHAR (*arg1)); | |
| 683 else if (MARKERP (*arg1)) | |
| 684 *arg1 = make_int (marker_position (*arg1)); | |
| 685 if (CHARP (*arg2)) | |
| 686 *arg2 = make_int (XCHAR (*arg2)); | |
| 687 else if (MARKERP (*arg2)) | |
| 688 *arg2 = make_int (marker_position (*arg2)); | |
| 689 | |
| 690 CHECK_NUMBER (*arg1); | |
| 691 CHECK_NUMBER (*arg2); | |
| 692 | |
| 693 type1 = get_number_type (*arg1); | |
| 694 type2 = get_number_type (*arg2); | |
| 695 | |
| 696 if (type1 < type2) | |
| 697 { | |
| 698 *arg1 = internal_coerce_number (*arg1, type2, | |
| 699 #ifdef HAVE_BIGFLOAT | |
| 700 type2 == BIGFLOAT_T | |
| 701 ? XBIGFLOAT_GET_PREC (*arg2) : | |
| 702 #endif | |
| 703 0UL); | |
| 704 return type2; | |
| 705 } | |
|
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
706 |
| 1983 | 707 if (type2 < type1) |
| 708 { | |
| 709 *arg2 = internal_coerce_number (*arg2, type1, | |
| 710 #ifdef HAVE_BIGFLOAT | |
| 711 type1 == BIGFLOAT_T | |
| 712 ? XBIGFLOAT_GET_PREC (*arg1) : | |
| 713 #endif | |
| 714 0UL); | |
| 715 return type1; | |
| 716 } | |
| 717 | |
| 718 /* No conversion necessary */ | |
| 719 return type1; | |
| 720 } | |
| 721 | |
| 722 DEFUN ("coerce-number", Fcoerce_number, 2, 3, 0, /* | |
| 723 Convert NUMBER to the indicated type, possibly losing information. | |
| 724 Do not call this function. Use `coerce' instead. | |
| 725 | |
| 3025 | 726 TYPE is one of the symbols `fixnum', `integer', `ratio', `float', or |
| 727 `bigfloat'. Not all of these types may be supported. | |
| 1983 | 728 |
| 729 PRECISION is the number of bits of precision to use when converting to | |
| 730 bigfloat; it is ignored otherwise. If nil, the default precision is used. | |
| 731 | |
| 732 Note that some conversions lose information. No error is signaled in such | |
| 733 cases; the information is silently lost. | |
| 734 */ | |
| 2595 | 735 (number, type, USED_IF_BIGFLOAT (precision))) |
| 1983 | 736 { |
| 737 CHECK_SYMBOL (type); | |
| 738 if (EQ (type, Qfixnum)) | |
| 739 return internal_coerce_number (number, FIXNUM_T, 0UL); | |
| 740 else if (EQ (type, Qinteger)) | |
| 741 { | |
| 742 /* If bignums are available, we always convert to one first, then | |
| 743 downgrade to a fixnum if possible. */ | |
| 744 #ifdef HAVE_BIGNUM | |
| 745 return Fcanonicalize_number | |
| 746 (internal_coerce_number (number, BIGNUM_T, 0UL)); | |
| 747 #else | |
| 748 return internal_coerce_number (number, FIXNUM_T, 0UL); | |
| 749 #endif | |
| 750 } | |
| 751 #ifdef HAVE_RATIO | |
| 752 else if (EQ (type, Qratio)) | |
| 753 return internal_coerce_number (number, RATIO_T, 0UL); | |
| 754 #endif | |
| 755 else if (EQ (type, Qfloat)) | |
| 756 return internal_coerce_number (number, FLOAT_T, 0UL); | |
| 757 #ifdef HAVE_BIGFLOAT | |
| 758 else if (EQ (type, Qbigfloat)) | |
| 759 { | |
| 760 unsigned long prec; | |
| 761 | |
| 762 if (NILP (precision)) | |
| 763 prec = bigfloat_get_default_prec (); | |
| 764 else | |
| 765 { | |
| 766 CHECK_INTEGER (precision); | |
| 767 #ifdef HAVE_BIGNUM | |
| 768 if (INTP (precision)) | |
| 769 #endif /* HAVE_BIGNUM */ | |
| 770 prec = (unsigned long) XREALINT (precision); | |
| 771 #ifdef HAVE_BIGNUM | |
| 772 else | |
| 773 { | |
| 774 if (!bignum_fits_ulong_p (XBIGNUM_DATA (precision))) | |
| 775 args_out_of_range (precision, Vbigfloat_max_prec); | |
| 776 prec = bignum_to_ulong (XBIGNUM_DATA (precision)); | |
| 777 } | |
| 778 #endif /* HAVE_BIGNUM */ | |
| 779 } | |
| 780 return internal_coerce_number (number, BIGFLOAT_T, prec); | |
| 781 } | |
| 782 #endif /* HAVE_BIGFLOAT */ | |
| 783 | |
| 784 Fsignal (Qunsupported_type, type); | |
| 785 /* NOTREACHED */ | |
| 786 return Qnil; | |
| 787 } | |
| 788 | |
| 789 | |
| 790 void | |
| 791 syms_of_number (void) | |
| 792 { | |
| 793 #ifdef HAVE_BIGNUM | |
| 794 INIT_LRECORD_IMPLEMENTATION (bignum); | |
| 795 #endif | |
| 796 #ifdef HAVE_RATIO | |
| 797 INIT_LRECORD_IMPLEMENTATION (ratio); | |
| 798 #endif | |
| 799 #ifdef HAVE_BIGFLOAT | |
| 800 INIT_LRECORD_IMPLEMENTATION (bigfloat); | |
| 801 #endif | |
| 802 | |
| 803 /* Type predicates */ | |
| 804 DEFSYMBOL (Qrationalp); | |
| 805 DEFSYMBOL (Qfloatingp); | |
| 806 DEFSYMBOL (Qrealp); | |
| 807 DEFSYMBOL (Qbignump); | |
| 808 DEFSYMBOL (Qratiop); | |
| 809 DEFSYMBOL (Qbigfloatp); | |
| 810 | |
| 811 /* Functions */ | |
| 812 DEFSUBR (Fbignump); | |
| 813 DEFSUBR (Fintegerp); | |
| 814 DEFSUBR (Fevenp); | |
| 815 DEFSUBR (Foddp); | |
| 816 DEFSUBR (Fratiop); | |
| 817 DEFSUBR (Frationalp); | |
| 818 DEFSUBR (Fnumerator); | |
| 819 DEFSUBR (Fdenominator); | |
| 820 DEFSUBR (Fbigfloatp); | |
| 2092 | 821 DEFSUBR (Fbigfloat_get_precision); |
| 822 DEFSUBR (Fbigfloat_set_precision); | |
| 2001 | 823 DEFSUBR (Ffloatingp); |
| 1983 | 824 DEFSUBR (Frealp); |
| 825 DEFSUBR (Fcanonicalize_number); | |
| 826 DEFSUBR (Fcoerce_number); | |
| 827 | |
| 828 /* Errors */ | |
| 829 DEFERROR_STANDARD (Qunsupported_type, Qwrong_type_argument); | |
| 830 } | |
| 831 | |
| 832 void | |
| 833 vars_of_number (void) | |
| 834 { | |
| 2051 | 835 /* These variables are Lisp variables rather than number variables so that |
| 836 we can put bignums in them. */ | |
| 1983 | 837 DEFVAR_LISP_MAGIC ("default-float-precision", &Vdefault_float_precision, /* |
| 838 The default floating-point precision for newly created floating point values. | |
| 2092 | 839 This should be 0 to create Lisp float types, or an unsigned integer no greater |
| 840 than `bigfloat-maximum-precision' to create Lisp bigfloat types with the | |
| 841 indicated precision. | |
| 1983 | 842 */ default_float_precision_changed); |
| 843 Vdefault_float_precision = make_int (0); | |
| 844 | |
| 2092 | 845 DEFVAR_CONST_LISP ("bigfloat-maximum-precision", &Vbigfloat_max_prec /* |
| 1983 | 846 The maximum number of bits of precision a bigfloat can have. |
| 2092 | 847 This is determined by the underlying library used to implement bigfloats. |
| 1983 | 848 */); |
| 849 | |
| 2061 | 850 #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
|
851 /* 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
|
852 See reinit_vars_of_number(). */ |
| 2061 | 853 Vbigfloat_max_prec = make_int (EMACS_INT_MAX); |
| 854 #else | |
| 2051 | 855 Vbigfloat_max_prec = make_int (0); |
| 856 #endif /* HAVE_BIGFLOAT */ | |
| 857 | |
| 1983 | 858 DEFVAR_CONST_INT ("most-negative-fixnum", &Vmost_negative_fixnum /* |
| 859 The fixnum closest in value to negative infinity. | |
| 860 */); | |
| 861 Vmost_negative_fixnum = EMACS_INT_MIN; | |
| 862 | |
| 863 DEFVAR_CONST_INT ("most-positive-fixnum", &Vmost_positive_fixnum /* | |
| 864 The fixnum closest in value to positive infinity. | |
| 865 */); | |
| 866 Vmost_positive_fixnum = EMACS_INT_MAX; | |
| 867 | |
| 868 Fprovide (intern ("number-types")); | |
| 869 #ifdef HAVE_BIGNUM | |
| 870 Fprovide (intern ("bignum")); | |
| 871 #endif | |
| 872 #ifdef HAVE_RATIO | |
| 873 Fprovide (intern ("ratio")); | |
| 874 #endif | |
| 875 #ifdef HAVE_BIGFLOAT | |
| 876 Fprovide (intern ("bigfloat")); | |
| 877 #endif | |
| 878 } | |
| 879 | |
| 880 void | |
|
4802
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 (void) |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
882 { |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
883 #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
|
884 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
|
885 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
|
886 #endif |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
887 } |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
888 |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
889 void |
| 1983 | 890 init_number (void) |
| 891 { | |
| 892 if (!number_initialized) | |
| 893 { | |
| 894 number_initialized = 1; | |
| 895 | |
| 896 #ifdef WITH_GMP | |
| 897 init_number_gmp (); | |
| 898 #endif | |
| 899 #ifdef WITH_MP | |
| 900 init_number_mp (); | |
| 901 #endif | |
| 902 | |
| 903 #ifdef HAVE_BIGNUM | |
| 904 bignum_init (scratch_bignum); | |
| 905 bignum_init (scratch_bignum2); | |
| 906 #endif | |
| 907 | |
| 908 #ifdef HAVE_RATIO | |
| 909 ratio_init (scratch_ratio); | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3391
diff
changeset
|
910 ratio_init (scratch_ratio2); |
| 1983 | 911 #endif |
| 912 | |
| 913 #ifdef HAVE_BIGFLOAT | |
| 914 bigfloat_init (scratch_bigfloat); | |
| 915 bigfloat_init (scratch_bigfloat2); | |
| 916 #endif | |
|
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
917 |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
918 #ifndef PDUMP |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
919 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
|
920 #endif |
| 1983 | 921 } |
| 922 } |