mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 01:30:27 +02:00
Code Activity

* Unified ssymbols and msymbols to a single symbol type 'scm_tc7_symbol'.

Browse source 
* Added scm_string_hash and deprecated scm_strhash.
This commit is contained in:
Dirk Herrmann 2000-09-12 12:30:36 +00:00
parent a5b265e3f9
commit 28b06554ca
15 changed files with 193 additions and 168 deletions
Download patch file Download diff file Expand all files Collapse all files

10
NEWS
View file

@ -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:

4
RELEASE
View file

@ -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

72
libguile/ChangeLog
View file

@ -1,3 +1,75 @@
2000-09-12 Dirk Herrmann <D.Herrmann@tu-bs.de>
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:
<type/length, chars, raw_hash, prop-pair>, 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 <mdj@linnaeus.mit.edu>
* symbols.h (scm_gentemp): Declared.

2
libguile/eval.c
View file

@ -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);

15
libguile/gc.c
View file

@ -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;

5
libguile/hash.c
View file

@ -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:
{

2
libguile/objects.c
View file

@ -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:

2
libguile/print.c
View file

@ -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;

2
libguile/properties.h
View file

@ -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:

25
libguile/strings.c
View file

@ -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--)

4
libguile/strings.h
View file

@ -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);

146
libguile/symbols.c
View file

@ -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

56
libguile/symbols.h
View file

@ -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 */
/*

2
libguile/tag.c
View file

@ -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) ;

14
libguile/tags.h
View file

@ -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