This set of patches introduces a new tc7 code scm_tc7_number for

numbers.  Bignums, reals and complex numbers are turned from smobs
	into subtypes of scm_tc7_number.

	* tags.h (scm_tc7_number): New.

	* eq.c (scm_equal_p), eval.c (SCM_CEVAL), evalext.c
	(scm_self_evaluating_p), gc-card.c (scm_i_sweep_card), gc-mark.c
	(scm_gc_mark_dependencies), goops.c (create_smob_classes), hash.c
	(scm_hasher), numbers.c, numbers.h (SCM_NUMP), objects.c
	(scm_class_of), print.c (scm_iprin1), smob.c
	(scm_smob_prehistory): Don't handle bignums, reals and complex
	numbers as subtypes of scm_tc7_smob any more.

	* numbers.h, tags.h (scm_tc16_big, scm_tc16_real,
	scm_tc16_complex): Moved definitions from tags.h to numbers.h.

libguile/ChangeLog

@@ -1,3 +1,22 @@
+2003-09-18  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+	This set of patches introduces a new tc7 code scm_tc7_number for
+	numbers.  Bignums, reals and complex numbers are turned from smobs
+	into subtypes of scm_tc7_number.
+
+	* tags.h (scm_tc7_number): New.
+
+	* eq.c (scm_equal_p), eval.c (SCM_CEVAL), evalext.c
+	(scm_self_evaluating_p), gc-card.c (scm_i_sweep_card), gc-mark.c
+	(scm_gc_mark_dependencies), goops.c (create_smob_classes), hash.c
+	(scm_hasher), numbers.c, numbers.h (SCM_NUMP), objects.c
+	(scm_class_of), print.c (scm_iprin1), smob.c
+	(scm_smob_prehistory): Don't handle bignums, reals and complex
+	numbers as subtypes of scm_tc7_smob any more.
+
+	* numbers.h, tags.h (scm_tc16_big, scm_tc16_real,
+	scm_tc16_complex): Moved definitions from tags.h to numbers.h.
+
 2003-09-18  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
 	* numbers.c (scm_make_complex), gc-card.c (scm_i_sweep_card): Use

libguile/eq.c

@@ -166,6 +166,16 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
     {
     default:
       break;
+    case scm_tc7_number:
+      switch SCM_TYP16 (x)
+        {
+        case scm_tc16_big:
+          return scm_bigequal (x, y);
+        case scm_tc16_real:
+          return scm_real_equalp (x, y);
+        case scm_tc16_complex:
+          return scm_complex_equalp (x, y);
+        }
     case scm_tc7_vector:
     case scm_tc7_wvect:
       return scm_vector_equal_p (x, y);

libguile/eval.c

@@ -2790,6 +2790,7 @@ dispatch:
     case scm_tc7_llvect:
 #endif
 #endif
+    case scm_tc7_number:
     case scm_tc7_string:
     case scm_tc7_smob:
     case scm_tcs_closures:

libguile/evalext.c

@@ -113,6 +113,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
 	case scm_tc7_llvect:
 #endif
 #endif
+	case scm_tc7_number:
 	case scm_tc7_string:
 	case scm_tc7_smob:
 	case scm_tc7_cclo:

libguile/gc-card.c

@@ -173,6 +173,21 @@ scm_i_sweep_card (scm_t_cell *  p, SCM *free_list, scm_t_heap_segment*seg)
 		       "vector");
 	  break;
 #endif
+	case scm_tc7_number:
+	  switch SCM_TYP16 (scmptr)
+            {
+            case scm_tc16_real:
+              break;
+            case scm_tc16_big:
+              mpz_clear (SCM_I_BIG_MPZ (scmptr));
+              /* nothing else to do here since the mpz is in a double cell */
+              break;
+	    case scm_tc16_complex:
+	      scm_gc_free (SCM_COMPLEX_MEM (scmptr), sizeof (scm_t_complex),
+			   "complex");
+	      break;
+            }
+          break;
 	case scm_tc7_string:
 	  scm_gc_free (SCM_STRING_CHARS (scmptr), 
 		       SCM_STRING_LENGTH (scmptr) + 1, "string");
