diff src/alloc.c @ 1983:9c872f33ecbe

[xemacs-hg @ 2004-04-05 22:49:31 by james] Add bignum, ratio, and bigfloat support.
author james
date Mon, 05 Apr 2004 22:50:11 +0000
parents 59e1bbea04fe
children f913c1545598
line wrap: on
line diff
--- a/src/alloc.c	Mon Apr 05 21:50:47 2004 +0000
+++ b/src/alloc.c	Mon Apr 05 22:50:11 2004 +0000
@@ -645,8 +645,8 @@
    may be more efficient when there are only a small number of them.
 
    The types that are stored in these large blocks (or "frob blocks")
-   are cons, float, compiled-function, symbol, marker, extent, event,
-   and string.
+   are cons, all number types except fixnum, compiled-function, symbol,
+   marker, extent, event, and string.
 
    Note that strings are special in that they are actually stored in
    two parts: a structure containing information about the string, and
@@ -1163,6 +1163,8 @@
 /*			  Float allocation				*/
 /************************************************************************/
 
+/*** With enhanced number support, these are short floats */
+
 DECLARE_FIXED_TYPE_ALLOC (float, Lisp_Float);
 #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_float 1000
 
@@ -1184,6 +1186,124 @@
 
 
 /************************************************************************/
+/*			Enhanced number allocation			*/
+/************************************************************************/
+
+/*** Bignum ***/
+#ifdef HAVE_BIGNUM
+DECLARE_FIXED_TYPE_ALLOC (bignum, Lisp_Bignum);
+#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_bignum 250
+
+/* WARNING: This function returns a bignum even if its argument fits into a
+   fixnum.  See Fcanonicalize_number(). */
+Lisp_Object
+make_bignum (long bignum_value)
+{
+  Lisp_Bignum *b;
+
+  ALLOCATE_FIXED_TYPE (bignum, Lisp_Bignum, b);
+  set_lheader_implementation (&b->lheader, &lrecord_bignum);
+  bignum_init (bignum_data (b));
+  bignum_set_long (bignum_data (b), bignum_value);
+  return wrap_bignum (b);
+}
+
+/* WARNING: This function returns a bignum even if its argument fits into a
+   fixnum.  See Fcanonicalize_number(). */
+Lisp_Object
+make_bignum_bg (bignum bg)
+{
+  Lisp_Bignum *b;
+
+  ALLOCATE_FIXED_TYPE (bignum, Lisp_Bignum, b);
+  set_lheader_implementation (&b->lheader, &lrecord_bignum);
+  bignum_init (bignum_data (b));
+  bignum_set (bignum_data (b), bg);
+  return wrap_bignum (b);
+}
+#endif /* HAVE_BIGNUM */
+
+/*** Ratio ***/
+#ifdef HAVE_RATIO
+DECLARE_FIXED_TYPE_ALLOC (ratio, Lisp_Ratio);
+#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_ratio 250
+
+Lisp_Object
+make_ratio (long numerator, unsigned long denominator)
+{
+  Lisp_Ratio *r;
+
+  ALLOCATE_FIXED_TYPE (ratio, Lisp_Ratio, r);
+  set_lheader_implementation (&r->lheader, &lrecord_ratio);
+  ratio_init (ratio_data (r));
+  ratio_set_long_ulong (ratio_data (r), numerator, denominator);
+  ratio_canonicalize (ratio_data (r));
+  return wrap_ratio (r);
+}
+
+Lisp_Object
+make_ratio_bg (bignum numerator, bignum denominator)
+{
+  Lisp_Ratio *r;
+
+  ALLOCATE_FIXED_TYPE (ratio, Lisp_Ratio, r);
+  set_lheader_implementation (&r->lheader, &lrecord_ratio);
+  ratio_init (ratio_data (r));
+  ratio_set_bignum_bignum (ratio_data (r), numerator, denominator);
+  ratio_canonicalize (ratio_data (r));
+  return wrap_ratio (r);
+}
+
+Lisp_Object
+make_ratio_rt (ratio rat)
+{
+  Lisp_Ratio *r;
+
+  ALLOCATE_FIXED_TYPE (ratio, Lisp_Ratio, r);
+  set_lheader_implementation (&r->lheader, &lrecord_ratio);
+  ratio_init (ratio_data (r));
+  ratio_set (ratio_data (r), rat);
+  return wrap_ratio (r);
+}
+#endif /* HAVE_RATIO */
+
+/*** Bigfloat ***/
+#ifdef HAVE_BIGFLOAT
+DECLARE_FIXED_TYPE_ALLOC (bigfloat, Lisp_Bigfloat);
+#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_bigfloat 250
+
+/* This function creates a bigfloat with the default precision if the
+   PRECISION argument is zero. */
+Lisp_Object
+make_bigfloat (double float_value, unsigned long precision)
+{
+  Lisp_Bigfloat *f;
+
+  ALLOCATE_FIXED_TYPE (bigfloat, Lisp_Bigfloat, f);
+  set_lheader_implementation (&f->lheader, &lrecord_bigfloat);
+  if (precision == 0UL)
+    bigfloat_init (bigfloat_data (f));
+  else
+    bigfloat_init_prec (bigfloat_data (f), precision);
+  bigfloat_set_double (bigfloat_data (f), float_value);
+  return wrap_bigfloat (f);
+}
+
+/* This function creates a bigfloat with the precision of its argument */
+Lisp_Object
+make_bigfloat_bf (bigfloat float_value)
+{
+  Lisp_Bigfloat *f;
+
+  ALLOCATE_FIXED_TYPE (bigfloat, Lisp_Bigfloat, f);
+  set_lheader_implementation (&f->lheader, &lrecord_bigfloat);
+  bigfloat_init_prec (bigfloat_data (f), bigfloat_get_prec (float_value));
+  bigfloat_set (bigfloat_data (f), float_value);
+  return wrap_bigfloat (f);
+}
+#endif /* HAVE_BIGFLOAT */
+
+/************************************************************************/
 /*			   Vector allocation				*/
 /************************************************************************/
 
