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:
parent
29c4382afd
commit
534c55a97d
14 changed files with 98 additions and 51 deletions
|
@ -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
|
||||||
|
|
|
@ -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);
|
||||||
|
|
|
@ -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:
|
||||||
|
|
|
@ -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:
|
||||||
|
|
|
@ -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:
|
||||||
{
|
{
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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:
|
||||||
|
|
|
@ -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)))
|
||||||
*/
|
*/
|
||||||
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -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:
|
||||||
|
|
|
@ -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))
|
||||||
{
|
{
|
||||||
|
|
|
@ -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);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/*
|
/*
|
||||||
|
|
|
@ -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}
|
||||||
*/
|
*/
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue