guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-2-17-gf84


From: Michael Gran
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-2-17-gf846bd1
Date: Thu, 20 Aug 2009 06:24:48 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=f846bd1a8f0e0d366fb8bb6944598641bc3dd246

The branch, master has been updated
       via  f846bd1a8f0e0d366fb8bb6944598641bc3dd246 (commit)
       via  1441e6dbd756c2e78abfe13b0b9af261fcecfc05 (commit)
      from  1b9ac4580c9405b7e665cbf8c88b85fe73627e9f (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit f846bd1a8f0e0d366fb8bb6944598641bc3dd246
Author: Michael Gran <address@hidden>
Date:   Wed Aug 19 05:25:47 2009 -0700

    Update srfi-13 functions for Unicode
    
    * libguile/srfi-13.c (MY_SUBF_VALIDATE_SUBSTRING_SPEC): new macro
      (MY_VALIDATE_SUBSTRING_SPEC_COPY): now unused, removed
      (MY_VALIDATE_SUBSTRING_SPEC_UCOPY): now unused, removed
      (REF_IN_CHARSET): new macro
      (race_error)[0]: unused, removed
      (scm_string_any, scm_string_every, scm_string_tabulate)
      (scm_substring_to_list, scm_reverse_string_to_list)
      (scm_reverse_list_to_string, scm_string_join)
      (s_scm_srfi13_substring_copy, scm_string_copy, scm_string_copy_x)
      (scm_string_pad, scm_string_pad_right, scm_string_trim)
      (scm_string_trim_right, scm_string_trim_both, scm_substring_fill_x):
      (scm_string_compare, scm_string_compare_ci): modified for
      both wide and narrow strings
      (compare_string): new function
      (scm_string_eq, scm_string_neq, scm_string_lt, scm_string_gt)
      (scm_string_le, scm_string_ge, scm_string_ci_eq, scm_string_ci_neq)
      (scm_string_ci_lt, scm-string_ci_gt, scm_string_ci_le, scm_string_ci_gt)
      (scm_substring_hash, scm_string_prefix_length, scm_string_suffix_length)
      (scm_string_prefix_length_ci, scm_string_suffix_length_ci)
      (scm_string_prefix_p, scm_string_prefix_ci_p, scm_string_suffix_p)
      (scm_string_suffix_ci_p, scm_string_index, scm_string_index_right)
      (scm_string_skip, scm_string_skip_right, scm_string_count)
      (scm_string_contains, scm_string_contains_ci, string_upcase_x)
      (scm_substring_upcase_x, scm_substring_upcase, string_downcase_x)
      (scm_string_downcase_x, scm_string_downcase, scm_string_titlecase_x)
      (scm_string_titlecase, scm_string_capitalize, scm_string_reverse)
      (scm_string_reverse_x, scm_string_map, scm_string_map_x)
      (scm_string_fold, scm_string_fold_right, scm_string_unfold)
      (scm_string_unfold_right, scm_xsubstring, scm_string_xcopy_x)
      (scm_string_replace, scm_string_tokenize, scm_string_split)
      (scm_string_filter, scm_string_delete): modified for both wide and
      narrow strings

commit 1441e6dbd756c2e78abfe13b0b9af261fcecfc05
Author: Michael Gran <address@hidden>
Date:   Wed Aug 19 23:21:18 2009 -0700

    Some srfi-13 test with wide strings
    
    * test-suite/tests/srfi-13.test: more tests

-----------------------------------------------------------------------

Summary of changes:
 libguile/srfi-13.c            | 1506 ++++++++++++++++-------------------------
 test-suite/tests/srfi-13.test |   56 ++-
 2 files changed, 645 insertions(+), 917 deletions(-)

diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c
index 781fe68..1eb4563 100644
--- a/libguile/srfi-13.c
+++ b/libguile/srfi-13.c
@@ -1,6 +1,6 @@
 /* srfi-13.c --- SRFI-13 procedures for Guile
  *
- * Copyright (C) 2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
+ * Copyright (C) 2001, 2004, 2005, 2006, 2008, 2009 Free Software Foundation, 
Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -24,41 +24,14 @@
 #endif
 
 #include <string.h>
-#include <ctype.h>
+#include <unicase.h>
+#include <unictype.h>
 
 #include "libguile.h"
 
 #include "libguile/srfi-13.h"
 #include "libguile/srfi-14.h"
 
-/* SCM_VALIDATE_SUBSTRING_SPEC_COPY is deprecated since it encourages
-   messing with the internal representation of strings.  We define our
-   own version since we use it so much and are messing with Guile
-   internals anyway.
-*/
-
-#define MY_VALIDATE_SUBSTRING_SPEC_COPY(pos_str, str, c_str,        \
-                                        pos_start, start, c_start,  \
-                                        pos_end, end, c_end)        \
-  do {                                                              \
-    SCM_VALIDATE_STRING (pos_str, str);                             \
-    c_str = scm_i_string_chars (str);                               \
-    scm_i_get_substring_spec (scm_i_string_length (str),            \
-                             start, &c_start, end, &c_end);        \
-  } while (0)
-
-/* Expecting "unsigned char *c_str" */
-#define MY_VALIDATE_SUBSTRING_SPEC_UCOPY(pos_str, str, c_str,           \
-                                         pos_start, start, c_start,     \
-                                         pos_end, end, c_end)           \
-  do {                                                                  \
-    const char *signed_c_str;                                           \
-    MY_VALIDATE_SUBSTRING_SPEC_COPY(pos_str, str, signed_c_str,         \
-                                    pos_start, start, c_start,          \
-                                    pos_end, end, c_end);               \
-    c_str = (unsigned char *) signed_c_str;                             \
-  } while (0)
-
 #define MY_VALIDATE_SUBSTRING_SPEC(pos_str, str,              \
                                    pos_start, start, c_start, \
                                    pos_end, end, c_end)       \
@@ -68,6 +41,18 @@
                              start, &c_start, end, &c_end);  \
   } while (0)
 
