diff options
Diffstat (limited to 'libguile/strings.c')
-rw-r--r-- | libguile/strings.c | 173 |
1 files changed, 96 insertions, 77 deletions
diff --git a/libguile/strings.c b/libguile/strings.c index 6e1f9c80b..cb883fa73 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -126,7 +126,7 @@ make_stringbuf (size_t len) lenhist[1000]++; #endif - buf = PTR2SCM (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + len + 1, + buf = SCM_PACK_POINTER (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + len + 1, "string")); SCM_SET_CELL_TYPE (buf, STRINGBUF_TAG); @@ -153,7 +153,7 @@ make_wide_stringbuf (size_t len) #endif raw_len = (len + 1) * sizeof (scm_t_wchar); - buf = PTR2SCM (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + raw_len, + buf = SCM_PACK_POINTER (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + raw_len, "string")); SCM_SET_CELL_TYPE (buf, STRINGBUF_TAG | STRINGBUF_F_WIDE); @@ -240,7 +240,7 @@ scm_i_pthread_mutex_t stringbuf_write_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER; #define SET_STRING_STRINGBUF(str,buf) (SCM_SET_CELL_OBJECT_1(str,buf)) #define SET_STRING_START(str,start) (SCM_SET_CELL_WORD_2(str,start)) -#define IS_STRING(str) (SCM_NIMP(str) && SCM_TYP7(str) == STRING_TAG) +#define IS_STRING(str) (SCM_HAS_TYP7 (str, STRING_TAG)) /* Read-only strings. */ @@ -1458,6 +1458,23 @@ scm_decoding_error (const char *subr, int err, const char *message, SCM port) /* String conversion to/from C. */ +static void +decoding_error (const char *func_name, int errno_save, + const char *str, size_t len) +{ + /* Raise an error and pass the raw C string as a bytevector to the `throw' + handler. */ + SCM bv; + signed char *buf; + + buf = scm_gc_malloc_pointerless (len, "bytevector"); + memcpy (buf, str, len); + bv = scm_c_take_gc_bytevector (buf, len, SCM_BOOL_F); + + scm_decoding_error (func_name, errno_save, + "input locale conversion error", bv); +} + SCM scm_from_stringn (const char *str, size_t len, const char *encoding, scm_t_string_failed_conversion_handler handler) @@ -1493,19 +1510,7 @@ scm_from_stringn (const char *str, size_t len, const char *encoding, NULL, &u32len); if (SCM_UNLIKELY (u32 == NULL)) - { - /* Raise an error and pass the raw C string as a bytevector to the `throw' - handler. */ - SCM bv; - signed char *buf; - - buf = scm_gc_malloc_pointerless (len, "bytevector"); - memcpy (buf, str, len); - bv = scm_c_take_gc_bytevector (buf, len); - - scm_decoding_error (__func__, errno, - "input locale conversion error", bv); - } + decoding_error (__func__, errno, str, len); i = 0; while (i < u32len) @@ -1579,7 +1584,81 @@ scm_from_utf8_string (const char *str) SCM scm_from_utf8_stringn (const char *str, size_t len) { - return scm_from_stringn (str, len, "UTF-8", SCM_FAILED_CONVERSION_ERROR); + size_t i, char_len; + const scm_t_uint8 *ustr = (const scm_t_uint8 *) str; + int ascii = 1, narrow = 1; + SCM res; + + if (len == (size_t) -1) + len = strlen (str); + + i = 0; + char_len = 0; + + while (i < len) + { + if (ustr[i] <= 127) + { + char_len++; + i++; + } + else + { + ucs4_t c; + int nbytes; + + ascii = 0; + + nbytes = u8_mbtouc (&c, ustr + i, len - i); + + if (nbytes < 0) + /* Bad UTF-8. */ + decoding_error (__func__, errno, str, len); + + if (c > 255) + narrow = 0; + + char_len++; + i += nbytes; + } + } + + if (ascii) + { + char *dst; + res = scm_i_make_string (char_len, &dst, 0); + memcpy (dst, str, len); + } + else if (narrow) + { + char *dst; + size_t j; + ucs4_t c; + + res = scm_i_make_string (char_len, &dst, 0); + + for (i = 0, j = 0; i < len; i++, j++) + { + i += u8_mbtouc_unsafe (&c, ustr + i, len - i); + dst[j] = (signed char) c; + } + } + else + { + scm_t_wchar *dst; + size_t j; + ucs4_t c; + + res = scm_i_make_wide_string (char_len, &dst, 0); + + for (i = 0, j = 0; i < len; i++, j++) + { + i += u8_mbtouc_unsafe (&c, ustr + i, len - i); + dst[j] = c; + } + } + + return res; } SCM @@ -2143,66 +2222,6 @@ scm_i_get_substring_spec (size_t len, *cend = scm_to_unsigned_integer (end, *cstart, len); } -#if SCM_ENABLE_DEPRECATED - -/* When these definitions are removed, it becomes reasonable to use - read-only strings for string literals. For that, change the reader - to create string literals with scm_c_substring_read_only instead of - with scm_c_substring_copy. -*/ - -int -scm_i_deprecated_stringp (SCM str) -{ - scm_c_issue_deprecation_warning - ("SCM_STRINGP is deprecated. Use scm_is_string instead."); - - return scm_is_string (str); -} - -char * -scm_i_deprecated_string_chars (SCM str) -{ - char *chars; - - scm_c_issue_deprecation_warning - ("SCM_STRING_CHARS is deprecated. See the manual for alternatives."); - - /* We don't accept shared substrings here since they are not - null-terminated. - */ - if (IS_SH_STRING (str)) - scm_misc_error (NULL, - "SCM_STRING_CHARS does not work with shared substrings", - SCM_EOL); - - /* We explicitly test for read-only strings to produce a better - error message. - */ - - if (IS_RO_STRING (str)) - scm_misc_error (NULL, - "SCM_STRING_CHARS does not work with read-only strings", - SCM_EOL); - - /* 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; -} - -size_t -scm_i_deprecated_string_length (SCM str) -{ - scm_c_issue_deprecation_warning - ("SCM_STRING_LENGTH is deprecated. Use scm_c_string_length instead."); - return scm_c_string_length (str); -} - -#endif - static SCM string_handle_ref (scm_t_array_handle *h, size_t index) { |