diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1997-03-05 22:49:12 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1997-03-05 22:49:12 +0000 |
commit | b2530d665af0e518bbd3136d7f0ff001653a7a6a (patch) | |
tree | c4b2afddd72d1366d85d0dcea540cf9cf357f7e1 | |
parent | 98672f5d0675517fa67316c85288266c678785f3 (diff) | |
download | guile-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/ChangeLog | 14 | ||||
-rw-r--r-- | libguile/symbols.c | 60 | ||||
-rw-r--r-- | libguile/tags.h | 8 |
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)) |