Mercurial > hg > xemacs-beta
annotate src/number.c @ 5124:623d57b7fbe8 ben-lisp-object
separate regular and disksave finalization, print method fixes.
Create separate disksave method and make the finalize method only be for
actual object finalization, not disksave finalization.
Fix places where 0 was given in place of a printer -- print methods are
mandatory, and internal objects formerly without a print method now must
explicitly specify internal_object_printer().
Change the defn of CONSOLE_LIVE_P to avoid problems in some weird situations.
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-01-20 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (very_old_free_lcrecord):
* alloc.c (disksave_object_finalization_1):
* alloc.c (make_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (sweep_lcrecords_1):
* buffer.c:
* bytecode.c:
* bytecode.c (Fcompiled_function_p):
* chartab.c:
* console-impl.h:
* console-impl.h (CONSOLE_TYPE_P):
* console.c:
* console.c (set_quit_events):
* data.c:
* data.c (Fmake_ephemeron):
* database.c:
* database.c (finalize_database):
* database.c (Fclose_database):
* device-msw.c:
* device-msw.c (finalize_devmode):
* device-msw.c (allocate_devmode):
* device.c:
* elhash.c:
* elhash.c (finalize_hash_table):
* eval.c:
* eval.c (bind_multiple_value_limits):
* event-stream.c:
* event-stream.c (finalize_command_builder):
* events.c:
* events.c (mark_event):
* extents.c:
* extents.c (finalize_extent_info):
* extents.c (uninit_buffer_extents):
* faces.c:
* file-coding.c:
* file-coding.c (finalize_coding_system):
* file-coding.h:
* file-coding.h (struct coding_system_methods):
* file-coding.h (struct detector):
* floatfns.c:
* floatfns.c (extract_float):
* fns.c:
* fns.c (Fidentity):
* font-mgr.c (finalize_fc_pattern):
* font-mgr.c (finalize_fc_config):
* frame.c:
* glyphs.c:
* glyphs.c (finalize_image_instance):
* glyphs.c (unmap_subwindow_instance_cache_mapper):
* gui.c:
* gui.c (gui_error):
* keymap.c:
* lisp.h (struct Lisp_Symbol):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER):
* lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE):
* lrecord.h (DEFINE_DUMPABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (MAKE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (MAKE_MODULE_LISP_OBJECT):
* lstream.c:
* lstream.c (finalize_lstream):
* lstream.c (disksave_lstream):
* marker.c:
* marker.c (finalize_marker):
* mule-charset.c (make_charset):
* number.c:
* objects.c:
* objects.c (finalize_color_instance):
* objects.c (finalize_font_instance):
* opaque.c:
* opaque.c (make_opaque_ptr):
* process-nt.c:
* process-nt.c (nt_finalize_process_data):
* process-nt.c (nt_deactivate_process):
* process.c:
* process.c (finalize_process):
* procimpl.h (struct process_methods):
* scrollbar.c:
* scrollbar.c (free_scrollbar_instance):
* specifier.c (finalize_specifier):
* symbols.c:
* toolbar.c:
* toolbar.c (Ftoolbar_button_p):
* tooltalk.c:
* ui-gtk.c:
* ui-gtk.c (emacs_gtk_object_finalizer):
* ui-gtk.c (allocate_emacs_gtk_boxed_data):
* window.c:
* window.c (finalize_window):
* window.c (mark_window_as_deleted):
Separate out regular and disksave finalization. Instead of a
FOR_DISKSAVE argument to the finalizer, create a separate object
method `disksaver'. Make `finalizer' have only one argument.
Go through and separate out all finalize methods into finalize
and disksave. Delete lots of thereby redundant disksave checking.
Delete places that signal an error if we attempt to disksave --
all of these objects are non-dumpable and we will get an error
from pdump anyway if we attempt to dump them. After this is done,
only one object remains that has a disksave method -- lstream.
Change DEFINE_*_LISP_OBJECT_WITH_PROPS to DEFINE_*_GENERAL_LISP_OBJECT,
which is used for specifying either property methods or disksave
methods (or in the future, any other less-used methods).
Remove the for_disksave argument to finalize_process_data. Don't
provide a disksaver for processes because no one currently needs
it.
Clean up various places where objects didn't provide a print method.
It was made mandatory in previous changes, and all methods now
either provide their own print method or use internal_object_printer
or external_object_printer.
Change the definition of CONSOLE_LIVE_P to use the contype enum
rather than looking into the conmeths structure -- in some weird
situations with dead objects, the conmeths structure is NULL,
and printing such objects from debug_print() will crash if we try
to look into the conmeths structure.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Wed, 20 Jan 2010 07:05:57 -0600 |
| parents | e0db3c197671 |
| 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 | |
| 18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 19 Boston, MA 02111-1307, USA. */ | |
| 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 { |
| 56 CIbyte *bstr = bignum_to_string (XBIGNUM_DATA (obj), 10); | |
| 57 write_c_string (printcharfun, bstr); | |
| 58 xfree (bstr, CIbyte *); | |
| 59 } | |
| 60 | |
| 61 static int | |
| 2286 | 62 bignum_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth)) |
| 1983 | 63 { |
| 64 return bignum_eql (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2)); | |
| 65 } | |
| 66 | |
| 67 static Hashcode | |
| 2286 | 68 bignum_hash (Lisp_Object obj, int UNUSED (depth)) |
| 1983 | 69 { |
| 70 return bignum_hashcode (XBIGNUM_DATA (obj)); | |
| 71 } | |
| 72 | |
| 2551 | 73 static void |
| 74 bignum_convert (const void *object, void **data, Bytecount *size) | |
| 75 { | |
| 76 CIbyte *bstr = bignum_to_string (*(bignum *)object, 10); | |
| 77 *data = bstr; | |
| 78 *size = strlen(bstr)+1; | |
| 79 } | |
| 80 | |
| 81 static void | |
| 82 bignum_convfree (const void * UNUSED (object), void *data, | |
| 83 Bytecount UNUSED (size)) | |
| 84 { | |
| 85 xfree (data, void *); | |
| 86 } | |
| 87 | |
| 88 static void * | |
| 89 bignum_deconvert (void *object, void *data, Bytecount UNUSED (size)) | |
| 90 { | |
| 91 bignum *b = (bignum *) object; | |
| 92 bignum_init(*b); | |
| 93 bignum_set_string(*b, (const char *) data, 10); | |
| 94 return object; | |
| 95 } | |
| 96 | |
| 97 static const struct opaque_convert_functions bignum_opc = { | |
| 98 bignum_convert, | |
| 99 bignum_convfree, | |
| 100 bignum_deconvert | |
| 101 }; | |
| 102 | |
| 1983 | 103 static const struct memory_description bignum_description[] = { |
| 2551 | 104 { XD_OPAQUE_DATA_CONVERTIBLE, offsetof (Lisp_Bignum, data), |
| 105 0, { &bignum_opc }, XD_FLAG_NO_KKCC }, | |
| 1983 | 106 { XD_END } |
| 107 }; | |
| 108 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
109 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("bignum", bignum, 0, bignum_print, |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
110 0, bignum_equal, bignum_hash, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
111 bignum_description, Lisp_Bignum); |
| 1983 | 112 |
| 2092 | 113 #endif /* HAVE_BIGNUM */ |
| 1983 | 114 |
| 115 Lisp_Object Qbignump; | |
| 116 | |
| 117 DEFUN ("bignump", Fbignump, 1, 1, 0, /* | |
| 118 Return t if OBJECT is a bignum, nil otherwise. | |
| 119 */ | |
| 120 (object)) | |
| 121 { | |
| 122 return BIGNUMP (object) ? Qt : Qnil; | |
| 123 } | |
| 124 | |
| 125 | |
| 126 /********************************* Integers *********************************/ | |
| 127 DEFUN ("integerp", Fintegerp, 1, 1, 0, /* | |
| 128 Return t if OBJECT is an integer, nil otherwise. | |
| 129 */ | |
| 130 (object)) | |
| 131 { | |
| 132 return INTEGERP (object) ? Qt : Qnil; | |
| 133 } | |
| 134 | |
| 135 DEFUN ("evenp", Fevenp, 1, 1, 0, /* | |
| 136 Return t if INTEGER is even, nil otherwise. | |
| 137 */ | |
| 138 (integer)) | |
| 139 { | |
| 140 CONCHECK_INTEGER (integer); | |
| 1996 | 141 return (BIGNUMP (integer) |
| 142 ? bignum_evenp (XBIGNUM_DATA (integer)) | |
| 143 : XTYPE (integer) == Lisp_Type_Int_Even) ? Qt : Qnil; | |
| 1983 | 144 } |
| 145 | |
| 2019 | 146 DEFUN ("oddp", Foddp, 1, 1, 0, /* |
| 1983 | 147 Return t if INTEGER is odd, nil otherwise. |
| 148 */ | |
| 149 (integer)) | |
| 150 { | |
| 151 CONCHECK_INTEGER (integer); | |
| 1996 | 152 return (BIGNUMP (integer) |
| 153 ? bignum_oddp (XBIGNUM_DATA (integer)) | |
| 154 : XTYPE (integer) == Lisp_Type_Int_Odd) ? Qt : Qnil; | |
| 1983 | 155 } |
| 156 | |
| 157 | |
| 158 /********************************** Ratios **********************************/ | |
| 159 #ifdef HAVE_RATIO | |
| 160 static void | |
| 2286 | 161 ratio_print (Lisp_Object obj, Lisp_Object printcharfun, |
| 162 int UNUSED (escapeflag)) | |
| 1983 | 163 { |
| 164 CIbyte *rstr = ratio_to_string (XRATIO_DATA (obj), 10); | |
| 165 write_c_string (printcharfun, rstr); | |
| 166 xfree (rstr, CIbyte *); | |
| 167 } | |
| 168 | |
| 169 static int | |
| 2286 | 170 ratio_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth)) |
| 1983 | 171 { |
| 172 return ratio_eql (XRATIO_DATA (obj1), XRATIO_DATA (obj2)); | |
| 173 } | |
| 174 | |
| 175 static Hashcode | |
| 2286 | 176 ratio_hash (Lisp_Object obj, int UNUSED (depth)) |
| 1983 | 177 { |
| 178 return ratio_hashcode (XRATIO_DATA (obj)); | |
| 179 } | |
| 180 | |
| 181 static const struct memory_description ratio_description[] = { | |
| 182 { XD_OPAQUE_PTR, offsetof (Lisp_Ratio, data) }, | |
| 183 { XD_END } | |
| 184 }; | |
| 185 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
186 DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("ratio", ratio, 0, ratio_print, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
187 0, ratio_equal, ratio_hash, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
188 ratio_description, Lisp_Ratio); |
| 1983 | 189 |
| 2092 | 190 #endif /* HAVE_RATIO */ |
| 1983 | 191 |
| 192 Lisp_Object Qratiop; | |
| 193 | |
| 194 DEFUN ("ratiop", Fratiop, 1, 1, 0, /* | |
| 195 Return t if OBJECT is a ratio, nil otherwise. | |
| 196 */ | |
| 197 (object)) | |
| 198 { | |
| 199 return RATIOP (object) ? Qt : Qnil; | |
| 200 } | |
| 201 | |
| 202 | |
| 203 /******************************** Rationals *********************************/ | |
| 204 DEFUN ("rationalp", Frationalp, 1, 1, 0, /* | |
| 205 Return t if OBJECT is a rational, nil otherwise. | |
| 206 */ | |
| 207 (object)) | |
| 208 { | |
| 209 return RATIONALP (object) ? Qt : Qnil; | |
| 210 } | |
| 211 | |
| 212 DEFUN ("numerator", Fnumerator, 1, 1, 0, /* | |
| 213 Return the numerator of the canonical form of RATIONAL. | |
| 214 If RATIONAL is an integer, RATIONAL is returned. | |
| 215 */ | |
| 216 (rational)) | |
| 217 { | |
| 218 CONCHECK_RATIONAL (rational); | |
| 219 #ifdef HAVE_RATIO | |
| 220 return RATIOP (rational) | |
| 221 ? make_bignum_bg (XRATIO_NUMERATOR (rational)) | |
| 222 : rational; | |
| 223 #else | |
| 224 return rational; | |
| 225 #endif | |
| 226 } | |
| 227 | |
| 228 DEFUN ("denominator", Fdenominator, 1, 1, 0, /* | |
| 229 Return the denominator of the canonical form of RATIONAL. | |
| 230 If RATIONAL is an integer, 1 is returned. | |
| 231 */ | |
| 232 (rational)) | |
| 233 { | |
| 234 CONCHECK_RATIONAL (rational); | |
| 235 #ifdef HAVE_RATIO | |
| 236 return RATIOP (rational) | |
| 237 ? make_bignum_bg (XRATIO_DENOMINATOR (rational)) | |
| 238 : make_int (1); | |
| 239 #else | |
| 240 return rational; | |
| 241 #endif | |
| 242 } | |
| 243 | |
| 244 | |
| 245 /******************************** Bigfloats *********************************/ | |
| 246 #ifdef HAVE_BIGFLOAT | |
| 247 static void | |
| 2286 | 248 bigfloat_print (Lisp_Object obj, Lisp_Object printcharfun, |
| 249 int UNUSED (escapeflag)) | |
| 1983 | 250 { |
| 251 CIbyte *fstr = bigfloat_to_string (XBIGFLOAT_DATA (obj), 10); | |
| 252 write_c_string (printcharfun, fstr); | |
| 253 xfree (fstr, CIbyte *); | |
| 254 } | |
| 255 | |
| 256 static int | |
| 2286 | 257 bigfloat_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth)) |
| 1983 | 258 { |
| 259 return bigfloat_eql (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2)); | |
| 260 } | |
| 261 | |
| 262 static Hashcode | |
| 2286 | 263 bigfloat_hash (Lisp_Object obj, int UNUSED (depth)) |
| 1983 | 264 { |
| 265 return bigfloat_hashcode (XBIGFLOAT_DATA (obj)); | |
| 266 } | |
| 267 | |
| 268 static const struct memory_description bigfloat_description[] = { | |
| 269 { XD_OPAQUE_PTR, offsetof (Lisp_Bigfloat, bf) }, | |
| 270 { XD_END } | |
| 271 }; | |
| 272 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
273 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("bigfloat", bigfloat, 0, |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
274 bigfloat_print, 0, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
275 bigfloat_equal, bigfloat_hash, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
276 bigfloat_description, Lisp_Bigfloat); |
| 1983 | 277 |
| 2092 | 278 #endif /* HAVE_BIGFLOAT */ |
| 1983 | 279 |
| 280 Lisp_Object Qbigfloatp; | |
| 281 | |
| 282 DEFUN ("bigfloatp", Fbigfloatp, 1, 1, 0, /* | |
| 283 Return t if OBJECT is a bigfloat, nil otherwise. | |
| 284 */ | |
| 285 (object)) | |
| 286 { | |
| 287 return BIGFLOATP (object) ? Qt : Qnil; | |
| 288 } | |
| 289 | |
| 2092 | 290 DEFUN ("bigfloat-get-precision", Fbigfloat_get_precision, 1, 1, 0, /* |
| 291 Return the precision of bigfloat F as an integer. | |
| 292 */ | |
| 293 (f)) | |
| 294 { | |
| 295 CHECK_BIGFLOAT (f); | |
| 296 #ifdef HAVE_BIGNUM | |
| 297 bignum_set_ulong (scratch_bignum, XBIGFLOAT_GET_PREC (f)); | |
| 298 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); | |
| 299 #else | |
| 300 return make_int ((int) XBIGFLOAT_GET_PREC (f)); | |
| 301 #endif | |
| 302 } | |
| 303 | |
| 304 DEFUN ("bigfloat-set-precision", Fbigfloat_set_precision, 2, 2, 0, /* | |
| 305 Set the precision of F, a bigfloat, to PRECISION, a nonnegative integer. | |
| 306 The new precision of F is returned. Note that the return value may differ | |
| 307 from PRECISION if the underlying library is unable to support exactly | |
| 308 PRECISION bits of precision. | |
| 309 */ | |
| 310 (f, precision)) | |
| 311 { | |
| 312 unsigned long prec; | |
| 313 | |
| 314 CHECK_BIGFLOAT (f); | |
| 315 if (INTP (precision)) | |
| 316 { | |
| 317 prec = (XINT (precision) <= 0) ? 1UL : (unsigned long) XINT (precision); | |
| 318 } | |
| 319 #ifdef HAVE_BIGNUM | |
| 320 else if (BIGNUMP (precision)) | |
| 321 { | |
| 322 prec = bignum_fits_ulong_p (XBIGNUM_DATA (precision)) | |
| 323 ? bignum_to_ulong (XBIGNUM_DATA (precision)) | |
| 324 : UINT_MAX; | |
| 325 } | |
| 326 #endif | |
| 327 else | |
| 328 { | |
| 329 dead_wrong_type_argument (Qintegerp, f); | |
| 330 return Qnil; | |
| 331 } | |
| 332 | |
| 333 XBIGFLOAT_SET_PREC (f, prec); | |
| 334 return Fbigfloat_get_precision (f); | |
| 335 } | |
| 336 | |
| 1983 | 337 static int |
| 2286 | 338 default_float_precision_changed (Lisp_Object UNUSED (sym), Lisp_Object *val, |
| 339 Lisp_Object UNUSED (in_object), | |
| 340 int UNUSED (flags)) | |
| 1983 | 341 { |
| 342 unsigned long prec; | |
| 343 | |
| 344 CONCHECK_INTEGER (*val); | |
| 345 #ifdef HAVE_BIGFLOAT | |
| 346 if (INTP (*val)) | |
| 347 prec = XINT (*val); | |
| 348 else | |
| 349 { | |
| 350 if (!bignum_fits_ulong_p (XBIGNUM_DATA (*val))) | |
| 351 args_out_of_range_3 (*val, Qzero, Vbigfloat_max_prec); | |
| 352 prec = bignum_to_ulong (XBIGNUM_DATA (*val)); | |
| 353 } | |
| 354 if (prec != 0UL) | |
| 355 bigfloat_set_default_prec (prec); | |
| 356 #endif | |
| 357 return 0; | |
| 358 } | |
| 359 | |
| 360 | |
| 361 /********************************* Floating *********************************/ | |
| 362 Lisp_Object | |
| 363 make_floating (double d) | |
| 364 { | |
| 365 #ifdef HAVE_BIGFLOAT | |
| 366 if (ZEROP (Vdefault_float_precision)) | |
| 367 #endif | |
| 368 return make_float (d); | |
| 369 #ifdef HAVE_BIGFLOAT | |
| 370 else | |
| 371 return make_bigfloat (d, 0UL); | |
| 372 #endif | |
| 373 } | |
| 374 | |
| 375 DEFUN ("floatingp", Ffloatingp, 1, 1, 0, /* | |
| 376 Return t if OBJECT is a floating point number of any kind, nil otherwise. | |
| 377 */ | |
| 378 (object)) | |
| 379 { | |
| 380 return FLOATINGP (object) ? Qt : Qnil; | |
| 381 } | |
| 382 | |
| 383 | |
| 384 /********************************** Reals ***********************************/ | |
| 385 DEFUN ("realp", Frealp, 1, 1, 0, /* | |
| 386 Return t if OBJECT is a real, nil otherwise. | |
| 387 */ | |
| 388 (object)) | |
| 389 { | |
| 390 return REALP (object) ? Qt : Qnil; | |
| 391 } | |
| 392 | |
| 393 | |
| 394 /********************************* Numbers **********************************/ | |
| 395 DEFUN ("canonicalize-number", Fcanonicalize_number, 1, 1, 0, /* | |
| 396 Return the canonical form of NUMBER. | |
| 397 */ | |
| 398 (number)) | |
| 399 { | |
| 400 /* The tests should go in order from larger, more expressive, or more | |
| 401 complex types to smaller, less expressive, or simpler types so that a | |
| 402 number can cascade all the way down to the simplest type if | |
| 403 appropriate. */ | |
| 404 #ifdef HAVE_RATIO | |
| 405 if (RATIOP (number) && | |
| 406 bignum_fits_long_p (XRATIO_DENOMINATOR (number)) && | |
| 407 bignum_to_long (XRATIO_DENOMINATOR (number)) == 1L) | |
| 408 number = make_bignum_bg (XRATIO_NUMERATOR (number)); | |
| 409 #endif | |
| 410 #ifdef HAVE_BIGNUM | |
| 3391 | 411 if (BIGNUMP (number) && bignum_fits_emacs_int_p (XBIGNUM_DATA (number))) |
| 1983 | 412 { |
| 3391 | 413 EMACS_INT n = bignum_to_emacs_int (XBIGNUM_DATA (number)); |
| 1983 | 414 if (NUMBER_FITS_IN_AN_EMACS_INT (n)) |
| 415 number = make_int (n); | |
| 416 } | |
| 417 #endif | |
| 418 return number; | |
| 419 } | |
| 420 | |
| 421 enum number_type | |
| 422 get_number_type (Lisp_Object arg) | |
| 423 { | |
| 424 if (INTP (arg)) | |
| 425 return FIXNUM_T; | |
| 426 #ifdef HAVE_BIGNUM | |
| 427 if (BIGNUMP (arg)) | |
| 428 return BIGNUM_T; | |
| 429 #endif | |
| 430 #ifdef HAVE_RATIO | |
| 431 if (RATIOP (arg)) | |
| 432 return RATIO_T; | |
| 433 #endif | |
| 434 if (FLOATP (arg)) | |
| 435 return FLOAT_T; | |
| 436 #ifdef HAVE_BIGFLOAT | |
| 437 if (BIGFLOATP (arg)) | |
| 438 return BIGFLOAT_T; | |
| 439 #endif | |
| 440 /* Catch unintentional bad uses of this function */ | |
| 2500 | 441 ABORT (); |
| 1995 | 442 /* NOTREACHED */ |
| 443 return FIXNUM_T; | |
| 1983 | 444 } |
| 445 | |
| 446 /* Convert NUMBER to type TYPE. If TYPE is BIGFLOAT_T then use the indicated | |
| 447 PRECISION; otherwise, PRECISION is ignored. */ | |
| 448 static Lisp_Object | |
| 449 internal_coerce_number (Lisp_Object number, enum number_type type, | |
| 2286 | 450 #ifdef HAVE_BIGFLOAT |
| 451 unsigned long precision | |
| 452 #else | |
| 453 unsigned long UNUSED (precision) | |
| 454 #endif | |
| 455 ) | |
| 1983 | 456 { |
| 457 enum number_type current_type; | |
| 458 | |
| 459 if (CHARP (number)) | |
| 460 number = make_int (XCHAR (number)); | |
| 461 else if (MARKERP (number)) | |
| 462 number = make_int (marker_position (number)); | |
| 463 | |
| 464 /* Note that CHECK_NUMBER ensures that NUMBER is a supported type. Hence, | |
| 2500 | 465 we ABORT() in the #else sections below, because it shouldn't be possible |
| 1983 | 466 to arrive there. */ |
| 467 CHECK_NUMBER (number); | |
| 468 current_type = get_number_type (number); | |
| 469 switch (current_type) | |
| 470 { | |
| 471 case FIXNUM_T: | |
| 472 switch (type) | |
| 473 { | |
| 474 case FIXNUM_T: | |
| 475 return number; | |
| 476 case BIGNUM_T: | |
| 477 #ifdef HAVE_BIGNUM | |
| 478 return make_bignum (XREALINT (number)); | |
| 479 #else | |
| 2500 | 480 ABORT (); |
| 1983 | 481 #endif /* HAVE_BIGNUM */ |
| 482 case RATIO_T: | |
| 483 #ifdef HAVE_RATIO | |
| 484 return make_ratio (XREALINT (number), 1UL); | |
| 485 #else | |
| 2500 | 486 ABORT (); |
| 1983 | 487 #endif /* HAVE_RATIO */ |
| 488 case FLOAT_T: | |
| 489 return make_float (XREALINT (number)); | |
| 490 case BIGFLOAT_T: | |
| 491 #ifdef HAVE_BIGFLOAT | |
| 492 return make_bigfloat (XREALINT (number), precision); | |
| 493 #else | |
| 2500 | 494 ABORT (); |
| 1983 | 495 #endif /* HAVE_BIGFLOAT */ |
| 496 } | |
| 497 case BIGNUM_T: | |
| 498 #ifdef HAVE_BIGNUM | |
| 499 switch (type) | |
| 500 { | |
| 501 case FIXNUM_T: | |
| 502 return make_int (bignum_to_long (XBIGNUM_DATA (number))); | |
| 503 case BIGNUM_T: | |
| 504 return number; | |
| 505 case RATIO_T: | |
| 506 #ifdef HAVE_RATIO | |
| 507 bignum_set_long (scratch_bignum, 1L); | |
| 508 return make_ratio_bg (XBIGNUM_DATA (number), scratch_bignum); | |
| 509 #else | |
| 2500 | 510 ABORT (); |
| 1983 | 511 #endif /* HAVE_RATIO */ |
| 512 case FLOAT_T: | |
| 513 return make_float (bignum_to_double (XBIGNUM_DATA (number))); | |
| 514 case BIGFLOAT_T: | |
| 515 #ifdef HAVE_BIGFLOAT | |
| 516 { | |
| 517 Lisp_Object temp; | |
| 518 temp = make_bigfloat (0.0, precision); | |
| 519 bigfloat_set_bignum (XBIGFLOAT_DATA (temp), XBIGNUM_DATA (number)); | |
| 520 return temp; | |
| 521 } | |
| 522 #else | |
| 2500 | 523 ABORT (); |
| 1983 | 524 #endif /* HAVE_BIGFLOAT */ |
| 525 } | |
| 526 #else | |
| 2500 | 527 ABORT (); |
| 1983 | 528 #endif /* HAVE_BIGNUM */ |
| 529 case RATIO_T: | |
| 530 #ifdef HAVE_RATIO | |
| 531 switch (type) | |
| 532 { | |
| 533 case FIXNUM_T: | |
| 534 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number), | |
| 535 XRATIO_DENOMINATOR (number)); | |
| 536 return make_int (bignum_to_long (scratch_bignum)); | |
| 537 case BIGNUM_T: | |
| 538 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number), | |
| 539 XRATIO_DENOMINATOR (number)); | |
| 540 return make_bignum_bg (scratch_bignum); | |
| 541 case RATIO_T: | |
| 542 return number; | |
| 543 case FLOAT_T: | |
| 544 return make_float (ratio_to_double (XRATIO_DATA (number))); | |
| 545 case BIGFLOAT_T: | |
| 546 #ifdef HAVE_BIGFLOAT | |
| 547 { | |
| 548 Lisp_Object temp; | |
| 549 temp = make_bigfloat (0.0, precision); | |
| 550 bigfloat_set_ratio (XBIGFLOAT_DATA (temp), XRATIO_DATA (number)); | |
| 551 return temp; | |
| 552 } | |
| 553 #else | |
| 2500 | 554 ABORT (); |
| 1983 | 555 #endif /* HAVE_BIGFLOAT */ |
| 556 } | |
| 557 #else | |
| 2500 | 558 ABORT (); |
| 1983 | 559 #endif /* HAVE_RATIO */ |
| 560 case FLOAT_T: | |
| 561 switch (type) | |
| 562 { | |
| 563 case FIXNUM_T: | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3391
diff
changeset
|
564 return Ftruncate (number, Qnil); |
| 1983 | 565 case BIGNUM_T: |
| 566 #ifdef HAVE_BIGNUM | |
| 567 bignum_set_double (scratch_bignum, XFLOAT_DATA (number)); | |
| 568 return make_bignum_bg (scratch_bignum); | |
| 569 #else | |
| 2500 | 570 ABORT (); |
| 1983 | 571 #endif /* HAVE_BIGNUM */ |
| 572 case RATIO_T: | |
| 573 #ifdef HAVE_RATIO | |
| 574 ratio_set_double (scratch_ratio, XFLOAT_DATA (number)); | |
| 575 return make_ratio_rt (scratch_ratio); | |
| 576 #else | |
| 2500 | 577 ABORT (); |
| 1983 | 578 #endif /* HAVE_RATIO */ |
| 579 case FLOAT_T: | |
| 580 return number; | |
| 581 case BIGFLOAT_T: | |
| 582 #ifdef HAVE_BIGFLOAT | |
| 583 bigfloat_set_prec (scratch_bigfloat, precision); | |
| 584 bigfloat_set_double (scratch_bigfloat, XFLOAT_DATA (number)); | |
| 585 return make_bigfloat_bf (scratch_bigfloat); | |
| 586 #else | |
| 2500 | 587 ABORT (); |
| 1983 | 588 #endif /* HAVE_BIGFLOAT */ |
| 589 } | |
| 590 case BIGFLOAT_T: | |
| 591 #ifdef HAVE_BIGFLOAT | |
| 592 switch (type) | |
| 593 { | |
| 594 case FIXNUM_T: | |
| 595 return make_int (bigfloat_to_long (XBIGFLOAT_DATA (number))); | |
| 596 case BIGNUM_T: | |
| 597 #ifdef HAVE_BIGNUM | |
| 598 bignum_set_bigfloat (scratch_bignum, XBIGFLOAT_DATA (number)); | |
| 599 return make_bignum_bg (scratch_bignum); | |
| 600 #else | |
| 2500 | 601 ABORT (); |
| 1983 | 602 #endif /* HAVE_BIGNUM */ |
| 603 case RATIO_T: | |
| 604 #ifdef HAVE_RATIO | |
| 605 ratio_set_bigfloat (scratch_ratio, XBIGFLOAT_DATA (number)); | |
| 606 return make_ratio_rt (scratch_ratio); | |
| 607 #else | |
| 2500 | 608 ABORT (); |
| 1983 | 609 #endif |
| 610 case FLOAT_T: | |
| 611 return make_float (bigfloat_to_double (XBIGFLOAT_DATA (number))); | |
| 612 case BIGFLOAT_T: | |
| 613 /* FIXME: Do we need to change the precision? */ | |
| 614 return number; | |
| 615 } | |
| 616 #else | |
| 2500 | 617 ABORT (); |
| 1983 | 618 #endif /* HAVE_BIGFLOAT */ |
| 619 } | |
| 2500 | 620 ABORT (); |
| 1995 | 621 /* NOTREACHED */ |
| 622 return Qzero; | |
| 1983 | 623 } |
| 624 | |
| 625 /* This function promotes its arguments as necessary to make them both the | |
| 626 same type. It destructively modifies its arguments to do so. Characters | |
| 627 and markers are ALWAYS converted to integers. */ | |
| 628 enum number_type | |
| 629 promote_args (Lisp_Object *arg1, Lisp_Object *arg2) | |
| 630 { | |
| 631 enum number_type type1, type2; | |
| 632 | |
| 633 if (CHARP (*arg1)) | |
| 634 *arg1 = make_int (XCHAR (*arg1)); | |
| 635 else if (MARKERP (*arg1)) | |
| 636 *arg1 = make_int (marker_position (*arg1)); | |
| 637 if (CHARP (*arg2)) | |
| 638 *arg2 = make_int (XCHAR (*arg2)); | |
| 639 else if (MARKERP (*arg2)) | |
| 640 *arg2 = make_int (marker_position (*arg2)); | |
| 641 | |
| 642 CHECK_NUMBER (*arg1); | |
| 643 CHECK_NUMBER (*arg2); | |
| 644 | |
| 645 type1 = get_number_type (*arg1); | |
| 646 type2 = get_number_type (*arg2); | |
| 647 | |
| 648 if (type1 < type2) | |
| 649 { | |
| 650 *arg1 = internal_coerce_number (*arg1, type2, | |
| 651 #ifdef HAVE_BIGFLOAT | |
| 652 type2 == BIGFLOAT_T | |
| 653 ? XBIGFLOAT_GET_PREC (*arg2) : | |
| 654 #endif | |
| 655 0UL); | |
| 656 return type2; | |
| 657 } | |
| 658 | |
| 659 if (type2 < type1) | |
| 660 { | |
| 661 *arg2 = internal_coerce_number (*arg2, type1, | |
| 662 #ifdef HAVE_BIGFLOAT | |
| 663 type1 == BIGFLOAT_T | |
| 664 ? XBIGFLOAT_GET_PREC (*arg1) : | |
| 665 #endif | |
| 666 0UL); | |
| 667 return type1; | |
| 668 } | |
| 669 | |
| 670 /* No conversion necessary */ | |
| 671 return type1; | |
| 672 } | |
| 673 | |
| 674 DEFUN ("coerce-number", Fcoerce_number, 2, 3, 0, /* | |
| 675 Convert NUMBER to the indicated type, possibly losing information. | |
| 676 Do not call this function. Use `coerce' instead. | |
| 677 | |
| 3025 | 678 TYPE is one of the symbols `fixnum', `integer', `ratio', `float', or |
| 679 `bigfloat'. Not all of these types may be supported. | |
| 1983 | 680 |
| 681 PRECISION is the number of bits of precision to use when converting to | |
| 682 bigfloat; it is ignored otherwise. If nil, the default precision is used. | |
| 683 | |
| 684 Note that some conversions lose information. No error is signaled in such | |
| 685 cases; the information is silently lost. | |
| 686 */ | |
| 2595 | 687 (number, type, USED_IF_BIGFLOAT (precision))) |
| 1983 | 688 { |
| 689 CHECK_SYMBOL (type); | |
| 690 if (EQ (type, Qfixnum)) | |
| 691 return internal_coerce_number (number, FIXNUM_T, 0UL); | |
| 692 else if (EQ (type, Qinteger)) | |
| 693 { | |
| 694 /* If bignums are available, we always convert to one first, then | |
| 695 downgrade to a fixnum if possible. */ | |
| 696 #ifdef HAVE_BIGNUM | |
| 697 return Fcanonicalize_number | |
| 698 (internal_coerce_number (number, BIGNUM_T, 0UL)); | |
| 699 #else | |
| 700 return internal_coerce_number (number, FIXNUM_T, 0UL); | |
| 701 #endif | |
| 702 } | |
| 703 #ifdef HAVE_RATIO | |
| 704 else if (EQ (type, Qratio)) | |
| 705 return internal_coerce_number (number, RATIO_T, 0UL); | |
| 706 #endif | |
| 707 else if (EQ (type, Qfloat)) | |
| 708 return internal_coerce_number (number, FLOAT_T, 0UL); | |
| 709 #ifdef HAVE_BIGFLOAT | |
| 710 else if (EQ (type, Qbigfloat)) | |
| 711 { | |
| 712 unsigned long prec; | |
| 713 | |
| 714 if (NILP (precision)) | |
| 715 prec = bigfloat_get_default_prec (); | |
| 716 else | |
| 717 { | |
| 718 CHECK_INTEGER (precision); | |
| 719 #ifdef HAVE_BIGNUM | |
| 720 if (INTP (precision)) | |
| 721 #endif /* HAVE_BIGNUM */ | |
| 722 prec = (unsigned long) XREALINT (precision); | |
| 723 #ifdef HAVE_BIGNUM | |
| 724 else | |
| 725 { | |
| 726 if (!bignum_fits_ulong_p (XBIGNUM_DATA (precision))) | |
| 727 args_out_of_range (precision, Vbigfloat_max_prec); | |
| 728 prec = bignum_to_ulong (XBIGNUM_DATA (precision)); | |
| 729 } | |
| 730 #endif /* HAVE_BIGNUM */ | |
| 731 } | |
| 732 return internal_coerce_number (number, BIGFLOAT_T, prec); | |
| 733 } | |
| 734 #endif /* HAVE_BIGFLOAT */ | |
| 735 | |
| 736 Fsignal (Qunsupported_type, type); | |
| 737 /* NOTREACHED */ | |
| 738 return Qnil; | |
| 739 } | |
| 740 | |
| 741 | |
| 742 void | |
| 743 syms_of_number (void) | |
| 744 { | |
| 745 #ifdef HAVE_BIGNUM | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
746 INIT_LISP_OBJECT (bignum); |
| 1983 | 747 #endif |
| 748 #ifdef HAVE_RATIO | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
749 INIT_LISP_OBJECT (ratio); |
| 1983 | 750 #endif |
| 751 #ifdef HAVE_BIGFLOAT | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
752 INIT_LISP_OBJECT (bigfloat); |
| 1983 | 753 #endif |
| 754 | |
| 755 /* Type predicates */ | |
| 756 DEFSYMBOL (Qrationalp); | |
| 757 DEFSYMBOL (Qfloatingp); | |
| 758 DEFSYMBOL (Qrealp); | |
| 759 DEFSYMBOL (Qbignump); | |
| 760 DEFSYMBOL (Qratiop); | |
| 761 DEFSYMBOL (Qbigfloatp); | |
| 762 | |
| 763 /* Functions */ | |
| 764 DEFSUBR (Fbignump); | |
| 765 DEFSUBR (Fintegerp); | |
| 766 DEFSUBR (Fevenp); | |
| 767 DEFSUBR (Foddp); | |
| 768 DEFSUBR (Fratiop); | |
| 769 DEFSUBR (Frationalp); | |
| 770 DEFSUBR (Fnumerator); | |
| 771 DEFSUBR (Fdenominator); | |
| 772 DEFSUBR (Fbigfloatp); | |
| 2092 | 773 DEFSUBR (Fbigfloat_get_precision); |
| 774 DEFSUBR (Fbigfloat_set_precision); | |
| 2001 | 775 DEFSUBR (Ffloatingp); |
| 1983 | 776 DEFSUBR (Frealp); |
| 777 DEFSUBR (Fcanonicalize_number); | |
| 778 DEFSUBR (Fcoerce_number); | |
| 779 | |
| 780 /* Errors */ | |
| 781 DEFERROR_STANDARD (Qunsupported_type, Qwrong_type_argument); | |
| 782 } | |
| 783 | |
| 784 void | |
| 785 vars_of_number (void) | |
| 786 { | |
| 2051 | 787 /* These variables are Lisp variables rather than number variables so that |
| 788 we can put bignums in them. */ | |
| 1983 | 789 DEFVAR_LISP_MAGIC ("default-float-precision", &Vdefault_float_precision, /* |
| 790 The default floating-point precision for newly created floating point values. | |
| 2092 | 791 This should be 0 to create Lisp float types, or an unsigned integer no greater |
| 792 than `bigfloat-maximum-precision' to create Lisp bigfloat types with the | |
| 793 indicated precision. | |
| 1983 | 794 */ default_float_precision_changed); |
| 795 Vdefault_float_precision = make_int (0); | |
| 796 | |
| 2092 | 797 DEFVAR_CONST_LISP ("bigfloat-maximum-precision", &Vbigfloat_max_prec /* |
| 1983 | 798 The maximum number of bits of precision a bigfloat can have. |
| 2092 | 799 This is determined by the underlying library used to implement bigfloats. |
| 1983 | 800 */); |
| 801 | |
| 2061 | 802 #ifdef HAVE_BIGFLOAT |
| 803 #ifdef HAVE_BIGNUM | |
| 804 Vbigfloat_max_prec = make_bignum (0L); | |
| 805 bignum_set_ulong (XBIGNUM_DATA (Vbigfloat_max_prec), ULONG_MAX); | |
| 2051 | 806 #else |
| 2061 | 807 Vbigfloat_max_prec = make_int (EMACS_INT_MAX); |
| 808 #endif | |
| 809 #else | |
| 2051 | 810 Vbigfloat_max_prec = make_int (0); |
| 811 #endif /* HAVE_BIGFLOAT */ | |
| 812 | |
| 1983 | 813 DEFVAR_CONST_INT ("most-negative-fixnum", &Vmost_negative_fixnum /* |
| 814 The fixnum closest in value to negative infinity. | |
| 815 */); | |
| 816 Vmost_negative_fixnum = EMACS_INT_MIN; | |
| 817 | |
| 818 DEFVAR_CONST_INT ("most-positive-fixnum", &Vmost_positive_fixnum /* | |
| 819 The fixnum closest in value to positive infinity. | |
| 820 */); | |
| 821 Vmost_positive_fixnum = EMACS_INT_MAX; | |
| 822 | |
| 823 Fprovide (intern ("number-types")); | |
| 824 #ifdef HAVE_BIGNUM | |
| 825 Fprovide (intern ("bignum")); | |
| 826 #endif | |
| 827 #ifdef HAVE_RATIO | |
| 828 Fprovide (intern ("ratio")); | |
| 829 #endif | |
| 830 #ifdef HAVE_BIGFLOAT | |
| 831 Fprovide (intern ("bigfloat")); | |
| 832 #endif | |
| 833 } | |
| 834 | |
| 835 void | |
| 836 init_number (void) | |
| 837 { | |
| 838 if (!number_initialized) | |
| 839 { | |
| 840 number_initialized = 1; | |
| 841 | |
| 842 #ifdef WITH_GMP | |
| 843 init_number_gmp (); | |
| 844 #endif | |
| 845 #ifdef WITH_MP | |
| 846 init_number_mp (); | |
| 847 #endif | |
| 848 | |
| 849 #ifdef HAVE_BIGNUM | |
| 850 bignum_init (scratch_bignum); | |
| 851 bignum_init (scratch_bignum2); | |
| 852 #endif | |
| 853 | |
| 854 #ifdef HAVE_RATIO | |
| 855 ratio_init (scratch_ratio); | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3391
diff
changeset
|
856 ratio_init (scratch_ratio2); |
| 1983 | 857 #endif |
| 858 | |
| 859 #ifdef HAVE_BIGFLOAT | |
| 860 bigfloat_init (scratch_bigfloat); | |
| 861 bigfloat_init (scratch_bigfloat2); | |
| 862 #endif | |
| 863 } | |
| 864 } |