diff options
-rw-r--r-- | libguile/ChangeLog | 19 | ||||
-rw-r--r-- | libguile/eq.c | 10 | ||||
-rw-r--r-- | libguile/eval.c | 1 | ||||
-rw-r--r-- | libguile/evalext.c | 1 | ||||
-rw-r--r-- | libguile/gc-card.c | 24 | ||||
-rw-r--r-- | libguile/gc-mark.c | 7 | ||||
-rw-r--r-- | libguile/goops.c | 3 | ||||
-rw-r--r-- | libguile/hash.c | 7 | ||||
-rw-r--r-- | libguile/numbers.c | 2 | ||||
-rw-r--r-- | libguile/numbers.h | 12 | ||||
-rw-r--r-- | libguile/objects.c | 9 | ||||
-rw-r--r-- | libguile/print.c | 13 | ||||
-rw-r--r-- | libguile/smob.c | 16 | ||||
-rw-r--r-- | libguile/tags.h | 25 |
14 files changed, 98 insertions, 51 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 2f6c4f82f..0c1445e19 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,24 @@ 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 sizeof (scm_t_complex) to determine the memory size of the malloc'd area for complex numbers. diff --git a/libguile/eq.c b/libguile/eq.c index 676df3ed1..06467c486 100644 --- a/libguile/eq.c +++ b/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); diff --git a/libguile/eval.c b/libguile/eval.c index f4ea80630..d52c84360 100644 --- a/libguile/eval.c +++ b/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: diff --git a/libguile/evalext.c b/libguile/evalext.c index 4db0a8030..0590f48c9 100644 --- a/libguile/evalext.c +++ b/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: diff --git a/libguile/gc-card.c b/libguile/gc-card.c index 26fd425d5..432ead5a9 100644 --- a/libguile/gc-card.c +++ b/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: { diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c index 53d57b67f..994d3aa88 100644 --- a/libguile/gc-mark.c +++ b/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) diff --git a/libguile/goops.c b/libguile/goops.c index 1a2bb7304..44da20efe 100644 --- a/libguile/goops.c +++ b/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) diff --git a/libguile/hash.c b/libguile/hash.c index 26c4fcd8e..8801a7a28 100644 --- a/libguile/hash.c +++ b/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: diff --git a/libguile/numbers.c b/libguile/numbers.c index 472866bd7..6f9c60622 100644 --- a/libguile/numbers.c +++ b/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))) */ diff --git a/libguile/numbers.h b/libguile/numbers.h index 4172c703e..10e8eddc9 100644 --- a/libguile/numbers.h +++ b/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) diff --git a/libguile/objects.c b/libguile/objects.c index be9481c9a..12ee5a9c0 100644 --- a/libguile/objects.c +++ b/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: diff --git a/libguile/print.c b/libguile/print.c index 8b9c506be..50b969e24 100644 --- a/libguile/print.c +++ b/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)) { diff --git a/libguile/smob.c b/libguile/smob.c index 6b3001ed8..c73b2a9ca 100644 --- a/libguile/smob.c +++ b/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); } /* diff --git a/libguile/tags.h b/libguile/tags.h index bc53ff23d..aeff81300 100644 --- a/libguile/tags.h +++ b/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} */ |