From ed35de727aeaa9f376b51439041151fb8cd899a5 Mon Sep 17 00:00:00 2001 From: Marius Vollmer Date: Wed, 22 Sep 2004 13:54:15 +0000 Subject: [PATCH] (scm_substring_read_only, scm_c_substring_read_only, scm_i_substring_read_only): New. (RO_STRING_TAG, IS_RO_STRING): New. (scm_i_string_writable_chars): Bail on read-only strings. --- libguile/strings.c | 61 ++++++++++++++++++++++++++++++++++++++++++++-- libguile/strings.h | 3 +++ 2 files changed, 62 insertions(+), 2 deletions(-) diff --git a/libguile/strings.c b/libguile/strings.c index cac77b101..b819bd24f 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -152,6 +152,12 @@ SCM_MUTEX (stringbuf_write_mutex); #define IS_STRING(str) (SCM_NIMP(str) && SCM_TYP7(str) == STRING_TAG) +/* Read-only strings. + */ + +#define RO_STRING_TAG (scm_tc7_string + 0x200) +#define IS_RO_STRING(str) (SCM_CELL_TYPE(str)==RO_STRING_TAG) + /* Mutation-sharing substrings */ @@ -211,6 +217,20 @@ scm_i_substring (SCM str, size_t start, size_t end) (scm_t_bits) end - start); } +SCM +scm_i_substring_read_only (SCM str, size_t start, size_t end) +{ + SCM buf; + size_t str_start; + get_str_buf_start (&str, &buf, &str_start); + scm_i_plugin_mutex_lock (&stringbuf_write_mutex); + SET_STRINGBUF_SHARED (buf); + scm_i_plugin_mutex_unlock (&stringbuf_write_mutex); + return scm_double_cell (RO_STRING_TAG, SCM_UNPACK(buf), + (scm_t_bits)str_start + start, + (scm_t_bits) end - start); +} + SCM scm_i_substring_copy (SCM str, size_t start, size_t end) { @@ -251,6 +271,13 @@ scm_c_substring (SCM str, size_t start, size_t end) return scm_i_substring (str, start, end); } +SCM +scm_c_substring_read_only (SCM str, size_t start, size_t end) +{ + validate_substring_args (str, start, end); + return scm_i_substring_read_only (str, start, end); +} + SCM scm_c_substring_copy (SCM str, size_t start, size_t end) { @@ -298,11 +325,15 @@ scm_i_string_chars (SCM str) } char * -scm_i_string_writable_chars (SCM str) +scm_i_string_writable_chars (SCM orig_str) { - SCM buf; + SCM buf, str = orig_str; size_t start; + get_str_buf_start (&str, &buf, &start); + if (IS_RO_STRING (str)) + scm_misc_error (NULL, "string is read-only: ~s", scm_list_1 (orig_str)); + scm_i_plugin_mutex_lock (&stringbuf_write_mutex); if (STRINGBUF_SHARED (buf)) { @@ -664,6 +695,32 @@ SCM_DEFINE (scm_substring, "substring", 2, 1, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_substring_read_only, "substring/read-only", 2, 1, 0, + (SCM str, SCM start, SCM end), + "Return a newly allocated string formed from the characters\n" + "of @var{str} beginning with index @var{start} (inclusive) and\n" + "ending with index @var{end} (exclusive).\n" + "@var{str} must be a string, @var{start} and @var{end} must be\n" + "exact integers satisfying:\n" + "\n" + "0 <= @var{start} <= @var{end} <= (string-length @var{str}).\n" + "\n" + "The returned string is read-only.\n") +#define FUNC_NAME s_scm_substring_read_only +{ + size_t len, from, to; + + SCM_VALIDATE_STRING (1, str); + len = scm_i_string_length (str); + from = scm_to_unsigned_integer (start, 0, len); + if (SCM_UNBNDP (end)) + to = len; + else + to = scm_to_unsigned_integer (end, from, len); + return scm_i_substring_read_only (str, from, to); +} +#undef FUNC_NAME + SCM_DEFINE (scm_substring_copy, "substring/copy", 2, 1, 0, (SCM str, SCM start, SCM end), "Return a newly allocated string formed from the characters\n" diff --git a/libguile/strings.h b/libguile/strings.h index af90a5b80..83085215b 100644 --- a/libguile/strings.h +++ b/libguile/strings.h @@ -83,6 +83,7 @@ SCM_API SCM scm_string_length (SCM str); SCM_API SCM scm_string_ref (SCM str, SCM k); SCM_API SCM scm_string_set_x (SCM str, SCM k, SCM chr); SCM_API SCM scm_substring (SCM str, SCM start, SCM end); +SCM_API SCM scm_substring_read_only (SCM str, SCM start, SCM end); SCM_API SCM scm_substring_shared (SCM str, SCM start, SCM end); SCM_API SCM scm_substring_copy (SCM str, SCM start, SCM end); SCM_API SCM scm_string_append (SCM args); @@ -92,6 +93,7 @@ SCM_API size_t scm_c_string_length (SCM str); SCM_API SCM scm_c_string_ref (SCM str, size_t pos); SCM_API void scm_c_string_set_x (SCM str, size_t pos, SCM chr); SCM_API SCM scm_c_substring (SCM str, size_t start, size_t end); +SCM_API SCM scm_c_substring_read_only (SCM str, size_t start, size_t end); SCM_API SCM scm_c_substring_shared (SCM str, size_t start, size_t end); SCM_API SCM scm_c_substring_copy (SCM str, size_t start, size_t end); @@ -110,6 +112,7 @@ SCM_API SCM scm_makfromstrs (int argc, char **argv); SCM_API SCM scm_i_make_string (size_t len, char **datap); SCM_API SCM scm_i_substring (SCM str, size_t start, size_t end); +SCM_API SCM scm_i_substring_read_only (SCM str, size_t start, size_t end); SCM_API SCM scm_i_substring_shared (SCM str, size_t start, size_t end); SCM_API SCM scm_i_substring_copy (SCM str, size_t start, size_t end); SCM_API size_t scm_i_string_length (SCM str); -- 2.20.1