summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>1997-03-05 22:49:12 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>1997-03-05 22:49:12 +0000
commitb2530d665af0e518bbd3136d7f0ff001653a7a6a (patch)
treec4b2afddd72d1366d85d0dcea540cf9cf357f7e1
parent98672f5d0675517fa67316c85288266c678785f3 (diff)
downloadguile-b2530d665af0e518bbd3136d7f0ff001653a7a6a.tar.gz
* 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.)
-rw-r--r--libguile/ChangeLog14
-rw-r--r--libguile/symbols.c60
-rw-r--r--libguile/tags.h8
3 files changed, 80 insertions, 2 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 95a297dc5..799c6d08b 100644
--- 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 d8da8d5b8..da00cd267 100644
--- 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 8eb09e325..0e65fb7e4 100644
--- 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))