@@ -3786,6 +3906,39 @@
   SWEEP_FIXED_TYPE_BLOCK (float, Lisp_Float);
 }
 
+#ifdef HAVE_BIGNUM
+static void
+sweep_bignums (void)
+{
+#define UNMARK_bignum(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
+#define ADDITIONAL_FREE_bignum(ptr) bignum_fini (ptr->data)
+
+  SWEEP_FIXED_TYPE_BLOCK (bignum, Lisp_Bignum);
+}
+#endif /* HAVE_BIGNUM */
+
+#ifdef HAVE_RATIO
+static void
+sweep_ratios (void)
+{
+#define UNMARK_ratio(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
+#define ADDITIONAL_FREE_ratio(ptr) ratio_fini (ptr->data)
+
+  SWEEP_FIXED_TYPE_BLOCK (ratio, Lisp_Ratio);
+}
+#endif /* HAVE_RATIO */
+
+#ifdef HAVE_BIGFLOAT
+static void
+sweep_bigfloats (void)
+{
+#define UNMARK_bigfloat(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader))
+#define ADDITIONAL_FREE_bigfloat(ptr) bigfloat_fini (ptr->bf)
+
+  SWEEP_FIXED_TYPE_BLOCK (bigfloat, Lisp_Bigfloat);
+}
+#endif
+
 static void
 sweep_symbols (void)
 {
@@ -4237,6 +4390,21 @@
   /* Put all unmarked floats on free list */
   sweep_floats ();
 
+#ifdef HAVE_BIGNUM
+  /* Put all unmarked bignums on free list */
+  sweep_bignums ();
+#endif
+
+#ifdef HAVE_RATIO
+  /* Put all unmarked ratios on free list */
+  sweep_ratios ();
+#endif
+
+#ifdef HAVE_BIGFLOAT
+  /* Put all unmarked bigfloats on free list */
+  sweep_bigfloats ();
+#endif
+
   /* Put all unmarked symbols on free list */
   sweep_symbols ();
 
@@ -4796,6 +4964,21 @@
   HACK_O_MATIC (float, "float-storage", pl);
   pl = gc_plist_hack ("floats-free", gc_count_num_float_freelist, pl);
   pl = gc_plist_hack ("floats-used", gc_count_num_float_in_use, pl);
+#ifdef HAVE_BIGNUM
+  HACK_O_MATIC (bignum, "bignum-storage", pl);
+  pl = gc_plist_hack ("bignums-free", gc_count_num_bignum_freelist, pl);
+  pl = gc_plist_hack ("bignums-used", gc_count_num_bignum_in_use, pl);
+#endif /* HAVE_BIGNUM */
+#ifdef HAVE_RATIO
+  HACK_O_MATIC (ratio, "ratio-storage", pl);
+  pl = gc_plist_hack ("ratios-free", gc_count_num_ratio_freelist, pl);
+  pl = gc_plist_hack ("ratios-used", gc_count_num_ratio_in_use, pl);
+#endif /* HAVE_RATIO */
+#ifdef HAVE_BIGFLOAT
+  HACK_O_MATIC (bigfloat, "bigfloat-storage", pl);
+  pl = gc_plist_hack ("bigfloats-free", gc_count_num_bigfloat_freelist, pl);
+  pl = gc_plist_hack ("bigfloats-used", gc_count_num_bigfloat_in_use, pl);
+#endif /* HAVE_BIGFLOAT */
   HACK_O_MATIC (string, "string-header-storage", pl);
   pl = gc_plist_hack ("long-strings-total-length",
                       gc_count_string_total_size
@@ -5079,6 +5262,15 @@
   init_symbol_alloc ();
   init_compiled_function_alloc ();
   init_float_alloc ();
+#ifdef HAVE_BIGNUM
+  init_bignum_alloc ();
+#endif
+#ifdef HAVE_RATIO
+  init_ratio_alloc ();
+#endif
+#ifdef HAVE_BIGFLOAT
+  init_bigfloat_alloc ();
+#endif
   init_marker_alloc ();
   init_extent_alloc ();
   init_event_alloc ();