+#define MY_SUBF_VALIDATE_SUBSTRING_SPEC(fname, pos_str, str,            \
+                                       pos_start, start, c_start,      \
+                                       pos_end, end, c_end)            \
+  do {                                                                  \
+    SCM_ASSERT_TYPE (scm_is_string (str), str, pos_str, fname, "string"); \
+    scm_i_get_substring_spec (scm_i_string_length (str),                \
+                             start, &c_start, end, &c_end);            \
+  } while (0)
+
+#define REF_IN_CHARSET(s, i, cs)                                       \
+  (scm_is_true (scm_char_set_contains_p ((cs), SCM_MAKE_CHAR (scm_i_string_ref 
(s, i)))))
+
 SCM_DEFINE (scm_string_null_p, "string-null?", 1, 0, 0,
            (SCM str),
            "Return @code{#t} if @var{str}'s length is zero, and\n"
@@ -111,25 +96,28 @@ SCM_DEFINE (scm_string_any, "string-any-c-code", 2, 2, 0,
 "@var{end}) then the return is @code{#f}.\n")
 #define FUNC_NAME s_scm_string_any
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM res = SCM_BOOL_F;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s,
+                             3, start, cstart,
+                             4, end, cend);
 
   if (SCM_CHARP (char_pred))
     {
-      res = (memchr (cstr+cstart, (int) SCM_CHAR (char_pred),
-                    cend-cstart) == NULL
-            ? SCM_BOOL_F : SCM_BOOL_T);
+      size_t i;
+      for (i = cstart; i < cend; i ++)
+       if (scm_i_string_ref (s, i) == SCM_CHAR (char_pred))
+         {
+           res = SCM_BOOL_T;
+           break;
+         }
     }
   else if (SCM_CHARSETP (char_pred))
     {
       size_t i;
       for (i = cstart; i < cend; i++)
-        if (SCM_CHARSET_GET (char_pred, cstr[i]))
+        if (REF_IN_CHARSET (s, i, char_pred))
          {
            res = SCM_BOOL_T;
            break;
@@ -142,10 +130,10 @@ SCM_DEFINE (scm_string_any, "string-any-c-code", 2, 2, 0,
 
       while (cstart < cend)
         {
-          res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+          res = pred_tramp (char_pred, 
+                            SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
           if (scm_is_true (res))
             break;
-         cstr = scm_i_string_chars (s);
           cstart++;
         }
     }
@@ -176,19 +164,17 @@ SCM_DEFINE (scm_string_every, "string-every-c-code", 2, 
2, 0,
 "@var{end}) then the return is @code{#t}.\n")
 #define FUNC_NAME s_scm_string_every
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM res = SCM_BOOL_T;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s,
+                             3, start, cstart,
+                             4, end, cend);
   if (SCM_CHARP (char_pred))
     {
-      char cchr = SCM_CHAR (char_pred);
       size_t i;
       for (i = cstart; i < cend; i++)
-        if (cstr[i] != cchr)
+        if (scm_i_string_ref (s, i) != SCM_CHAR (char_pred))
          {
            res = SCM_BOOL_F;
            break;
@@ -198,7 +184,7 @@ SCM_DEFINE (scm_string_every, "string-every-c-code", 2, 2, 
0,
     {
       size_t i;
       for (i = cstart; i < cend; i++)
-        if (!SCM_CHARSET_GET (char_pred, cstr[i]))
+        if (!REF_IN_CHARSET (s, i, char_pred))
          {
            res = SCM_BOOL_F;
            break;
@@ -211,10 +197,10 @@ SCM_DEFINE (scm_string_every, "string-every-c-code", 2, 
2, 0,
 
       while (cstart < cend)
         {
-          res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+          res = pred_tramp (char_pred, 
+                            SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)));
           if (scm_is_false (res))
             break;
-          cstr = scm_i_string_chars (s);
           cstart++;
         }
     }
@@ -236,7 +222,6 @@ SCM_DEFINE (scm_string_tabulate, "string-tabulate", 2, 0, 0,
   size_t clen, i;
   SCM res;
   SCM ch;
-  char *p;
   scm_t_trampoline_1 proc_tramp;
 
   proc_tramp = scm_trampoline_1 (proc);
@@ -245,19 +230,41 @@ SCM_DEFINE (scm_string_tabulate, "string-tabulate", 2, 0, 
0,
   clen = scm_to_size_t (len);
   SCM_ASSERT_RANGE (2, len, clen >= 0);
 
-  res = scm_i_make_string (clen, &p);
-  i = 0;
-  while (i < clen)
-    {
-      /* The RES string remains untouched since nobody knows about it
-        yet. No need to refetch P.
-      */
-      ch = proc_tramp (proc, scm_from_size_t (i));
-      if (!SCM_CHARP (ch))
-       SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
-      *p++ = SCM_CHAR (ch);
-      i++;
-    }
+  {
+    /* This function is more complicated than necessary for the sake
+       of speed.  */
+    scm_t_wchar *buf = scm_malloc (clen * sizeof (scm_t_wchar));
+    int wide = 0;
+    i = 0; 
+    while (i < clen)
+      {
+        ch = proc_tramp (proc, scm_from_size_t (i));
+        if (!SCM_CHARP (ch))
+          {
+            SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 
(proc));
+          }
+        if (SCM_CHAR (ch) > 255)
+          wide = 1;
+        buf[i] = SCM_CHAR (ch);
+        i++;
+      }
+    if (wide)
+      {
+        scm_t_wchar *wbuf = NULL;
+        res = scm_i_make_wide_string (clen, &wbuf);
+        memcpy (wbuf, buf, clen * sizeof (scm_t_wchar));
+        free (buf);
+      }
+    else
+      {
+        char *nbuf = NULL;
+        res = scm_i_make_string (clen, &nbuf);
+        for (i = 0; i < clen; i ++)
+          nbuf[i] = (unsigned char) buf[i];
+        free (buf);
+      }
+  }
+
   return res;
 }
 #undef FUNC_NAME
@@ -268,18 +275,34 @@ SCM_DEFINE (scm_substring_to_list, "string->list", 1, 2, 
0,
            "Convert the string @var{str} into a list of characters.")
 #define FUNC_NAME s_scm_substring_to_list
 {
-  const char *cstr;
   size_t cstart, cend;
+  int narrow;
   SCM result = SCM_EOL;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-                                  2, start, cstart,
-                                  3, end, cend);
-  while (cstart < cend)
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+                             2, start, cstart,
+                             3, end, cend);
+
+  /* This explicit narrow/wide logic (instead of just using
+     scm_i_string_ref) is for speed optimizaion.  */
+  narrow = scm_i_is_narrow_string (str);
+  if (narrow)
     {
-      cend--;
-      result = scm_cons (SCM_MAKE_CHAR (cstr[cend]), result);
-      cstr = scm_i_string_chars (str);
+      const char *buf = scm_i_string_chars (str);
+      while (cstart < cend)
+        {
+          cend--;
+          result = scm_cons (SCM_MAKE_CHAR (buf[cend]), result);
+        }
+    }
+  else
+    {
+      const scm_t_wchar *buf = scm_i_string_wide_chars (str);
+      while (cstart < cend)
+        {
+          cend--;
+          result = scm_cons (SCM_MAKE_CHAR (buf[cend]), result);
+        }
     }
   scm_remember_upto_here_1 (str);
   return result;
@@ -308,7 +331,7 @@ SCM_DEFINE (scm_reverse_list_to_string, 
"reverse-list->string", 1, 0, 0,
 #define FUNC_NAME s_scm_reverse_list_to_string
 {
   SCM result;
-  long i = scm_ilength (chrs);
+  long i = scm_ilength (chrs), j;
   char *data;
 
   if (i < 0)
@@ -316,18 +339,27 @@ SCM_DEFINE (scm_reverse_list_to_string, 
"reverse-list->string", 1, 0, 0,
   result = scm_i_make_string (i, &data);
 
   {
-    
-    data += i;
-    while (i > 0 && scm_is_pair (chrs))
+    SCM rest;
+    rest = chrs;
+    j = 0;
+    while (j < i && scm_is_pair (rest))
       {
-       SCM elt = SCM_CAR (chrs);
-
-       SCM_VALIDATE_CHAR (SCM_ARGn, elt);
-       data--;
-       *data = SCM_CHAR (elt);
-       chrs = SCM_CDR (chrs);
-       i--;
+        SCM elt = SCM_CAR (rest);
+        SCM_VALIDATE_CHAR (SCM_ARGn, elt);
+        j++;
+        rest = SCM_CDR (rest);
+      }
+    rest = chrs;
+    j = i;
+    result = scm_i_string_start_writing (result);
+    while (j > 0 && scm_is_pair (rest))
+      {
+        SCM elt = SCM_CAR (rest);
+        scm_i_string_set_x (result, j-1, SCM_CHAR (elt));
+        rest = SCM_CDR (rest);
+        j--;
       }
+    scm_i_string_stop_writing ();
   }
 
   return result;
@@ -340,18 +372,6 @@ SCM_SYMBOL (scm_sym_strict_infix, "strict-infix");
 SCM_SYMBOL (scm_sym_suffix, "suffix");
 SCM_SYMBOL (scm_sym_prefix, "prefix");
 
-static void
-append_string (char **sp, size_t *lp, SCM str)
-{
-  size_t len;
-  len = scm_c_string_length (str);
-  if (len > *lp)
-    len = *lp;
-  memcpy (*sp, scm_i_string_chars (str), len);
-  *lp -= len;
-  *sp += len;
-}
-
 SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
             (SCM ls, SCM delimiter, SCM grammar),
            "Append the string in the string list @var{ls}, using the string\n"
@@ -382,8 +402,6 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
   SCM result;
   int gram = GRAM_INFIX;
   size_t del_len = 0;
-  size_t len = 0;
-  char *p;
   long strings = scm_ilength (ls);
 
   /* Validate the string list.  */
@@ -397,7 +415,10 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
       del_len = 1;
     }
   else
-    del_len = scm_c_string_length (delimiter);
+    {
+      SCM_VALIDATE_STRING (2, delimiter);
+      del_len = scm_i_string_length (delimiter);
+    }
 
   /* Validate the grammar symbol and remember the grammar.  */
   if (SCM_UNBNDP (grammar))
@@ -413,33 +434,12 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
   else
     SCM_WRONG_TYPE_ARG (3, grammar);
 
-  /* Check grammar constraints and calculate the space required for
-     the delimiter(s).  */
-  switch (gram)
-    {
-    case GRAM_INFIX:
-      if (!scm_is_null (ls))
-       len = (strings > 0) ? ((strings - 1) * del_len) : 0;
-      break;
-    case GRAM_STRICT_INFIX:
-      if (strings == 0)
-       SCM_MISC_ERROR ("strict-infix grammar requires non-empty list",
-                       SCM_EOL);
-      len = (strings - 1) * del_len;
-      break;
-    default:
-      len = strings * del_len;
-      break;
-    }
-
-  tmp = ls;
-  while (scm_is_pair (tmp))
-    {
-      len += scm_c_string_length (SCM_CAR (tmp));
-      tmp = SCM_CDR (tmp);
-    }
+  /* Check grammar constraints.  */
+  if (strings == 0 && gram == GRAM_STRICT_INFIX)
+    SCM_MISC_ERROR ("strict-infix grammar requires non-empty list",
+                   SCM_EOL);
 
-  result = scm_i_make_string (len, &p);
+  result = scm_i_make_string (0, NULL);
 
   tmp = ls;
   switch (gram)
@@ -448,18 +448,18 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
     case GRAM_STRICT_INFIX:
       while (scm_is_pair (tmp))
        {
-         append_string (&p, &len, SCM_CAR (tmp));
+         result = scm_string_append (scm_list_2 (result, SCM_CAR (tmp)));
          if (!scm_is_null (SCM_CDR (tmp)) && del_len > 0)
-           append_string (&p, &len, delimiter);
+           result = scm_string_append (scm_list_2 (result, delimiter));
          tmp = SCM_CDR (tmp);
        }
       break;
     case GRAM_SUFFIX:
       while (scm_is_pair (tmp))
        {
-         append_string (&p, &len, SCM_CAR (tmp));
+         result = scm_string_append (scm_list_2 (result, SCM_CAR (tmp)));
          if (del_len > 0)
-           append_string (&p, &len, delimiter);
+           result = scm_string_append (scm_list_2 (result, delimiter));
          tmp = SCM_CDR (tmp);
        }
       break;
@@ -467,8 +467,8 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
       while (scm_is_pair (tmp))
        {
          if (del_len > 0)
-           append_string (&p, &len, delimiter);
-         append_string (&p, &len, SCM_CAR (tmp));
+           result = scm_string_append (scm_list_2 (result, delimiter));
+         result = scm_string_append (scm_list_2 (result, SCM_CAR (tmp)));
          tmp = SCM_CDR (tmp);
        }
       break;
@@ -508,20 +508,22 @@ SCM_DEFINE (scm_srfi13_substring_copy, "string-copy", 1, 
2, 0,
            "@var{str} which is copied.")
 #define FUNC_NAME s_scm_srfi13_substring_copy
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-                                  2, start, cstart,
-                                  3, end, cend);
-  return scm_c_substring_copy (str, cstart, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+                             2, start, cstart,
+                             3, end, cend);
+  return scm_i_substring_copy (str, cstart, cend);
 }
 #undef FUNC_NAME
 
 SCM 
 scm_string_copy (SCM str)
 {
-  return scm_c_substring (str, 0, scm_c_string_length (str));
+  if (!scm_is_string (str))
+    scm_wrong_type_arg ("scm_string_copy", 0, str);
+
+  return scm_i_substring (str, 0, scm_i_string_length (str));
 }
 
 SCM_DEFINE (scm_string_copy_x, "string-copy!", 3, 2, 0,
@@ -535,23 +537,24 @@ SCM_DEFINE (scm_string_copy_x, "string-copy!", 3, 2, 0,
            "string.")
 #define FUNC_NAME s_scm_string_copy_x
 {
-  const char *cstr;
-  char *ctarget;
-  size_t cstart, cend, ctstart, dummy, len;
+  size_t cstart, cend, ctstart, dummy, len, i;
   SCM sdummy = SCM_UNDEFINED;
 
   MY_VALIDATE_SUBSTRING_SPEC (1, target,
                              2, tstart, ctstart,
                              2, sdummy, dummy);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (3, s, cstr,
-                                  4, start, cstart,
-                                  5, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (3, s,
+                             4, start, cstart,
+                             5, end, cend);
   len = cend - cstart;
   SCM_ASSERT_RANGE (3, s, len <= scm_i_string_length (target) - ctstart);
 
   target = scm_i_string_start_writing (target);
-  ctarget = scm_i_string_writable_chars (target);
-  memmove (ctarget + ctstart, cstr + cstart, len);
+  for (i = 0; i < cend - cstart; i++)
+    {
+      scm_i_string_set_x (target, ctstart + i, 
+                          scm_i_string_ref (s, cstart + i));
+    }
   scm_i_string_stop_writing ();
   scm_remember_upto_here_1 (target);
 
@@ -622,7 +625,6 @@ SCM_DEFINE (scm_string_pad, "string-pad", 2, 3, 0,
            "string is longer than @var{len}, it is truncated on the right.")
 #define FUNC_NAME s_scm_string_pad
 {
-  char cchr;
   size_t cstart, cend, clen;
 
   MY_VALIDATE_SUBSTRING_SPEC (1, s,
@@ -631,23 +633,19 @@ SCM_DEFINE (scm_string_pad, "string-pad", 2, 3, 0,
   clen = scm_to_size_t (len);
 
   if (SCM_UNBNDP (chr))
-    cchr = ' ';
+    chr = SCM_MAKE_CHAR (' ');
   else
     {
       SCM_VALIDATE_CHAR (3, chr);
-      cchr = SCM_CHAR (chr);
     }
   if (clen < (cend - cstart))
-    return scm_c_substring (s, cend - clen, cend);
+    return scm_i_substring (s, cend - clen, cend);
   else
     {
       SCM result;
-      char *dst;
-
-      result = scm_i_make_string (clen, &dst);
-      memset (dst, cchr, (clen - (cend - cstart)));
-      memmove (dst + clen - (cend - cstart),
-              scm_i_string_chars (s) + cstart, cend - cstart);
+      result = (scm_string_append 
+               (scm_list_2 (scm_c_make_string (clen - (cend - cstart), chr),
+                            scm_i_substring (s, cstart, cend))));
       return result;
     }
 }
@@ -662,7 +660,6 @@ SCM_DEFINE (scm_string_pad_right, "string-pad-right", 2, 3, 
0,
            "string is longer than @var{len}, it is truncated on the left.")
 #define FUNC_NAME s_scm_string_pad_right
 {
-  char cchr;
   size_t cstart, cend, clen;
 
   MY_VALIDATE_SUBSTRING_SPEC (1, s,
@@ -671,22 +668,21 @@ SCM_DEFINE (scm_string_pad_right, "string-pad-right", 2, 
3, 0,
   clen = scm_to_size_t (len);
 
   if (SCM_UNBNDP (chr))
-    cchr = ' ';
+    chr = SCM_MAKE_CHAR (' ');
   else
     {
       SCM_VALIDATE_CHAR (3, chr);
-      cchr = SCM_CHAR (chr);
     }
   if (clen < (cend - cstart))
-    return scm_c_substring (s, cstart, cstart + clen);
+    return scm_i_substring (s, cstart, cstart + clen);
   else
     {
       SCM result;
-      char *dst;
 
-      result = scm_i_make_string (clen, &dst);
-      memset (dst + (cend - cstart), cchr, clen - (cend - cstart));
-      memmove (dst, scm_i_string_chars (s) + cstart, cend - cstart);
+      result = (scm_string_append 
+               (scm_list_2 (scm_i_substring (s, cstart, cend),
+                            scm_c_make_string (clen - (cend - cstart), chr))));
+
       return result;
     }
 }
@@ -715,27 +711,25 @@ SCM_DEFINE (scm_string_trim, "string-trim", 1, 3, 0,
            "trimmed.")
 #define FUNC_NAME s_scm_string_trim
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
   if (SCM_UNBNDP (char_pred))
     {
       while (cstart < cend)
        {
-         if (!isspace((int) (unsigned char) cstr[cstart]))
+         if (!uc_is_c_whitespace (scm_i_string_ref (s, cstart)))
            break;
          cstart++;
        }
     }
   else if (SCM_CHARP (char_pred))
     {
-      char chr = SCM_CHAR (char_pred);
       while (cstart < cend)
        {
-         if (chr != cstr[cstart])
+         if (scm_i_string_ref (s, cstart) != SCM_CHAR (char_pred))
            break;
          cstart++;
        }
@@ -744,7 +738,7 @@ SCM_DEFINE (scm_string_trim, "string-trim", 1, 3, 0,
     {
       while (cstart < cend)
        {
-         if (!SCM_CHARSET_GET (char_pred, cstr[cstart]))
+         if (!REF_IN_CHARSET (s, cstart, char_pred))
            break;
          cstart++;
        }
@@ -758,21 +752,20 @@ SCM_DEFINE (scm_string_trim, "string-trim", 1, 3, 0,
        {
          SCM res;
 
-         res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+         res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, 
cstart)));
          if (scm_is_false (res))
            break;
-         cstr = scm_i_string_chars (s);
          cstart++;
        }
     }
-  return scm_c_substring (s, cstart, cend);
+  return scm_i_substring (s, cstart, cend);
 }
 #undef FUNC_NAME
 
 
 SCM_DEFINE (scm_string_trim_right, "string-trim-right", 1, 3, 0,
            (SCM s, SCM char_pred, SCM start, SCM end),
-           "Trim @var{s} by skipping over all characters on the rightt\n"
+           "Trim @var{s} by skipping over all characters on the right\n"
            "that satisfy the parameter @var{char_pred}:\n"
            "\n"
            "@itemize @bullet\n"
@@ -793,27 +786,25 @@ SCM_DEFINE (scm_string_trim_right, "string-trim-right", 
1, 3, 0,
            "trimmed.")
 #define FUNC_NAME s_scm_string_trim_right
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
   if (SCM_UNBNDP (char_pred))
     {
       while (cstart < cend)
        {
-         if (!isspace((int) (unsigned char) cstr[cend - 1]))
+         if (!uc_is_c_whitespace (scm_i_string_ref (s, cend - 1)))
            break;
          cend--;
        }
     }
   else if (SCM_CHARP (char_pred))
     {
-      char chr = SCM_CHAR (char_pred);
       while (cstart < cend)
        {
-         if (chr != cstr[cend - 1])
+         if (scm_i_string_ref (s, cend - 1) != SCM_CHAR (char_pred))
            break;
          cend--;
        }
@@ -822,7 +813,7 @@ SCM_DEFINE (scm_string_trim_right, "string-trim-right", 1, 
3, 0,
     {
       while (cstart < cend)
        {
-         if (!SCM_CHARSET_GET (char_pred, cstr[cend - 1]))
+         if (!REF_IN_CHARSET (s, cend-1, char_pred))
            break;
          cend--;
        }
@@ -836,14 +827,13 @@ SCM_DEFINE (scm_string_trim_right, "string-trim-right", 
1, 3, 0,
        {
          SCM res;
 
-         res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cend - 1]));
+         res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend 
- 1)));
          if (scm_is_false (res))
            break;
-         cstr = scm_i_string_chars (s);
          cend--;
        }
     }
-  return scm_c_substring (s, cstart, cend);
+  return scm_i_substring (s, cstart, cend);
 }
 #undef FUNC_NAME
 
@@ -871,39 +861,37 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 
3, 0,
            "trimmed.")
 #define FUNC_NAME s_scm_string_trim_both
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
   if (SCM_UNBNDP (char_pred))
     {
       while (cstart < cend)
        {
-         if (!isspace((int) (unsigned char) cstr[cstart]))
+         if (!uc_is_c_whitespace (scm_i_string_ref (s, cstart)))
            break;
          cstart++;
        }
       while (cstart < cend)
        {
-         if (!isspace((int) (unsigned char) cstr[cend - 1]))
+         if (!uc_is_c_whitespace (scm_i_string_ref (s, cend - 1)))
            break;
          cend--;
        }
     }
   else if (SCM_CHARP (char_pred))
     {
-      char chr = SCM_CHAR (char_pred);
       while (cstart < cend)
        {
-         if (chr != cstr[cstart])
+         if (scm_i_string_ref (s, cstart) != SCM_CHAR(char_pred))
            break;
          cstart++;
        }
       while (cstart < cend)
        {
-         if (chr != cstr[cend - 1])
+         if (scm_i_string_ref (s, cend - 1) != SCM_CHAR (char_pred))
            break;
          cend--;
        }
@@ -912,13 +900,13 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 
3, 0,
     {
       while (cstart < cend)
        {
-         if (!SCM_CHARSET_GET (char_pred, cstr[cstart]))
+         if (!REF_IN_CHARSET (s, cstart, char_pred))
            break;
          cstart++;
        }
       while (cstart < cend)
        {
-         if (!SCM_CHARSET_GET (char_pred, cstr[cend - 1]))
+         if (!REF_IN_CHARSET (s, cend-1, char_pred))
            break;
          cend--;
        }
@@ -932,24 +920,22 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 
3, 0,
        {
          SCM res;
 
-         res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+         res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, 
cstart)));
          if (scm_is_false (res))
            break;
-         cstr = scm_i_string_chars (s);
          cstart++;
        }
       while (cstart < cend)
        {
          SCM res;
 
-         res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cend - 1]));
+         res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend 
- 1)));
          if (scm_is_false (res))
            break;
