mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

(scm_substring_read_only,

Browse source 
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.
This commit is contained in:
Marius Vollmer 2004-09-22 13:54:15 +00:00
parent 22ab5ba3d2
commit ed35de727a
2 changed files with 62 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

61
libguile/strings.c
View file

@ -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"

3
libguile/strings.h
View file

@ -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);