diff options
author | Han-Wen Nienhuys <hanwen@lilypond.org> | 2006-01-24 20:30:09 +0000 |
---|---|---|
committer | Han-Wen Nienhuys <hanwen@lilypond.org> | 2006-01-24 20:30:09 +0000 |
commit | fd0a5bbcb7922fe35a13d1cc87216c6b93f2251e (patch) | |
tree | 0addd243ee1258981dae2cb0dd65a7cec391a8d3 /libguile | |
parent | 2ca2ffe6b26556dc01677fe0e360f46f30ca8cfd (diff) | |
download | guile-fd0a5bbcb7922fe35a13d1cc87216c6b93f2251e.tar.gz |
patches by Ludovic Courtès for symbol generation.
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/ChangeLog | 21 | ||||
-rw-r--r-- | libguile/strings.c | 38 | ||||
-rw-r--r-- | libguile/strings.h | 7 | ||||
-rw-r--r-- | libguile/symbols.c | 138 | ||||
-rw-r--r-- | libguile/symbols.h | 2 |
5 files changed, 171 insertions, 35 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index e7f6572a3..c0bdbcf44 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,24 @@ +2005-12-19 Ludovic Courtès <ludovic.courtes@laas.fr> + + * strings.c (scm_i_take_stringbufn): New. + (scm_i_c_take_symbol): New. + (scm_take_locale_stringn): Use `scm_i_take_stringbufn ()'. + + * strings.h (scm_i_c_take_symbol): New. + (scm_i_take_stringbufn): New. + + * symbols.c (lookup_interned_symbol): New function. + (scm_i_c_mem2symbol): New function. + (scm_i_mem2symbol): Use `lookup_symbol ()'. + (scm_from_locale_symbol): Use `scm_i_c_mem2symbol ()'. This avoids + creating a new Scheme string. + (scm_from_locale_symboln): Likewise. + (scm_take_locale_symbol): New. + (scm_take_locale_symboln): New. + + * symbols.h (scm_take_locale_symbol): New. + (scm_take_locale_symboln): New. + 2006-01-18 Han-Wen Nienhuys <hanwen@xs4all.nl> * gc-card.c ("sweep_card"): don't count scm_tc_free_cell for diff --git a/libguile/strings.c b/libguile/strings.c index 9a2656b80..fd6be5065 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -122,6 +122,17 @@ make_stringbuf (size_t len) } } +/* Return a new stringbuf whose underlying storage consists of the LEN octets + pointed to by STR. */ +SCM_C_INLINE SCM +scm_i_take_stringbufn (char *str, size_t len) +{ + scm_gc_register_collectable_memory (str, len, "stringbuf"); + + return scm_double_cell (STRINGBUF_TAG, (scm_t_bits) str, + (scm_t_bits) len, (scm_t_bits) 0); +} + SCM scm_i_stringbuf_mark (SCM buf) { @@ -412,6 +423,29 @@ scm_i_make_symbol (SCM name, scm_t_bits flags, (scm_t_bits) hash, SCM_UNPACK (props)); } +SCM +scm_i_c_make_symbol (const char *name, size_t len, + scm_t_bits flags, unsigned long hash, SCM props) +{ + SCM buf = make_stringbuf (len); + memcpy (STRINGBUF_CHARS (buf), name, len); + + return scm_double_cell (scm_tc7_symbol | flags, SCM_UNPACK (buf), + (scm_t_bits) hash, SCM_UNPACK (props)); +} + +/* Return a new symbol that uses the LEN bytes pointed to by NAME as its + underlying storage. */ +SCM +scm_i_c_take_symbol (char *name, size_t len, + scm_t_bits flags, unsigned long hash, SCM props) +{ + SCM buf = scm_i_take_stringbufn (name, len); + + return scm_double_cell (scm_tc7_symbol | flags, SCM_UNPACK (buf), + (scm_t_bits) hash, SCM_UNPACK (props)); +} + size_t scm_i_symbol_length (SCM sym) { @@ -842,12 +876,10 @@ scm_take_locale_stringn (char *str, size_t len) str[len] = '\0'; } - buf = scm_double_cell (STRINGBUF_TAG, (scm_t_bits) str, - (scm_t_bits) len, (scm_t_bits) 0); + buf = scm_i_take_stringbufn (str, len); res = scm_double_cell (STRING_TAG, SCM_UNPACK (buf), (scm_t_bits) 0, (scm_t_bits) len); - scm_gc_register_collectable_memory (str, len+1, "string"); return res; } diff --git a/libguile/strings.h b/libguile/strings.h index a2ec51ae9..a8a7af670 100644 --- a/libguile/strings.h +++ b/libguile/strings.h @@ -124,6 +124,12 @@ SCM_API void scm_i_string_stop_writing (void); SCM_API SCM scm_i_make_symbol (SCM name, scm_t_bits flags, unsigned long hash, SCM props); +SCM_API SCM +scm_i_c_make_symbol (const char *name, size_t len, + scm_t_bits flags, unsigned long hash, SCM props); +SCM_API SCM +scm_i_c_take_symbol (char *name, size_t len, + scm_t_bits flags, unsigned long hash, SCM props); SCM_API const char *scm_i_symbol_chars (SCM sym); SCM_API size_t scm_i_symbol_length (SCM sym); SCM_API SCM scm_i_symbol_substring (SCM sym, size_t start, size_t end); @@ -144,6 +150,7 @@ SCM_API void scm_i_free_string_pointers (char **pointers); SCM_API void scm_i_get_substring_spec (size_t len, SCM start, size_t *cstart, SCM end, size_t *cend); +SCM_API SCM scm_i_take_stringbufn (char *str, size_t len); /* deprecated stuff */ 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 diff --git a/libguile/symbols.h b/libguile/symbols.h index eadff545a..35b327f08 100644 --- a/libguile/symbols.h +++ b/libguile/symbols.h @@ -56,6 +56,8 @@ SCM_API SCM scm_gensym (SCM prefix); SCM_API SCM scm_from_locale_symbol (const char *str); SCM_API SCM scm_from_locale_symboln (const char *str, size_t len); +SCM_API SCM scm_take_locale_symbol (char *sym); +SCM_API SCM scm_take_locale_symboln (char *sym, size_t len); /* internal functions. */ |