-         cstr = scm_i_string_chars (s);
          cend--;
        }
     }
-  return scm_c_substring (s, cstart, cend);
+  return scm_i_substring (s, cstart, cend);
 }
 #undef FUNC_NAME
 
@@ -960,9 +946,7 @@ SCM_DEFINE (scm_substring_fill_x, "string-fill!", 2, 2, 0,
            "returns an unspecified value.")
 #define FUNC_NAME s_scm_substring_fill_x
 {
-  char *cstr;
   size_t cstart, cend;
-  int c;
   size_t k;
 
   /* Older versions of Guile provided the function
@@ -984,14 +968,13 @@ SCM_DEFINE (scm_substring_fill_x, "string-fill!", 2, 2, 0,
   MY_VALIDATE_SUBSTRING_SPEC (1, str,
                              3, start, cstart,
                              4, end, cend);
-  SCM_VALIDATE_CHAR_COPY (2, chr, c);
+  SCM_VALIDATE_CHAR (2, chr);
+
 
   str = scm_i_string_start_writing (str);
-  cstr = scm_i_string_writable_chars (str);
   for (k = cstart; k < cend; k++)
-    cstr[k] = c;
+    scm_i_string_set_x (str, k, SCM_CHAR (chr));
   scm_i_string_stop_writing ();
-  scm_remember_upto_here_1 (str);
 
   return SCM_UNSPECIFIED;
 }
@@ -1013,28 +996,29 @@ SCM_DEFINE (scm_string_compare, "string-compare", 5, 4, 
0,
            "@var{i} is the first position that does not match.")
 #define FUNC_NAME s_scm_string_compare
 {
-  const unsigned char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   SCM proc;
 
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    6, start1, cstart1,
-                                    7, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    8, start2, cstart2,
-                                    9, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             6, start1, cstart1,
+                             7, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             8, start2, cstart2,
+                             9, end2, cend2);
   SCM_VALIDATE_PROC (3, proc_lt);
   SCM_VALIDATE_PROC (4, proc_eq);
   SCM_VALIDATE_PROC (5, proc_gt);
 
   while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (cstr1[cstart1] < cstr2[cstart2])
+      if (scm_i_string_ref (s1, cstart1)
+         < scm_i_string_ref (s2, cstart2))
        {
          proc = proc_lt;
          goto ret;
        }
-      else if (cstr1[cstart1] > cstr2[cstart2])
+      else if (scm_i_string_ref (s1, cstart1) 
+              > scm_i_string_ref (s2, cstart2))
        {
          proc = proc_gt;
          goto ret;
@@ -1063,33 +1047,33 @@ SCM_DEFINE (scm_string_compare_ci, "string-compare-ci", 
5, 4, 0,
            "equal to, or greater than @var{s2}.  The mismatch index is the\n"
            "largest index @var{i} such that for every 0 <= @var{j} <\n"
            "@var{i}, @address@hidden = @address@hidden -- that is,\n"
-           "@var{i} is the first position that does not match.  The\n"
-           "character comparison is done case-insensitively.")
+           "@var{i} is the first position where the lowercased letters \n"
+           "do not match.\n")
 #define FUNC_NAME s_scm_string_compare_ci
 {
-  const unsigned char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   SCM proc;
 
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    6, start1, cstart1,
-                                    7, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    8, start2, cstart2,
-                                    9, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             6, start1, cstart1,
+                             7, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             8, start2, cstart2,
+                             9, end2, cend2);
   SCM_VALIDATE_PROC (3, proc_lt);
   SCM_VALIDATE_PROC (4, proc_eq);
   SCM_VALIDATE_PROC (5, proc_gt);
 
   while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
+      if (uc_tolower (uc_toupper (scm_i_string_ref (s1, cstart1)))
+         < uc_tolower (uc_toupper (scm_i_string_ref (s2, cstart2))))
        {
          proc = proc_lt;
          goto ret;
        }
-      else if (scm_c_downcase (cstr1[cstart1]) 
-              > scm_c_downcase (cstr2[cstart2]))
+      else if (uc_tolower (uc_toupper (scm_i_string_ref (s1, cstart1)))
+              > uc_tolower (uc_toupper (scm_i_string_ref (s2, cstart2))))
        {
          proc = proc_gt;
          goto ret;
@@ -1111,42 +1095,83 @@ SCM_DEFINE (scm_string_compare_ci, "string-compare-ci", 
5, 4, 0,
 }
 #undef FUNC_NAME
 
-
-SCM_DEFINE (scm_string_eq, "string=", 2, 4, 0,
-           (SCM s1, SCM s2, SCM start1, SCM end1, SCM start2, SCM end2),
-           "Return @code{#f} if @var{s1} and @var{s2} are not equal, a true\n"
-           "value otherwise.")
-#define FUNC_NAME s_scm_string_eq
+/* This function compares two substrings, S1 from START1 to END1 and
+   S2 from START2 to END2, possibly case insensitively, and returns
+   one of the parameters LESSTHAN, GREATERTHAN, LONGER, SHORTER, or
+   EQUAL depending if S1 is less than S2, greater than S2, longer,
+   shorter, or equal. */
+static SCM
+compare_strings (const char *fname, int case_insensitive,
+                SCM s1, SCM s2, SCM start1, SCM end1, SCM start2, SCM end2,
+                SCM lessthan, SCM greaterthan, SCM longer, SCM shorter, SCM 
equal)
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
+  SCM ret;
+  scm_t_wchar a, b;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
+  MY_SUBF_VALIDATE_SUBSTRING_SPEC (fname, 1, s1,
                                   3, start1, cstart1,
                                   4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
+  MY_SUBF_VALIDATE_SUBSTRING_SPEC (fname, 2, s2,
                                   5, start2, cstart2,
                                   6, end2, cend2);
 
-  if ((cend1 - cstart1) != (cend2 - cstart2))
-    goto false;
-
-  while (cstart1 < cend1)
+  while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (cstr1[cstart1] < cstr2[cstart2])
-       goto false;
-      else if (cstr1[cstart1] > cstr2[cstart2])
-       goto false;
+      if (case_insensitive)
+       {
+         a = uc_tolower (uc_toupper (scm_i_string_ref (s1, cstart1)));
+         b = uc_tolower (uc_toupper (scm_i_string_ref (s2, cstart2)));
+       }
+      else
+       {
+         a = scm_i_string_ref (s1, cstart1);
+         b = scm_i_string_ref (s2, cstart2);
+       }
+      if (a < b)
+       {
+         ret = lessthan;
+         goto done;
+       }
+      else if (a > b)
+       {
+         ret = greaterthan;
+         goto done;
+       }
       cstart1++;
       cstart2++;
     }
-  
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
+  if (cstart1 < cend1)
+    {
+      ret = longer;
+      goto done;
+    }
+  else if (cstart2 < cend2)
+    {
+      ret = shorter;
+      goto done;
+    }
+  else
+    {
+      ret = equal;
+      goto done;
+    }
 
- false:
+ done:
   scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return ret;
+}
+
+
+SCM_DEFINE (scm_string_eq, "string=", 2, 4, 0,
+           (SCM s1, SCM s2, SCM start1, SCM end1, SCM start2, SCM end2),
+           "Return @code{#f} if @var{s1} and @var{s2} are not equal, a true\n"
+           "value otherwise.")
+#define FUNC_NAME s_scm_string_eq
+{
+  return compare_strings (FUNC_NAME, 0, 
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, 
SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -1157,39 +1182,9 @@ SCM_DEFINE (scm_string_neq, "string<>", 2, 4, 0,
            "value otherwise.")
 #define FUNC_NAME s_scm_string_neq
 {
-  const char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (cstr1[cstart1] < cstr2[cstart2])
-       goto true;
-      else if (cstr1[cstart1] > cstr2[cstart2])
-       goto true;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto true;
-  else if (cstart2 < cend2)
-    goto true;
-  else
-    goto false;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 0,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_T, SCM_BOOL_T, SCM_BOOL_T, SCM_BOOL_T, 
SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1200,39 +1195,9 @@ SCM_DEFINE (scm_string_lt, "string<", 2, 4, 0,
            "true value otherwise.")
 #define FUNC_NAME s_scm_string_lt
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (cstr1[cstart1] < cstr2[cstart2])
-       goto true;
-      else if (cstr1[cstart1] > cstr2[cstart2])
-       goto false;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto false;
-  else if (cstart2 < cend2)
-    goto true;
-  else
-    goto false;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 0,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, 
SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1243,39 +1208,9 @@ SCM_DEFINE (scm_string_gt, "string>", 2, 4, 0,
            "true value otherwise.")
 #define FUNC_NAME s_scm_string_gt
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (cstr1[cstart1] < cstr2[cstart2])
-       goto false;
-      else if (cstr1[cstart1] > cstr2[cstart2])
-       goto true;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto true;
-  else if (cstart2 < cend2)
-    goto false;
-  else
-    goto false;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 0,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, 
SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1286,39 +1221,9 @@ SCM_DEFINE (scm_string_le, "string<=", 2, 4, 0,
            "value otherwise.")
 #define FUNC_NAME s_scm_string_le
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (cstr1[cstart1] < cstr2[cstart2])
-       goto true;
-      else if (cstr1[cstart1] > cstr2[cstart2])
-       goto false;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto false;
-  else if (cstart2 < cend2)
-    goto true;
-  else
-    goto true;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 0,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, 
SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -1329,39 +1234,9 @@ SCM_DEFINE (scm_string_ge, "string>=", 2, 4, 0,
            "otherwise.")
 #define FUNC_NAME s_scm_string_ge
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (cstr1[cstart1] < cstr2[cstart2])
-       goto false;
-      else if (cstr1[cstart1] > cstr2[cstart2])
-       goto true;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto true;
-  else if (cstart2 < cend2)
-    goto false;
-  else
-    goto true;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 0,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, 
SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -1373,39 +1248,9 @@ SCM_DEFINE (scm_string_ci_eq, "string-ci=", 2, 4, 0,
            "case-insensitively.")
 #define FUNC_NAME s_scm_string_ci_eq
 {
-  const char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
-       goto false;
-      else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase 
(cstr2[cstart2]))
-       goto false;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto false;
-  else if (cstart2 < cend2)
-    goto false;
-  else
-    goto true;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 1,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, SCM_BOOL_F, 
SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -1417,39 +1262,9 @@ SCM_DEFINE (scm_string_ci_neq, "string-ci<>", 2, 4, 0,
            "case-insensitively.")
 #define FUNC_NAME s_scm_string_ci_neq
 {
-  const char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
-       goto true;
-      else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase 
(cstr2[cstart2]))
-       goto true;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto true;
-  else if (cstart2 < cend2)
-    goto true;
-  else
-    goto false;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 1,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_T, SCM_BOOL_T, SCM_BOOL_T, SCM_BOOL_T, 
SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1461,39 +1276,9 @@ SCM_DEFINE (scm_string_ci_lt, "string-ci<", 2, 4, 0,
            "case-insensitively.")
 #define FUNC_NAME s_scm_string_ci_lt
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
-       goto true;
-      else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase 
(cstr2[cstart2]))
-       goto false;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto false;
-  else if (cstart2 < cend2)
-    goto true;
-  else
-    goto false;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 1,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, 
SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1505,39 +1290,9 @@ SCM_DEFINE (scm_string_ci_gt, "string-ci>", 2, 4, 0,
            "case-insensitively.")
 #define FUNC_NAME s_scm_string_ci_gt
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
-       goto false;
-      else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase 
(cstr2[cstart2]))
-       goto true;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto true;
-  else if (cstart2 < cend2)
-    goto false;
-  else
-    goto false;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 1,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, 
SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -1549,39 +1304,9 @@ SCM_DEFINE (scm_string_ci_le, "string-ci<=", 2, 4, 0,
            "case-insensitively.")
 #define FUNC_NAME s_scm_string_ci_le
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
-       goto true;
-      else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase 
(cstr2[cstart2]))
-       goto false;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto false;
-  else if (cstart2 < cend2)
-    goto true;
-  else
-    goto true;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 1,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, 
SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -1593,39 +1318,9 @@ SCM_DEFINE (scm_string_ci_ge, "string-ci>=", 2, 4, 0,
            "case-insensitively.")
 #define FUNC_NAME s_scm_string_ci_ge
 {
-  const unsigned char *cstr1, *cstr2;
-  size_t cstart1, cend1, cstart2, cend2;
-
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (1, s1, cstr1,
-                                    3, start1, cstart1,
-                                    4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_UCOPY (2, s2, cstr2,
-                                    5, start2, cstart2,
-                                    6, end2, cend2);
-
-  while (cstart1 < cend1 && cstart2 < cend2)
-    {
-      if (scm_c_downcase (cstr1[cstart1]) < scm_c_downcase (cstr2[cstart2]))
-       goto false;
-      else if (scm_c_downcase (cstr1[cstart1]) > scm_c_downcase 
(cstr2[cstart2]))
-       goto true;
-      cstart1++;
-      cstart2++;
-    }
-  if (cstart1 < cend1)
-    goto true;
-  else if (cstart2 < cend2)
-    goto false;
-  else
-    goto true;
-
- true:
-  scm_remember_upto_here_2 (s1, s2);
-  return scm_from_size_t (cstart1);
-
- false:
-  scm_remember_upto_here_2 (s1, s2);
-  return SCM_BOOL_F;
+  return compare_strings (FUNC_NAME, 1,
+                         s1, s2, start1, end1, start2, end2,
+                         SCM_BOOL_F, SCM_BOOL_T, SCM_BOOL_F, SCM_BOOL_T, 
SCM_BOOL_T);
 }
 #undef FUNC_NAME
 
@@ -1667,19 +1362,20 @@ SCM_DEFINE (scm_string_prefix_length, 
"string-prefix-length", 2, 4, 0,
            "strings.")
 #define FUNC_NAME s_scm_string_prefix_length
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
+  
   while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (cstr1[cstart1] != cstr2[cstart2])
+      if (scm_i_string_ref (s1, cstart1)
+          != scm_i_string_ref (s2, cstart2))
        goto ret;
       len++;
       cstart1++;
@@ -1699,19 +1395,19 @@ SCM_DEFINE (scm_string_prefix_length_ci, 
"string-prefix-length-ci", 2, 4, 0,
            "strings, ignoring character case.")
 #define FUNC_NAME s_scm_string_prefix_length_ci
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
   while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (scm_c_downcase (cstr1[cstart1]) != scm_c_downcase (cstr2[cstart2]))
+      if (uc_tolower (uc_toupper (scm_i_string_ref (s1, cstart1)))
+         != uc_tolower (uc_toupper (scm_i_string_ref (s2, cstart2))))
        goto ret;
       len++;
       cstart1++;
@@ -1731,21 +1427,21 @@ SCM_DEFINE (scm_string_suffix_length, 
"string-suffix-length", 2, 4, 0,
            "strings.")
 #define FUNC_NAME s_scm_string_suffix_length
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
   while (cstart1 < cend1 && cstart2 < cend2)
     {
       cend1--;
       cend2--;
-      if (cstr1[cend1] != cstr2[cend2])
+      if (scm_i_string_ref (s1, cend1) 
+         != scm_i_string_ref (s2, cend2))
        goto ret;
       len++;
     }
@@ -1763,21 +1459,21 @@ SCM_DEFINE (scm_string_suffix_length_ci, 
"string-suffix-length-ci", 2, 4, 0,
            "strings, ignoring character case.")
 #define FUNC_NAME s_scm_string_suffix_length_ci
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
   while (cstart1 < cend1 && cstart2 < cend2)
     {
       cend1--;
       cend2--;
-      if (scm_c_downcase (cstr1[cend1]) != scm_c_downcase (cstr2[cend2]))
+      if (uc_tolower (uc_toupper (scm_i_string_ref (s1, cend1)))
+         != uc_tolower (uc_toupper (scm_i_string_ref (s2, cend2))))
        goto ret;
       len++;
     }
@@ -1794,20 +1490,20 @@ SCM_DEFINE (scm_string_prefix_p, "string-prefix?", 2, 
4, 0,
            "Is @var{s1} a prefix of @var{s2}?")
 #define FUNC_NAME s_scm_string_prefix_p
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0, len1;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
   len1 = cend1 - cstart1;
   while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (cstr1[cstart1] != cstr2[cstart2])
+      if (scm_i_string_ref (s1, cstart1)
+          != scm_i_string_ref (s2, cstart2))
        goto ret;
       len++;
       cstart1++;
@@ -1826,20 +1522,21 @@ SCM_DEFINE (scm_string_prefix_ci_p, 
"string-prefix-ci?", 2, 4, 0,
            "Is @var{s1} a prefix of @var{s2}, ignoring character case?")
 #define FUNC_NAME s_scm_string_prefix_ci_p
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0, len1;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
   len1 = cend1 - cstart1;
   while (cstart1 < cend1 && cstart2 < cend2)
     {
-      if (scm_c_downcase (cstr1[cstart1]) != scm_c_downcase (cstr2[cstart2]))
+      scm_t_wchar a = uc_tolower (uc_toupper (scm_i_string_ref (s1, cstart1)));
+      scm_t_wchar b = uc_tolower (uc_toupper (scm_i_string_ref (s2, cstart2)));
+      if (a != b)
        goto ret;
       len++;
       cstart1++;
@@ -1858,22 +1555,22 @@ SCM_DEFINE (scm_string_suffix_p, "string-suffix?", 2, 
4, 0,
            "Is @var{s1} a suffix of @var{s2}?")
 #define FUNC_NAME s_scm_string_suffix_p
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0, len1;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
   len1 = cend1 - cstart1;
   while (cstart1 < cend1 && cstart2 < cend2)
     {
       cend1--;
       cend2--;
-      if (cstr1[cend1] != cstr2[cend2])
+      if (scm_i_string_ref (s1, cend1) 
+         != scm_i_string_ref (s2, cend2))
        goto ret;
       len++;
     }
@@ -1890,22 +1587,22 @@ SCM_DEFINE (scm_string_suffix_ci_p, 
"string-suffix-ci?", 2, 4, 0,
            "Is @var{s1} a suffix of @var{s2}, ignoring character case?")
 #define FUNC_NAME s_scm_string_suffix_ci_p
 {
-  const char *cstr1, *cstr2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len = 0, len1;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cstr1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cstr2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
   len1 = cend1 - cstart1;
   while (cstart1 < cend1 && cstart2 < cend2)
     {
       cend1--;
       cend2--;
-      if (scm_c_downcase (cstr1[cend1]) != scm_c_downcase (cstr2[cend2]))
+      if (uc_tolower (uc_toupper (scm_i_string_ref (s1, cend1)))
+         != uc_tolower (uc_toupper (scm_i_string_ref (s2, cend2))))
        goto ret;
       len++;
     }
@@ -1934,18 +1631,16 @@ SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0,
            "@end itemize")
 #define FUNC_NAME s_scm_string_index
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
   if (SCM_CHARP (char_pred))
     {
-      char cchr = SCM_CHAR (char_pred);
       while (cstart < cend)
        {
-         if (cchr == cstr[cstart])
+         if (scm_i_string_ref (s, cstart) == SCM_CHAR (char_pred))
            goto found;
          cstart++;
        }
@@ -1954,7 +1649,7 @@ SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0,
     {
       while (cstart < cend)
        {
-         if (SCM_CHARSET_GET (char_pred, cstr[cstart]))
+         if (REF_IN_CHARSET (s, cstart, char_pred))
            goto found;
          cstart++;
        }
@@ -1967,10 +1662,9 @@ SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0,
       while (cstart < cend)
        {
          SCM res;
-         res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+         res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, 
cstart)));
          if (scm_is_true (res))
            goto found;
-         cstr = scm_i_string_chars (s);
          cstart++;
        }
     }