@@ -232,15 +247,6 @@ scm_i_sweep_card (scm_t_cell *  p, SCM *free_list, scm_t_heap_segment*seg)
 	  switch SCM_TYP16 (scmptr)
 	    {
 	    case scm_tc_free_cell:
-	    case scm_tc16_real:
-	      break;
-            case scm_tc16_big:
-              mpz_clear (SCM_I_BIG_MPZ (scmptr));
-              /* nothing else to do here since the mpz is in a double cell */
-              break;
-	    case scm_tc16_complex:
-	      scm_gc_free (SCM_COMPLEX_MEM (scmptr), sizeof (scm_t_complex),
-			   "complex");
 	      break;
 	    default:
 	      {

libguile/gc-mark.c

@@ -280,6 +280,9 @@ scm_gc_mark_dependencies (SCM p)
     case scm_tc7_string:
       break;
 
+    case scm_tc7_number:
+      break;
+
     case scm_tc7_wvect:
       SCM_SET_WVECT_GC_CHAIN (ptr, scm_weak_vectors);
       scm_weak_vectors = ptr;
@@ -374,10 +377,6 @@ scm_gc_mark_dependencies (SCM p)
 	   * on the C stack points into guile's heap and is scanned during
 	   * conservative marking.  */
 	  break;
-	case scm_tc16_big:
-	case scm_tc16_real:
-	case scm_tc16_complex:
-	  break;
 	default:
 	  i = SCM_SMOBNUM (ptr);
 #if (SCM_DEBUG_CELL_ACCESSES == 1)

libguile/goops.c

@@ -2516,9 +2516,6 @@ create_smob_classes (void)
   for (i = 0; i < 255; ++i)
     scm_smob_class[i] = 0;
 
-  scm_smob_class[SCM_TC2SMOBNUM (scm_tc16_big)] = scm_class_integer;
-  scm_smob_class[SCM_TC2SMOBNUM (scm_tc16_real)] = scm_class_real;
-  scm_smob_class[SCM_TC2SMOBNUM (scm_tc16_complex)] = scm_class_complex;
   scm_smob_class[SCM_TC2SMOBNUM (scm_tc16_keyword)] = scm_class_keyword;
 
   for (i = 0; i < scm_numsmob; ++i)

libguile/hash.c

@@ -96,11 +96,11 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
     default: 
       return 263 % n;
     case scm_tc7_smob:
+      return 263 % n;
+    case scm_tc7_number:
       switch SCM_TYP16 (obj) {
       case scm_tc16_big:
         return SCM_INUM (scm_modulo (obj, SCM_MAKINUM (n)));
-      default: 
-	return 263 % n;
       case scm_tc16_real:
 	{
 	  double r = SCM_REAL_VALUE (obj);
@@ -110,9 +110,12 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
 	    return SCM_INUM (scm_modulo (obj, SCM_MAKINUM (n)));
 	  }
 	}
+        /* Fall through */
       case scm_tc16_complex:
 	obj = scm_number_to_string (obj, SCM_MAKINUM (10));
+        /* Fall through */
       }
+      /* Fall through */
     case scm_tc7_string:
       return scm_string_hash (SCM_STRING_UCHARS (obj), SCM_STRING_LENGTH (obj)) % n;
     case scm_tc7_symbol:

libguile/numbers.c

@@ -76,7 +76,7 @@
   #define SCM_I_NUMTAG(x) \
     (SCM_INUMP(x) ? SCM_I_NUMTAG_INUM \
        : (SCM_IMP(x) ? SCM_I_NUMTAG_NOTNUM \
-         : (((0xfcff & SCM_CELL_TYPE (x)) == scm_tc7_smob) ? SCM_TYP16(x) \
+         : (((0xfcff & SCM_CELL_TYPE (x)) == scm_tc7_number) ? SCM_TYP16(x) \
            : SCM_I_NUMTAG_NOTNUM)))
 */
 

libguile/numbers.h

@@ -121,6 +121,16 @@
 /* Numbers 
  */
 
+
+/* Note that scm_tc16_real and scm_tc16_complex are given tc16-codes that only
+ * differ in one bit: This way, checking if an object is an inexact number can
+ * be done quickly (using the TYP16S macro).  */
+
+/* Number subtype 1 to 3 (note the dependency on the predicate SCM_NUMP)  */
+#define scm_tc16_big		(scm_tc7_number + 1 * 256L)
+#define scm_tc16_real           (scm_tc7_number + 2 * 256L)
+#define scm_tc16_complex        (scm_tc7_number + 3 * 256L)
+
 #define SCM_INEXACTP(x) (!SCM_IMP (x) && SCM_TYP16S (x) == scm_tc16_real)
 #define SCM_REALP(x) (!SCM_IMP (x) && SCM_TYP16 (x) == scm_tc16_real)
 #define SCM_COMPLEXP(x) (!SCM_IMP (x) && SCM_TYP16 (x) == scm_tc16_complex)
@@ -136,7 +146,7 @@
 
 #define SCM_NUMBERP(x) (SCM_INUMP(x) || SCM_NUMP(x))
 #define SCM_NUMP(x) (!SCM_IMP(x) \
-  && (0xfcff & SCM_CELL_TYPE (x)) == scm_tc7_smob)
+  && (0xfcff & SCM_CELL_TYPE (x)) == scm_tc7_number)
 
 
 

libguile/objects.c

@@ -102,6 +102,15 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
 	  return scm_class_vector;
 	case scm_tc7_string:
 	  return scm_class_string;
+        case scm_tc7_number:
+          switch SCM_TYP16 (x) {
+          case scm_tc16_big:
+            return scm_class_integer;
+          case scm_tc16_real:
+            return scm_class_real;
+          case scm_tc16_complex:
+            return scm_class_complex;
+          }
 	case scm_tc7_asubr:
 	case scm_tc7_subr_0:
 	case scm_tc7_subr_1:

