diff --git a/eval.c b/eval.c index 203043da..3860d91f 100644 --- a/eval.c +++ b/eval.c @@ -2012,7 +2012,7 @@ void sexp_string_utf8_set (sexp ctx, sexp str, sexp index, sexp ch) { p = (unsigned char*)sexp_string_data(str) + i; old_len = sexp_utf8_initial_byte_count(*p); new_len = sexp_utf8_char_byte_count(c); - if (old_len != new_len) { /* resize bytes if needed */ + if (sexp_copy_on_writep(str) || old_len != new_len) { /* resize bytes if needed */ len = sexp_string_size(str)+(new_len-old_len); b = sexp_make_bytes(ctx, sexp_make_fixnum(len), SEXP_VOID); if (! sexp_exceptionp(b)) { @@ -2023,6 +2023,7 @@ void sexp_string_utf8_set (sexp ctx, sexp str, sexp index, sexp ch) { p = q + i; } sexp_string_size(str) += new_len - old_len; + sexp_copy_on_writep(str) = 0; } sexp_utf8_encode_char(p, new_len, c); if (old_len != new_len) diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index 676d77d0..d431bc6a 100644 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -442,6 +442,7 @@ struct sexp_struct { unsigned int freep:1; unsigned int brokenp:1; unsigned int syntacticp:1; + unsigned int copyonwritep:1; #if SEXP_USE_TRACK_ALLOC_SOURCE const char* source; void* backtrace[SEXP_BACKTRACE_SIZE]; @@ -773,6 +774,7 @@ void* sexp_alloc(sexp ctx, size_t size); #define sexp_freep(x) ((x)->freep) #define sexp_brokenp(x) ((x)->brokenp) #define sexp_pointer_magic(x) ((x)->magic) +#define sexp_copy_on_writep(x) ((x)->copyonwritep) #if SEXP_USE_TRACK_ALLOC_SOURCE #define sexp_pointer_source(x) ((x)->source) diff --git a/lib/chibi/ast.c b/lib/chibi/ast.c index 50b295ca..b160f299 100644 --- a/lib/chibi/ast.c +++ b/lib/chibi/ast.c @@ -372,6 +372,23 @@ sexp sexp_make_immutable_op (sexp ctx, sexp self, sexp_sint_t n, sexp x) { return SEXP_FALSE; } +sexp sexp_immutable_string_op (sexp ctx, sexp self, sexp_sint_t n, sexp s) { + sexp res; + sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, s); +#if SEXP_USE_PACKED_STRINGS + /* no sharing with packed strings */ + res = sexp_c_string(ctx, sexp_string_data(s), sexp_string_size(s)); +#else + res = sexp_alloc_type(ctx, string, SEXP_STRING); + sexp_string_bytes(res) = sexp_string_bytes(s); + sexp_string_offset(res) = sexp_string_offset(s); + sexp_string_size(res) = sexp_string_size(s); + sexp_copy_on_writep(s) = 1; +#endif + sexp_immutablep(res) = 1; + return res; +} + sexp sexp_integer_to_immediate (sexp ctx, sexp self, sexp_sint_t n, sexp i, sexp dflt) { sexp x = (sexp)sexp_unbox_fixnum(i); sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, i); @@ -756,6 +773,7 @@ sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char sexp_define_foreign(ctx, env, "object-size", 1, sexp_object_size); sexp_define_foreign(ctx, env, "immutable?", 1, sexp_immutablep_op); sexp_define_foreign(ctx, env, "make-immutable!", 1, sexp_make_immutable_op); + sexp_define_foreign(ctx, env, "immutable-string", 1, sexp_immutable_string_op); sexp_define_foreign_opt(ctx, env, "integer->immediate", 2, sexp_integer_to_immediate, SEXP_FALSE); sexp_define_foreign_opt(ctx, env, "object->integer", 1, sexp_object_to_integer, SEXP_FALSE); sexp_define_foreign(ctx, env, "gc", 0, sexp_gc_op); diff --git a/lib/chibi/ast.sld b/lib/chibi/ast.sld index ad0367cb..477b4fba 100644 --- a/lib/chibi/ast.sld +++ b/lib/chibi/ast.sld @@ -41,7 +41,7 @@ atomically thread-list abort string-contains string-cursor-copy! errno integer->error-string flatten-dot update-free-vars! setenv unsetenv safe-setenv - immutable? make-immutable! + immutable? immutable-string make-immutable! thread-interrupt! chibi-version) (import (chibi))