@@ -2001,19 +1695,17 @@ SCM_DEFINE (scm_string_index_right, 
"string-index-right", 2, 2, 0,
            "@end itemize")
 #define FUNC_NAME s_scm_string_index_right
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
   if (SCM_CHARP (char_pred))
     {
-      char cchr = SCM_CHAR (char_pred);
       while (cstart < cend)
        {
          cend--;
-         if (cchr == cstr[cend])
+         if (scm_i_string_ref (s, cend) == SCM_CHAR (char_pred))
            goto found;
        }
     }
@@ -2022,7 +1714,7 @@ SCM_DEFINE (scm_string_index_right, "string-index-right", 
2, 2, 0,
       while (cstart < cend)
        {
          cend--;
-         if (SCM_CHARSET_GET (char_pred, cstr[cend]))
+         if (REF_IN_CHARSET (s, cend, char_pred))
            goto found;
        }
     }
@@ -2035,10 +1727,9 @@ SCM_DEFINE (scm_string_index_right, 
"string-index-right", 2, 2, 0,
        {
          SCM res;
          cend--;
-         res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cend]));
+         res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, 
cend)));
          if (scm_is_true (res))
            goto found;
-         cstr = scm_i_string_chars (s);
        }
     }
 
@@ -2090,18 +1781,16 @@ SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0,
            "@end itemize")
 #define FUNC_NAME s_scm_string_skip
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
   if (SCM_CHARP (char_pred))
     {
-      char cchr = SCM_CHAR (char_pred);
       while (cstart < cend)
        {
-         if (cchr != cstr[cstart])
+         if (scm_i_string_ref (s, cstart) !=  SCM_CHAR (char_pred))
            goto found;
          cstart++;
        }
@@ -2110,7 +1799,7 @@ SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0,
     {
       while (cstart < cend)
        {
-         if (!SCM_CHARSET_GET (char_pred, cstr[cstart]))
+         if (!REF_IN_CHARSET (s, cstart, char_pred))
            goto found;
          cstart++;
        }
@@ -2123,10 +1812,9 @@ SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0,
       while (cstart < cend)
        {
          SCM res;
-         res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+         res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, 
cstart)));
          if (scm_is_false (res))
            goto found;
