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

* Added scm_string_hash and deprecated scm_strhash.

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:
 

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

libguile/ChangeLog

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

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

libguile/gc.c

@@ -1313,11 +1313,9 @@ gc_mark_nimp:
 	}
       break;
 
-    case scm_tc7_msymbol:
+    case scm_tc7_symbol:
-      scm_gc_mark (SCM_SYMBOL_FUNC (ptr));
+      ptr = SCM_PROP_SLOTS (ptr);
-      ptr = SCM_SYMBOL_PROPS (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:
+	    case scm_tc7_symbol:
-	      m += (SCM_LENGTH (scmptr) + 1
+	      m += SCM_LENGTH (scmptr) + 1;
-		    + (SCM_CHARS (scmptr) - (char *) SCM_SLOTS (scmptr)));
+	      scm_must_free (SCM_CHARS (scmptr));
-	      scm_must_free ((char *)SCM_SLOTS (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;

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

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:

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;

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:

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_SETCHARS (s, mem);
-  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_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--)

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

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),
+      scm_sizet hash
-				    (unsigned long) scm_symhash_dim);
+	= 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_SETCDR (lsym, SCM_VELTS(scm_symhash)[hash]);
-		  SCM_VELTS(scm_symhash)[scm_hash] = lsym;
+		  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_sizet hash 
-
+    = scm_string_hash (SCM_UCHARS (sym), SCM_LENGTH (sym)) % SCM_LENGTH (obarray);
-  scm_hash = scm_strhash (SCM_UCHARS (sym),
-			  (scm_sizet) 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));
+  hash = raw_hash % 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 ();
 
  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);
+      scm_sizet i;
-      z = SCM_CAR (z);
+      SCM a = SCM_CAR (lsym);
-      tmp = SCM_UCHARS (z);
+      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_SETCDR (b, SCM_VELTS(obarray)[hash]);
-      SCM_VELTS(obarray)[scm_hash] = b;
+      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,
+      scm_sizet raw_hash = scm_string_hash ((unsigned char *) name, len);
-					len,
+      scm_sizet hash = raw_hash % scm_symhash_dim;
-					(unsigned long) scm_symhash_dim);
+
-      SCM_NEWCELL (lsym);
+      SCM_NEWCELL2 (lsym);
-      SCM_SETLENGTH (lsym, (long) len, scm_tc7_ssymbol);
       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);
+  SCM_VALIDATE_SYMBOL (1, s);
-  return scm_makfromstr(SCM_CHARS(s), (scm_sizet)SCM_LENGTH(s), 0);
+  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),
+	    (SCM symbol),
-	    "Return the hash value derived from @var{symbol}'s name, i.e. the integer\n"
+	    "Return a hash value for @var{symbol}.")
-	    "index into @var{symbol}'s obarray at which it is stored.")
 #define FUNC_NAME s_scm_symbol_hash
 {
-  SCM_VALIDATE_SYMBOL (1,s);
+  SCM_VALIDATE_SYMBOL (1, symbol);
-  if (SCM_TYP7(s) == scm_tc7_ssymbol)
+  return SCM_MAKINUM (SCM_SYMBOL_HASH (symbol));
-    msymbolize (s);
-  return SCM_MAKINUM (SCM_UNPACK (s) ^ SCM_SYMBOL_HASH (s));
 }
 #undef FUNC_NAME
 

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,
+#define SCM_SYMBOLP(x)	(SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_symbol))
-   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_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_PROP_SLOTS(X)           (SCM_CELL_WORD_3 (X))
-#define SCM_SLOTS(x)		    ((scm_bits_t *) (* ((scm_bits_t *) SCM_CHARS (x) - 1)))
+#define SCM_SET_PROP_SLOTS(X, v)    (SCM_SET_CELL_WORD_3 ((X), (v)))
-#define SCM_SYMBOL_FUNC(X)	    (SCM_PACK (SCM_SLOTS (X) [0]))
+#define SCM_SYMBOL_FUNC(X)	    (SCM_CAR (SCM_CELL_WORD_3 (X)))
-#define SCM_SET_SYMBOL_FUNC(X, v)   (SCM_SLOTS (X) [0] = SCM_UNPACK (v))
+#define SCM_SET_SYMBOL_FUNC(X, v)   (SCM_SETCAR (SCM_CELL_WORD_3 (X), (v)))
-#define SCM_SYMBOL_PROPS(X)	    (SCM_PACK (SCM_SLOTS (X) [1]))
+#define SCM_SYMBOL_PROPS(X)	    (SCM_CDR (SCM_CELL_WORD_3 (X)))
-#define SCM_SET_SYMBOL_PROPS(X, v)  (SCM_SLOTS (X) [1] = SCM_UNPACK (v))
+#define SCM_SET_SYMBOL_PROPS(X, v)  (SCM_SETCDR (SCM_CELL_WORD_3 (X), (v)))
-#define SCM_SYMBOL_HASH(X)	    (SCM_SLOTS (X) [2])
+#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 */
 
 /*

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

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
+ *		for strings and vectors (among other things).
- *		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_symbol		5
-#define scm_tc7_ssymbol		5
+/* free                         7 */
-#define scm_tc7_msymbol		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