summaryrefslogtreecommitdiff
path: root/libguile/symbols.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/symbols.c')
-rw-r--r--libguile/symbols.c138
1 files changed, 106 insertions, 32 deletions
diff --git a/libguile/symbols.c b/libguile/symbols.c
index a60ab9355..314dcb79e 100644
--- a/libguile/symbols.c
+++ b/libguile/symbols.c
@@ -85,43 +85,79 @@ scm_i_hash_symbol (SCM obj, unsigned long n, void *closure)
}
static SCM
-scm_i_mem2symbol (SCM str)
+lookup_interned_symbol (const char *name, size_t len,
+ unsigned long raw_hash)
{
- const char *name = scm_i_string_chars (str);
- size_t len = scm_i_string_length (str);
+ /* Try to find the symbol in the symbols table */
+ SCM l;
+ unsigned long hash = raw_hash % SCM_HASHTABLE_N_BUCKETS (symbols);
+
+ for (l = SCM_HASHTABLE_BUCKET (symbols, hash);
+ !scm_is_null (l);
+ l = SCM_CDR (l))
+ {
+ SCM sym = SCM_CAAR (l);
+ if (scm_i_symbol_hash (sym) == raw_hash
+ && scm_i_symbol_length (sym) == len)
+ {
+ const char *chrs = scm_i_symbol_chars (sym);
+ size_t i = len;
+
+ while (i != 0)
+ {
+ --i;
+ if (name[i] != chrs[i])
+ goto next_symbol;
+ }
+
+ return sym;
+ }
+ next_symbol:
+ ;
+ }
+
+ return SCM_BOOL_F;
+}
+static SCM
+scm_i_c_mem2symbol (const char *name, size_t len)
+{
+ SCM symbol;
size_t raw_hash = scm_string_hash ((const unsigned char *) name, len);
size_t hash = raw_hash % SCM_HASHTABLE_N_BUCKETS (symbols);
+ symbol = lookup_interned_symbol (name, len, raw_hash);
+ if (symbol != SCM_BOOL_F)
+ return symbol;
+
{
- /* Try to find the symbol in the symbols table */
-
- SCM l;
-
- for (l = SCM_HASHTABLE_BUCKET (symbols, hash);
- !scm_is_null (l);
- l = SCM_CDR (l))
- {
- SCM sym = SCM_CAAR (l);
- if (scm_i_symbol_hash (sym) == raw_hash
- && scm_i_symbol_length (sym) == len)
- {
- const char *chrs = scm_i_symbol_chars (sym);
- size_t i = len;
-
- while (i != 0)
- {
- --i;
- if (name[i] != chrs[i])
- goto next_symbol;
- }
-
- return sym;
- }
- next_symbol:
- ;
- }
+ /* The symbol was not found - create it. */
+ SCM symbol = scm_i_c_make_symbol (name, len, 0, raw_hash,
+ scm_cons (SCM_BOOL_F, SCM_EOL));
+
+ SCM slot = SCM_HASHTABLE_BUCKET (symbols, hash);
+ SCM cell = scm_cons (symbol, SCM_UNDEFINED);
+ SCM_SET_HASHTABLE_BUCKET (symbols, hash, scm_cons (cell, slot));
+ SCM_HASHTABLE_INCREMENT (symbols);
+ if (SCM_HASHTABLE_N_ITEMS (symbols) > SCM_HASHTABLE_UPPER (symbols))
+ scm_i_rehash (symbols, scm_i_hash_symbol, 0, "scm_mem2symbol");
+
+ return symbol;
}
+}
+
+static SCM
+scm_i_mem2symbol (SCM str)
+{
+ SCM symbol;
+ const char *name = scm_i_string_chars (str);
+ size_t len = scm_i_string_length (str);
+ size_t raw_hash = scm_string_hash ((const unsigned char *) name, len);
+ size_t hash = raw_hash % SCM_HASHTABLE_N_BUCKETS (symbols);
+
+ symbol = lookup_interned_symbol (name, len, raw_hash);
+ if (symbol != SCM_BOOL_F)
+ return symbol;
{
/* The symbol was not found - create it. */
@@ -139,6 +175,7 @@ scm_i_mem2symbol (SCM str)
}
}
+
static SCM
scm_i_mem2uninterned_symbol (SCM str)
{
@@ -348,13 +385,50 @@ SCM_DEFINE (scm_symbol_pset_x, "symbol-pset!", 2, 0, 0,
SCM
scm_from_locale_symbol (const char *sym)
{
- return scm_string_to_symbol (scm_from_locale_string (sym));
+ return scm_i_c_mem2symbol (sym, strlen (sym));
}
SCM
scm_from_locale_symboln (const char *sym, size_t len)
{
- return scm_string_to_symbol (scm_from_locale_stringn (sym, len));
+ return scm_i_c_mem2symbol (sym, len);
+}
+
+SCM
+scm_take_locale_symboln (char *sym, size_t len)
+{
+ SCM res;
+ unsigned long raw_hash;
+
+ if (len == (size_t)-1)
+ len = strlen (sym);
+ else
+ {
+ /* Ensure STR is null terminated. A realloc for 1 extra byte should
+ often be satisfied from the alignment padding after the block, with
+ no actual data movement. */
+ sym = scm_realloc (sym, len+1);
+ sym[len] = '\0';
+ }
+
+ raw_hash = scm_string_hash ((unsigned char *)sym, len);
+ res = lookup_interned_symbol (sym, len, raw_hash);
+ if (res != SCM_BOOL_F)
+ {
+ free (sym);
+ return res;
+ }
+
+ res = scm_i_c_take_symbol (sym, len, 0, raw_hash,
+ scm_cons (SCM_BOOL_F, SCM_EOL));
+
+ return res;
+}
+
+SCM
+scm_take_locale_symbol (char *sym)
+{
+ return scm_take_locale_symboln (sym, (size_t)-1);
}
void