diff options
Diffstat (limited to 'libguile/strings.c')
-rw-r--r-- | libguile/strings.c | 649 |
1 files changed, 545 insertions, 104 deletions
diff --git a/libguile/strings.c b/libguile/strings.c index 4e21f3e28..fc92fd233 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -24,6 +24,8 @@ #include <string.h> #include <stdio.h> +#include <ctype.h> +#include <unistr.h> #include "libguile/_scm.h" #include "libguile/chars.h" @@ -69,10 +71,12 @@ #define STRINGBUF_F_SHARED 0x100 #define STRINGBUF_F_INLINE 0x200 +#define STRINGBUF_F_WIDE 0x400 #define STRINGBUF_TAG scm_tc7_stringbuf #define STRINGBUF_SHARED(buf) (SCM_CELL_WORD_0(buf) & STRINGBUF_F_SHARED) #define STRINGBUF_INLINE(buf) (SCM_CELL_WORD_0(buf) & STRINGBUF_F_INLINE) +#define STRINGBUF_WIDE(buf) (SCM_CELL_WORD_0(buf) & STRINGBUF_F_WIDE) #define STRINGBUF_OUTLINE_CHARS(buf) ((char *)SCM_CELL_WORD_1(buf)) #define STRINGBUF_OUTLINE_LENGTH(buf) (SCM_CELL_WORD_2(buf)) @@ -82,6 +86,7 @@ #define STRINGBUF_CHARS(buf) (STRINGBUF_INLINE (buf) \ ? STRINGBUF_INLINE_CHARS (buf) \ : STRINGBUF_OUTLINE_CHARS (buf)) +#define STRINGBUF_WIDE_CHARS(buf) ((scm_t_wchar *)SCM_CELL_WORD_1(buf)) #define STRINGBUF_LENGTH(buf) (STRINGBUF_INLINE (buf) \ ? STRINGBUF_INLINE_LENGTH (buf) \ : STRINGBUF_OUTLINE_LENGTH (buf)) @@ -126,6 +131,23 @@ make_stringbuf (size_t len) } } +static SCM +make_wide_stringbuf (size_t len) +{ + scm_t_wchar *mem; +#if SCM_DEBUG + if (len < 1000) + lenhist[len]++; + else + lenhist[1000]++; +#endif + + mem = scm_gc_malloc (sizeof (scm_t_wchar) * (len + 1), "string"); + mem[len] = 0; + return scm_double_cell (STRINGBUF_TAG | STRINGBUF_F_WIDE, (scm_t_bits) mem, + (scm_t_bits) len, (scm_t_bits) 0); +} + /* Return a new stringbuf whose underlying storage consists of the LEN+1 octets pointed to by STR (the last octet is zero). */ SCM @@ -147,8 +169,58 @@ void scm_i_stringbuf_free (SCM buf) { if (!STRINGBUF_INLINE (buf)) - scm_gc_free (STRINGBUF_OUTLINE_CHARS (buf), - STRINGBUF_OUTLINE_LENGTH (buf) + 1, "string"); + { + if (!STRINGBUF_WIDE (buf)) + scm_gc_free (STRINGBUF_OUTLINE_CHARS (buf), + STRINGBUF_OUTLINE_LENGTH (buf) + 1, "string"); + else + scm_gc_free (STRINGBUF_OUTLINE_CHARS (buf), + sizeof (scm_t_wchar) * (STRINGBUF_OUTLINE_LENGTH (buf) + + 1), "string"); + } + +} + +static void +widen_stringbuf (SCM buf) +{ + size_t i, len; + scm_t_wchar *mem; + + if (STRINGBUF_WIDE (buf)) + return; + + if (STRINGBUF_INLINE (buf)) + { + len = STRINGBUF_INLINE_LENGTH (buf); + + mem = scm_gc_malloc (sizeof (scm_t_wchar) * (len + 1), "string"); + for (i = 0; i < len; i++) + mem[i] = + (scm_t_wchar) (unsigned char) STRINGBUF_INLINE_CHARS (buf)[i]; + mem[len] = 0; + + SCM_SET_CELL_WORD_0 (buf, SCM_CELL_WORD_0 (buf) ^ STRINGBUF_F_INLINE); + SCM_SET_CELL_WORD_0 (buf, SCM_CELL_WORD_0 (buf) | STRINGBUF_F_WIDE); + SCM_SET_CELL_WORD_1 (buf, mem); + SCM_SET_CELL_WORD_2 (buf, len); + } + else + { + len = STRINGBUF_OUTLINE_LENGTH (buf); + + mem = scm_gc_malloc (sizeof (scm_t_wchar) * (len + 1), "string"); + for (i = 0; i < len; i++) + mem[i] = + (scm_t_wchar) (unsigned char) STRINGBUF_OUTLINE_CHARS (buf)[i]; + mem[len] = 0; + + scm_gc_free (STRINGBUF_OUTLINE_CHARS (buf), len + 1, "string"); + + SCM_SET_CELL_WORD_0 (buf, SCM_CELL_WORD_0 (buf) | STRINGBUF_F_WIDE); + SCM_SET_CELL_WORD_1 (buf, mem); + SCM_SET_CELL_WORD_2 (buf, len); + } } scm_i_pthread_mutex_t stringbuf_write_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER; @@ -195,6 +267,18 @@ scm_i_make_string (size_t len, char **charsp) return res; } +SCM +scm_i_make_wide_string (size_t len, scm_t_wchar ** charsp) +{ + SCM buf = make_wide_stringbuf (len); + SCM res; + if (charsp) + *charsp = STRINGBUF_WIDE_CHARS (buf); + res = scm_double_cell (STRING_TAG, SCM_UNPACK (buf), + (scm_t_bits) 0, (scm_t_bits) len); + return res; +} + static void validate_substring_args (SCM str, size_t start, size_t end) { @@ -253,12 +337,24 @@ scm_i_substring_copy (SCM str, size_t start, size_t end) SCM buf, my_buf; size_t str_start; get_str_buf_start (&str, &buf, &str_start); - my_buf = make_stringbuf (len); - memcpy (STRINGBUF_CHARS (my_buf), - STRINGBUF_CHARS (buf) + str_start + start, len); + if (scm_i_is_narrow_string (str)) + { + my_buf = make_stringbuf (len); + memcpy (STRINGBUF_CHARS (my_buf), + STRINGBUF_CHARS (buf) + str_start + start, len); + } + else + { + my_buf = make_wide_stringbuf (len); + u32_cpy ((scm_t_uint32 *) STRINGBUF_WIDE_CHARS (my_buf), + (scm_t_uint32 *) (STRINGBUF_WIDE_CHARS (buf) + str_start + + start), len); + /* Even though this string is wide, the substring may be narrow. + Consider adding code to narrow string. */ + } scm_remember_upto_here_1 (buf); - return scm_double_cell (STRING_TAG, SCM_UNPACK(my_buf), - (scm_t_bits)0, (scm_t_bits) len); + return scm_double_cell (STRING_TAG, SCM_UNPACK (my_buf), + (scm_t_bits) 0, (scm_t_bits) len); } SCM @@ -330,17 +426,45 @@ scm_i_string_length (SCM str) return STRING_LENGTH (str); } +int +scm_i_is_narrow_string (SCM str) +{ + return !STRINGBUF_WIDE (STRING_STRINGBUF (str)); +} + const char * scm_i_string_chars (SCM str) { SCM buf; size_t start; get_str_buf_start (&str, &buf, &start); - return STRINGBUF_CHARS (buf) + start; + if (scm_i_is_narrow_string (str)) + return STRINGBUF_CHARS (buf) + start; + else + scm_misc_error (NULL, "Invalid read access of chars of wide string: ~s", + scm_list_1 (str)); + return NULL; } -char * -scm_i_string_writable_chars (SCM orig_str) +const scm_t_wchar * +scm_i_string_wide_chars (SCM str) +{ + SCM buf; + size_t start; + + get_str_buf_start (&str, &buf, &start); + if (!scm_i_is_narrow_string (str)) + return STRINGBUF_WIDE_CHARS (buf) + start; + else + scm_misc_error (NULL, "Invalid read access of chars of narrow string: ~s", + scm_list_1 (str)); +} + +/* If the buffer in ORIG_STR is shared, copy ORIG_STR's characters to + a new string buffer, so that it can be modified without modifying + other strings. */ +SCM +scm_i_string_start_writing (SCM orig_str) { SCM buf, str = orig_str; size_t start; @@ -352,18 +476,26 @@ scm_i_string_writable_chars (SCM orig_str) scm_i_pthread_mutex_lock (&stringbuf_write_mutex); if (STRINGBUF_SHARED (buf)) { - /* Clone stringbuf. For this, we put all threads to sleep. - */ - + /* Clone the stringbuf. */ size_t len = STRING_LENGTH (str); SCM new_buf; scm_i_pthread_mutex_unlock (&stringbuf_write_mutex); - new_buf = make_stringbuf (len); - memcpy (STRINGBUF_CHARS (new_buf), - STRINGBUF_CHARS (buf) + STRING_START (str), len); - + if (scm_i_is_narrow_string (str)) + { + new_buf = make_stringbuf (len); + memcpy (STRINGBUF_CHARS (new_buf), + STRINGBUF_CHARS (buf) + STRING_START (str), len); + + } + else + { + new_buf = make_wide_stringbuf (len); + u32_cpy ((scm_t_uint32 *) STRINGBUF_WIDE_CHARS (new_buf), + (scm_t_uint32 *) (STRINGBUF_WIDE_CHARS (buf) + + STRING_START (str)), len); + } scm_i_thread_put_to_sleep (); SET_STRING_STRINGBUF (str, new_buf); start -= STRING_START (str); @@ -374,8 +506,39 @@ scm_i_string_writable_chars (SCM orig_str) scm_i_pthread_mutex_lock (&stringbuf_write_mutex); } + return orig_str; +} + +/* Return a pointer to the chars of a string that fits in a Latin-1 + encoding. */ +char * +scm_i_string_writable_chars (SCM str) +{ + SCM buf; + size_t start; - return STRINGBUF_CHARS (buf) + start; + get_str_buf_start (&str, &buf, &start); + if (scm_i_is_narrow_string (str)) + return STRINGBUF_CHARS (buf) + start; + else + scm_misc_error (NULL, "Invalid write access of chars of wide string: ~s", + scm_list_1 (str)); + return NULL; +} + +/* Return a pointer to the Unicode codepoints of a string. */ +static scm_t_wchar * +scm_i_string_writable_wide_chars (SCM str) +{ + SCM buf; + size_t start; + + get_str_buf_start (&str, &buf, &start); + if (!scm_i_is_narrow_string (str)) + return STRINGBUF_WIDE_CHARS (buf) + start; + else + scm_misc_error (NULL, "Invalid read access of chars of narrow string: ~s", + scm_list_1 (str)); } void @@ -384,6 +547,34 @@ scm_i_string_stop_writing (void) scm_i_pthread_mutex_unlock (&stringbuf_write_mutex); } +/* Return the Xth character is C. */ +scm_t_wchar +scm_i_string_ref (SCM str, size_t x) +{ + if (scm_i_is_narrow_string (str)) + return (scm_t_wchar) (unsigned char) (scm_i_string_chars (str)[x]); + else + return scm_i_string_wide_chars (str)[x]; +} + +void +scm_i_string_set_x (SCM str, size_t p, scm_t_wchar chr) +{ + if (chr > 0xFF && scm_i_is_narrow_string (str)) + widen_stringbuf (STRING_STRINGBUF (str)); + + if (scm_i_is_narrow_string (str)) + { + char *dst = scm_i_string_writable_chars (str); + dst[p] = (char) (unsigned char) chr; + } + else + { + scm_t_wchar *dst = scm_i_string_writable_wide_chars (str); + dst[p] = chr; + } +} + /* Symbols. Basic symbol creation and accessing is done here, the rest is in @@ -418,10 +609,21 @@ scm_i_make_symbol (SCM name, scm_t_bits flags, else { /* make new buf. */ - SCM new_buf = make_stringbuf (length); - memcpy (STRINGBUF_CHARS (new_buf), - STRINGBUF_CHARS (buf) + start, length); - buf = new_buf; + if (scm_i_is_narrow_string (name)) + { + SCM new_buf = make_stringbuf (length); + memcpy (STRINGBUF_CHARS (new_buf), + STRINGBUF_CHARS (buf) + start, length); + buf = new_buf; + } + else + { + SCM new_buf = make_wide_stringbuf (length); + u32_cpy ((scm_t_uint32 *) STRINGBUF_WIDE_CHARS (new_buf), + (scm_t_uint32 *) STRINGBUF_WIDE_CHARS (buf) + start, + length); + buf = new_buf; + } } return scm_double_cell (scm_tc7_symbol | flags, SCM_UNPACK (buf), (scm_t_bits) hash, SCM_UNPACK (props)); @@ -466,11 +668,40 @@ scm_c_symbol_length (SCM sym) } #undef FUNC_NAME +int +scm_i_is_narrow_symbol (SCM sym) +{ + SCM buf; + + buf = SYMBOL_STRINGBUF (sym); + return !STRINGBUF_WIDE (buf); +} + const char * scm_i_symbol_chars (SCM sym) { - SCM buf = SYMBOL_STRINGBUF (sym); - return STRINGBUF_CHARS (buf); + SCM buf; + + buf = SYMBOL_STRINGBUF (sym); + if (!STRINGBUF_WIDE (buf)) + return STRINGBUF_CHARS (buf); + else + scm_misc_error (NULL, "Invalid access of chars of a wide symbol ~S", + scm_list_1 (sym)); +} + +/* Return a pointer to the Unicode codepoints of a symbol's name. */ +const scm_t_wchar * +scm_i_symbol_wide_chars (SCM sym) +{ + SCM buf; + + buf = SYMBOL_STRINGBUF (sym); + if (STRINGBUF_WIDE (buf)) + return STRINGBUF_WIDE_CHARS (buf); + else + scm_misc_error (NULL, "Invalid access of chars of a narrow symbol ~S", + scm_list_1 (sym)); } SCM @@ -496,6 +727,15 @@ scm_i_symbol_substring (SCM sym, size_t start, size_t end) (scm_t_bits)start, (scm_t_bits) end - start); } +scm_t_wchar +scm_i_symbol_ref (SCM sym, size_t x) +{ + if (scm_i_is_narrow_symbol (sym)) + return (scm_t_wchar) (unsigned char) (scm_i_symbol_chars (sym)[x]); + else + return scm_i_symbol_wide_chars (sym)[x]; +} + /* Debugging */ @@ -505,15 +745,17 @@ SCM scm_sys_string_dump (SCM); SCM scm_sys_symbol_dump (SCM); SCM scm_sys_stringbuf_hist (void); -SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0, - (SCM str), - "") +SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0, (SCM str), "") #define FUNC_NAME s_scm_sys_string_dump { SCM_VALIDATE_STRING (1, str); fprintf (stderr, "%p:\n", str); fprintf (stderr, " start: %u\n", STRING_START (str)); fprintf (stderr, " len: %u\n", STRING_LENGTH (str)); + if (scm_i_is_narrow_string (str)) + fprintf (stderr, " format: narrow\n"); + else + fprintf (stderr, " format: wide\n"); if (IS_SH_STRING (str)) { fprintf (stderr, " string: %p\n", SH_STRING_STRING (str)); @@ -524,36 +766,54 @@ SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0, { SCM buf = STRING_STRINGBUF (str); fprintf (stderr, " buf: %p\n", buf); - fprintf (stderr, " chars: %p\n", STRINGBUF_CHARS (buf)); + if (scm_i_is_narrow_string (str)) + fprintf (stderr, " chars: %p\n", STRINGBUF_CHARS (buf)); + else + fprintf (stderr, " chars: %p\n", STRINGBUF_WIDE_CHARS (buf)); fprintf (stderr, " length: %u\n", STRINGBUF_LENGTH (buf)); - fprintf (stderr, " flags: %x\n", (SCM_CELL_WORD_0 (buf) & 0x300)); + if (STRINGBUF_SHARED (buf)) + fprintf (stderr, " shared: true\n"); + else + fprintf (stderr, " shared: false\n"); + if (STRINGBUF_INLINE (buf)) + fprintf (stderr, " inline: true\n"); + else + fprintf (stderr, " inline: false\n"); + } return SCM_UNSPECIFIED; } #undef FUNC_NAME -SCM_DEFINE (scm_sys_symbol_dump, "%symbol-dump", 1, 0, 0, - (SCM sym), - "") +SCM_DEFINE (scm_sys_symbol_dump, "%symbol-dump", 1, 0, 0, (SCM sym), "") #define FUNC_NAME s_scm_sys_symbol_dump { SCM_VALIDATE_SYMBOL (1, sym); fprintf (stderr, "%p:\n", sym); fprintf (stderr, " hash: %lu\n", scm_i_symbol_hash (sym)); + if (scm_i_is_narrow_symbol (sym)) + fprintf (stderr, " format: narrow\n"); + else + fprintf (stderr, " format: wide\n"); { SCM buf = SYMBOL_STRINGBUF (sym); fprintf (stderr, " buf: %p\n", buf); - fprintf (stderr, " chars: %p\n", STRINGBUF_CHARS (buf)); + if (scm_i_is_narrow_symbol (sym)) + fprintf (stderr, " chars: %p\n", STRINGBUF_CHARS (buf)); + else + fprintf (stderr, " chars: %p\n", STRINGBUF_WIDE_CHARS (buf)); fprintf (stderr, " length: %u\n", STRINGBUF_LENGTH (buf)); - fprintf (stderr, " shared: %u\n", STRINGBUF_SHARED (buf)); + if (STRINGBUF_SHARED (buf)) + fprintf (stderr, " shared: true\n"); + else + fprintf (stderr, " shared: false\n"); + } return SCM_UNSPECIFIED; } #undef FUNC_NAME -SCM_DEFINE (scm_sys_stringbuf_hist, "%stringbuf-hist", 0, 0, 0, - (void), - "") +SCM_DEFINE (scm_sys_stringbuf_hist, "%stringbuf-hist", 0, 0, 0, (void), "") #define FUNC_NAME s_scm_sys_stringbuf_hist { int i; @@ -589,29 +849,46 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1, #define FUNC_NAME s_scm_string { SCM result; + SCM rest; size_t len; - char *data; - - { - long i = scm_ilength (chrs); + size_t p = 0; + long i; - SCM_ASSERT (i >= 0, chrs, SCM_ARG1, FUNC_NAME); - len = i; - } + /* Verify that this is a list of chars. */ + i = scm_ilength (chrs); + len = (size_t) i; + rest = chrs; - result = scm_i_make_string (len, &data); - while (len > 0 && scm_is_pair (chrs)) + SCM_ASSERT (len >= 0, chrs, SCM_ARG1, FUNC_NAME); + while (len > 0 && scm_is_pair (rest)) { - SCM elt = SCM_CAR (chrs); - + SCM elt = SCM_CAR (rest); SCM_VALIDATE_CHAR (SCM_ARGn, elt); - *data++ = SCM_CHAR (elt); - chrs = SCM_CDR (chrs); + rest = SCM_CDR (rest); + len--; + scm_remember_upto_here_1 (elt); + } + + /* Construct a string containing this list of chars. */ + len = (size_t) i; + rest = chrs; + + result = scm_i_make_string (len, NULL); + result = scm_i_string_start_writing (result); + while (len > 0 && scm_is_pair (rest)) + { + SCM elt = SCM_CAR (rest); + scm_i_string_set_x (result, p, SCM_CHAR (elt)); + p++; + rest = SCM_CDR (rest); len--; + scm_remember_upto_here_1 (elt); } + scm_i_string_stop_writing (); + if (len > 0) scm_misc_error (NULL, "list changed while constructing string", SCM_EOL); - if (!scm_is_null (chrs)) + if (!scm_is_null (rest)) scm_wrong_type_arg_msg (NULL, 0, chrs, "proper list"); return result; @@ -634,13 +911,16 @@ SCM scm_c_make_string (size_t len, SCM chr) #define FUNC_NAME NULL { - char *dst; - SCM res = scm_i_make_string (len, &dst); + size_t p; + SCM res = scm_i_make_string (len, NULL); if (!SCM_UNBNDP (chr)) { SCM_VALIDATE_CHAR (0, chr); - memset (dst, SCM_CHAR (chr), len); + res = scm_i_string_start_writing (res); + for (p = 0; p < len; p++) + scm_i_string_set_x (res, p, SCM_CHAR (chr)); + scm_i_string_stop_writing (); } return res; @@ -657,6 +937,20 @@ SCM_DEFINE (scm_string_length, "string-length", 1, 0, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_string_width, "string-width", 1, 0, 0, + (SCM string), + "Return the bytes used to represent a character in @var{string}." + "This will return 1 or 4.") +#define FUNC_NAME s_scm_string_width +{ + SCM_VALIDATE_STRING (1, string); + if (!scm_i_is_narrow_string (string)) + return scm_from_int (4); + + return scm_from_int (1); +} +#undef FUNC_NAME + size_t scm_c_string_length (SCM string) { @@ -667,8 +961,8 @@ scm_c_string_length (SCM string) SCM_DEFINE (scm_string_ref, "string-ref", 2, 0, 0, (SCM str, SCM k), - "Return character @var{k} of @var{str} using zero-origin\n" - "indexing. @var{k} must be a valid index of @var{str}.") + "Return character @var{k} of @var{str} using zero-origin\n" + "indexing. @var{k} must be a valid index of @var{str}.") #define FUNC_NAME s_scm_string_ref { size_t len; @@ -682,7 +976,10 @@ SCM_DEFINE (scm_string_ref, "string-ref", 2, 0, 0, else scm_out_of_range (NULL, k); - return SCM_MAKE_CHAR (scm_i_string_chars (str)[idx]); + if (scm_i_is_narrow_string (str)) + return SCM_MAKE_CHAR (scm_i_string_chars (str)[idx]); + else + return SCM_MAKE_CHAR (scm_i_string_wide_chars (str)[idx]); } #undef FUNC_NAME @@ -691,14 +988,18 @@ scm_c_string_ref (SCM str, size_t p) { if (p >= scm_i_string_length (str)) scm_out_of_range (NULL, scm_from_size_t (p)); - return SCM_MAKE_CHAR (scm_i_string_chars (str)[p]); + if (scm_i_is_narrow_string (str)) + return SCM_MAKE_CHAR (scm_i_string_chars (str)[p]); + else + return SCM_MAKE_CHAR (scm_i_string_wide_chars (str)[p]); + } SCM_DEFINE (scm_string_set_x, "string-set!", 3, 0, 0, (SCM str, SCM k, SCM chr), - "Store @var{chr} in element @var{k} of @var{str} and return\n" - "an unspecified value. @var{k} must be a valid index of\n" - "@var{str}.") + "Store @var{chr} in element @var{k} of @var{str} and return\n" + "an unspecified value. @var{k} must be a valid index of\n" + "@var{str}.") #define FUNC_NAME s_scm_string_set_x { size_t len; @@ -713,11 +1014,10 @@ SCM_DEFINE (scm_string_set_x, "string-set!", 3, 0, 0, scm_out_of_range (NULL, k); SCM_VALIDATE_CHAR (3, chr); - { - char *dst = scm_i_string_writable_chars (str); - dst[idx] = SCM_CHAR (chr); - scm_i_string_stop_writing (); - } + str = scm_i_string_start_writing (str); + scm_i_string_set_x (str, idx, SCM_CHAR (chr)); + scm_i_string_stop_writing (); + return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -727,11 +1027,9 @@ scm_c_string_set_x (SCM str, size_t p, SCM chr) { if (p >= scm_i_string_length (str)) scm_out_of_range (NULL, scm_from_size_t (p)); - { - char *dst = scm_i_string_writable_chars (str); - dst[p] = SCM_CHAR (chr); - scm_i_string_stop_writing (); - } + str = scm_i_string_start_writing (str); + scm_i_string_set_x (str, p, SCM_CHAR (chr)); + scm_i_string_stop_writing (); } SCM_DEFINE (scm_substring, "substring", 2, 1, 0, @@ -832,31 +1130,55 @@ SCM_DEFINE (scm_substring_shared, "substring/shared", 2, 1, 0, SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1, (SCM args), - "Return a newly allocated string whose characters form the\n" + "Return a newly allocated string whose characters form the\n" "concatenation of the given strings, @var{args}.") #define FUNC_NAME s_scm_string_append { SCM res; - size_t i = 0; + size_t len = 0; + int wide = 0; SCM l, s; char *data; + scm_t_wchar *wdata; + int i; SCM_VALIDATE_REST_ARGUMENT (args); - for (l = args; !scm_is_null (l); l = SCM_CDR (l)) + for (l = args; !scm_is_null (l); l = SCM_CDR (l)) { s = SCM_CAR (l); SCM_VALIDATE_STRING (SCM_ARGn, s); - i += scm_i_string_length (s); + len += scm_i_string_length (s); + if (!scm_i_is_narrow_string (s)) + wide = 1; } - res = scm_i_make_string (i, &data); - for (l = args; !scm_is_null (l); l = SCM_CDR (l)) + if (!wide) + res = scm_i_make_string (len, &data); + else + res = scm_i_make_wide_string (len, &wdata); + + for (l = args; !scm_is_null (l); l = SCM_CDR (l)) { size_t len; s = SCM_CAR (l); SCM_VALIDATE_STRING (SCM_ARGn, s); len = scm_i_string_length (s); - memcpy (data, scm_i_string_chars (s), len); - data += len; + if (!wide) + { + memcpy (data, scm_i_string_chars (s), len); + data += len; + } + else + { + if (scm_i_is_narrow_string (s)) + { + for (i = 0; i < scm_i_string_length (s); i++) + wdata[i] = (unsigned char) scm_i_string_chars (s)[i]; + } + else + u32_cpy ((scm_t_uint32 *) wdata, + (scm_t_uint32 *) scm_i_string_wide_chars (s), len); + wdata += len; + } scm_remember_upto_here_1 (s); } return res; @@ -875,8 +1197,11 @@ scm_from_locale_stringn (const char *str, size_t len) SCM res; char *dst; - if (len == (size_t)-1) + if (len == (size_t) -1) len = strlen (str); + if (len == 0) + return scm_nullstr; + res = scm_i_make_string (len, &dst); memcpy (dst, str, len); return res; @@ -885,6 +1210,9 @@ scm_from_locale_stringn (const char *str, size_t len) SCM scm_from_locale_string (const char *str) { + if (str == NULL) + return scm_nullstr; + return scm_from_locale_stringn (str, -1); } @@ -893,21 +1221,20 @@ scm_take_locale_stringn (char *str, size_t len) { SCM buf, res; - if (len == (size_t)-1) + if (len == (size_t) -1) len = strlen (str); 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. */ - str = scm_realloc (str, len+1); + str = scm_realloc (str, len + 1); str[len] = '\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_UNPACK (buf), (scm_t_bits) 0, (scm_t_bits) len); return res; } @@ -917,33 +1244,143 @@ scm_take_locale_string (char *str) return scm_take_locale_stringn (str, -1); } +/* Change libunistring escapes (\uXXXX and \UXXXXXXXX) to \xXX \uXXXX + and \UXXXXXX. */ +static void +unistring_escapes_to_guile_escapes (char **bufp, size_t *lenp) +{ + char *before, *after; + size_t i, j; + + before = *bufp; + after = *bufp; + i = 0; + j = 0; + while (i < *lenp) + { + if ((i <= *lenp - 6) + && before[i] == '\\' + && before[i + 1] == 'u' + && before[i + 2] == '0' && before[i + 3] == '0') + { + /* Convert \u00NN to \xNN */ + after[j] = '\\'; + after[j + 1] = 'x'; + after[j + 2] = tolower (before[i + 4]); + after[j + 3] = tolower (before[i + 5]); + i += 6; + j += 4; + } + else if ((i <= *lenp - 10) + && before[i] == '\\' + && before[i + 1] == 'U' + && before[i + 2] == '0' && before[i + 3] == '0') + { + /* Convert \U00NNNNNN to \UNNNNNN */ + after[j] = '\\'; + after[j + 1] = 'U'; + after[j + 2] = tolower (before[i + 4]); + after[j + 3] = tolower (before[i + 5]); + after[j + 4] = tolower (before[i + 6]); + after[j + 5] = tolower (before[i + 7]); + after[j + 6] = tolower (before[i + 8]); + after[j + 7] = tolower (before[i + 9]); + i += 10; + j += 8; + } + else + { + after[j] = before[i]; + i++; + j++; + } + } + *lenp = j; + after = scm_realloc (after, j); +} + char * -scm_to_locale_stringn (SCM str, size_t *lenp) +scm_to_locale_stringn (SCM str, size_t * lenp) { - char *res; - size_t len; + const char *enc; + + /* In the future, enc will hold the port's encoding. */ + enc = NULL; + + return scm_to_stringn (str, lenp, enc, iconveh_escape_sequence); +} + +/* Low-level scheme to C string conversion function. */ +char * +scm_to_stringn (SCM str, size_t * lenp, const char *encoding, + enum iconv_ilseq_handler handler) +{ + static const char iso[11] = "ISO-8859-1"; + char *buf; + size_t ilen, len, i; if (!scm_is_string (str)) scm_wrong_type_arg_msg (NULL, 0, str, "string"); - len = scm_i_string_length (str); - res = scm_malloc (len + ((lenp==NULL)? 1 : 0)); - memcpy (res, scm_i_string_chars (str), len); + ilen = scm_i_string_length (str); + + if (ilen == 0) + { + buf = scm_malloc (1); + buf[0] = '\0'; + if (lenp) + *lenp = 0; + return buf; + } + if (lenp == NULL) + for (i = 0; i < ilen; i++) + if (scm_i_string_ref (str, i) == '\0') + scm_misc_error (NULL, + "string contains #\\nul character: ~S", + scm_list_1 (str)); + + if (scm_i_is_narrow_string (str)) { - res[len] = '\0'; - if (strlen (res) != len) - { - free (res); - scm_misc_error (NULL, - "string contains #\\nul character: ~S", - scm_list_1 (str)); - } + if (lenp) + { + buf = scm_malloc (ilen); + memcpy (buf, scm_i_string_chars (str), ilen); + *lenp = ilen; + return buf; + } + else + { + buf = scm_malloc (ilen + 1); + memcpy (buf, scm_i_string_chars (str), ilen); + buf[ilen] = '\0'; + return buf; + } } - else + + + buf = NULL; + len = 0; + buf = u32_conv_to_encoding (iso, + handler, + (scm_t_uint32 *) scm_i_string_wide_chars (str), + ilen, NULL, NULL, &len); + if (buf == NULL) + scm_misc_error (NULL, "cannot convert to output locale ~s: \"~s\"", + scm_list_2 (scm_from_locale_string (iso), str)); + + if (handler == iconveh_escape_sequence) + unistring_escapes_to_guile_escapes (&buf, &len); + + if (lenp) *lenp = len; + else + { + buf = scm_realloc (buf, len + 1); + buf[len] = '\0'; + } scm_remember_upto_here_1 (str); - return res; + return buf; } char * @@ -956,18 +1393,21 @@ size_t scm_to_locale_stringbuf (SCM str, char *buf, size_t max_len) { size_t len; - + char *result = NULL; if (!scm_is_string (str)) scm_wrong_type_arg_msg (NULL, 0, str, "string"); - len = scm_i_string_length (str); - memcpy (buf, scm_i_string_chars (str), (len > max_len)? max_len : len); + result = scm_to_locale_stringn (str, &len); + + memcpy (buf, result, (len > max_len) ? max_len : len); + free (result); + scm_remember_upto_here_1 (str); return len; } /* converts C scm_array of strings to SCM scm_list of strings. */ /* If argc < 0, a null terminated scm_array is assumed. */ -SCM +SCM scm_makfromstrs (int argc, char **argv) { int i = argc; @@ -1081,6 +1521,7 @@ scm_i_deprecated_string_chars (SCM str) /* The following is still wrong, of course... */ + str = scm_i_string_start_writing (str); chars = scm_i_string_writable_chars (str); scm_i_string_stop_writing (); return chars; |