* tags.h (SCM_ECONSP, SCM_NECONSP): Bugfix: Discriminate structs

from pairs with a GLOC in the car.

* symbols.c (msymbolize): Bugfix: Also initialize SCM_SYMBOL_HASH,
otherwise `symbol-hash' will behave badly.
(scm_symbol_hash): Bugfix: Must msymbolize if tc7_ssymbol, othwise
we get segmentation fault!

* symbols.c: Added #include "weaks.h".  New functions
`builtin-bindings' and `builtin-weak-bindings'.  (These will be
moved to an extraneous library when we split libguile.)

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 95a297d..799c6d0 100644 (file)
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,17 @@
+Wed Mar  5 23:31:21 1997  Mikael Djurfeldt  <mdj@mdj.nada.kth.se>
+
+       * tags.h (SCM_ECONSP, SCM_NECONSP): Bugfix: Discriminate structs
+       from pairs with a GLOC in the car.
+
+       * symbols.c (msymbolize): Bugfix: Also initialize SCM_SYMBOL_HASH,
+       otherwise `symbol-hash' will behave badly.
+       (scm_symbol_hash): Bugfix: Must msymbolize if tc7_ssymbol, othwise
+       we get segmentation fault!
+
+       * symbols.c: Added #include "weaks.h".  New functions
+       `builtin-bindings' and `builtin-weak-bindings'.  (These will be
+       moved to an extraneous library when we split libguile.)
+
 Tue Mar  4 19:50:07 1997  Mikael Djurfeldt  <mdj@mdj.nada.kth.se>
 
        * filesys.c (scm_stat): stat now takes fport arguments too as

diff --git a/libguile/symbols.c b/libguile/symbols.c
index d8da8d5..da00cd2 100644 (file)
--- a/libguile/symbols.c
+++ b/libguile/symbols.c
@@ -47,6 +47,7 @@
 #include "variable.h"
 #include "alist.h"
 #include "mbstrings.h"
+#include "weaks.h"
 
 #include "symbols.h"
 
@@ -692,6 +693,10 @@ msymbolize (s)
   SCM_SETCDR (string, SCM_EOL);
   SCM_SETCAR (string, SCM_EOL);
   SCM_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));
 }
 
 
@@ -766,10 +771,65 @@ scm_symbol_hash (s)
      SCM s;
 {
   SCM_ASSERT(SCM_NIMP(s) && SCM_SYMBOLP(s), s, SCM_ARG1, s_symbol_hash);
+  if (SCM_TYP7(s) == scm_tc7_ssymbol)
+    msymbolize (s);
   return SCM_MAKINUM ((unsigned long)s ^ SCM_SYMBOL_HASH (s));
 }
 
 
+static void copy_and_prune_obarray SCM_P ((SCM from, SCM to));
+
+static void
+copy_and_prune_obarray (from, to)
+     SCM from;
+     SCM to;
+{
+  int i;
+  int length = SCM_LENGTH (from);
+  for (i = 0; i < length; ++i)
+    {
+      SCM head = SCM_VELTS (from)[i]; /* GC protection */
+      SCM ls = head;
+      SCM res = SCM_EOL;
+      SCM *lloc = &res;
+      while (SCM_NIMP (ls))
+       {
+         if (!SCM_UNBNDP (SCM_CDAR (ls)))
+           {
+             *lloc = scm_cons (SCM_CAR (ls), SCM_EOL);
+             lloc = SCM_CDRLOC (*lloc);
+           }
+         ls = SCM_CDR (ls);
+       }
+      SCM_VELTS (to)[i] = res;
+    }
+}
+
+
+SCM_PROC(s_builtin_bindings, "builtin-bindings", 0, 0, 0, scm_builtin_bindings);
+
+SCM
+scm_builtin_bindings ()
+{
+  int length = SCM_LENGTH (scm_symhash);
+  SCM obarray = scm_make_vector (SCM_MAKINUM (length), SCM_EOL, SCM_UNDEFINED);
+  copy_and_prune_obarray (scm_symhash, obarray);
+  return obarray;
+}
+
+
+SCM_PROC(s_builtin_weak_bindings, "builtin-weak-bindings", 0, 0, 0, scm_builtin_weak_bindings);
+
+SCM
+scm_builtin_weak_bindings ()
+{
+  int length = SCM_LENGTH (scm_weak_symhash);
+  SCM obarray = scm_make_doubly_weak_hash_table (SCM_MAKINUM (length));
+  copy_and_prune_obarray (scm_weak_symhash, obarray);
+  return obarray;
+}
+
+
 
 void
 scm_init_symbols ()

diff --git a/libguile/tags.h b/libguile/tags.h
index 8eb09e3..0e65fb7 100644 (file)
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -279,8 +279,12 @@ typedef long SCM;
  * There are two places to fix where structures and glocs can be confused.
  * !!!
  */
-#define SCM_ECONSP(x) (SCM_CONSP(x) || (1==SCM_TYP3(x)))
-#define SCM_NECONSP(x) (SCM_NCONSP(x) && (1 != SCM_TYP3(x)))
+#define SCM_ECONSP(x) (SCM_CONSP (x) \
+                      || (SCM_TYP3(x) == 1 \
+                           && SCM_CDR (SCM_CAR (x) - 1) != 0))
+#define SCM_NECONSP(x) (SCM_NCONSP(x) \
+                       && (SCM_TYP3(x) != 1 \
+                           || SCM_CDR (SCM_CAR (x) - 1) == 0))
 
 \f