libguile/print.c

@@ -516,6 +516,19 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 	      scm_putc ('>', port);
 	    }
 	  break;
+	case scm_tc7_number:
+          switch SCM_TYP16 (exp) {
+          case scm_tc16_big:
+            scm_bigprint (exp, port, pstate);
+            break;
+          case scm_tc16_real:
+            scm_print_real (exp, port, pstate);
+            break;
+          case scm_tc16_complex:
+            scm_print_complex (exp, port, pstate);
+            break;
+          }
+	  break;
 	case scm_tc7_string:
 	  if (SCM_WRITINGP (pstate))
 	    {

libguile/smob.c

@@ -448,7 +448,7 @@ scm_make_smob (scm_t_bits tc)
 }
 
 
-/* {Initialization for i/o types, float, bignum, the type of free cells}
+/* {Initialization for the type of free cells}
  */
 
 static int
@@ -491,21 +491,9 @@ scm_smob_prehistory ()
       scm_smobs[i].gsubr_type = 0;
     }
 
-  /* WARNING: These scm_make_smob_type calls must be done in this order */
+  /* WARNING: This scm_make_smob_type call must be done first.  */
   tc = scm_make_smob_type ("free", 0);
   scm_set_smob_print (tc, free_print);
-
-  tc = scm_make_smob_type ("big", 0);  /* freed in gc */
-  scm_set_smob_print (tc, scm_bigprint);
-  scm_set_smob_equalp (tc, scm_bigequal);
-
-  tc = scm_make_smob_type ("real", 0);	/* freed in gc */
-  scm_set_smob_print (tc, scm_print_real);
-  scm_set_smob_equalp (tc, scm_real_equalp);
-
-  tc = scm_make_smob_type ("complex", 0);  /* freed in gc */
-  scm_set_smob_print (tc, scm_print_complex);
-  scm_set_smob_equalp (tc, scm_complex_equalp);
 }
 
 /*

libguile/tags.h

@@ -353,21 +353,17 @@ typedef unsigned long scm_t_bits;
  *   cases.  Thus, their tc7-codes are chosen to only differ in one bit.  This
  *   makes it possible to check an object at the same time for being a vector
  *   or a weak vector by comparing its tc7 code with that bit masked (using
- *   the TYP7S macro).  Two more special tc7-codes are of interest:  ports and
- *   smobs in fact each represent collections of types, which are subdivided
- *   using tc16-codes.
+ *   the TYP7S macro).  Three more special tc7-codes are of interest:
+ *   numbers, ports and smobs in fact each represent collections of types,
+ *   which are subdivided using tc16-codes.
  *
  * tc16 (for tc7==scm_tc7_smob):
  *   The largest part of the space of smob types is not subdivided in a
  *   predefined way, since smobs can be added arbitrarily by user C code.
  *   However, while Guile also defines a number of smob types throughout,
- *   there are four smob types for which Guile assumes that they are declared
- *   first and thus get known-in-advance tc16-codes.  These are
- *   scm_tc_free_cell, scm_tc16_big, scm_tc16_real and scm_tc16_complex.  The
- *   reason of requiring fixed tc16-codes for these types is performance.  For
- *   the same reason, scm_tc16_real and scm_tc16_complex are given tc16-codes
- *   that only differ in one bit: This way, checking if an object is an
- *   inexact number can be done quickly (using the TYP16S macro)
+ *   there is one smob type, namely scm_tc_free_cell, for which Guile assumes
+ *   that it is declared first and thus gets a known-in-advance tc16-code.
+ *   The reason of requiring a fixed tc16-code for this type is performance.
  */
 
 
@@ -425,7 +421,7 @@ typedef unsigned long scm_t_bits;
 #define scm_tc7_wvect		15
 
 #define scm_tc7_string		21
-/* free                         23 */
+#define scm_tc7_number		23
 
 /* Many of the following should be turned
  * into structs or smobs.  We need back some
@@ -476,17 +472,12 @@ typedef unsigned long scm_t_bits;
 
 #define SCM_TYP16_PREDICATE(tag, x) (!SCM_IMP (x) && SCM_TYP16 (x) == (tag))
 
-/* Here are the first four smob subtypes.  */
+/* Here is the first smob subtype.  */
 
 /* scm_tc_free_cell is the 0th smob type.  We place this in free cells to tell
  * the conservative marker not to trace it.  */
 #define scm_tc_free_cell	(scm_tc7_smob + 0 * 256L)
 
-/* Smob type 1 to 3 (note the dependency on the predicate SCM_NUMP)  */
-#define scm_tc16_big		(scm_tc7_smob + 1 * 256L)
-#define scm_tc16_real           (scm_tc7_smob + 2 * 256L)
-#define scm_tc16_complex        (scm_tc7_smob + 3 * 256L)
-
 
 /* {Immediate Values}
  */