1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00

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.
This commit is contained in:
Dirk Herrmann 2003-09-18 20:55:40 +00:00
parent 29c4382afd
commit 534c55a97d
14 changed files with 98 additions and 51 deletions

View file

@ -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> 2003-09-18 Dirk Herrmann <D.Herrmann@tu-bs.de>
* numbers.c (scm_make_complex), gc-card.c (scm_i_sweep_card): Use * numbers.c (scm_make_complex), gc-card.c (scm_i_sweep_card): Use

View file

@ -166,6 +166,16 @@ SCM_PRIMITIVE_GENERIC_1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
{ {
default: default:
break; 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_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
return scm_vector_equal_p (x, y); return scm_vector_equal_p (x, y);

View file

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

View file

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

View file

@ -173,6 +173,21 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg)
"vector"); "vector");
break; break;
#endif #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: case scm_tc7_string:
scm_gc_free (SCM_STRING_CHARS (scmptr), scm_gc_free (SCM_STRING_CHARS (scmptr),
SCM_STRING_LENGTH (scmptr) + 1, "string"); 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) switch SCM_TYP16 (scmptr)
{ {
case scm_tc_free_cell: 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; break;
default: default:
{ {

View file

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

View file

@ -2516,9 +2516,6 @@ create_smob_classes (void)
for (i = 0; i < 255; ++i) for (i = 0; i < 255; ++i)
scm_smob_class[i] = 0; 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; scm_smob_class[SCM_TC2SMOBNUM (scm_tc16_keyword)] = scm_class_keyword;
for (i = 0; i < scm_numsmob; ++i) for (i = 0; i < scm_numsmob; ++i)

View file

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

View file

@ -76,7 +76,7 @@
#define SCM_I_NUMTAG(x) \ #define SCM_I_NUMTAG(x) \
(SCM_INUMP(x) ? SCM_I_NUMTAG_INUM \ (SCM_INUMP(x) ? SCM_I_NUMTAG_INUM \
: (SCM_IMP(x) ? SCM_I_NUMTAG_NOTNUM \ : (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))) : SCM_I_NUMTAG_NOTNUM)))
*/ */

View file

@ -121,6 +121,16 @@
/* Numbers /* 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_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_REALP(x) (!SCM_IMP (x) && SCM_TYP16 (x) == scm_tc16_real)
#define SCM_COMPLEXP(x) (!SCM_IMP (x) && SCM_TYP16 (x) == scm_tc16_complex) #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_NUMBERP(x) (SCM_INUMP(x) || SCM_NUMP(x))
#define SCM_NUMP(x) (!SCM_IMP(x) \ #define SCM_NUMP(x) (!SCM_IMP(x) \
&& (0xfcff & SCM_CELL_TYPE (x)) == scm_tc7_smob) && (0xfcff & SCM_CELL_TYPE (x)) == scm_tc7_number)

View file

@ -102,6 +102,15 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
return scm_class_vector; return scm_class_vector;
case scm_tc7_string: case scm_tc7_string:
return scm_class_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_asubr:
case scm_tc7_subr_0: case scm_tc7_subr_0:
case scm_tc7_subr_1: case scm_tc7_subr_1:

View file

@ -516,6 +516,19 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
scm_putc ('>', port); scm_putc ('>', port);
} }
break; 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: case scm_tc7_string:
if (SCM_WRITINGP (pstate)) if (SCM_WRITINGP (pstate))
{ {

View file

@ -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 static int
@ -491,21 +491,9 @@ scm_smob_prehistory ()
scm_smobs[i].gsubr_type = 0; 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); tc = scm_make_smob_type ("free", 0);
scm_set_smob_print (tc, free_print); 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);
} }
/* /*

View file

@ -353,21 +353,17 @@ typedef unsigned long scm_t_bits;
* cases. Thus, their tc7-codes are chosen to only differ in one bit. This * 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 * 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 * 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 * the TYP7S macro). Three more special tc7-codes are of interest:
* smobs in fact each represent collections of types, which are subdivided * numbers, ports and smobs in fact each represent collections of types,
* using tc16-codes. * which are subdivided using tc16-codes.
* *
* tc16 (for tc7==scm_tc7_smob): * tc16 (for tc7==scm_tc7_smob):
* The largest part of the space of smob types is not subdivided in a * 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. * predefined way, since smobs can be added arbitrarily by user C code.
* However, while Guile also defines a number of smob types throughout, * However, while Guile also defines a number of smob types throughout,
* there are four smob types for which Guile assumes that they are declared * there is one smob type, namely scm_tc_free_cell, for which Guile assumes
* first and thus get known-in-advance tc16-codes. These are * that it is declared first and thus gets a known-in-advance tc16-code.
* scm_tc_free_cell, scm_tc16_big, scm_tc16_real and scm_tc16_complex. The * The reason of requiring a fixed tc16-code for this type is performance.
* 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)
*/ */
@ -425,7 +421,7 @@ typedef unsigned long scm_t_bits;
#define scm_tc7_wvect 15 #define scm_tc7_wvect 15
#define scm_tc7_string 21 #define scm_tc7_string 21
/* free 23 */ #define scm_tc7_number 23
/* Many of the following should be turned /* Many of the following should be turned
* into structs or smobs. We need back some * 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)) #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 /* scm_tc_free_cell is the 0th smob type. We place this in free cells to tell
* the conservative marker not to trace it. */ * the conservative marker not to trace it. */
#define scm_tc_free_cell (scm_tc7_smob + 0 * 256L) #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} /* {Immediate Values}
*/ */