-         cstr = scm_i_string_chars (s);
          cstart++;
        }
     }
@@ -2159,19 +1847,17 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 
2, 2, 0,
            "@end itemize")
 #define FUNC_NAME s_scm_string_skip_right
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
   if (SCM_CHARP (char_pred))
     {
-      char cchr = SCM_CHAR (char_pred);
       while (cstart < cend)
        {
          cend--;
-         if (cchr != cstr[cend])
+         if (scm_i_string_ref (s, cend) != SCM_CHAR (char_pred))
            goto found;
        }
     }
@@ -2180,7 +1866,7 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 
2, 2, 0,
       while (cstart < cend)
        {
          cend--;
-         if (!SCM_CHARSET_GET (char_pred, cstr[cend]))
+         if (!REF_IN_CHARSET (s, cend, char_pred))
            goto found;
        }
     }
@@ -2193,10 +1879,9 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 
2, 2, 0,
        {
          SCM res;
          cend--;
-         res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cend]));
+         res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, 
cend)));
          if (scm_is_false (res))
            goto found;
-         cstr = scm_i_string_chars (s);
        }
     }
 
@@ -2228,19 +1913,17 @@ SCM_DEFINE (scm_string_count, "string-count", 2, 2, 0,
            "@end itemize")
 #define FUNC_NAME s_scm_string_count
 {
-  const char *cstr;
   size_t cstart, cend;
   size_t count = 0;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
   if (SCM_CHARP (char_pred))
     {
-      char cchr = SCM_CHAR (char_pred);
       while (cstart < cend)
        {
-         if (cchr == cstr[cstart])
+         if (scm_i_string_ref (s, cstart) == SCM_CHAR(char_pred))
            count++;
          cstart++;
        }
@@ -2249,7 +1932,7 @@ SCM_DEFINE (scm_string_count, "string-count", 2, 2, 0,
     {
       while (cstart < cend)
        {
-         if (SCM_CHARSET_GET (char_pred, cstr[cstart]))
+         if (REF_IN_CHARSET (s, cstart, char_pred))
            count++;
          cstart++;
        }
@@ -2262,10 +1945,9 @@ SCM_DEFINE (scm_string_count, "string-count", 2, 2, 0,
       while (cstart < cend)
        {
          SCM res;
-         res = pred_tramp (char_pred, SCM_MAKE_CHAR (cstr[cstart]));
+         res = pred_tramp (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, 
cstart)));
          if (scm_is_true (res))
            count++;
-         cstr = scm_i_string_chars (s);
          cstart++;
        }
     }
@@ -2287,23 +1969,25 @@ SCM_DEFINE (scm_string_contains, "string-contains", 2, 
4, 0,
            "indicated substrings.")
 #define FUNC_NAME s_scm_string_contains
 {
-  const char *cs1, * cs2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len2, i, j;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cs1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cs2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
   len2 = cend2 - cstart2;
   if (cend1 - cstart1 >= len2)
     while (cstart1 <= cend1 - len2)
       {
        i = cstart1;
        j = cstart2;
-       while (i < cend1 && j < cend2 && cs1[i] == cs2[j])
+       while (i < cend1 
+              && j < cend2 
+              && (scm_i_string_ref (s1, i)
+                  == scm_i_string_ref (s2, j)))
          {
            i++;
            j++;
@@ -2334,24 +2018,25 @@ SCM_DEFINE (scm_string_contains_ci, 
"string-contains-ci", 2, 4, 0,
            "case-insensitively.")
 #define FUNC_NAME s_scm_string_contains_ci
 {
-  const char *cs1, * cs2;
   size_t cstart1, cend1, cstart2, cend2;
   size_t len2, i, j;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s1, cs1,
-                                  3, start1, cstart1,
-                                  4, end1, cend1);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (2, s2, cs2,
-                                  5, start2, cstart2,
-                                  6, end2, cend2);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s1,
+                             3, start1, cstart1,
+                             4, end1, cend1);
+  MY_VALIDATE_SUBSTRING_SPEC (2, s2,
+                             5, start2, cstart2,
+                             6, end2, cend2);
   len2 = cend2 - cstart2;
   if (cend1 - cstart1 >= len2)
     while (cstart1 <= cend1 - len2)
       {
        i = cstart1;
        j = cstart2;
-       while (i < cend1 && j < cend2 &&
-              scm_c_downcase (cs1[i]) == scm_c_downcase (cs2[j]))
+       while (i < cend1 
+              && j < cend2 
+              && (uc_tolower (uc_toupper (scm_i_string_ref (s1, i)))
+                  == uc_tolower (uc_toupper (scm_i_string_ref (s2, j)))))
          {
            i++;
            j++;
@@ -2370,18 +2055,15 @@ SCM_DEFINE (scm_string_contains_ci, 
"string-contains-ci", 2, 4, 0,
 #undef FUNC_NAME
 
 
-/* Helper function for the string uppercase conversion functions.
- * No argument checking is performed.  */
+/* Helper function for the string uppercase conversion functions. */
 static SCM
 string_upcase_x (SCM v, size_t start, size_t end)
 {
   size_t k;
-  char *dst;
 
   v = scm_i_string_start_writing (v);
-  dst = scm_i_string_writable_chars (v);
   for (k = start; k < end; ++k)
-    dst[k] = scm_c_upcase (dst[k]);
+    scm_i_string_set_x (v, k, uc_toupper (scm_i_string_ref (v, k)));
   scm_i_string_stop_writing ();
   scm_remember_upto_here_1 (v);
 
@@ -2400,12 +2082,11 @@ SCM_DEFINE (scm_substring_upcase_x, "string-upcase!", 
1, 2, 0,
            "@end lisp")
 #define FUNC_NAME s_scm_substring_upcase_x
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-                                  2, start, cstart,
-                                  3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+                             2, start, cstart,
+                             3, end, cend);
   return string_upcase_x (str, cstart, cend);
 }
 #undef FUNC_NAME
@@ -2421,12 +2102,11 @@ SCM_DEFINE (scm_substring_upcase, "string-upcase", 1, 
2, 0,
            "Upcase every character in @code{str}.")
 #define FUNC_NAME s_scm_substring_upcase
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-                                  2, start, cstart,
-                                  3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+                             2, start, cstart,
+                             3, end, cend);
   return string_upcase_x (scm_string_copy (str), cstart, cend);
 }
 #undef FUNC_NAME
@@ -2443,12 +2123,10 @@ static SCM
 string_downcase_x (SCM v, size_t start, size_t end)
 {
   size_t k;
-  char *dst;
 
   v = scm_i_string_start_writing (v);
-  dst = scm_i_string_writable_chars (v);
   for (k = start; k < end; ++k)
-    dst[k] = scm_c_downcase (dst[k]);
+    scm_i_string_set_x (v, k, uc_tolower (scm_i_string_ref (v, k)));
   scm_i_string_stop_writing ();
   scm_remember_upto_here_1 (v);
 
@@ -2469,12 +2147,11 @@ SCM_DEFINE (scm_substring_downcase_x, 
"string-downcase!", 1, 2, 0,
            "@end lisp")
 #define FUNC_NAME s_scm_substring_downcase_x
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-                                  2, start, cstart,
-                                  3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+                             2, start, cstart,
+                             3, end, cend);
   return string_downcase_x (str, cstart, cend);
 }
 #undef FUNC_NAME
@@ -2490,12 +2167,11 @@ SCM_DEFINE (scm_substring_downcase, "string-downcase", 
1, 2, 0,
            "Downcase every character in @var{str}.")
 #define FUNC_NAME s_scm_substring_downcase
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-                                  2, start, cstart,
-                                  3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+                             2, start, cstart,
+                             3, end, cend);
   return string_downcase_x (scm_string_copy (str), cstart, cend);
 }
 #undef FUNC_NAME
@@ -2511,24 +2187,24 @@ scm_string_downcase (SCM str)
 static SCM
 string_titlecase_x (SCM str, size_t start, size_t end)
 {
-  unsigned char *sz;
+  SCM ch;
   size_t i;
   int in_word = 0;
 
   str = scm_i_string_start_writing (str);
-  sz = (unsigned char *) scm_i_string_writable_chars (str);
   for(i = start; i < end;  i++)
     {
-      if (scm_is_true (scm_char_alphabetic_p (SCM_MAKE_CHAR (sz[i]))))
+      ch = SCM_MAKE_CHAR (scm_i_string_ref (str, i));
+      if (scm_is_true (scm_char_alphabetic_p (ch)))
        {
          if (!in_word)
            {
-             sz[i] = scm_c_upcase(sz[i]);
+             scm_i_string_set_x (str, i, uc_toupper (SCM_CHAR (ch)));
              in_word = 1;
            }
          else
            {
-             sz[i] = scm_c_downcase(sz[i]);
+             scm_i_string_set_x (str, i, uc_tolower (SCM_CHAR (ch)));
            }
        }
       else
@@ -2547,12 +2223,11 @@ SCM_DEFINE (scm_string_titlecase_x, 
"string-titlecase!", 1, 2, 0,
            "@var{str}.")
 #define FUNC_NAME s_scm_string_titlecase_x
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-                                  2, start, cstart,
-                                  3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+                             2, start, cstart,
+                             3, end, cend);
   return string_titlecase_x (str, cstart, cend);
 }
 #undef FUNC_NAME
@@ -2563,12 +2238,11 @@ SCM_DEFINE (scm_string_titlecase, "string-titlecase", 
1, 2, 0,
            "Titlecase every first character in a word in @var{str}.")
 #define FUNC_NAME s_scm_string_titlecase
 {
-  const char *cstr;
   size_t cstart, cend;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-                                  2, start, cstart,
-                                  3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+                             2, start, cstart,
+                             3, end, cend);
   return string_titlecase_x (scm_string_copy (str), cstart, cend);
 }
 #undef FUNC_NAME
