From 28b06554ca3c019cc1f5996d2890d95b2f1a5a21 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Tue, 12 Sep 2000 12:30:36 +0000 Subject: [PATCH] * Unified ssymbols and msymbols to a single symbol type 'scm_tc7_symbol'. * Added scm_string_hash and deprecated scm_strhash. --- NEWS | 10 ++- RELEASE | 4 ++ libguile/ChangeLog | 72 +++++++++++++++++++++ libguile/eval.c | 2 +- libguile/gc.c | 15 ++--- libguile/hash.c | 5 +- libguile/objects.c | 2 +- libguile/print.c | 2 +- libguile/properties.h | 2 +- libguile/strings.c | 25 ++------ libguile/strings.h | 4 +- libguile/symbols.c | 146 +++++++++++++++++------------------------- libguile/symbols.h | 56 +++++++--------- libguile/tag.c | 2 +- libguile/tags.h | 14 ++-- 15 files changed, 193 insertions(+), 168 deletions(-) diff --git a/NEWS b/NEWS index 4bbbbc91f..f98a4b61c 100644 --- a/NEWS +++ b/NEWS @@ -136,7 +136,7 @@ of this variable is (and has been) not fully safe anyway. ** Deprecated macros: SCM_OUTOFRANGE, SCM_NALLOC, SCM_HUP_SIGNAL, SCM_INT_SIGNAL, SCM_FPE_SIGNAL, SCM_BUS_SIGNAL, SCM_SEGV_SIGNAL, SCM_ALRM_SIGNAL, SCM_GC_SIGNAL, SCM_TICK_SIGNAL, SCM_SIG_ORD, -SCM_ORD_SIG, SCM_NUM_SIGS +SCM_ORD_SIG, SCM_NUM_SIGS, SCM_SYMBOL_SLOTS, SCM_SLOTS Use SCM_ASSERT_RANGE or SCM_VALIDATE_XXX_RANGE instead of SCM_OUTOFRANGE. Use scm_memory_error instead of SCM_NALLOC. @@ -147,6 +147,10 @@ Use scm_memory_error instead of SCM_NALLOC. Use scm_catch or scm_lazy_catch from throw.[ch] instead. +** Deprecated function: scm_strhash + +Use scm_string_hash instead. + ** scm_gensym has changed prototype scm_gensym now only takes one argument. @@ -155,6 +159,10 @@ scm_gensym now only takes one argument. The builtin `gentemp' has now become a primitive. +** Deprecated type tags: scm_tc7_ssymbol, scm_tc7_msymbol, scm_tcs_symbols + +There is now only a single symbol type scm_tc7_symbol. + Changes since Guile 1.3.4: diff --git a/RELEASE b/RELEASE index c13ae47c6..ff52517db 100644 --- a/RELEASE +++ b/RELEASE @@ -56,6 +56,10 @@ In release 1.6: - remove support for "#&" reader syntax in (ice-9 optargs). - remove scm_make_shared_substring - remove scm_read_only_string_p +- remove scm_strhash +- remove scm_tc7_ssymbol +- remove scm_tc7_msymbol +- remove scm_tcs_symbols Modules sort.c and random.c should be factored out into separate modules (but still be distributed with guile-core) when we get a new diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 38a472df6..fb44cce9e 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,75 @@ +2000-09-12 Dirk Herrmann + + This patch unifies the formerly distinct ssymbol and msymbol types + to a common symbol type scm_tc7_symbol. The representation of the + new symbol type uses a double cell with the following layout: + , where the car of + prop-pair holds the symbol's function property and the cdr of + prop-pair holds the symbol's other properties. In the long run, + these properties will be removed. Then, the generic property + functions will be uses. + + * eval.c (SCM_CEVAL), objects.c (scm_class_of), print.c + (scm_iprin1), tag.c (scm_tag): Use scm_tc7_symbol instead of + scm_tc7_ssymbol, scm_tc7_msymbol or scm_tcs_symbols. + + * gc.c (scm_gc_mark): Mark the symbols property pair. + + (scm_gc_sweep): There are no symbol slots any more. + + * hash.c (scm_hasher): Instead of re-calculating the hash value + of a symbol, use the raw_hash value stored in the symbol itself. + + * properties.h: Fix typo. + + * strings.[ch] (scm_makstr, scm_makfromstr): The slot parameter + is not used any more. + + * symbols.[ch] (scm_strhash): Deprecated, replaced by a macro. + + (scm_intern_obarray_soft): Made softness parameter unsigned. + + (scm_string_hash): New function with the same functionality as + scm_strhash had before, except that the hash value is not adjusted + to a hash table size. Instead, the 'raw' hash value is returned. + + * symbols.c (duplicate_string): New static convenience function. + + (scm_sym2vcell, scm_sym2ovcell_soft, scm_intern_obarray_soft): + Renamed local variable from scm_hash to hash. + + (scm_intern_obarray_soft): Don't check for a negative softness + any more. When generating symbol cells, use the new layout and + store the raw hash value in the symbol's cell. + + (scm_symbol_to_string): Removed unnecessary cast. + + (scm_intern_symbol, scm_unintern_symbol): Use scm_string_hash to + determine the hash values. + + (msymbolize): Removed. + + (scm_symbol_fref, scm_symbol_pref, scm_symbol_fset_x, + scm_symbol_pset_x, scm_symbol_hash): No need to distinguish + between different symbol types any more. + + (scm_symbol_hash): Comment fixed. + + * symbols.h: Comment about the distinction between ssymbols and + msymbols removed. + + (SCM_SYMBOLP, SCM_ROSTRINGP): No need to distinguish between + different symbol types any more. + + (SCM_PROP_SLOTS, SCM_SET_PROP_SLOTS): Added. + + (SCM_SYMBOL_FUNC, SCM_SET_SYMBOL_FUNC, SCM_SYMBOL_PROPS, + SCM_SET_SYMBOL_PROPS, SCM_SYMBOL_HASH, SCM_SET_SYMBOL_HASH): Use + the new symbol cell layout. + + * tags.h (scm_tc7_ssymbol, scm_tc7_msymbol, scm_tcs_symbols): + Deprecated. + 2000-09-12 Mikael Djurfeldt * symbols.h (scm_gentemp): Declared. diff --git a/libguile/eval.c b/libguile/eval.c index 86b21f6e0..effa23b56 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -1913,7 +1913,7 @@ dispatch: SCM_TICK; switch (SCM_TYP7 (x)) { - case scm_tcs_symbols: + case scm_tc7_symbol: /* Only happens when called at top level. */ x = scm_cons (x, SCM_UNDEFINED); diff --git a/libguile/gc.c b/libguile/gc.c index 20883d300..0463cba46 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -1313,11 +1313,9 @@ gc_mark_nimp: } break; - case scm_tc7_msymbol: - scm_gc_mark (SCM_SYMBOL_FUNC (ptr)); - ptr = SCM_SYMBOL_PROPS (ptr); + case scm_tc7_symbol: + ptr = SCM_PROP_SLOTS (ptr); goto gc_mark_loop; - case scm_tc7_ssymbol: case scm_tcs_subrs: break; case scm_tc7_port: @@ -1653,17 +1651,14 @@ scm_gc_sweep () case scm_tc7_string: m += SCM_HUGE_LENGTH (scmptr) + 1; goto freechars; - case scm_tc7_msymbol: - m += (SCM_LENGTH (scmptr) + 1 - + (SCM_CHARS (scmptr) - (char *) SCM_SLOTS (scmptr))); - scm_must_free ((char *)SCM_SLOTS (scmptr)); + case scm_tc7_symbol: + m += SCM_LENGTH (scmptr) + 1; + scm_must_free (SCM_CHARS (scmptr)); break; case scm_tc7_contin: m += SCM_LENGTH (scmptr) * sizeof (SCM_STACKITEM) + sizeof (scm_contregs); if (SCM_VELTS (scmptr)) goto freechars; - case scm_tc7_ssymbol: - break; case scm_tcs_subrs: /* the various "subrs" (primitives) are never freed */ continue; diff --git a/libguile/hash.c b/libguile/hash.c index a70f4ceaa..be1f33133 100644 --- a/libguile/hash.c +++ b/libguile/hash.c @@ -116,10 +116,11 @@ scm_hasher(SCM obj, unsigned long n, scm_sizet d) case scm_tc16_complex: obj = scm_number_to_string(obj, SCM_MAKINUM(10)); } - case scm_tcs_symbols: case scm_tc7_string: case scm_tc7_substring: - return scm_strhash(SCM_ROUCHARS(obj), (scm_sizet) SCM_ROLENGTH(obj), n); + return scm_string_hash (SCM_ROUCHARS (obj), SCM_ROLENGTH (obj)) % n; + case scm_tc7_symbol: + return SCM_SYMBOL_HASH (obj) % n; case scm_tc7_wvect: case scm_tc7_vector: { diff --git a/libguile/objects.c b/libguile/objects.c index b8c6ac0dd..3c70ea090 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -120,7 +120,7 @@ scm_class_of (SCM x) return scm_class_pair; case scm_tcs_closures: return scm_class_procedure; - case scm_tcs_symbols: + case scm_tc7_symbol: return scm_class_symbol; case scm_tc7_vector: case scm_tc7_wvect: diff --git a/libguile/print.c b/libguile/print.c index 5b3e35e69..99d7be796 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -479,7 +479,7 @@ taloop: scm_lfwrite (SCM_ROCHARS (exp), (scm_sizet) SCM_ROLENGTH (exp), port); break; - case scm_tcs_symbols: + case scm_tc7_symbol: { int pos; int end; diff --git a/libguile/properties.h b/libguile/properties.h index e256046a7..1a3298626 100644 --- a/libguile/properties.h +++ b/libguile/properties.h @@ -53,7 +53,7 @@ SCM scm_primitive_property_del_x (SCM prop, SCM obj); void scm_init_properties (void); -#endif /* PROPEERTIES_H */ +#endif /* PROPERTIES_H */ /* Local Variables: diff --git a/libguile/strings.c b/libguile/strings.c index 1c4df1da1..35733e66d 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -125,27 +125,16 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1, #undef FUNC_NAME SCM -scm_makstr (long len, int slots) +scm_makstr (long len, int dummy) { SCM s; - scm_bits_t * mem; + char *mem = (char *) scm_must_malloc (len + 1, "scm_makstr"); + mem[len] = 0; SCM_NEWCELL (s); - --slots; - SCM_REDEFER_INTS; - mem = (scm_bits_t *) scm_must_malloc (sizeof (scm_bits_t) * (slots + 1) - + len + 1, "scm_makstr"); - if (slots >= 0) - { - int x; - mem[slots] = (scm_bits_t) mem; - for (x = 0; x < slots; ++x) - mem[x] = SCM_UNPACK (SCM_BOOL_F); - } - SCM_SETCHARS (s, (char *) (mem + slots + 1)); + SCM_SETCHARS (s, mem); SCM_SETLENGTH (s, len, scm_tc7_string); - SCM_REALLOW_INTS; - SCM_CHARS (s)[len] = 0; + return s; } @@ -194,9 +183,9 @@ scm_take0str (char *s) } SCM -scm_makfromstr (const char *src, scm_sizet len, int slots) +scm_makfromstr (const char *src, scm_sizet len, int dummy) { - SCM s = scm_makstr (len, slots); + SCM s = scm_makstr (len, 0); char *dst = SCM_CHARS (s); while (len--) diff --git a/libguile/strings.h b/libguile/strings.h index 1b8189850..b56ab91f5 100644 --- a/libguile/strings.h +++ b/libguile/strings.h @@ -62,11 +62,11 @@ extern SCM scm_string_p (SCM x); extern SCM scm_read_only_string_p (SCM x); extern SCM scm_string (SCM chrs); -extern SCM scm_makstr (long len, int slots); +extern SCM scm_makstr (long len, int); extern SCM scm_makfromstrs (int argc, char **argv); extern SCM scm_take_str (char *s, int len); extern SCM scm_take0str (char *s); -extern SCM scm_makfromstr (const char *src, scm_sizet len, int slots); +extern SCM scm_makfromstr (const char *src, scm_sizet len, int); extern SCM scm_makfrom0str (const char *src); extern SCM scm_makfrom0str_opt (const char *src); extern SCM scm_make_string (SCM k, SCM chr); diff --git a/libguile/symbols.c b/libguile/symbols.c index b67c85025..641ea8a17 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -66,27 +66,35 @@ - /* NUM_HASH_BUCKETS is the number of symbol scm_hash table buckets. */ #define NUM_HASH_BUCKETS 137 +static char * +duplicate_string (const char * src, unsigned long length) +{ + char * dst = scm_must_malloc (length + 1, "duplicate_string"); + memcpy (dst, src, length + 1); + return dst; +} + + /* {Symbols} */ unsigned long -scm_strhash (const unsigned char *str, scm_sizet len, unsigned long n) +scm_string_hash (const unsigned char *str, scm_sizet len) { if (len > 5) { scm_sizet i = 5; - unsigned long h = 264 % n; + unsigned long h = 264; while (i--) - h = ((h << 8) + ((unsigned) (scm_downcase (str[h % len])))) % n; + h = (h << 8) + ((unsigned) (scm_downcase (str[h % len]))); return h; } else @@ -94,11 +102,12 @@ scm_strhash (const unsigned char *str, scm_sizet len, unsigned long n) scm_sizet i = len; unsigned long h = 0; while (i) - h = ((h << 8) + ((unsigned) (scm_downcase (str[--i])))) % n; + h = (h << 8) + ((unsigned) (scm_downcase (str[--i]))); return h; } } + int scm_symhash_dim = NUM_HASH_BUCKETS; @@ -133,11 +142,11 @@ scm_sym2vcell (SCM sym, SCM thunk, SCM definep) SCM lsym; SCM * lsymp; SCM z; - scm_sizet scm_hash = scm_strhash (SCM_UCHARS (sym), (scm_sizet) SCM_LENGTH (sym), - (unsigned long) scm_symhash_dim); + scm_sizet hash + = scm_string_hash (SCM_UCHARS (sym), SCM_LENGTH (sym)) % scm_symhash_dim; SCM_DEFER_INTS; - for (lsym = SCM_VELTS (scm_symhash)[scm_hash]; SCM_NIMP (lsym); lsym = SCM_CDR (lsym)) + for (lsym = SCM_VELTS (scm_symhash)[hash]; SCM_NIMP (lsym); lsym = SCM_CDR (lsym)) { z = SCM_CAR (lsym); if (SCM_EQ_P (SCM_CAR (z), sym)) @@ -147,7 +156,7 @@ scm_sym2vcell (SCM sym, SCM thunk, SCM definep) } } - for (lsym = *(lsymp = &SCM_VELTS (scm_weak_symhash)[scm_hash]); + for (lsym = *(lsymp = &SCM_VELTS (scm_weak_symhash)[hash]); SCM_NIMP (lsym); lsym = *(lsymp = SCM_CDRLOC (lsym))) { @@ -158,8 +167,8 @@ scm_sym2vcell (SCM sym, SCM thunk, SCM definep) { /* Move handle from scm_weak_symhash to scm_symhash. */ *lsymp = SCM_CDR (lsym); - SCM_SETCDR (lsym, SCM_VELTS(scm_symhash)[scm_hash]); - SCM_VELTS(scm_symhash)[scm_hash] = lsym; + SCM_SETCDR (lsym, SCM_VELTS(scm_symhash)[hash]); + SCM_VELTS(scm_symhash)[hash] = lsym; } SCM_ALLOW_INTS; return z; @@ -178,13 +187,10 @@ SCM scm_sym2ovcell_soft (SCM sym, SCM obarray) { SCM lsym, z; - scm_sizet scm_hash; - - scm_hash = scm_strhash (SCM_UCHARS (sym), - (scm_sizet) SCM_LENGTH (sym), - SCM_LENGTH (obarray)); + scm_sizet hash + = scm_string_hash (SCM_UCHARS (sym), SCM_LENGTH (sym)) % SCM_LENGTH (obarray); SCM_REDEFER_INTS; - for (lsym = SCM_VELTS (obarray)[scm_hash]; + for (lsym = SCM_VELTS (obarray)[hash]; SCM_NIMP (lsym); lsym = SCM_CDR (lsym)) { @@ -235,45 +241,35 @@ scm_sym2ovcell (SCM sym, SCM obarray) SCM -scm_intern_obarray_soft (const char *name,scm_sizet len,SCM obarray,int softness) +scm_intern_obarray_soft (const char *name,scm_sizet len,SCM obarray,unsigned int softness) { + scm_sizet raw_hash = scm_string_hash ((unsigned char *) name, len); + scm_sizet hash; SCM lsym; - SCM z; - register scm_sizet i; - register unsigned char *tmp; - scm_sizet scm_hash; SCM_REDEFER_INTS; if (SCM_FALSEP (obarray)) { - scm_hash = scm_strhash ((unsigned char *) name, len, 1019); + hash = raw_hash % 1019; goto uninterned_symbol; } - scm_hash = scm_strhash ((unsigned char *) name, len, SCM_LENGTH (obarray)); - - /* softness == -1 used to mean that it was known that the symbol - wasn't already in the obarray. I don't think there are any - callers that use that case any more, but just in case... - -- JimB, Oct 1996 */ - if (softness == -1) - abort (); + hash = raw_hash % SCM_LENGTH (obarray); retry_new_obarray: - for (lsym = SCM_VELTS (obarray)[scm_hash]; SCM_NIMP (lsym); lsym = SCM_CDR (lsym)) + for (lsym = SCM_VELTS (obarray)[hash]; SCM_NIMP (lsym); lsym = SCM_CDR (lsym)) { - z = SCM_CAR (lsym); - z = SCM_CAR (z); - tmp = SCM_UCHARS (z); + scm_sizet i; + SCM a = SCM_CAR (lsym); + SCM z = SCM_CAR (a); + unsigned char *tmp = SCM_UCHARS (z); if (SCM_LENGTH (z) != len) goto trynext; for (i = len; i--;) if (((unsigned char *) name)[i] != tmp[i]) goto trynext; { - SCM a; - a = SCM_CAR (lsym); SCM_REALLOW_INTS; return a; } @@ -293,10 +289,12 @@ scm_intern_obarray_soft (const char *name,scm_sizet len,SCM obarray,int softness return SCM_BOOL_F; } - lsym = scm_makfromstr (name, len, SCM_SYMBOL_SLOTS); + SCM_NEWCELL2 (lsym); + SCM_SETCHARS (lsym, duplicate_string (name, len)); + SCM_SET_SYMBOL_HASH (lsym, raw_hash); + SCM_SET_PROP_SLOTS (lsym, scm_cons (SCM_BOOL_F, SCM_BOOL_F)); + SCM_SETLENGTH (lsym, (long) len, scm_tc7_symbol); - SCM_SETLENGTH (lsym, (long) len, scm_tc7_msymbol); - SCM_SYMBOL_HASH (lsym) = scm_hash; SCM_SET_SYMBOL_PROPS (lsym, SCM_EOL); if (SCM_FALSEP (obarray)) { @@ -319,8 +317,8 @@ scm_intern_obarray_soft (const char *name,scm_sizet len,SCM obarray,int softness SCM_SETCAR (a, lsym); SCM_SETCDR (a, SCM_UNDEFINED); SCM_SETCAR (b, a); - SCM_SETCDR (b, SCM_VELTS(obarray)[scm_hash]); - SCM_VELTS(obarray)[scm_hash] = b; + SCM_SETCDR (b, SCM_VELTS(obarray)[hash]); + SCM_VELTS(obarray)[hash] = b; SCM_REALLOW_INTS; return SCM_CAR (b); } @@ -364,14 +362,17 @@ scm_sysintern0_no_module_lookup (const char *name) { SCM lsym; scm_sizet len = strlen (name); - scm_sizet scm_hash = scm_strhash ((unsigned char *) name, - len, - (unsigned long) scm_symhash_dim); - SCM_NEWCELL (lsym); - SCM_SETLENGTH (lsym, (long) len, scm_tc7_ssymbol); + scm_sizet raw_hash = scm_string_hash ((unsigned char *) name, len); + scm_sizet hash = raw_hash % scm_symhash_dim; + + SCM_NEWCELL2 (lsym); SCM_SETCHARS (lsym, name); + SCM_SET_SYMBOL_HASH (lsym, raw_hash); + SCM_SET_PROP_SLOTS (lsym, scm_cons (SCM_BOOL_F, SCM_BOOL_F)); + SCM_SETLENGTH (lsym, (long) len, scm_tc7_symbol); + lsym = scm_cons (lsym, SCM_UNDEFINED); - SCM_VELTS (scm_symhash)[scm_hash] = scm_cons (lsym, SCM_VELTS (scm_symhash)[scm_hash]); + SCM_VELTS (scm_symhash)[hash] = scm_cons (lsym, SCM_VELTS (scm_symhash)[hash]); SCM_ALLOW_INTS; return lsym; } @@ -459,8 +460,8 @@ SCM_DEFINE (scm_symbol_to_string, "symbol->string", 1, 0, 0, "@end format") #define FUNC_NAME s_scm_symbol_to_string { - SCM_VALIDATE_SYMBOL (1,s); - return scm_makfromstr(SCM_CHARS(s), (scm_sizet)SCM_LENGTH(s), 0); + SCM_VALIDATE_SYMBOL (1, s); + return scm_makfromstr (SCM_CHARS (s), SCM_LENGTH (s), 0); } #undef FUNC_NAME @@ -557,7 +558,7 @@ SCM_DEFINE (scm_intern_symbol, "intern-symbol", 2, 0, 0, if (SCM_FALSEP (o)) o = scm_symhash; SCM_VALIDATE_VECTOR (1,o); - hval = scm_strhash (SCM_UCHARS (s), SCM_LENGTH (s), SCM_LENGTH(o)); + hval = scm_string_hash (SCM_UCHARS (s), SCM_LENGTH (s)) % SCM_LENGTH (o); /* If the symbol is already interned, simply return. */ SCM_REDEFER_INTS; { @@ -594,7 +595,7 @@ SCM_DEFINE (scm_unintern_symbol, "unintern-symbol", 2, 0, 0, if (SCM_FALSEP (o)) o = scm_symhash; SCM_VALIDATE_VECTOR (1,o); - hval = scm_strhash (SCM_UCHARS (s), SCM_LENGTH (s), SCM_LENGTH(o)); + hval = scm_string_hash (SCM_UCHARS (s), SCM_LENGTH (s)) % SCM_LENGTH (o); SCM_DEFER_INTS; { SCM lsym_follow; @@ -700,22 +701,6 @@ SCM_DEFINE (scm_symbol_set_x, "symbol-set!", 3, 0, 0, } #undef FUNC_NAME -static void -msymbolize (SCM s) -{ - SCM string; - string = scm_makfromstr (SCM_CHARS (s), SCM_LENGTH (s), SCM_SYMBOL_SLOTS); - SCM_SETCHARS (s, SCM_CHARS (string)); - SCM_SETLENGTH (s, SCM_LENGTH (s), scm_tc7_msymbol); - SCM_SETCDR (string, SCM_EOL); - SCM_SETCAR (string, SCM_EOL); - SCM_SET_SYMBOL_PROPS (s, SCM_EOL); - /* If it's a tc7_ssymbol, it comes from scm_symhash */ - SCM_SYMBOL_HASH (s) = scm_strhash (SCM_UCHARS (s), - (scm_sizet) SCM_LENGTH (s), - SCM_LENGTH (scm_symhash)); -} - SCM_DEFINE (scm_symbol_fref, "symbol-fref", 1, 0, 0, (SCM s), @@ -723,10 +708,6 @@ SCM_DEFINE (scm_symbol_fref, "symbol-fref", 1, 0, 0, #define FUNC_NAME s_scm_symbol_fref { SCM_VALIDATE_SYMBOL (1,s); - SCM_DEFER_INTS; - if (SCM_TYP7(s) == scm_tc7_ssymbol) - msymbolize (s); - SCM_ALLOW_INTS; return SCM_SYMBOL_FUNC (s); } #undef FUNC_NAME @@ -738,10 +719,6 @@ SCM_DEFINE (scm_symbol_pref, "symbol-pref", 1, 0, 0, #define FUNC_NAME s_scm_symbol_pref { SCM_VALIDATE_SYMBOL (1,s); - SCM_DEFER_INTS; - if (SCM_TYP7(s) == scm_tc7_ssymbol) - msymbolize (s); - SCM_ALLOW_INTS; return SCM_SYMBOL_PROPS (s); } #undef FUNC_NAME @@ -753,10 +730,6 @@ SCM_DEFINE (scm_symbol_fset_x, "symbol-fset!", 2, 0, 0, #define FUNC_NAME s_scm_symbol_fset_x { SCM_VALIDATE_SYMBOL (1,s); - SCM_DEFER_INTS; - if (SCM_TYP7(s) == scm_tc7_ssymbol) - msymbolize (s); - SCM_ALLOW_INTS; SCM_SET_SYMBOL_FUNC (s, val); return SCM_UNSPECIFIED; } @@ -770,8 +743,6 @@ SCM_DEFINE (scm_symbol_pset_x, "symbol-pset!", 2, 0, 0, { SCM_VALIDATE_SYMBOL (1,s); SCM_DEFER_INTS; - if (SCM_TYP7(s) == scm_tc7_ssymbol) - msymbolize (s); SCM_SET_SYMBOL_PROPS (s, val); SCM_ALLOW_INTS; return SCM_UNSPECIFIED; @@ -780,15 +751,12 @@ SCM_DEFINE (scm_symbol_pset_x, "symbol-pset!", 2, 0, 0, SCM_DEFINE (scm_symbol_hash, "symbol-hash", 1, 0, 0, - (SCM s), - "Return the hash value derived from @var{symbol}'s name, i.e. the integer\n" - "index into @var{symbol}'s obarray at which it is stored.") + (SCM symbol), + "Return a hash value for @var{symbol}.") #define FUNC_NAME s_scm_symbol_hash { - SCM_VALIDATE_SYMBOL (1,s); - if (SCM_TYP7(s) == scm_tc7_ssymbol) - msymbolize (s); - return SCM_MAKINUM (SCM_UNPACK (s) ^ SCM_SYMBOL_HASH (s)); + SCM_VALIDATE_SYMBOL (1, symbol); + return SCM_MAKINUM (SCM_SYMBOL_HASH (symbol)); } #undef FUNC_NAME diff --git a/libguile/symbols.h b/libguile/symbols.h index d2a9af0ee..72a83cdf7 100644 --- a/libguile/symbols.h +++ b/libguile/symbols.h @@ -53,31 +53,10 @@ extern int scm_symhash_dim; /* SCM_LENGTH(SYM) is the length of SYM's name in characters, and - SCM_CHARS(SYM) is the address of the first character of SYM's name. + * SCM_CHARS(SYM) is the address of the first character of SYM's name. + */ - Beyond that, there are two kinds of symbols: ssymbols and msymbols, - distinguished by the 'S' bit in the type. - - Ssymbols are just uniquified strings. They have a length, chars, - and that's it. They use the scm_tc7_ssymbol tag (S bit clear). - - Msymbols are symbols with extra slots. These slots hold a property - list and a function value (for Emacs Lisp compatibility), and a hash - code. They use the scm_tc7_msymbol tag. - - We'd like SCM_CHARS to work on msymbols just as it does on - ssymbols, so we'll have it point to the symbol's name as usual, and - store a pointer to the slots just before the name in memory. Thus, - you have to do some casting and pointer arithmetic to find the - slots; see the SCM_SLOTS macro. - - In practice, the slots always live just before the pointer to them. - So why not ditch the pointer, and use negative indices to refer to - the slots? That's a good question; ask the author. I think it was - the cognac. */ - -#define SCM_SYMBOLP(x) (SCM_NIMP (x) \ - && (SCM_TYP7S (x) == scm_tc7_ssymbol)) +#define SCM_SYMBOLP(x) (SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_symbol)) #define SCM_LENGTH_MAX (0xffffffL) #define SCM_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) @@ -87,16 +66,17 @@ extern int scm_symhash_dim; #define SCM_UCHARS(x) ((unsigned char *) (SCM_CELL_WORD_1 (x))) #define SCM_SETCHARS(x, v) (SCM_SET_CELL_WORD_1 ((x), (scm_bits_t) (v))) -#define SCM_SYMBOL_SLOTS 4 -#define SCM_SLOTS(x) ((scm_bits_t *) (* ((scm_bits_t *) SCM_CHARS (x) - 1))) -#define SCM_SYMBOL_FUNC(X) (SCM_PACK (SCM_SLOTS (X) [0])) -#define SCM_SET_SYMBOL_FUNC(X, v) (SCM_SLOTS (X) [0] = SCM_UNPACK (v)) -#define SCM_SYMBOL_PROPS(X) (SCM_PACK (SCM_SLOTS (X) [1])) -#define SCM_SET_SYMBOL_PROPS(X, v) (SCM_SLOTS (X) [1] = SCM_UNPACK (v)) -#define SCM_SYMBOL_HASH(X) (SCM_SLOTS (X) [2]) +#define SCM_PROP_SLOTS(X) (SCM_CELL_WORD_3 (X)) +#define SCM_SET_PROP_SLOTS(X, v) (SCM_SET_CELL_WORD_3 ((X), (v))) +#define SCM_SYMBOL_FUNC(X) (SCM_CAR (SCM_CELL_WORD_3 (X))) +#define SCM_SET_SYMBOL_FUNC(X, v) (SCM_SETCAR (SCM_CELL_WORD_3 (X), (v))) +#define SCM_SYMBOL_PROPS(X) (SCM_CDR (SCM_CELL_WORD_3 (X))) +#define SCM_SET_SYMBOL_PROPS(X, v) (SCM_SETCDR (SCM_CELL_WORD_3 (X), (v))) +#define SCM_SYMBOL_HASH(X) (SCM_CELL_WORD_2 (X)) +#define SCM_SET_SYMBOL_HASH(X, v) (SCM_SET_CELL_WORD_2 ((X), (v))) #define SCM_ROSTRINGP(x) (SCM_NIMP(x) && ((SCM_TYP7S(x)==scm_tc7_string) \ - || (SCM_TYP7S(x) == scm_tc7_ssymbol))) + || (SCM_TYP7(x) == scm_tc7_symbol))) #define SCM_ROCHARS(x) ((char *)((SCM_TYP7(x) == scm_tc7_substring) \ ? SCM_INUM (SCM_CADR (x)) + SCM_CHARS (SCM_CDDR (x)) \ : SCM_CHARS (x))) @@ -115,11 +95,11 @@ extern int scm_symhash_dim; -extern unsigned long scm_strhash (const unsigned char *str, scm_sizet len, unsigned long n); +extern unsigned long scm_string_hash (const unsigned char *str, scm_sizet len); extern SCM scm_sym2vcell (SCM sym, SCM thunk, SCM definep); extern SCM scm_sym2ovcell_soft (SCM sym, SCM obarray); extern SCM scm_sym2ovcell (SCM sym, SCM obarray); -extern SCM scm_intern_obarray_soft (const char *name, scm_sizet len, SCM obarray, int softness); +extern SCM scm_intern_obarray_soft (const char *name, scm_sizet len, SCM obarray, unsigned int softness); extern SCM scm_intern_obarray (const char *name, scm_sizet len, SCM obarray); extern SCM scm_intern (const char *name, scm_sizet len); extern SCM scm_intern0 (const char *name); @@ -148,6 +128,14 @@ extern SCM scm_gensym (SCM prefix); extern SCM scm_gentemp (SCM prefix, SCM obarray); extern void scm_init_symbols (void); + + +#if (SCM_DEBUG_DEPRECATED == 0) + +#define scm_strhash(str, len, n) (scm_string_hash ((str), (len)) % (n)) + +#endif /* SCM_DEBUG_DEPRECATED == 0 */ + #endif /* SYMBOLSH */ /* diff --git a/libguile/tag.c b/libguile/tag.c index b33dc7545..ed60a0d1c 100644 --- a/libguile/tag.c +++ b/libguile/tag.c @@ -118,7 +118,7 @@ SCM_DEFINE (scm_tag, "tag", 1, 0, 0, return SCM_CDR (scm_utag_pair) ; case scm_tcs_closures: return SCM_CDR (scm_utag_closure) ; - case scm_tcs_symbols: + case scm_tc7_symbol: return SCM_CDR (scm_utag_symbol) ; case scm_tc7_vector: return SCM_CDR (scm_utag_vector) ; diff --git a/libguile/tags.h b/libguile/tags.h index dac0cd652..2b8ec0d48 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -221,8 +221,7 @@ typedef long scm_bits_t; * handy property that all bits of the CAR above the * bottom eight can be used to store a length, thus * saving a word in the body itself. Thus, we use them - * for strings, symbols, and vectors (among other - * things). + * for strings and vectors (among other things). * * SCM_LENGTH returns the bits in "length" (see the diagram). * SCM_CHARS returns the data cast to "char *" @@ -333,9 +332,8 @@ typedef long scm_bits_t; -/* couple */ -#define scm_tc7_ssymbol 5 -#define scm_tc7_msymbol 7 +#define scm_tc7_symbol 5 +/* free 7 */ /* couple */ #define scm_tc7_vector 13 @@ -551,12 +549,14 @@ extern char *scm_isymnames[]; /* defined in print.c */ case scm_tc7_subr_3:case scm_tc7_subr_2:case scm_tc7_rpsubr:case scm_tc7_subr_1o:\ case scm_tc7_subr_2o:case scm_tc7_lsubr_2:case scm_tc7_lsubr -#define scm_tcs_symbols scm_tc7_ssymbol:case scm_tc7_msymbol - #if (SCM_DEBUG_DEPRECATED == 0) +#define scm_tc7_ssymbol scm_tc7_symbol +#define scm_tc7_msymbol scm_tc7_symbol +#define scm_tcs_symbols scm_tc7_symbol + #define scm_tc16_flo scm_tc16_real #define scm_tc_flo 0x017fL #define scm_tc_dblr scm_tc16_real -- 2.20.1