summaryrefslogtreecommitdiff
path: root/libguile/strings.c
diff options
context:
space:
mode:
authorMarius Vollmer <mvo@zagadka.de>2004-09-22 13:54:15 +0000
committerMarius Vollmer <mvo@zagadka.de>2004-09-22 13:54:15 +0000
commited35de727aeaa9f376b51439041151fb8cd899a5 (patch)
tree7fc6c9c1056cda12fda5d611977fbc6a63d3470d /libguile/strings.c
parent22ab5ba3d2247a6c62c1216f1486a46a3e4f62d7 (diff)
downloadguile-ed35de727aeaa9f376b51439041151fb8cd899a5.tar.gz
(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.
Diffstat (limited to 'libguile/strings.c')
-rw-r--r--libguile/strings.c61
1 files changed, 59 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
*/
@@ -212,6 +218,20 @@ scm_i_substring (SCM str, size_t start, size_t end)
}
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)
{
size_t len = end - start;
@@ -252,6 +272,13 @@ scm_c_substring (SCM str, size_t start, size_t 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)
{
validate_substring_args (str, start, 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"