@@ -2605,22 +2279,24 @@ SCM_DEFINE (scm_string_capitalize, "string-capitalize", 
1, 0, 0,
 /* Reverse the portion of @var{str} between str[cstart] (including)
    and str[cend] excluding.  */
 static void
-string_reverse_x (char * str, size_t cstart, size_t cend)
+string_reverse_x (SCM str, size_t cstart, size_t cend)
 {
-  char tmp;
+  SCM tmp;
 
+  str = scm_i_string_start_writing (str);
   if (cend > 0)
     {
       cend--;
       while (cstart < cend)
        {
-         tmp = str[cstart];
-         str[cstart] = str[cend];
-         str[cend] = tmp;
+         tmp = SCM_MAKE_CHAR (scm_i_string_ref (str, cstart));
+         scm_i_string_set_x (str, cstart, scm_i_string_ref (str, cend));
+         scm_i_string_set_x (str, cend, SCM_CHAR (tmp));
          cstart++;
          cend--;
        }
     }
+  scm_i_string_stop_writing ();
 }
 
 
@@ -2631,19 +2307,14 @@ SCM_DEFINE (scm_string_reverse, "string-reverse", 1, 2, 
0,
            "operate on.")
 #define FUNC_NAME s_scm_string_reverse
 {
-  const char *cstr;
-  char *ctarget;
   size_t cstart, cend;
   SCM result;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, str, cstr,
-                                  2, start, cstart,
-                                  3, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, str,
+                             2, start, cstart,
+                             3, end, cend);
   result = scm_string_copy (str);
-  result = scm_i_string_start_writing (result);
-  ctarget = scm_i_string_writable_chars (result);
-  string_reverse_x (ctarget, cstart, cend);
-  scm_i_string_stop_writing ();
+  string_reverse_x (result, cstart, cend);
   scm_remember_upto_here_1 (str);
   return result;
 }
@@ -2657,17 +2328,13 @@ SCM_DEFINE (scm_string_reverse_x, "string-reverse!", 1, 
2, 0,
            "operate on.  The return value is unspecified.")
 #define FUNC_NAME s_scm_string_reverse_x
 {
-  char *cstr;
   size_t cstart, cend;
 
   MY_VALIDATE_SUBSTRING_SPEC (1, str,
                              2, start, cstart,
                              3, end, cend);
 
-  str = scm_i_string_start_writing (str);
-  cstr = scm_i_string_writable_chars (str);
-  string_reverse_x (cstr, cstart, cend);
-  scm_i_string_stop_writing ();
+  string_reverse_x (str, cstart, cend);
   scm_remember_upto_here_1 (str);
   return SCM_UNSPECIFIED;
 }
@@ -2693,7 +2360,9 @@ SCM_DEFINE (scm_string_append_shared, 
"string-append/shared", 0, 0, 1,
   for (l = rest; scm_is_pair (l); l = SCM_CDR (l))
     {
       s = SCM_CAR (l);
-      if (scm_c_string_length (s) != 0)
+      if (!scm_is_string (s))
+       scm_wrong_type_arg (FUNC_NAME, 0, s);
+      if (scm_i_string_length (s) != 0)
         {
           if (seen_nonempty)
             /* two or more non-empty strings, need full concat */
@@ -2780,7 +2449,7 @@ SCM_DEFINE (scm_string_map, "string-map", 2, 2, 0,
            "string elements is not specified.")
 #define FUNC_NAME s_scm_string_map
 {
-  char *p;
+  size_t p;
   size_t cstart, cend;
   SCM result;
   scm_t_trampoline_1 proc_tramp = scm_trampoline_1 (proc);
@@ -2789,15 +2458,20 @@ SCM_DEFINE (scm_string_map, "string-map", 2, 2, 0,
   MY_VALIDATE_SUBSTRING_SPEC (2, s,
                              3, start, cstart,
                              4, end, cend);
-  result = scm_i_make_string (cend - cstart, &p);
+  result = scm_i_make_string (cend - cstart, NULL);
+  p = 0;
   while (cstart < cend)
     {
       SCM ch = proc_tramp (proc, scm_c_string_ref (s, cstart));
       if (!SCM_CHARP (ch))
        SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
       cstart++;
-      *p++ = SCM_CHAR (ch);
+      result = scm_i_string_start_writing (result);
+      scm_i_string_set_x (result, p, SCM_CHAR (ch));
+      scm_i_string_stop_writing ();
+      p++;
     }
+  
   return result;
 }
 #undef FUNC_NAME
@@ -2823,7 +2497,9 @@ SCM_DEFINE (scm_string_map_x, "string-map!", 2, 2, 0,
       SCM ch = proc_tramp (proc, scm_c_string_ref (s, cstart));
       if (!SCM_CHARP (ch))
        SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
-      scm_c_string_set_x (s, cstart, ch);
+      s = scm_i_string_start_writing (s);
+      scm_i_string_set_x (s, cstart, SCM_CHAR (ch));
+      scm_i_string_stop_writing ();
       cstart++;
     }
   return SCM_UNSPECIFIED;
@@ -2839,20 +2515,17 @@ SCM_DEFINE (scm_string_fold, "string-fold", 3, 2, 0,
            "result of @var{kons}' application.")
 #define FUNC_NAME s_scm_string_fold
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM result;
 
   SCM_VALIDATE_PROC (1, kons);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (3, s, cstr,
-                                  4, start, cstart,
-                                  5, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (3, s,
+                             4, start, cstart,
+                             5, end, cend);
   result = knil;
   while (cstart < cend)
     {
-      unsigned int c = (unsigned char) cstr[cstart];
-      result = scm_call_2 (kons, SCM_MAKE_CHAR (c), result);
-      cstr = scm_i_string_chars (s);
+      result = scm_call_2 (kons, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)), 
result);
       cstart++;
     }
 
@@ -2870,20 +2543,17 @@ SCM_DEFINE (scm_string_fold_right, "string-fold-right", 
3, 2, 0,
            "result of @var{kons}' application.")
 #define FUNC_NAME s_scm_string_fold_right
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM result;
 
   SCM_VALIDATE_PROC (1, kons);
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (3, s, cstr,
-                                  4, start, cstart,
-                                  5, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (3, s,
+                             4, start, cstart,
+                             5, end, cend);
   result = knil;
   while (cstart < cend)
     {
-      unsigned int c  = (unsigned char) cstr[cend - 1];
-      result = scm_call_2 (kons, SCM_MAKE_CHAR (c), result);
-      cstr = scm_i_string_chars (s);
+      result = scm_call_2 (kons, SCM_MAKE_CHAR (scm_i_string_ref (s, cend-1)), 
result);
       cend--;
     }
 
@@ -2934,12 +2604,15 @@ SCM_DEFINE (scm_string_unfold, "string-unfold", 4, 2, 0,
   while (scm_is_false (res))
     {
       SCM str;
-      char *ptr;
+      size_t i = 0;
       SCM ch = scm_call_1 (f, seed);
       if (!SCM_CHARP (ch))
        SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f));
-      str = scm_i_make_string (1, &ptr);
-      *ptr = SCM_CHAR (ch);
+      str = scm_i_make_string (1, NULL);
+      str = scm_i_string_start_writing (str);
+      scm_i_string_set_x (str, i, SCM_CHAR (ch));
+      scm_i_string_stop_writing ();
+      i++;
 
       ans = scm_string_append (scm_list_2 (ans, str));
       seed = scm_call_1 (g, seed);
@@ -2997,12 +2670,15 @@ SCM_DEFINE (scm_string_unfold_right, 
"string-unfold-right", 4, 2, 0,
   while (scm_is_false (res))
     {
       SCM str;
-      char *ptr;
+      size_t i = 0;
       SCM ch = scm_call_1 (f, seed);
       if (!SCM_CHARP (ch))
        SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f));
-      str = scm_i_make_string (1, &ptr);
-      *ptr = SCM_CHAR (ch);
+      str = scm_i_make_string (1, NULL);
+      str = scm_i_string_start_writing (str);
+      scm_i_string_set_x (str, i, SCM_CHAR (ch));
+      scm_i_string_stop_writing ();
+      i++;
 
       ans = scm_string_append (scm_list_2 (str, ans));
       seed = scm_call_1 (g, seed);
@@ -3096,8 +2772,7 @@ SCM_DEFINE (scm_xsubstring, "xsubstring", 2, 3, 0,
            "defaults to @var{from} + (@var{end} - @var{start}).")
 #define FUNC_NAME s_scm_xsubstring
 {
-  const char *cs;
-  char *p;
+  size_t p;
   size_t cstart, cend;
   int cfrom, cto;
   SCM result;
@@ -3114,19 +2789,22 @@ SCM_DEFINE (scm_xsubstring, "xsubstring", 2, 3, 0,
   if (cstart == cend && cfrom != cto)
     SCM_MISC_ERROR ("start and end indices must not be equal", SCM_EOL);
 
-  result = scm_i_make_string (cto - cfrom, &p);
+  result = scm_i_make_string (cto - cfrom, NULL);
+  result = scm_i_string_start_writing (result);
 
-  cs = scm_i_string_chars (s);
+  p = 0;
   while (cfrom < cto)
     {
       size_t t = ((cfrom < 0) ? -cfrom : cfrom) % (cend - cstart);
       if (cfrom < 0)
-       *p = cs[(cend - cstart) - t];
+       scm_i_string_set_x (result, p, 
+                            scm_i_string_ref (s, (cend - cstart) - t));
       else
-       *p = cs[t];
+       scm_i_string_set_x (result, p, scm_i_string_ref (s, t));
       cfrom++;
       p++;
     }
+  scm_i_string_stop_writing ();
 
   scm_remember_upto_here_1 (s);
   return result;
@@ -3143,8 +2821,7 @@ SCM_DEFINE (scm_string_xcopy_x, "string-xcopy!", 4, 3, 0,
            "cannot copy a string on top of itself.")
 #define FUNC_NAME s_scm_string_xcopy_x
 {
-  char *p;
-  const char *cs;
+  size_t p;
   size_t ctstart, cstart, cend;
   int csfrom, csto;
   SCM dummy = SCM_UNDEFINED;
@@ -3166,16 +2843,15 @@ SCM_DEFINE (scm_string_xcopy_x, "string-xcopy!", 4, 3, 
0,
   SCM_ASSERT_RANGE (1, tstart,
                    ctstart + (csto - csfrom) <= scm_i_string_length (target));
 
+  p = 0;
   target = scm_i_string_start_writing (target);
-  p = scm_i_string_writable_chars (target) + ctstart;
-  cs = scm_i_string_chars (s);
   while (csfrom < csto)
     {
       size_t t = ((csfrom < 0) ? -csfrom : csfrom) % (cend - cstart);
       if (csfrom < 0)
-       *p = cs[(cend - cstart) - t];
+       scm_i_string_set_x (target, p + cstart, scm_i_string_ref (s, (cend - 
cstart) - t));
       else
-       *p = cs[t];
+       scm_i_string_set_x (target, p + cstart, scm_i_string_ref (s, t));
       csfrom++;
       p++;
     }
@@ -3194,8 +2870,6 @@ SCM_DEFINE (scm_string_replace, "string-replace", 2, 4, 0,
            "@var{start2} @dots{} @var{end2} from @var{s2}.")
 #define FUNC_NAME s_scm_string_replace
 {
-  const char *cstr1, *cstr2;
-  char *p;
   size_t cstart1, cend1, cstart2, cend2;
   SCM result;
 
@@ -3205,16 +2879,10 @@ SCM_DEFINE (scm_string_replace, "string-replace", 2, 4, 
0,
   MY_VALIDATE_SUBSTRING_SPEC (2, s2,
                              5, start2, cstart2,
                              6, end2, cend2);
-  result = scm_i_make_string ((cstart1 + cend2 - cstart2
-                               + scm_i_string_length (s1) - cend1), &p);
-  cstr1 = scm_i_string_chars (s1);
-  cstr2 = scm_i_string_chars (s2);
-  memmove (p, cstr1, cstart1 * sizeof (char));
-  memmove (p + cstart1, cstr2 + cstart2, (cend2 - cstart2) * sizeof (char));
-  memmove (p + cstart1 + (cend2 - cstart2),
-          cstr1 + cend1,
-          (scm_i_string_length (s1) - cend1) * sizeof (char));
-  scm_remember_upto_here_2 (s1, s2);
+  return (scm_string_append 
+         (scm_list_3 (scm_i_substring (s1, 0, cstart1),
+                      scm_i_substring (s2, cstart2, cend2),
+                      scm_i_substring (s1, cend1, scm_i_string_length (s1)))));
   return result;
 }
 #undef FUNC_NAME
@@ -3231,13 +2899,12 @@ SCM_DEFINE (scm_string_tokenize, "string-tokenize", 1, 
3, 0,
            "of @var{s}.")
 #define FUNC_NAME s_scm_string_tokenize
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM result = SCM_EOL;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
 
   if (SCM_UNBNDP (token_set))
     token_set = scm_char_set_graphic;
@@ -3250,7 +2917,7 @@ SCM_DEFINE (scm_string_tokenize, "string-tokenize", 1, 3, 
0,
        {
          while (cstart < cend)
            {
-             if (SCM_CHARSET_GET (token_set, cstr[cend - 1]))
+             if (REF_IN_CHARSET (s, cend-1, token_set))
                break;
              cend--;
            }
@@ -3259,12 +2926,11 @@ SCM_DEFINE (scm_string_tokenize, "string-tokenize", 1, 
3, 0,
          idx = cend;
          while (cstart < cend)
            {
-             if (!SCM_CHARSET_GET (token_set, cstr[cend - 1]))
+             if (!REF_IN_CHARSET (s, cend-1, token_set))
                break;
              cend--;
            }
-         result = scm_cons (scm_c_substring (s, cend, idx), result);
-         cstr = scm_i_string_chars (s);
+         result = scm_cons (scm_i_substring (s, cend, idx), result);
        }
     }
   else
@@ -3298,27 +2964,45 @@ SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0,
 #define FUNC_NAME s_scm_string_split
 {
   long idx, last_idx;
-  const char * p;
-  char ch;
+  int narrow;
   SCM res = SCM_EOL;
 
   SCM_VALIDATE_STRING (1, str);
   SCM_VALIDATE_CHAR (2, chr);
-
+  
+  /* This is explicit wide/narrow logic (instead of using
+     scm_i_string_ref) is a speed optimization.  */
   idx = scm_i_string_length (str);
-  p = scm_i_string_chars (str);
-  ch = SCM_CHAR (chr);
-  while (idx >= 0)
-    {
-      last_idx = idx;
-      while (idx > 0 && p[idx - 1] != ch)
-       idx--;
-      if (idx >= 0)
-       {
-         res = scm_cons (scm_c_substring (str, idx, last_idx), res);
-         p = scm_i_string_chars (str);
-         idx--;
-       }
+  narrow = scm_i_is_narrow_string (str);
+  if (narrow)
+    {
+      const char *buf = scm_i_string_chars (str);
+      while (idx >= 0)
+        {
+          last_idx = idx;
+          while (idx > 0 && buf[idx-1] != (char) SCM_CHAR(chr))
+            idx--;
+          if (idx >= 0)
+            {
+              res = scm_cons (scm_i_substring (str, idx, last_idx), res);
+              idx--;
+            }
+        }
+    }
+  else
+    {
+      const scm_t_wchar *buf = scm_i_string_wide_chars (str);
+      while (idx >= 0)
+        {
+          last_idx = idx;
+          while (idx > 0 && buf[idx-1] != SCM_CHAR(chr))
+            idx--;
+          if (idx >= 0)
+            {
+              res = scm_cons (scm_i_substring (str, idx, last_idx), res);
+              idx--;
+            }
+        }
     }
   scm_remember_upto_here_1 (str);
   return res;
@@ -3337,14 +3021,13 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
            "membership.")
 #define FUNC_NAME s_scm_string_filter
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM result;
   size_t idx;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
 
   /* The explicit loops below stripping leading and trailing non-matches
      mean we can return a substring if those are the only deletions, making
@@ -3353,22 +3036,19 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
   if (SCM_CHARP (char_pred))
     {
       size_t count;
-      char chr;
-
-      chr = SCM_CHAR (char_pred);
 
       /* strip leading non-matches by incrementing cstart */
-      while (cstart < cend && cstr[cstart] != chr)
+      while (cstart < cend && scm_i_string_ref (s, cstart) != SCM_CHAR 
(char_pred))
         cstart++;
 
       /* strip trailing non-matches by decrementing cend */
-      while (cend > cstart && cstr[cend-1] != chr)
+      while (cend > cstart && scm_i_string_ref (s, cend-1) != SCM_CHAR 
(char_pred))
         cend--;
 
       /* count chars to keep */
       count = 0;
       for (idx = cstart; idx < cend; idx++)
-        if (cstr[idx] == chr)
+        if (scm_i_string_ref (s, idx) == SCM_CHAR (char_pred))
           count++;
 
       if (count == cend - cstart)
@@ -3386,17 +3066,17 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
       size_t count;
 
       /* strip leading non-matches by incrementing cstart */
-      while (cstart < cend && ! SCM_CHARSET_GET (char_pred, cstr[cstart]))
+      while (cstart < cend && ! REF_IN_CHARSET (s, cstart, char_pred))
         cstart++;
 
       /* strip trailing non-matches by decrementing cend */
-      while (cend > cstart && ! SCM_CHARSET_GET (char_pred, cstr[cend-1]))
+      while (cend > cstart && ! REF_IN_CHARSET (s, cend-1, char_pred))
         cend--;
 
       /* count chars to be kept */
       count = 0;
       for (idx = cstart; idx < cend; idx++)
-        if (SCM_CHARSET_GET (char_pred, cstr[idx]))
+        if (REF_IN_CHARSET (s, idx, char_pred))
           count++;
 
       /* if whole of start to end kept then return substring */
@@ -3404,21 +3084,23 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
         goto result_substring;
       else
         {
-          char *dst;
-          result = scm_i_make_string (count, &dst);
-          cstr = scm_i_string_chars (s);
+          size_t dst = 0;
+          result = scm_i_make_string (count, NULL);
+         result = scm_i_string_start_writing (result);
 
           /* decrement "count" in this loop as well as using idx, so that if
              another thread is simultaneously changing "s" there's no chance
              it'll make us copy more than count characters */
           for (idx = cstart; idx < cend && count != 0; idx++)
             {
-              if (SCM_CHARSET_GET (char_pred, cstr[idx]))
+              if (REF_IN_CHARSET (s, idx, char_pred))
                 {
-                  *dst++ = cstr[idx];
+                 scm_i_string_set_x (result, dst, scm_i_string_ref (s, idx));
+                 dst ++;
                   count--;
                 }
             }
+         scm_i_string_stop_writing ();
         }
     }
   else
@@ -3431,11 +3113,10 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
       while (idx < cend)
        {
          SCM res, ch;
-         ch = SCM_MAKE_CHAR (cstr[idx]);
+         ch = SCM_MAKE_CHAR (scm_i_string_ref (s, idx));
          res = pred_tramp (char_pred, ch);
          if (scm_is_true (res))
            ls = scm_cons (ch, ls);
-         cstr = scm_i_string_chars (s);
          idx++;
        }
       result = scm_reverse_list_to_string (ls);
@@ -3457,14 +3138,13 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
            "membership.")
 #define FUNC_NAME s_scm_string_delete
 {
-  const char *cstr;
   size_t cstart, cend;
   SCM result;
   size_t idx;
 
-  MY_VALIDATE_SUBSTRING_SPEC_COPY (1, s, cstr,
-                                  3, start, cstart,
-                                  4, end, cend);
+  MY_VALIDATE_SUBSTRING_SPEC (1, s,
+                             3, start, cstart,
+                             4, end, cend);
 
   /* The explicit loops below stripping leading and trailing matches mean we
      can return a substring if those are the only deletions, making
@@ -3473,22 +3153,19 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
   if (SCM_CHARP (char_pred))
     {
       size_t count;
-      char chr;
-
-      chr = SCM_CHAR (char_pred);
 
       /* strip leading matches by incrementing cstart */
-      while (cstart < cend && cstr[cstart] == chr)
+      while (cstart < cend && scm_i_string_ref (s, cstart) == 
SCM_CHAR(char_pred))
         cstart++;
 
       /* strip trailing matches by decrementing cend */
-      while (cend > cstart && cstr[cend-1] == chr)
+      while (cend > cstart && scm_i_string_ref (s, cend-1) == SCM_CHAR 
(char_pred))
         cend--;
 
       /* count chars to be kept */
       count = 0;
       for (idx = cstart; idx < cend; idx++)
-        if (cstr[idx] != chr)
+        if (scm_i_string_ref (s, idx) != SCM_CHAR (char_pred))
           count++;
 
       if (count == cend - cstart)
@@ -3500,22 +3177,24 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
         }
       else
         {
+         int i = 0;
           /* new string for retained portion */
-          char *dst;
-          result = scm_i_make_string (count, &dst);
-          cstr = scm_i_string_chars (s);
-
+          result = scm_i_make_string (count, NULL); 
+          result = scm_i_string_start_writing (result);
           /* decrement "count" in this loop as well as using idx, so that if
              another thread is simultaneously changing "s" there's no chance
              it'll make us copy more than count characters */
           for (idx = cstart; idx < cend && count != 0; idx++)
             {
-              if (cstr[idx] != chr)
+             scm_t_wchar c = scm_i_string_ref (s, idx);
+              if (c != SCM_CHAR (char_pred))
                 {
-                  *dst++ = cstr[idx];
+                  scm_i_string_set_x (result, i, c);
+                 i++;
                   count--;
                 }
             }
+         scm_i_string_stop_writing ();
         }
     }
   else if (SCM_CHARSETP (char_pred))
@@ -3523,39 +3202,41 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
       size_t count;
 
       /* strip leading matches by incrementing cstart */
-      while (cstart < cend && SCM_CHARSET_GET (char_pred, cstr[cstart]))
+      while (cstart < cend && REF_IN_CHARSET (s, cstart, char_pred))
         cstart++;
 
       /* strip trailing matches by decrementing cend */
-      while (cend > cstart && SCM_CHARSET_GET (char_pred, cstr[cend-1]))
+      while (cend > cstart && REF_IN_CHARSET (s, cend-1, char_pred))
         cend--;
 
       /* count chars to be kept */
       count = 0;
       for (idx = cstart; idx < cend; idx++)
-        if (! SCM_CHARSET_GET (char_pred, cstr[idx]))
+        if (!REF_IN_CHARSET (s, idx, char_pred))
           count++;
 
       if (count == cend - cstart)
         goto result_substring;
       else
         {
+         size_t i = 0;
           /* new string for retained portion */
-          char *dst;
-          result = scm_i_make_string (count, &dst);
-          cstr = scm_i_string_chars (s);
+          result = scm_i_make_string (count, NULL);
+         result = scm_i_string_start_writing (result);
 
           /* decrement "count" in this loop as well as using idx, so that if
              another thread is simultaneously changing "s" there's no chance
              it'll make us copy more than count characters */
           for (idx = cstart; idx < cend && count != 0; idx++)
             {
-              if (! SCM_CHARSET_GET (char_pred, cstr[idx]))
+              if (!REF_IN_CHARSET (s, idx, char_pred))
                 {
-                  *dst++ = cstr[idx];
+                 scm_i_string_set_x (result, i, scm_i_string_ref (s, idx));
+                 i++;
                   count--;
                 }
             }
+         scm_i_string_stop_writing ();
         }
     }
   else
@@ -3567,11 +3248,10 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
       idx = cstart;
       while (idx < cend)
        {
-         SCM res, ch = SCM_MAKE_CHAR (cstr[idx]);
+         SCM res, ch = SCM_MAKE_CHAR (scm_i_string_ref (s, idx));
          res = pred_tramp (char_pred, ch);
          if (scm_is_false (res))
            ls = scm_cons (ch, ls);
-         cstr = scm_i_string_chars (s);
          idx++;
        }
       result = scm_reverse_list_to_string (ls);
diff --git a/test-suite/tests/srfi-13.test b/test-suite/tests/srfi-13.test
index 9dbf5bf..d8e3799 100644
--- a/test-suite/tests/srfi-13.test
+++ b/test-suite/tests/srfi-13.test
@@ -30,6 +30,9 @@
 (define (string-ints . args)
   (apply string (map integer->char args)))
 
+;; Some abbreviations
+;; BMP - Basic Multilingual Plane (codepoints below U+FFFF)
+;; SMP - Suplementary Multilingual Plane (codebpoints from U+10000 to U+1FFFF)
 
 ;;;
 ;;; string-any
@@ -53,6 +56,12 @@
     (pass-if "one match"
       (string-any #\C "abCde"))
 
+    (pass-if "one match: BMP"
+      (string-any (integer->char #x0100) "ab\u0100de"))
+
+    (pass-if "one match: SMP"
+      (string-any (integer->char #x010300) "ab\U010300de"))
+
     (pass-if "more than one match"
       (string-any #\X "abXXX"))
 
@@ -151,7 +160,9 @@
     (pass-if (string=? ""       (string-append/shared ""    "")))
     (pass-if (string=? "xyz"    (string-append/shared "xyz" "")))
     (pass-if (string=? "xyz"    (string-append/shared ""    "xyz")))
-    (pass-if (string=? "abcxyz" (string-append/shared "abc" "xyz"))))
+    (pass-if (string=? "abcxyz" (string-append/shared "abc" "xyz")))
+    (pass-if (string=? "abc\u0100\u0101" 
+                       (string-append/shared "abc" "\u0100\u0101"))))
 
   (with-test-prefix "three args"
     (pass-if (string=? ""      (string-append/shared ""   ""   "")))
@@ -191,7 +202,10 @@
   (pass-if-exception "improper 1" exception:wrong-type-arg
     (string-concatenate '("a" . "b")))
 
-  (pass-if (equal? "abc" (string-concatenate '("a" "b" "c")))))
+  (pass-if (equal? "abc" (string-concatenate '("a" "b" "c"))))
+
+  (pass-if "concatenate BMP"
+    (equal? "a\u0100" (string-concatenate '("a" "\u0100")))))
 
 ;;
 ;; string-compare
@@ -234,7 +248,10 @@
   (pass-if-exception "improper 1" exception:wrong-type-arg
     (string-concatenate/shared '("a" . "b")))
 
-  (pass-if (equal? "abc" (string-concatenate/shared '("a" "b" "c")))))
+  (pass-if (equal? "abc" (string-concatenate/shared '("a" "b" "c"))))
+
+  (pass-if "BMP" 
+    (equal? "a\u0100c" (string-concatenate/shared '("a" "\u0100" "c")))))
 
 ;;;
 ;;; string-every
@@ -267,6 +284,9 @@
     (pass-if "all match"
       (string-every #\X "XXXXX"))
 
+    (pass-if "all match BMP"
+      (string-every #\200000 "\U010000\U010000"))
+
     (pass-if "no match at all, start index"
       (not (string-every #\X "Xbcde" 1)))
 
@@ -386,6 +406,9 @@
 
    (pass-if "nonempty, start index"
      (= (length (string->list "foo" 1 3)) 2))
+
+   (pass-if "nonempty, start index, BMP"
+     (= (length (string->list "\xff\u0100\u0300" 1 3)) 2))
   )
 
 (with-test-prefix "reverse-list->string"
@@ -394,8 +417,10 @@
      (string-null? (reverse-list->string '())))
 
   (pass-if "nonempty"
-     (string=? "foo" (reverse-list->string '(#\o #\o #\f)))))
+     (string=? "foo" (reverse-list->string '(#\o #\o #\f))))
 
+  (pass-if "nonempty, BMP"
+     (string=? "\u0100\u0101\u0102" (reverse-list->string '(#\402 #\401 
#\400)))))
 
 (with-test-prefix "string-join"
 
@@ -436,6 +461,11 @@
      (string=? "bla|delim|fasel" (string-join '("bla" "fasel") "|delim|"
                                              'infix)))
 
+  (pass-if "two strings, explicit infix, BMP"
+     (string=? "\u0100\u0101::\u0102\u0103" 
+               (string-join '("\u0100\u0101" "\u0102\u0103") "::"
+                            'infix)))
+
   (pass-if-exception "empty list, strict infix"
      exception:strict-infix-grammar
      (string-join '() "|delim|" 'strict-infix))
@@ -484,9 +514,15 @@
   (pass-if "full string"
     (string=? "foo-bar" (string-copy "foo-bar")))
 
+  (pass-if "full string, BMP"
+    (string=? "foo-\u0100\u0101" (string-copy "foo-\u0100\u0101")))
+
   (pass-if "start index"
     (string=? "o-bar" (string-copy "foo-bar" 2)))
 
+  (pass-if "start index"
+    (string=? "o-bar" (string-copy "\u0100\u0101o-bar" 2)))
+
   (pass-if "start and end index"
     (string=? "o-ba" (string-copy "foo-bar" 2 6)))
 )
@@ -519,6 +555,9 @@
   (pass-if "non-empty string"
     (string=? "foo " (string-take "foo bar braz" 4)))
 
+  (pass-if "non-empty string BMP"
+    (string=? "\u0100oo " (string-take "\u0100oo \u0101ar braz" 4)))
+
   (pass-if "full string"
     (string=? "foo bar braz" (string-take "foo bar braz" 12))))
 
@@ -530,6 +569,9 @@
   (pass-if "non-empty string"
     (string=? "braz" (string-take-right "foo bar braz" 4)))
 
+  (pass-if "non-empty string"
+    (string=? "braz" (string-take-right "foo ba\u0100 braz" 4)))
+
   (pass-if "full string"
     (string=? "foo bar braz" (string-take-right "foo bar braz" 12))))
 
@@ -541,6 +583,9 @@
   (pass-if "non-empty string"
     (string=? "braz" (string-drop "foo bar braz" 8)))
 
+  (pass-if "non-empty string BMP"
+    (string=? "braz" (string-drop "foo \u0100\u0101\u0102 braz" 8)))
+
   (pass-if "full string"
     (string=? "foo bar braz" (string-drop "foo bar braz" 0))))
 
@@ -552,6 +597,9 @@
   (pass-if "non-empty string"
     (string=? "foo " (string-drop-right "foo bar braz" 8)))
 
+  (pass-if "non-empty string BMP"
+    (string=? "foo " (string-drop-right "foo \u0100\u0101\u0102 braz" 8)))
+
   (pass-if "full string"
     (string=? "foo bar braz" (string-drop-right "foo bar braz" 0))))
 


hooks/post-receive
-- 
GNU Guile




reply via email to

[Prev in Thread] Current Thread [Next in Thread]