rodeo coding

31 files changed, 760 insertions, 382 deletions

diff --git a/guile-readline/readline.c b/guile-readline/readline.c
index 9f7b39df0..c0fe8ec6e 100644
--- a/guile-readline/readline.c
+++ b/guile-readline/readline.c
@@ -165,7 +165,7 @@ SCM_DEFINE (scm_readline, "%readline", 0, 4, 0,
 
   if (!SCM_UNBNDP (text))
     {
-      if (!SCM_STRINGP (text))
+      if (!scm_is_string (text))
 	{
 	  --in_readline;
 	  scm_wrong_type_arg (s_scm_readline, SCM_ARG1, text);
@@ -253,15 +253,17 @@ internal_readline (SCM text)
 {
   SCM ret;
   char *s;
-  char *prompt = SCM_UNBNDP (text) ? "" : SCM_STRING_CHARS (text);
+  char *prompt = SCM_UNBNDP (text) ? "" : scm_to_locale_string (text);
 
   promptp = 1;
   s = readline (prompt);
   if (s)
-    ret = scm_makfrom0str (s);
+    ret = scm_from_locale_string (s);
   else 
     ret = SCM_EOF_VAL;
 
+  if (!SCM_UNBNDP (text))
+    free (prompt);
   free (s);
 
   return ret;
@@ -326,10 +328,9 @@ SCM_DEFINE (scm_add_history, "add-history", 1, 0, 0,
 #define FUNC_NAME s_scm_add_history
 {
   char* s;
-  SCM_VALIDATE_STRING (1,text);
 
-  s = SCM_STRING_CHARS (text);
-  add_history (strdup (s));
+  s = scm_to_locale_string (text);
+  add_history (s);
 
   return SCM_UNSPECIFIED;
 }
@@ -341,8 +342,13 @@ SCM_DEFINE (scm_read_history, "read-history", 1, 0, 0,
 "")
 #define FUNC_NAME s_scm_read_history
 {
-  SCM_VALIDATE_STRING (1,file);
-  return scm_from_bool (!read_history (SCM_STRING_CHARS (file)));
+  char *filename;
+  SCM ret;
+
+  filename = scm_to_locale_string (file);
+  ret = scm_from_bool (!read_history (filename));
+  free (filename);
+  return ret;
 }
 #undef FUNC_NAME
 
@@ -352,8 +358,13 @@ SCM_DEFINE (scm_write_history, "write-history", 1, 0, 0,
 "")
 #define FUNC_NAME s_scm_write_history
 {
-  SCM_VALIDATE_STRING (1,file);
-  return scm_from_bool (!write_history (SCM_STRING_CHARS (file)));
+  char *filename;
+  SCM ret;
+
+  filename = scm_to_locale_string (file);
+  ret = scm_from_bool (!write_history (filename));
+  free (filename);
+  return ret;
 }
 #undef FUNC_NAME
 
@@ -375,14 +386,14 @@ SCM_DEFINE (scm_filename_completion_function, "filename-completion-function", 2,
 {
   char *s;
   SCM ans;
-  SCM_VALIDATE_STRING (1,text);
+  char *c_text = scm_to_locale_string (text);
 #ifdef HAVE_RL_FILENAME_COMPLETION_FUNCTION
-  s = rl_filename_completion_function (SCM_STRING_CHARS (text), scm_is_true (continuep));
+  s = rl_filename_completion_function (c_text, scm_is_true (continuep));
 #else
-  s = filename_completion_function (SCM_STRING_CHARS (text), scm_is_true (continuep));
+  s = filename_completion_function (c_text, scm_is_true (continuep));
 #endif
-  ans = scm_makfrom0str (s);
-  free (s);
+  ans = scm_take_locale_string (s);
+  free (c_text);
   return ans;
 }
 #undef FUNC_NAME
@@ -404,18 +415,14 @@ completion_function (char *text, int continuep)
     return NULL; /* #f => completion disabled */
   else
     {
-      SCM t = scm_makfrom0str (text);
+      SCM t = scm_from_locale_string (text);
       SCM c = scm_from_bool (continuep);
       res = scm_apply (compfunc, scm_list_2 (t, c), SCM_EOL);
   
       if (scm_is_false (res))
 	return NULL;
   
-      if (!SCM_STRINGP (res))
-	scm_misc_error (s_scm_readline,
-			"Completion function returned bogus value: %S",
-			scm_list_1 (res));
-      return strdup (SCM_STRING_CHARS (res));
+      return scm_to_locale_string (res);
     }
 }
 
diff --git a/libguile/backtrace.c b/libguile/backtrace.c
index 23e67e4da..db55877c9 100644
--- a/libguile/backtrace.c
+++ b/libguile/backtrace.c
@@ -401,18 +401,22 @@ display_frame_expr (char *hdr, SCM exp, char *tlr, int indentation, SCM sport, S
   string = scm_strport_to_string (sport);
   assert (scm_is_string (string));
 
-  /* Remove control characters */
-  for (i = 0; i < n; ++i)
-    if (iscntrl ((int) SCM_I_STRING_UCHARS (string)[i]))
-      SCM_I_STRING_UCHARS (string)[i] = ' ';
-  /* Truncate */
-  if (indentation + n > SCM_BACKTRACE_WIDTH)
-    {
-      n = SCM_BACKTRACE_WIDTH - indentation;
-      SCM_I_STRING_UCHARS (string)[n - 1] = '$';
-    }
+  {
+    char *data = scm_i_string_writable_chars (string);
+
+    /* Remove control characters */
+    for (i = 0; i < n; ++i)
+      if (iscntrl (data[i]))
+	data[i] = ' ';
+    /* Truncate */
+    if (indentation + n > SCM_BACKTRACE_WIDTH)
+      {
+	n = SCM_BACKTRACE_WIDTH - indentation;
+	data[n-1] = '$';
+      }
+  }
       
-  scm_lfwrite (SCM_I_STRING_CHARS (string), n, port);
+  scm_lfwrite (scm_i_string_chars (string), n, port);
   scm_remember_upto_here_1 (string);
 }
 
diff --git a/libguile/convert.i.c b/libguile/convert.i.c
index 1fe928110..230aa5192 100644
--- a/libguile/convert.i.c
+++ b/libguile/convert.i.c
@@ -163,11 +163,11 @@ SCM2CTYPES (SCM obj, CTYPE *data)
 
 #if SIZEOF_CTYPE == 1
     case scm_tc7_string:
-      n = SCM_I_STRING_LENGTH (obj);
+      n = scm_i_string_length (obj);
       if (data == NULL)
         if ((data = (CTYPE *) malloc (n * sizeof (CTYPE))) == NULL)
 	  return NULL;
-      memcpy (data, SCM_I_STRING_CHARS (obj), n * sizeof (CTYPE));
+      memcpy (data, scm_i_string_chars (obj), n * sizeof (CTYPE));
       break;
 #endif
 
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 99b6e70cd..d356644a9 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -814,8 +814,8 @@ SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0,
   else if (scm_is_eq (o, SCM_BOOL_T))
     o = SCM_BOOL_F;
     
-  vcell = scm_intern_obarray_soft (SCM_I_STRING_CHARS(s),
-				   SCM_I_STRING_LENGTH (s),
+  vcell = scm_intern_obarray_soft (scm_i_string_chars (s),
+				   scm_i_string_length (s),
 				   o,
 				   softness);
   if (scm_is_false (vcell))
@@ -1047,10 +1047,10 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
   else
     {
       SCM_VALIDATE_STRING (1, prefix);
-      len = SCM_I_STRING_LENGTH (prefix);
+      len = scm_i_string_length (prefix);
       if (len > MAX_PREFIX_LENGTH)
 	name = SCM_MUST_MALLOC (MAX_PREFIX_LENGTH + SCM_INTBUFLEN);
-      strncpy (name, SCM_I_STRING_CHARS (prefix), len);
+      strncpy (name, scm_i_string_chars (prefix), len);
     }
 
   if (SCM_UNBNDP (obarray))
@@ -1112,7 +1112,7 @@ scm_c_string2str (SCM obj, char *str, size_t *lenp)
     {
       char *result = scm_to_locale_string (obj);
       if (lenp)
-	*lenp = SCM_I_STRING_LENGTH (obj);
+	*lenp = scm_i_string_length (obj);
       return result;
     }
   else
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 403996d04..b6d312c09 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1501,14 +1501,14 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0,
 	    "component, @code{.} is returned.")
 #define FUNC_NAME s_scm_dirname
 {
-  char *s;
+  const char *s;
   long int i;
   unsigned long int len;
 
   SCM_VALIDATE_STRING (1, filename);
 
-  s = SCM_I_STRING_CHARS (filename);
-  len = SCM_I_STRING_LENGTH (filename);
+  s = scm_i_string_chars (filename);
+  len = scm_i_string_length (filename);
 
   i = len - 1;
 #ifdef __MINGW32__
@@ -1527,12 +1527,12 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0,
 #else
       if (len > 0 && s[0] == '/')
 #endif /* ndef __MINGW32__ */
-	return scm_substring (filename, SCM_INUM0, scm_from_int (1));
+	return scm_c_substring (filename, 0, 1);
       else
 	return scm_dot_string;
     }
   else
-    return scm_substring (filename, SCM_INUM0, scm_from_int (i + 1));
+    return scm_c_substring (filename, 0, i + 1);
 }
 #undef FUNC_NAME
 
@@ -1544,20 +1544,20 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
 	    "@var{basename}, it is removed also.")
 #define FUNC_NAME s_scm_basename
 {
-  char *f, *s = 0;
+  const char *f, *s = 0;
   int i, j, len, end;
 
   SCM_VALIDATE_STRING (1, filename);
-  f = SCM_I_STRING_CHARS (filename);
-  len = SCM_I_STRING_LENGTH (filename);
+  f = scm_i_string_chars (filename);
+  len = scm_i_string_length (filename);
 
   if (SCM_UNBNDP (suffix))
     j = -1;
   else
     {
       SCM_VALIDATE_STRING (2, suffix);
-      s = SCM_I_STRING_CHARS (suffix);
-      j = SCM_I_STRING_LENGTH (suffix) - 1;
+      s = scm_i_string_chars (suffix);
+      j = scm_i_string_length (suffix) - 1;
     }
   i = len - 1;
 #ifdef __MINGW32__
@@ -1581,12 +1581,12 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
 #else
       if (len > 0 && f[0] == '/')
 #endif /* ndef __MINGW32__ */
-	return scm_substring (filename, SCM_INUM0, scm_from_int (1));
+	return scm_c_substring (filename, 0, 1);
       else
 	return scm_dot_string;
     }
   else
-    return scm_substring (filename, scm_from_int (i+1), scm_from_int (end+1));
+    return scm_c_substring (filename, i+1, end+1);
 }
 #undef FUNC_NAME
 
diff --git a/libguile/gc-card.c b/libguile/gc-card.c
index 2f57736b3..4acdbb0c5 100644
--- a/libguile/gc-card.c
+++ b/libguile/gc-card.c
@@ -193,8 +193,10 @@ scm_i_sweep_card (scm_t_cell *  p, SCM *free_list, scm_t_heap_segment*seg)
             }
           break;
 	case scm_tc7_string:
-	  scm_gc_free (SCM_I_STRING_CHARS (scmptr), 
-		       SCM_I_STRING_LENGTH (scmptr) + 1, "string");
+	  scm_i_string_free (scmptr);
+	  break;
+	case scm_tc7_stringbuf:
+	  scm_i_stringbuf_free (scmptr);
 	  break;
 	case scm_tc7_symbol:
 	  scm_gc_free (SCM_SYMBOL_CHARS (scmptr), 
diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c
index cb966c9f3..87574125f 100644
--- a/libguile/gc-mark.c
+++ b/libguile/gc-mark.c
@@ -278,7 +278,11 @@ scm_gc_mark_dependencies (SCM p)
 #endif
 #endif
     case scm_tc7_string:
-      break;
+      ptr = scm_i_string_mark (ptr);
+      goto gc_mark_loop;
+    case scm_tc7_stringbuf:
+      ptr = scm_i_stringbuf_mark (ptr);
+      goto gc_mark_loop;
 
     case scm_tc7_number:
       if (SCM_TYP16 (ptr) == scm_tc16_fraction)
diff --git a/libguile/gc.c b/libguile/gc.c
index 2e163df83..27d613092 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -642,7 +642,7 @@ scm_igc (const char *what)
  * the conservative gc we add the call to scm_remember_upto_here_1 _after_ the
  * call to 'some_function'.  Note that this would not be necessary if str was
  * used anyway after the call to 'some_function'.
- *   char *chars = SCM_I_STRING_CHARS (str);
+ *   char *chars = scm_i_string_chars (str);
  *   some_function (chars);
  *   scm_remember_upto_here_1 (str);  // str will be alive up to this point.
  */
diff --git a/libguile/gh_data.c b/libguile/gh_data.c
index 7f41b206d..f4cc9e537 100644
--- a/libguile/gh_data.c
+++ b/libguile/gh_data.c
@@ -80,12 +80,12 @@ gh_set_substr (char *src, SCM dst, long start, size_t len)
   char *dst_ptr;
   size_t dst_len;
 
-  SCM_ASSERT (SCM_I_STRINGP (dst), dst, SCM_ARG3, "gh_set_substr");
+  SCM_ASSERT (scm_is_string (dst), dst, SCM_ARG3, "gh_set_substr");
 
-  dst_ptr = SCM_I_STRING_CHARS (dst);
-  dst_len = SCM_I_STRING_LENGTH (dst);
+  dst_len = scm_i_string_length (dst);
   SCM_ASSERT (start + len <= dst_len, dst, SCM_ARG4, "gh_set_substr");
-  
+
+  dst_ptr = scm_i_string_writable_chars (dst);
   memmove (dst_ptr + start, src, len);
   scm_remember_upto_here_1 (dst);
 }
@@ -259,12 +259,12 @@ gh_scm2chars (SCM obj, char *m)
       break;
 #endif
     case scm_tc7_string:
-      n = SCM_I_STRING_LENGTH (obj);
+      n = scm_i_string_length (obj);
       if (m == 0)
 	m = (char *) malloc (n * sizeof (char));
       if (m == NULL)
 	return NULL;
-      memcpy (m, SCM_I_STRING_CHARS (obj), n * sizeof (char));
+      memcpy (m, scm_i_string_chars (obj), n * sizeof (char));
       break;
     default:
       scm_wrong_type_arg (0, 0, obj);
@@ -525,7 +525,7 @@ gh_scm2newstr (SCM str, size_t *lenp)
 
   ret_str = scm_to_locale_string (str);
   if (lenp)
-    *lenp = SCM_I_STRING_LENGTH (str);
+    *lenp = scm_i_string_length (str);
   return ret_str;
 }
 
@@ -540,11 +540,11 @@ void
 gh_get_substr (SCM src, char *dst, long start, size_t len)
 {
   size_t src_len, effective_length;
-  SCM_ASSERT (SCM_I_STRINGP (src), src, SCM_ARG3, "gh_get_substr");
+  SCM_ASSERT (scm_is_string (src), src, SCM_ARG3, "gh_get_substr");
 
-  src_len = SCM_I_STRING_LENGTH (src);
+  src_len = scm_i_string_length (src);
   effective_length = (len < src_len) ? len : src_len;
-  memcpy (dst + start, SCM_I_STRING_CHARS (src), effective_length * sizeof (char));
+  memcpy (dst + start, scm_i_string_chars (src), effective_length * sizeof (char));
   /* FIXME: must signal an error if len > src_len */
   scm_remember_upto_here_1 (src);
 }
diff --git a/libguile/hash.c b/libguile/hash.c
index b2c7fa592..090fd5f43 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -110,8 +110,8 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
       /* Fall through */
     case scm_tc7_string:
       {
-	unsigned long hash = scm_string_hash (SCM_I_STRING_UCHARS (obj),
-					      SCM_I_STRING_LENGTH (obj)) % n;
+	unsigned long hash = scm_string_hash (scm_i_string_chars (obj),
+					      scm_i_string_length (obj)) % n;
 	scm_remember_upto_here_1 (obj);
 	return hash;
       }
diff --git a/libguile/numbers.c b/libguile/numbers.c
index a50ca8889..8c92ea2c4 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -2338,7 +2338,7 @@ scm_i_print_fraction (SCM sexp, SCM port, scm_print_state *pstate SCM_UNUSED)
   SCM str;
   scm_i_fraction_reduce (sexp);
   str = scm_number_to_string (sexp, SCM_UNDEFINED);
-  scm_lfwrite (SCM_I_STRING_CHARS (str), SCM_I_STRING_LENGTH (str), port);
+  scm_lfwrite (scm_i_string_chars (str), scm_i_string_length (str), port);
   scm_remember_upto_here_1 (str);
   return !0;
 }
@@ -2967,8 +2967,8 @@ SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0,
   else
     base = scm_to_unsigned_integer (radix, 2, INT_MAX);
 
-  answer = scm_i_mem2number (SCM_I_STRING_CHARS (string),
-			     SCM_I_STRING_LENGTH (string),
+  answer = scm_i_mem2number (scm_i_string_chars (string),
+			     scm_i_string_length (string),
 			     base);
   scm_remember_upto_here_1 (string);
   return answer;
diff --git a/libguile/ports.c b/libguile/ports.c
index d0931ed71..d503e7825 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -319,6 +319,7 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
 #define FUNC_NAME s_scm_drain_input
 {
   SCM result;
+  char *data;
   scm_t_port *pt;
   long count;
 
@@ -329,9 +330,8 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0,
   if (pt->read_buf == pt->putback_buf)
     count += pt->saved_read_end - pt->saved_read_pos;
 
-  result = scm_allocate_string (count);
-  scm_take_from_input_buffers (port, SCM_I_STRING_CHARS (result), count);
-
+  result = scm_c_make_string (count, &data);
+  scm_take_from_input_buffers (port, data, count);
   return result;
 }
 #undef FUNC_NAME
@@ -668,16 +668,22 @@ SCM_DEFINE (scm_set_port_revealed_x, "set-port-revealed!", 2, 0, 0,
  * See PORT FLAGS in scm.h
  */
 
+static long
+scm_i_mode_bits_n (const char *modes, size_t n)
+{
+  return (SCM_OPN
+	  | (memchr (modes, 'r', n) || memchr (modes, '+', n) ? SCM_RDNG : 0)
+	  | (   memchr (modes, 'w', n)
+	     || memchr (modes, 'a', n)
+	     || memchr (modes, '+', n) ? SCM_WRTNG : 0)
+	  | (memchr (modes, '0', n) ? SCM_BUF0 : 0)
+	  | (memchr (modes, 'l', n) ? SCM_BUFLINE : 0));
+}
+
 long
 scm_mode_bits (char *modes)
 {
-  return (SCM_OPN
-	  | (strchr (modes, 'r') || strchr (modes, '+') ? SCM_RDNG : 0)
-	  | (   strchr (modes, 'w')
-	     || strchr (modes, 'a')
-	     || strchr (modes, '+') ? SCM_WRTNG : 0)
-	  | (strchr (modes, '0') ? SCM_BUF0 : 0)
-	  | (strchr (modes, 'l') ? SCM_BUFLINE : 0));
+  return scm_i_mode_bits_n (modes, strlen (modes));
 }
 
 long
@@ -688,7 +694,8 @@ scm_i_mode_bits (SCM modes)
   if (!scm_is_string (modes))
     scm_wrong_type_arg_msg (NULL, 0, modes, "string");
 
-  bits = scm_mode_bits (SCM_I_STRING_CHARS (modes));
+  bits = scm_i_mode_bits_n (scm_i_string_chars (modes),
+			    scm_i_string_length (modes));
   scm_remember_upto_here_1 (modes);
   return bits;
 }
@@ -1322,7 +1329,7 @@ SCM_DEFINE (scm_unread_string, "unread-string", 2, 0, 0,
   else
     SCM_VALIDATE_OPINPORT (2, port);
 
-  scm_ungets (SCM_I_STRING_CHARS (str), SCM_I_STRING_LENGTH (str), port);
+  scm_ungets (scm_i_string_chars (str), scm_i_string_length (str), port);
   
   return str;
 }
diff --git a/libguile/print.c b/libguile/print.c
index 0b69ebd0e..6c975d45a 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -484,12 +484,15 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 	case scm_tc7_string:
 	  if (SCM_WRITINGP (pstate))
 	    {
-	      size_t i;
+	      size_t i, len;
+	      const char *data;
 
 	      scm_putc ('"', port);
-	      for (i = 0; i < SCM_I_STRING_LENGTH (exp); ++i)
+	      len = scm_i_string_length (exp);
+	      data = scm_i_string_chars (exp);
+	      for (i = 0; i < len; ++i)
 		{
-		  unsigned char ch = SCM_I_STRING_CHARS (exp)[i];
+		  unsigned char ch = data[i];
 		  if ((ch < 32 && ch != '\n') || (127 <= ch && ch < 148))
 		    {
 		      static char const hex[]="0123456789abcdef";
@@ -506,9 +509,10 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 		    }
 		}
 	      scm_putc ('"', port);
+	      scm_remember_upto_here_1 (exp);
 	    }
 	  else
-	    scm_lfwrite (SCM_I_STRING_CHARS (exp), SCM_I_STRING_LENGTH (exp),
+	    scm_lfwrite (scm_i_string_chars (exp), scm_i_string_length (exp),
 			 port);
 	  scm_remember_upto_here_1 (exp);
 	  break;
@@ -913,9 +917,9 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
   SCM port, answer = SCM_UNSPECIFIED;
   int fReturnString = 0;
   int writingp;
-  char *start;
-  char *end;
-  char *p;
+  const char *start;
+  const char *end;
+  const char *p;
 
   if (scm_is_eq (destination, SCM_BOOL_T))
     {
@@ -938,8 +942,8 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
   SCM_VALIDATE_STRING (2, message);
   SCM_VALIDATE_REST_ARGUMENT (args);
 
-  start = SCM_I_STRING_CHARS (message);
-  end = start + SCM_I_STRING_LENGTH (message);
+  start = scm_i_string_chars (message);
+  end = start + scm_i_string_length (message);
   for (p = start; p != end; ++p)
     if (*p == '~')
       {
diff --git a/libguile/ramap.c b/libguile/ramap.c
index 49ec40f11..a57b4ba8b 100644
--- a/libguile/ramap.c
+++ b/libguile/ramap.c
@@ -468,8 +468,11 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
       break;
     case scm_tc7_string:
       SCM_ASRTGO (SCM_CHARP (fill), badarg2);
-      for (i = base; n--; i += inc)
-	SCM_I_STRING_CHARS (ra)[i] = SCM_CHAR (fill);
+      {
+	char *data = scm_i_string_writable_chars (ra);
+	for (i = base; n--; i += inc)
+	  data[i] = SCM_CHAR (fill);
+      }
       break;
     case scm_tc7_byvect:
       if (SCM_CHARP (fill))
@@ -630,8 +633,12 @@ racp (SCM src, SCM dst)
     case scm_tc7_string:
       if (SCM_TYP7 (src) != scm_tc7_string)
 	goto gencase;
-      for (; n-- > 0; i_s += inc_s, i_d += inc_d)
-	SCM_I_STRING_CHARS (dst)[i_d] = SCM_I_STRING_CHARS (src)[i_s];
+      {
+	char *dst_data = scm_i_string_writable_chars (dst);
+	const char *src_data = scm_i_string_chars (src);
+	for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+	  dst_data[i_d] = src_data[i_s];
+      }
       break;
     case scm_tc7_byvect:
       if (SCM_TYP7 (src) != scm_tc7_byvect)
@@ -1791,8 +1798,8 @@ raeql_1 (SCM ra0, SCM as_equal, SCM ra1)
       return 1;
     case scm_tc7_string:
       {
-	char *v0 = SCM_I_STRING_CHARS (ra0) + i0;
-	char *v1 = SCM_I_STRING_CHARS (ra1) + i1;
+	const char *v0 = scm_i_string_chars (ra0) + i0;
+	const char *v1 = scm_i_string_chars (ra1) + i1;
 	for (; n--; v0 += inc0, v1 += inc1)
 	  if (*v0 != *v1)
 	    return 0;
diff --git a/libguile/random.c b/libguile/random.c
index bb8d48355..0375f6b65 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -119,7 +119,7 @@ scm_i_uniform32 (scm_t_i_rstate *state)
 #endif
 
 void
-scm_i_init_rstate (scm_t_i_rstate *state, char *seed, int n)
+scm_i_init_rstate (scm_t_i_rstate *state, const char *seed, int n)
 {
   scm_t_int32 w = 0L;
   scm_t_int32 c = 0L;
@@ -153,7 +153,7 @@ scm_i_copy_rstate (scm_t_i_rstate *state)
  */
 
 scm_t_rstate *
-scm_c_make_rstate (char *seed, int n)
+scm_c_make_rstate (const char *seed, int n)
 {
   scm_t_rstate *state = scm_malloc (scm_the_rng.rstate_size);
   if (state == 0)
@@ -387,8 +387,8 @@ SCM_DEFINE (scm_seed_to_random_state, "seed->random-state", 1, 0, 0,
   if (SCM_NUMBERP (seed))
     seed = scm_number_to_string (seed, SCM_UNDEFINED);
   SCM_VALIDATE_STRING (1, seed);
-  res = make_rstate (scm_c_make_rstate (SCM_I_STRING_CHARS (seed),
-					SCM_I_STRING_LENGTH (seed)));
+  res = make_rstate (scm_c_make_rstate (scm_i_string_chars (seed),
+					scm_i_string_length (seed)));
   scm_remember_upto_here_1 (seed);
   return res;
   
diff --git a/libguile/random.h b/libguile/random.h
index 8620c3738..ff0b08c6f 100644
--- a/libguile/random.h
+++ b/libguile/random.h
@@ -46,7 +46,7 @@ typedef struct scm_t_rstate {
 typedef struct scm_t_rng {
   size_t rstate_size;				    /* size of random state */
   unsigned long (*random_bits) (scm_t_rstate *state); /* gives 32 random bits */
-  void (*init_rstate) (scm_t_rstate *state, char *seed, int n);
+  void (*init_rstate) (scm_t_rstate *state, const char *seed, int n);
   scm_t_rstate *(*copy_rstate) (scm_t_rstate *state);
 } scm_t_rng;
 
@@ -63,14 +63,14 @@ typedef struct scm_t_i_rstate {
 } scm_t_i_rstate;
 
 SCM_API unsigned long scm_i_uniform32 (scm_t_i_rstate *);
-SCM_API void scm_i_init_rstate (scm_t_i_rstate *, char *seed, int n);
+SCM_API void scm_i_init_rstate (scm_t_i_rstate *, const char *seed, int n);
 SCM_API scm_t_i_rstate *scm_i_copy_rstate (scm_t_i_rstate *);
 
 
 /*
  * Random number library functions
  */
-SCM_API scm_t_rstate *scm_c_make_rstate (char *, int);
+SCM_API scm_t_rstate *scm_c_make_rstate (const char *, int);
 SCM_API scm_t_rstate *scm_c_default_rstate (void);
 #define scm_c_uniform32(RSTATE) scm_the_rng.random_bits (RSTATE)
 SCM_API double scm_c_uniform01 (scm_t_rstate *);
diff --git a/libguile/rdelim.c b/libguile/rdelim.c
index 3967a1d72..02e0c907b 100644
--- a/libguile/rdelim.c
+++ b/libguile/rdelim.c
@@ -60,16 +60,16 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
   size_t cstart;
   size_t cend;
   int c;
-  char *cdelims;
+  const char *cdelims;
   size_t num_delims;
 
   SCM_VALIDATE_STRING (1, delims);
-  cdelims = SCM_I_STRING_CHARS (delims);
-  num_delims = SCM_I_STRING_LENGTH (delims);
+  cdelims = scm_i_string_chars (delims);
+  num_delims = scm_i_string_length (delims);
 
   SCM_VALIDATE_STRING (2, str);
-  buf = SCM_I_STRING_CHARS (str);
-  scm_i_get_substring_spec (SCM_I_STRING_LENGTH (str),
+  buf = scm_i_string_writable_chars (str);
+  scm_i_get_substring_spec (scm_i_string_length (str),
 			    start, &cstart, end, &cend);
 
   if (SCM_UNBNDP (port))
diff --git a/libguile/read.c b/libguile/read.c
index fc973dcd2..d33ed861b 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -151,15 +151,17 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0,
 char *
 scm_grow_tok_buf (SCM *tok_buf)
 {
-  size_t oldlen = SCM_I_STRING_LENGTH (*tok_buf);
-  SCM newstr = scm_allocate_string (2 * oldlen);
+  size_t oldlen = scm_i_string_length (*tok_buf);
+  const char *olddata = scm_i_string_chars (*tok_buf);
+  char *newdata;
+  SCM newstr = scm_c_make_string (2 * oldlen, &newdata);
   size_t i;
 
   for (i = 0; i != oldlen; ++i)
-    SCM_I_STRING_CHARS (newstr) [i] = SCM_I_STRING_CHARS (*tok_buf) [i];
+    newdata[i] = olddata[i];
 
   *tok_buf = newstr;
-  return SCM_I_STRING_CHARS (newstr);
+  return newdata;
 }
 
 
@@ -437,7 +439,8 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
 #if SCM_HAVE_ARRAYS
 	case '*':
 	  j = scm_read_token (c, tok_buf, port, 0);
-	  p = scm_istr2bve (SCM_I_STRING_CHARS (*tok_buf) + 1, (long) (j - 1));
+	  p = scm_istr2bve (scm_i_string_writable_chars (*tok_buf) + 1,
+			    (long) (j - 1));
 	  if (scm_is_true (p))
 	    return p;
 	  else
@@ -446,7 +449,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
 
 	case '{':
 	  j = scm_read_token (c, tok_buf, port, 1);
-	  return scm_mem2symbol (SCM_I_STRING_CHARS (*tok_buf), j);
+	  return scm_mem2symbol (scm_i_string_chars (*tok_buf), j);
 
 	case '\\':
 	  c = scm_getc (port);
@@ -460,20 +463,21 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
 	       * does only consist of octal digits.  Finally, it should be
 	       * checked whether the resulting fixnum is in the range of
 	       * characters.  */
-	      p = scm_i_mem2number (SCM_I_STRING_CHARS (*tok_buf), j, 8);
+	      p = scm_i_mem2number (scm_i_string_chars (*tok_buf), j, 8);
 	      if (SCM_I_INUMP (p))
 		return SCM_MAKE_CHAR (SCM_I_INUM (p));
 	    }
 	  for (c = 0; c < scm_n_charnames; c++)
 	    if (scm_charnames[c]
-		&& (scm_casei_streq (scm_charnames[c], SCM_I_STRING_CHARS (*tok_buf))))
+		&& (scm_casei_streq (scm_charnames[c],
+				     scm_i_string_writable_chars (*tok_buf))))
 	      return SCM_MAKE_CHAR (scm_charnums[c]);
 	  scm_input_error (FUNC_NAME, port, "unknown # object", SCM_EOL);
 
 	  /* #:SYMBOL is a syntax for keywords supported in all contexts.  */
 	case ':':
 	  j = scm_read_token ('-', tok_buf, port, 0);
-	  p = scm_mem2symbol (SCM_I_STRING_CHARS (*tok_buf), j);
+	  p = scm_mem2symbol (scm_i_string_chars (*tok_buf), j);
 	  return scm_make_keyword_from_dash_symbol (p);
 
 	default:
@@ -509,7 +513,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
 	  if (c == EOF)
 	    str_eof: scm_input_error (FUNC_NAME, port, "end of file in string constant", SCM_EOL);
 
-	  while (j + 2 >= SCM_I_STRING_LENGTH (*tok_buf))
+	  while (j + 2 >= scm_i_string_length (*tok_buf))
 	    scm_grow_tok_buf (tok_buf);
 
 	  if (c == '\\')
@@ -574,13 +578,13 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
 				"illegal character in escape sequence: ~S",
 				scm_list_1 (SCM_MAKE_CHAR (c)));
 	      }
-	  SCM_I_STRING_CHARS (*tok_buf)[j] = c;
+	  scm_i_string_writable_chars (*tok_buf)[j] = c;
 	  ++j;
 	}
       if (j == 0)
 	return scm_nullstr;
-      SCM_I_STRING_CHARS (*tok_buf)[j] = 0;
-      return scm_mem2string (SCM_I_STRING_CHARS (*tok_buf), j);
+      scm_i_string_writable_chars (*tok_buf)[j] = 0;
+      return scm_mem2string (scm_i_string_chars (*tok_buf), j);
 
     case '0': case '1': case '2': case '3': case '4':
     case '5': case '6': case '7': case '8': case '9':
@@ -593,7 +597,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
 	/* Shortcut:  Detected symbol '+ or '- */
 	goto tok;
 
-      p = scm_i_mem2number (SCM_I_STRING_CHARS (*tok_buf), j, 10);
+      p = scm_i_mem2number (scm_i_string_chars (*tok_buf), j, 10);
       if (scm_is_true (p))
 	return p;
       if (c == '#')
@@ -601,7 +605,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
 	  if ((j == 2) && (scm_getc (port) == '('))
 	    {
 	      scm_ungetc ('(', port);
-	      c = SCM_I_STRING_CHARS (*tok_buf)[1];
+	      c = scm_i_string_chars (*tok_buf)[1];
 	      goto callshrp;
 	    }
 	  scm_input_error (FUNC_NAME, port, "unknown # object", SCM_EOL);
@@ -612,7 +616,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
       if (scm_is_eq (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_prefix))
 	{
 	  j = scm_read_token ('-', tok_buf, port, 0);
-	  p = scm_mem2symbol (SCM_I_STRING_CHARS (*tok_buf), j);
+	  p = scm_mem2symbol (scm_i_string_chars (*tok_buf), j);
 	  return scm_make_keyword_from_dash_symbol (p);
 	}
       /* fallthrough */
@@ -624,7 +628,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
       /* fallthrough */
 
     tok:
-      return scm_mem2symbol (SCM_I_STRING_CHARS (*tok_buf), j);
+      return scm_mem2symbol (scm_i_string_chars (*tok_buf), j);
     }
 }
 #undef FUNC_NAME
@@ -642,14 +646,14 @@ scm_read_token (int ic, SCM *tok_buf, SCM port, int weird)
   register char *p;
 
   c = (SCM_CASE_INSENSITIVE_P ? scm_c_downcase(ic) : ic);
-  p = SCM_I_STRING_CHARS (*tok_buf);
+  p = scm_i_string_writable_chars (*tok_buf);
 
   if (weird)
     j = 0;
   else
     {
       j = 0;
-      while (j + 2 >= SCM_I_STRING_LENGTH (*tok_buf))
+      while (j + 2 >= scm_i_string_length (*tok_buf))
 	p = scm_grow_tok_buf (tok_buf);
       p[j] = c;
       ++j;
@@ -657,7 +661,7 @@ scm_read_token (int ic, SCM *tok_buf, SCM port, int weird)
 
   while (1)
     {
-      while (j + 2 >= SCM_I_STRING_LENGTH (*tok_buf))
+      while (j + 2 >= scm_i_string_length (*tok_buf))
 	p = scm_grow_tok_buf (tok_buf);
       c = scm_getc (port);
       switch (c)
diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c
index a79fde6c6..9587dfa0e 100644
--- a/libguile/regex-posix.c
+++ b/libguile/regex-posix.c
@@ -82,32 +82,21 @@ regex_free (SCM obj)
 
 SCM_SYMBOL (scm_regexp_error_key, "regular-expression-syntax");
 
-static char *
+static SCM
 scm_regexp_error_msg (int regerrno, regex_t *rx)
 {
-  SCM errmsg;
+  char *errmsg;
   int l;
 
-  /* FIXME: must we wrap any external calls in SCM_DEFER_INTS...SCM_ALLOW_INTS?
-     Or are these only necessary when a SCM object may be left in an
-     undetermined state (half-formed)?  If the latter then I believe we
-     may do without the critical section code. -twp */
-
-  /* We could simply make errmsg a char pointer, and allocate space with
-     malloc.  But since we are about to pass the pointer to scm_error, which
-     never returns, we would never have the opportunity to free it.  Creating
-     it as a SCM object means that the system will GC it at some point. */
-
-  errmsg = scm_make_string (scm_from_int (80), SCM_UNDEFINED);
-  SCM_DEFER_INTS;
-  l = regerror (regerrno, rx, SCM_I_STRING_CHARS (errmsg), 80);
+  errmsg = scm_malloc (80);
+  l = regerror (regerrno, rx, errmsg, 80);
   if (l > 80)
     {
-      errmsg = scm_make_string (scm_from_int (l), SCM_UNDEFINED);
-      regerror (regerrno, rx, SCM_I_STRING_CHARS (errmsg), l);
+      free (errmsg);
+      errmsg = scm_malloc (l);
+      regerror (regerrno, rx, errmsg, l);
     }
-  SCM_ALLOW_INTS;
-  return SCM_I_STRING_CHARS (errmsg);
+  return scm_take_locale_string (errmsg);
 }
 
 SCM_DEFINE (scm_regexp_p, "regexp?", 1, 0, 0,
@@ -164,6 +153,7 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
   SCM flag;
   regex_t *rx;
   int status, cflags;
+  char *c_pat;
 
   SCM_VALIDATE_STRING (1, pat);
   SCM_VALIDATE_REST_ARGUMENT (flags);
@@ -182,19 +172,21 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
     }
 
   rx = scm_gc_malloc (sizeof(regex_t), "regex");
-  status = regcomp (rx, SCM_I_STRING_CHARS (pat),
+  c_pat = scm_to_locale_string (pat);
+  status = regcomp (rx, c_pat,
 		    /* Make sure they're not passing REG_NOSUB;
                        regexp-exec assumes we're getting match data.  */
 		    cflags & ~REG_NOSUB);
+  free (c_pat);
   if (status != 0)
     {
-      char *errmsg = scm_regexp_error_msg (status, rx);
+      SCM errmsg = scm_regexp_error_msg (status, rx);
       scm_gc_free (rx, sizeof(regex_t), "regex");
-      scm_error (scm_regexp_error_key,
-		 FUNC_NAME,
-		 errmsg,
-		 SCM_BOOL_F,
-		 SCM_BOOL_F);
+      scm_error_scm (scm_regexp_error_key,
+		     scm_from_locale_string (FUNC_NAME),
+		     errmsg,
+		     SCM_BOOL_F,
+		     SCM_BOOL_F);
       /* never returns */
     }
   SCM_RETURN_NEWSMOB (scm_tc16_regex, rx);
@@ -234,7 +226,7 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
   if (SCM_UNBNDP (start))
     offset = 0;
   else
-    offset = scm_to_signed_integer (start, 0, SCM_I_STRING_LENGTH (str));
+    offset = scm_to_signed_integer (start, 0, scm_i_string_length (str));
 
   if (SCM_UNBNDP (flags))
     flags = SCM_INUM0;
@@ -245,7 +237,7 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
   nmatches = SCM_RGX(rx)->re_nsub + 1;
   SCM_DEFER_INTS;
   matches = scm_malloc (sizeof (regmatch_t) * nmatches);
-  status = regexec (SCM_RGX (rx), SCM_I_STRING_CHARS (str) + offset,
+  status = regexec (SCM_RGX (rx), scm_i_string_chars (str) + offset,
 		    nmatches, matches,
 		    scm_to_int (flags));
   if (!status)
@@ -268,11 +260,11 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
   SCM_ALLOW_INTS;
 
   if (status != 0 && status != REG_NOMATCH)
-    scm_error (scm_regexp_error_key,
-	       FUNC_NAME,
-	       scm_regexp_error_msg (status, SCM_RGX (rx)),
-	       SCM_BOOL_F,
-	       SCM_BOOL_F);
+    scm_error_scm (scm_regexp_error_key,
+		   scm_from_locale_string (FUNC_NAME),
+		   scm_regexp_error_msg (status, SCM_RGX (rx)),
+		   SCM_BOOL_F,
+		   SCM_BOOL_F);
   return mvec;
 }
 #undef FUNC_NAME
diff --git a/libguile/rw.c b/libguile/rw.c
index 23b562d8f..6b5831865 100644
--- a/libguile/rw.c
+++ b/libguile/rw.c
@@ -111,8 +111,8 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0,
     size_t last;
 
     SCM_VALIDATE_STRING (1, str);
-    dest = SCM_I_STRING_CHARS (str);
-    scm_i_get_substring_spec (SCM_I_STRING_LENGTH (str),
+    dest = scm_i_string_writable_chars (str);
+    scm_i_get_substring_spec (scm_i_string_length (str),
 			      start, &offset, end, &last);
     dest += offset;
     read_len = last - offset;
@@ -202,7 +202,7 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0,
 	    "@end itemize")
 #define FUNC_NAME s_scm_write_string_partial
 {
-  char *src;
+  const char *src;
   long write_len;
   int fdes;
 
@@ -211,8 +211,8 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0,
     size_t last;
 
     SCM_VALIDATE_STRING (1, str);
-    src = SCM_I_STRING_CHARS (str);
-    scm_i_get_substring_spec (SCM_I_STRING_LENGTH (str),
+    src = scm_i_string_chars (str);
+    scm_i_get_substring_spec (scm_i_string_length (str),
 			      start, &offset, end, &last);
     src += offset;
     write_len = last - offset;
diff --git a/libguile/socket.c b/libguile/socket.c
index 53034f678..2aa650122 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -1134,6 +1134,8 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
   int rv;
   int fd;
   int flg;
+  char *dest;
+  size_t len;
 
   SCM_VALIDATE_OPFPORT (1, sock);
   SCM_VALIDATE_STRING (2, buf);
@@ -1143,9 +1145,9 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
     flg = scm_to_int (flags);
   fd = SCM_FPORT_FDES (sock);
 
-  SCM_SYSCALL (rv = recv (fd, 
-			  SCM_I_STRING_CHARS (buf), SCM_I_STRING_LENGTH (buf),
-			  flg));
+  dest = scm_i_string_writable_chars (buf);
+  len =  scm_i_string_length (buf);
+  SCM_SYSCALL (rv = recv (fd, dest, len, flg));
   if (rv == -1)
     SCM_SYSERROR;
 
@@ -1173,6 +1175,8 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
   int rv;
   int fd;
   int flg;
+  const char *src;
+  size_t len;
 
   sock = SCM_COERCE_OUTPORT (sock);
   SCM_VALIDATE_OPFPORT (1, sock);
@@ -1183,10 +1187,9 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
     flg = scm_to_int (flags);
   fd = SCM_FPORT_FDES (sock);
 
-  SCM_SYSCALL (rv = send (fd,
-			  SCM_I_STRING_CHARS (message),
-			  SCM_I_STRING_LENGTH (message),
-			  flg));
+  src = scm_i_string_writable_chars (message);
+  len = scm_i_string_length (message);
+  SCM_SYSCALL (rv = send (fd, src, len, flg));
   if (rv == -1)
     SCM_SYSERROR;
 
@@ -1233,8 +1236,8 @@ SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
   fd = SCM_FPORT_FDES (sock);
   
   SCM_VALIDATE_STRING (2, str);
-  buf = SCM_I_STRING_CHARS (str);
-  scm_i_get_substring_spec (SCM_I_STRING_LENGTH (str),
+  buf = scm_i_string_writable_chars (str);
+  scm_i_get_substring_spec (scm_i_string_length (str),
 			    start, &offset, end, &cend);
 
   if (SCM_UNBNDP (flags))
@@ -1301,8 +1304,8 @@ SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1,
       flg = SCM_NUM2ULONG (5, SCM_CAR (args_and_flags));
     }
   SCM_SYSCALL (rv = sendto (fd,
-			    SCM_I_STRING_CHARS (message),
-			    SCM_I_STRING_LENGTH (message),
+			    scm_i_string_chars (message),
+			    scm_i_string_length (message),
 			    flg, soka, size));
   if (rv == -1)
     {
diff --git a/libguile/stime.c b/libguile/stime.c
index f08ae28b5..6f70051b8 100644
--- a/libguile/stime.c
+++ b/libguile/stime.c
@@ -32,6 +32,7 @@
 #include "libguile/feature.h"
 #include "libguile/strings.h"
 #include "libguile/vectors.h"
+#include "libguile/dynwind.h"
 
 #include "libguile/validate.h"
 #include "libguile/stime.h"
@@ -480,7 +481,7 @@ bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
   if (scm_is_false (velts[10]))
     lt->tm_zone = NULL;
   else
-    lt->tm_zone  = SCM_STRING_CHARS (velts[10]);
+    lt->tm_zone  = scm_to_locale_string (velts[10]);
 #endif
 }
 
@@ -503,7 +504,10 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0,
   char **oldenv;
   int err;
 
+  scm_frame_begin (0);
+
   bdtime2c (sbd_time, &lt, SCM_ARG1, FUNC_NAME);
+  scm_frame_free ((char *)lt.tm_zone);
 
   SCM_DEFER_INTS;
   oldenv = setzone (zone, SCM_ARG2, FUNC_NAME);
@@ -560,6 +564,8 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0,
   SCM_ALLOW_INTS;
   if (zname)
     free (zname);
+
+  scm_frame_end ();
   return result;
 }
 #undef FUNC_NAME
@@ -594,15 +600,16 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
 
   char *tbuf;
   int size = 50;
-  char *fmt, *myfmt;
+  const char *fmt;
+  char *myfmt;
   int len;
   SCM result;
 
   SCM_VALIDATE_STRING (1, format);
   bdtime2c (stime, &t, SCM_ARG2, FUNC_NAME);
 
-  fmt = SCM_STRING_CHARS (format);
-  len = SCM_STRING_LENGTH (format);
+  fmt = scm_i_string_chars (format);
+  len = scm_i_string_length (format);
 
   /* Ugly hack: strftime can return 0 if its buffer is too small,
      but some valid time strings (e.g. "%p") can sometimes produce
@@ -688,13 +695,13 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
 #define FUNC_NAME s_scm_strptime
 {
   struct tm t;
-  char *fmt, *str, *rest;
+  const char *fmt, *str, *rest;
 
   SCM_VALIDATE_STRING (1, format);
   SCM_VALIDATE_STRING (2, string);
 
-  fmt = SCM_STRING_CHARS (format);
-  str = SCM_STRING_CHARS (string);
+  fmt = scm_i_string_chars (format);
+  str = scm_i_string_chars (string);
 
   /* initialize the struct tm */
 #define tm_init(field) t.field = 0
diff --git a/libguile/strings.c b/libguile/strings.c
index 0e15f7222..bfa3d3616 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -19,6 +19,7 @@
 
 
 #include <string.h>
+#include <stdio.h>
 
 #include "libguile/_scm.h"
 #include "libguile/chars.h"
@@ -33,12 +34,212 @@
 /* {Strings}
  */
 
+/* Stringbufs 
+ */
+
+#define STRINGBUF_TAG           scm_tc7_stringbuf
+#define STRINGBUF_REFCOUNT(buf) ((size_t)(SCM_CELL_WORD_3 (buf)))
+#define STRINGBUF_CHARS(buf)    ((char *)SCM_CELL_WORD_1(buf))
+#define STRINGBUF_LENGTH(buf)   (SCM_CELL_WORD_2(buf))
+
+#define SET_STRINGBUF_REFCOUNT(buf,rc)\
+         (SCM_SET_CELL_WORD_3 ((buf), (scm_t_bits)rc))
+
+static SCM
+make_stringbuf (size_t len)
+{
+  /* XXX - for the benefit of SCM_STRING_CHARS, all stringbufs are
+     null-terminated.  Once SCM_STRING_CHARS is removed, this
+     null-termination can be dropped.
+  */
+
+  char *mem = scm_gc_malloc (len+1, "string");
+  mem[len] = '\0';
+  return scm_double_cell (STRINGBUF_TAG, (scm_t_bits) mem,
+			  (scm_t_bits) len, (scm_t_bits) 1);
+}
+
+SCM
+scm_i_stringbuf_mark (SCM buf)
+{
+  return SCM_BOOL_F;
+}
+
+void
+scm_i_stringbuf_free (SCM buf)
+{
+  //  fprintf (stderr, "freeing buf %p\n", buf);
+  scm_gc_free (STRINGBUF_CHARS (buf), STRINGBUF_LENGTH (buf) + 1, "string");
+}
+
+SCM_MUTEX (stringbuf_refcount_mutex);
+
+static void
+stringbuf_ref (SCM buf)
+{
+  scm_mutex_lock (&stringbuf_refcount_mutex);
+  SET_STRINGBUF_REFCOUNT (buf, STRINGBUF_REFCOUNT (buf) + 1);
+  scm_mutex_unlock (&stringbuf_refcount_mutex);
+}
+
+/* Copy-on-write strings.
+ */
+
+#define STRING_TAG            scm_tc7_string
+
+#define STRING_STRINGBUF(str) (SCM_CELL_OBJECT_1(str))
+#define STRING_START(str)     ((size_t)SCM_CELL_WORD_2(str))
+#define STRING_LENGTH(str)    ((size_t)SCM_CELL_WORD_3(str))
+
+#define SET_STRING_STRINGBUF(str,buf) (SCM_SET_CELL_OBJECT_1(str,buf))
+#define SET_STRING_START(str,start) (SCM_SET_CELL_WORD_2(str,start))
+
+#define IS_STRING(str)        (SCM_NIMP(str) && SCM_TYP7(str) == STRING_TAG)
+
+SCM
+scm_c_make_string (size_t len, char **charsp)
+{
+  SCM buf = make_stringbuf (len);
+  if (charsp)
+    *charsp = STRINGBUF_CHARS (buf);
+  return scm_double_cell (STRING_TAG, SCM_UNPACK(buf),
+			  (scm_t_bits)0, (scm_t_bits) len);
+}
+
+SCM
+scm_c_substring (SCM str, size_t start, size_t end)
+{
+  size_t len = end - start;
+  SCM buf = STRING_STRINGBUF (str);
+  stringbuf_ref (buf);
+  return scm_double_cell (STRING_TAG, SCM_UNPACK(buf),
+			  (scm_t_bits)start, (scm_t_bits) len);
+}
+
+SCM
+scm_c_substring_copy (SCM str, size_t start, size_t end)
+{
+  size_t len = end - start;
+  SCM buf = STRING_STRINGBUF (str);
+  SCM my_buf = make_stringbuf (len);
+  memcpy (STRINGBUF_CHARS (my_buf), STRINGBUF_CHARS (buf) + start, len);
+  return scm_double_cell (STRING_TAG, SCM_UNPACK(my_buf),
+			  (scm_t_bits)0, (scm_t_bits) len);
+}
+
+/* Mutation-sharing substrings
+ */
+
+#define SH_STRING_TAG       (scm_tc7_string + 0x100)
+
+#define SH_STRING_STRING(sh) (SCM_CELL_OBJECT_1(sh))
+/* START and LENGTH as for STRINGs. */
+
+#define IS_SH_STRING(str)   (SCM_CELL_TYPE(str)==SH_STRING_TAG)
+
+SCM
+scm_c_substring_shared (SCM str, size_t start, size_t end)
+{
+  size_t len = end - start;
+  return scm_double_cell (SH_STRING_TAG, SCM_UNPACK(str),
+			  (scm_t_bits)start, (scm_t_bits) len);
+}
+
+SCM
+scm_i_string_mark (SCM str)
+{
+  if (IS_SH_STRING (str))
+    return SH_STRING_STRING (str);
+  else
+    return STRING_STRINGBUF (str);
+}
+
+void
+scm_i_string_free (SCM str)
+{
+  /* The refcount of a stringbuf is stored in its fourth word, so even
+     if the stringbuf of this string has already been swept, we can
+     safely decrement its refcount.
+  */
+  if (!IS_SH_STRING (str))
+    {
+#if 0
+      SCM buf = STRING_STRINGBUF (str);
+      SET_STRINGBUF_REFCOUNT (buf, STRINGBUF_REFCOUNT (buf) - 1);
+#endif
+    }
+}
+
+
+/* Internal accessors
+ */
+
+size_t
+scm_i_string_length (SCM str)
+{
+  return STRING_LENGTH (str);
+}
+
+const char *
+scm_i_string_chars (SCM str)
+{
+  size_t start = STRING_START(str);
+  if (IS_SH_STRING (str))
+    {
+      str = SH_STRING_STRING (str);
+      start += STRING_START (str);
+    }
+  return STRINGBUF_CHARS (STRING_STRINGBUF (str)) + start;
+}
+
+char *
+scm_i_string_writable_chars (SCM str)
+{
+  SCM buf;
+  size_t start = STRING_START(str);
+  if (IS_SH_STRING (str))
+    {
+      str = SH_STRING_STRING (str);
+      start += STRING_START (str);
+    }
+  buf = STRING_STRINGBUF (str);
+  scm_mutex_lock (&stringbuf_refcount_mutex);
+  if (STRINGBUF_REFCOUNT (buf) > 1)
+    {
+      /* Clone stringbuf.  For this, we put all threads to sleep.
+       */
+      size_t len = STRING_LENGTH (str);
+      SCM new_buf;
+
+      SET_STRINGBUF_REFCOUNT (buf, STRINGBUF_REFCOUNT (buf) - 1);
+      scm_mutex_unlock (&stringbuf_refcount_mutex);
+      new_buf = make_stringbuf (len);
+      memcpy (STRINGBUF_CHARS (new_buf),
+	      STRINGBUF_CHARS (buf) + STRING_START (str), len);
+
+      fprintf (stderr, "cloned %p to %p\n", buf, new_buf);
+      buf = new_buf;
+
+      scm_i_thread_put_to_sleep ();
+      SET_STRING_STRINGBUF (str, buf);
+      start -= STRING_START (str);
+      SET_STRING_START (str, 0);
+      scm_i_thread_wake_up ();
+    }
+  else
+    scm_mutex_unlock (&stringbuf_refcount_mutex);
+
+  return STRINGBUF_CHARS (buf) + start;
+}
+
+
+
 SCM_DEFINE (scm_string_p, "string?", 1, 0, 0, 
 	    (SCM obj),
 	    "Return @code{#t} if @var{obj} is a string, else @code{#f}.")
 #define FUNC_NAME s_scm_string_p
 {
-  return scm_from_bool (SCM_I_STRINGP (obj));
+  return scm_from_bool (IS_STRING (obj));
 }
 #undef FUNC_NAME
 
@@ -53,26 +254,31 @@ SCM_DEFINE (scm_string, "string", 0, 0, 1,
 #define FUNC_NAME s_scm_string
 {
   SCM result;
+  size_t len;
+  char *data;
 
   {
     long i = scm_ilength (chrs);
 
     SCM_ASSERT (i >= 0, chrs, SCM_ARG1, FUNC_NAME);
-    result = scm_allocate_string (i);
+    len = i;
   }
 
-  {
-    unsigned char *data = SCM_I_STRING_UCHARS (result);
+  result = scm_c_make_string (len, &data);
+  while (len > 0 && SCM_CONSP (chrs))
+    {
+      SCM elt = SCM_CAR (chrs);
 
-    while (!SCM_NULLP (chrs))
-      {
-	SCM elt = SCM_CAR (chrs);
+      SCM_VALIDATE_CHAR (SCM_ARGn, elt);
+      *data++ = SCM_CHAR (elt);
+      chrs = SCM_CDR (chrs);
+      len--;
+    }
+  if (len > 0)
+    scm_misc_error (NULL, "list changed while constructing string", SCM_EOL);
+  if (!SCM_NULLP (chrs))
+    scm_wrong_type_arg_msg (NULL, 0, chrs, "proper list");
 
-	SCM_VALIDATE_CHAR (SCM_ARGn, elt);
-	*data++ = SCM_CHAR (elt);
-	chrs = SCM_CDR (chrs);
-      }
-  }
   return result;
 }
 #undef FUNC_NAME
@@ -88,7 +294,7 @@ scm_makfromstrs (int argc, char **argv)
   if (0 > i)
     for (i = 0; argv[i]; i++);
   while (i--)
-    lst = scm_cons (scm_mem2string (argv[i], strlen (argv[i])), lst);
+    lst = scm_cons (scm_from_locale_string (argv[i]), lst);
   return lst;
 }
 
@@ -105,13 +311,8 @@ SCM
 scm_take_str (char *s, size_t len)
 #define FUNC_NAME "scm_take_str"
 {
-  SCM answer;
-
-  SCM_ASSERT_RANGE (2, scm_from_ulong (len), len <= SCM_STRING_MAX_LENGTH);
-
-  answer = scm_cell (SCM_I_MAKE_STRING_TAG (len), (scm_t_bits) s);
-  scm_gc_register_collectable_memory (s, len+1, "string");
-
+  SCM answer = scm_from_locale_stringn (s, len);
+  free (s);
   return answer;
 }
 #undef FUNC_NAME
@@ -158,17 +359,7 @@ SCM
 scm_allocate_string (size_t len)
 #define FUNC_NAME "scm_allocate_string"
 {
-  char *mem;
-  SCM s;
-
-  SCM_ASSERT_RANGE (1, scm_from_size_t (len), len <= SCM_STRING_MAX_LENGTH);
-
-  mem = (char *) scm_gc_malloc (len + 1, "string");
-  mem[len] = 0;
-
-  s = scm_cell (SCM_I_MAKE_STRING_TAG (len), (scm_t_bits) mem);
-
-  return s;
+  return scm_c_make_string (len, NULL);
 }
 #undef FUNC_NAME
 
@@ -181,16 +372,13 @@ SCM_DEFINE (scm_make_string, "make-string", 1, 1, 0,
 	    "of the @var{string} are unspecified.")
 #define FUNC_NAME s_scm_make_string
 {
-  size_t i = scm_to_unsigned_integer (k, 0, SCM_STRING_MAX_LENGTH);
-  SCM res = scm_allocate_string (i);
+  size_t i = scm_to_size_t (k);
+  char *dst;
+  SCM res = scm_c_make_string (i, &dst);
 
   if (!SCM_UNBNDP (chr))
     {
-      unsigned char *dst;
-      
       SCM_VALIDATE_CHAR (2, chr);
-      
-      dst = SCM_I_STRING_UCHARS (res);
       memset (dst, SCM_CHAR (chr), i);
     }
 
@@ -205,7 +393,7 @@ SCM_DEFINE (scm_string_length, "string-length", 1, 0, 0,
 #define FUNC_NAME s_scm_string_length
 {
   SCM_VALIDATE_STRING (1, string);
-  return scm_from_size_t (SCM_I_STRING_LENGTH (string));
+  return scm_from_size_t (STRING_LENGTH (string));
 }
 #undef FUNC_NAME
 
@@ -218,11 +406,18 @@ SCM_DEFINE (scm_string_ref, "string-ref", 2, 0, 0,
   unsigned long idx;
 
   SCM_VALIDATE_STRING (1, str);
-  idx = scm_to_unsigned_integer (k, 0, SCM_I_STRING_LENGTH(str)-1);
-  return SCM_MAKE_CHAR (SCM_I_STRING_UCHARS (str)[idx]);
+  idx = scm_to_unsigned_integer (k, 0, scm_i_string_length (str)-1);
+  return SCM_MAKE_CHAR (scm_i_string_chars (str)[idx]);
 }
 #undef FUNC_NAME
 
+SCM
+scm_c_string_ref (SCM str, size_t p)
+{
+  if (p >= scm_i_string_length (str))
+    scm_out_of_range (NULL, scm_from_size_t (p));
+  return SCM_MAKE_CHAR (scm_i_string_chars (str)[p]);
+}
 
 SCM_DEFINE (scm_string_set_x, "string-set!", 3, 0, 0,
             (SCM str, SCM k, SCM chr),
@@ -234,13 +429,27 @@ SCM_DEFINE (scm_string_set_x, "string-set!", 3, 0, 0,
   unsigned long idx;
 
   SCM_VALIDATE_STRING (1, str);
-  idx = scm_to_unsigned_integer (k, 0, SCM_I_STRING_LENGTH(str)-1);
+  idx = scm_to_unsigned_integer (k, 0, scm_i_string_length(str)-1);
   SCM_VALIDATE_CHAR (3, chr);
-  SCM_I_STRING_UCHARS (str)[idx] = SCM_CHAR (chr);
+  {
+    char *dst = scm_i_string_writable_chars (str);
+    dst[idx] = SCM_CHAR (chr);
+  }
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
+SCM
+scm_c_string_set_x (SCM str, size_t p, SCM chr)
+{
+  if (p >= scm_i_string_length (str))
+    scm_out_of_range (NULL, scm_from_size_t (p));
+  {
+    char *dst = scm_i_string_writable_chars (str);
+    dst[p] = SCM_CHAR (chr);
+  }
+  return SCM_UNSPECIFIED;
+}
 
 SCM_DEFINE (scm_substring, "substring", 2, 1, 0,
 	    (SCM str, SCM start, SCM end),
@@ -252,24 +461,64 @@ SCM_DEFINE (scm_substring, "substring", 2, 1, 0,
             "0 <= @var{start} <= @var{end} <= (string-length @var{str}).")
 #define FUNC_NAME s_scm_substring
 {
-  unsigned long int from;
-  unsigned long int to;
-  SCM substr;
+  size_t len, from, to;
 
   SCM_VALIDATE_STRING (1, str);
-  from = scm_to_unsigned_integer (start, 0, SCM_I_STRING_LENGTH(str));
+  len = scm_i_string_length (str);
+  from = scm_to_unsigned_integer (start, 0, len);
   if (SCM_UNBNDP (end))
-    to = SCM_I_STRING_LENGTH(str);
+    to = len;
   else
-    to = scm_to_unsigned_integer (end, from, SCM_I_STRING_LENGTH(str));
-  substr = scm_allocate_string (to - from);
-  memcpy (SCM_I_STRING_CHARS (substr), SCM_I_STRING_CHARS (str) + from,
-	  to - from);
-  scm_remember_upto_here_1 (str);
-  return substr;
+    to = scm_to_unsigned_integer (end, from, len);
+  return scm_c_substring (str, from, to);
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_substring_copy, "substring/copy", 2, 1, 0,
+	    (SCM str, SCM start, SCM end),
+	    "Return a newly allocated string formed from the characters\n"
+            "of @var{str} beginning with index @var{start} (inclusive) and\n"
+	    "ending with index @var{end} (exclusive).\n"
+            "@var{str} must be a string, @var{start} and @var{end} must be\n"
+	    "exact integers satisfying:\n\n"
+            "0 <= @var{start} <= @var{end} <= (string-length @var{str}).")
+#define FUNC_NAME s_scm_substring_copy
+{
+  size_t len, from, to;
+
+  SCM_VALIDATE_STRING (1, str);
+  len = scm_i_string_length (str);
+  from = scm_to_unsigned_integer (start, 0, len);
+  if (SCM_UNBNDP (end))
+    to = len;
+  else
+    to = scm_to_unsigned_integer (end, from, len);
+  return scm_c_substring_copy (str, from, to);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_substring_shared, "substring/shared", 2, 1, 0,
+	    (SCM str, SCM start, SCM end),
+	    "Return string that indirectly refers to the characters\n"
+            "of @var{str} beginning with index @var{start} (inclusive) and\n"
+	    "ending with index @var{end} (exclusive).\n"
+            "@var{str} must be a string, @var{start} and @var{end} must be\n"
+	    "exact integers satisfying:\n\n"
+            "0 <= @var{start} <= @var{end} <= (string-length @var{str}).")
+#define FUNC_NAME s_scm_substring_shared
+{
+  size_t len, from, to;
+
+  SCM_VALIDATE_STRING (1, str);
+  len = scm_i_string_length (str);
+  from = scm_to_unsigned_integer (start, 0, len);
+  if (SCM_UNBNDP (end))
+    to = len;
+  else
+    to = scm_to_unsigned_integer (end, from, len);
+  return scm_c_substring_shared (str, from, to);
+}
+#undef FUNC_NAME
 
 SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1, 
             (SCM args),
@@ -287,15 +536,16 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
     {
       s = SCM_CAR (l);
       SCM_VALIDATE_STRING (SCM_ARGn, s);
-      i += SCM_I_STRING_LENGTH (s);
+      i += scm_i_string_length (s);
     }
-  res = scm_allocate_string (i);
-  data = SCM_I_STRING_CHARS (res);
+  res = scm_c_make_string (i, &data);
   for (l = args; !SCM_NULLP (l); l = SCM_CDR (l)) 
     {
       s = SCM_CAR (l);
-      memcpy (data, SCM_I_STRING_CHARS (s), SCM_I_STRING_LENGTH (s));
-      data += SCM_I_STRING_LENGTH (s);
+      SCM_VALIDATE_STRING (SCM_ARGn, s);
+      size_t len = scm_i_string_length (s);
+      memcpy (data, scm_i_string_chars (s), len);
+      data += len;
       scm_remember_upto_here_1 (s);
     }
   return res;
@@ -305,7 +555,7 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
 int
 scm_is_string (SCM obj)
 {
-  return SCM_I_STRINGP (obj);
+  return IS_STRING (obj);
 }
 
 SCM
@@ -316,8 +566,7 @@ scm_from_locale_stringn (const char *str, size_t len)
 
   if (len == (size_t)-1)
     len = strlen (str);
-  res = scm_allocate_string (len);
-  dst = SCM_I_STRING_CHARS (res);
+  res = scm_c_make_string (len, &dst);
   memcpy (dst, str, len);
   return res;
 }
@@ -348,15 +597,13 @@ SCM
 scm_take_locale_string (char *str)
 {
   size_t len = strlen (str);
-  SCM res;
-
-  if (len > SCM_STRING_MAX_LENGTH)
-    {
-      free (str);
-      scm_out_of_range (NULL, scm_from_size_t (len));
-    }
+  SCM buf, res;
 
-  res = scm_cell (SCM_I_MAKE_STRING_TAG (len), (scm_t_bits) str);
+  buf = scm_double_cell (STRINGBUF_TAG, (scm_t_bits) str,
+			 (scm_t_bits) len, 0);
+  res = scm_double_cell (STRING_TAG,
+			 SCM_UNPACK (buf),
+			 (scm_t_bits) 0, (scm_t_bits) len);
   scm_gc_register_collectable_memory (str, len+1, "string");
 
   return res;
@@ -368,11 +615,11 @@ scm_to_locale_stringn (SCM str, size_t *lenp)
   char *res;
   size_t len;
 
-  if (!SCM_I_STRINGP (str))
+  if (!scm_is_string (str))
     scm_wrong_type_arg_msg (NULL, 0, str, "string");
-  len = SCM_I_STRING_LENGTH (str);
+  len = scm_i_string_length (str);
   res = scm_malloc (len + ((lenp==NULL)? 1 : 0));
-  memcpy (res, SCM_I_STRING_CHARS (str), len);
+  memcpy (res, scm_i_string_chars (str), len);
   if (lenp == NULL)
     {
       res[len] = '\0';
@@ -402,10 +649,10 @@ scm_to_locale_stringbuf (SCM str, char *buf, size_t max_len)
 {
   size_t len;
   
-  if (!SCM_I_STRINGP (str))
+  if (!scm_is_string (str))
     scm_wrong_type_arg_msg (NULL, 0, str, "string");
-  len = SCM_I_STRING_LENGTH (str);
-  memcpy (buf, SCM_I_STRING_CHARS (str), (len > max_len)? max_len : len);
+  len = scm_i_string_length (str);
+  memcpy (buf, scm_i_string_chars (str), (len > max_len)? max_len : len);
   scm_remember_upto_here_1 (str);
   return len;
 }
@@ -471,7 +718,7 @@ scm_i_get_substring_spec (size_t len,
 void
 scm_init_strings ()
 {
-  scm_nullstr = scm_allocate_string (0);
+  scm_nullstr = scm_c_make_string (0, NULL);
 
 #include "libguile/strings.x"
 }
diff --git a/libguile/strings.h b/libguile/strings.h
index 942001e07..5a27b9f54 100644
--- a/libguile/strings.h
+++ b/libguile/strings.h
@@ -26,20 +26,59 @@
 
 
 
-#define SCM_STRING_MAX_LENGTH ((SCM_T_BITS_MAX-255)/256)
+/* String representation.
 
-#define SCM_I_MAKE_STRING_TAG(l) ((((scm_t_bits) (l)) << 8) + scm_tc7_string)
-#define SCM_I_STRINGP(x) (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_string))
-#define SCM_I_STRING_UCHARS(x) ((unsigned char *) (SCM_CELL_WORD_1 (x)))
-#define SCM_I_STRING_CHARS(x)  ((char *) (SCM_CELL_WORD_1 (x)))
-#define SCM_I_STRING_LENGTH(x) ((size_t) (SCM_CELL_WORD_0 (x) >> 8))
+   A string is a piece of a stringbuf.  A stringbuf can be used by
+   more than one string.  When a string is written to and the
+   stringbuf of that string is used by more than one string, a new
+   stringbuf is created.  That is, strings are copy-on-write.  This
+   behavior can be used to make the substring operation quite
+   efficient.
 
-#define SCM_STRINGP        SCM_I_STRINGP
-#define SCM_STRING_CHARS   SCM_I_STRING_CHARS
-#define SCM_STRING_UCHARS  SCM_I_STRING_UCHARS
-#define SCM_STRING_LENGTH  SCM_I_STRING_LENGTH
+   The implementation is tuned so that mutating a string is costly,
+   but just reading it is cheap and lock-free.
+
+   There are also mutation-sharing strings.  They refer to a part of
+   an ordinary string.  Writing to a mutation-sharing string just
+   writes to the ordinary string.  Mutation-sharing strings are called
+   sh-strings in the following.
+
+
+   Low level interface to the character arrays
+
+   - Use scm_i_string_chars to get a pointer to the byte array of a
+     string or sh-string for reading.  Use scm_i_string_length to get
+     the number of bytes in that array.  The array is not
+     null-terminated.
+
+   - The array is valid as long as the corresponding SCM object is
+     protected but only until the next SCM_TICK.  During such a 'safe
+     point', strings might change their representation.
+
+   - Use scm_i_string_writable_chars to get the same pointer as with
+     scm_i_string_chars, but for reading and writing.  This is a
+     potentially costly operation since it implements the
+     copy-on-write behavior.
+
+     When a (not-sh) substring is created of the string that is being
+     written, the bahvior is undefined.  The mutations of the original
+     string might be reflected in the substring or they might not, or
+     they migh even be visible one after the other.
+
+   - Use the usual scm_substring or scm_substring_shared to create
+     strings.
 
-
+
+   Legacy interface
+
+   - SCM_STRINGP returns false for sh-strings.
+
+   - SCM_STRING_CHARS uses scm_i_string_writable_chars and immediately
+     calls scm_i_stop_writing, hoping for the best.  SCM_STRING_LENGTH
+     is the same as SCM_I_STRING_LENGTH.
+*/
+
+#define SCM_I_STRINGP scm_is_string
 
 SCM_API SCM scm_string_p (SCM x);
 SCM_API SCM scm_string (SCM chrs);
@@ -48,8 +87,17 @@ SCM_API SCM scm_string_length (SCM str);
 SCM_API SCM scm_string_ref (SCM str, SCM k);
 SCM_API SCM scm_string_set_x (SCM str, SCM k, SCM chr);
 SCM_API SCM scm_substring (SCM str, SCM start, SCM end);
+SCM_API SCM scm_substring_shared (SCM str, SCM start, SCM end);
+SCM_API SCM scm_substring_copy (SCM str, SCM start, SCM end);
 SCM_API SCM scm_string_append (SCM args);
 
+SCM_API SCM scm_c_make_string (size_t len, char **datap);
+SCM_API SCM scm_c_substring (SCM str, size_t start, size_t end);
+SCM_API SCM scm_c_substring_shared (SCM str, size_t start, size_t end);
+SCM_API SCM scm_c_substring_copy (SCM str, size_t start, size_t end);
+SCM_API SCM scm_c_string_ref (SCM str, size_t pos);
+SCM_API SCM scm_c_string_set_x (SCM str, size_t pos, SCM chr);
+
 SCM_API SCM scm_makfromstrs (int argc, char **argv);
 SCM_API SCM scm_take_str (char *s, size_t len);
 SCM_API SCM scm_take0str (char *s);
@@ -68,6 +116,17 @@ SCM_API char *scm_to_locale_string (SCM str);
 SCM_API char *scm_to_locale_stringn (SCM str, size_t *lenp);
 SCM_API size_t scm_to_locale_stringbuf (SCM str, char *buf, size_t max_len);
 
+/* internal accessor functions.  Arguments must be valid. */
+
+SCM_API size_t scm_i_string_length (SCM str);
+SCM_API const char *scm_i_string_chars (SCM str);
+SCM_API char *scm_i_string_writable_chars (SCM str);
+
+SCM_API SCM scm_i_string_mark (SCM str);
+SCM_API SCM scm_i_stringbuf_mark (SCM buf);
+SCM_API void scm_i_string_free (SCM str);
+SCM_API void scm_i_stringbuf_free (SCM buf);
+
 /* internal utility functions. */
 
 SCM_API char **scm_i_allocate_string_pointers (SCM list);
diff --git a/libguile/strop.c b/libguile/strop.c
index 1d7483d97..dfdaeb894 100644
--- a/libguile/strop.c
+++ b/libguile/strop.c
@@ -57,24 +57,24 @@ scm_i_index (SCM str, SCM chr, int direction, SCM sub_start,
   long upper;
   int ch;
 
-  SCM_ASSERT (SCM_I_STRINGP (str), str, SCM_ARG1, why);
+  SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, why);
   SCM_ASSERT (SCM_CHARP (chr), chr, SCM_ARG2, why);
 
   if (scm_is_false (sub_start))
     lower = 0;
   else
-    lower = scm_to_signed_integer (sub_start, 0, SCM_I_STRING_LENGTH(str));
+    lower = scm_to_signed_integer (sub_start, 0, scm_i_string_length(str));
 
   if (scm_is_false (sub_end))
-    upper = SCM_I_STRING_LENGTH (str);
+    upper = scm_i_string_length (str);
   else
-    upper = scm_to_signed_integer (sub_end, lower, SCM_I_STRING_LENGTH(str));
+    upper = scm_to_signed_integer (sub_end, lower, scm_i_string_length(str));
 
   x = -1;
 
   if (direction > 0)
     {
-      p = SCM_I_STRING_UCHARS (str) + lower;
+      p = (unsigned char *) scm_i_string_chars (str) + lower;
       ch = SCM_CHAR (chr);
 
       for (x = lower; x < upper; ++x, ++p)
@@ -83,7 +83,7 @@ scm_i_index (SCM str, SCM chr, int direction, SCM sub_start,
     }
   else
     {
-      p = upper - 1 + SCM_I_STRING_UCHARS (str);
+      p = upper - 1 + (unsigned char *)scm_i_string_chars (str);
       ch = SCM_CHAR (chr);
       for (x = upper - 1; x >= lower; --x, --p)
 	if (*p == ch)
@@ -164,17 +164,19 @@ SCM_DEFINE (scm_substring_move_x, "substring-move!", 5, 0, 0,
 #define FUNC_NAME s_scm_substring_move_x
 {
   unsigned long s1, s2, e, len;
+  const char *src;
+  char *dst;
 
   SCM_VALIDATE_STRING (1, str1);
   SCM_VALIDATE_STRING (4, str2);
-  s1 = scm_to_unsigned_integer (start1, 0, SCM_I_STRING_LENGTH(str1));
-  e = scm_to_unsigned_integer (end1, s1, SCM_I_STRING_LENGTH(str1));
+  s1 = scm_to_unsigned_integer (start1, 0, scm_i_string_length(str1));
+  e = scm_to_unsigned_integer (end1, s1, scm_i_string_length(str1));
   len = e - s1;
-  s2 = scm_to_unsigned_integer (start2, 0, SCM_I_STRING_LENGTH(str2)-len);
+  s2 = scm_to_unsigned_integer (start2, 0, scm_i_string_length(str2)-len);
 
-  SCM_SYSCALL(memmove((void *)(&(SCM_I_STRING_CHARS(str2)[s2])),
-		      (void *)(&(SCM_I_STRING_CHARS(str1)[s1])),
-		      len));
+  src = scm_i_string_chars (str2);
+  dst = scm_i_string_writable_chars (str1);
+  SCM_SYSCALL (memmove (dst+s2, src+s1, len));
 
   scm_remember_upto_here_2 (str1, str2);
   return SCM_UNSPECIFIED;
@@ -197,12 +199,16 @@ SCM_DEFINE (scm_substring_fill_x, "substring-fill!", 4, 0, 0,
 {
   size_t i, e;
   char c;
+  char *dst;
+
   SCM_VALIDATE_STRING (1, str);
-  i = scm_to_unsigned_integer (start, 0, SCM_I_STRING_LENGTH (str));
-  e = scm_to_unsigned_integer (end, i, SCM_I_STRING_LENGTH (str));
+  i = scm_to_unsigned_integer (start, 0, scm_i_string_length (str));
+  e = scm_to_unsigned_integer (end, i, scm_i_string_length (str));
   SCM_VALIDATE_CHAR_COPY (4, fill, c);
+  dst = scm_i_string_writable_chars (str);
   while (i<e)
-    SCM_I_STRING_CHARS (str)[i++] = c;
+    dst[i++] = c;
+  scm_remember_upto_here (str);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -220,7 +226,7 @@ SCM_DEFINE (scm_string_null_p, "string-null?", 1, 0, 0,
 #define FUNC_NAME s_scm_string_null_p
 {
   SCM_VALIDATE_STRING (1, str);
-  return scm_from_bool (SCM_I_STRING_LENGTH (str) == 0);
+  return scm_from_bool (scm_i_string_length (str) == 0);
 }
 #undef FUNC_NAME
 
@@ -235,10 +241,10 @@ SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0,
 {
   long i;
   SCM res = SCM_EOL;
-  unsigned char *src;
+  const unsigned char *src;
   SCM_VALIDATE_STRING (1, str);
-  src = SCM_I_STRING_UCHARS (str);
-  for (i = SCM_I_STRING_LENGTH (str)-1;i >= 0;i--)
+  src = scm_i_string_chars (str);
+  for (i = scm_i_string_length (str)-1;i >= 0;i--)
     res = scm_cons (SCM_MAKE_CHAR (src[i]), res);
   scm_remember_upto_here_1 (src);
   return res;
@@ -251,10 +257,11 @@ SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0,
 static SCM
 string_copy (SCM str)
 {
-  const char* chars = SCM_I_STRING_CHARS (str);
-  size_t length = SCM_I_STRING_LENGTH (str);
-  SCM new_string = scm_allocate_string (length);
-  memcpy (SCM_I_STRING_CHARS (new_string), chars, length+1);
+  const char* chars = scm_i_string_chars (str);
+  size_t length = scm_i_string_length (str);
+  char *dst;
+  SCM new_string = scm_c_make_string (length, &dst);
+  memcpy (dst, chars, length);
   scm_remember_upto_here_1 (str);
   return new_string;
 }
@@ -282,8 +289,8 @@ SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0,
   long k;
   SCM_VALIDATE_STRING (1, str);
   SCM_VALIDATE_CHAR_COPY (2, chr, c);
-  dst = SCM_I_STRING_CHARS (str);
-  for (k = SCM_I_STRING_LENGTH (str)-1;k >= 0;k--)
+  dst = scm_i_string_writable_chars (str);
+  for (k = scm_i_string_length (str)-1;k >= 0;k--)
     dst[k] = c;
   scm_remember_upto_here_1 (str);
   return SCM_UNSPECIFIED;
@@ -296,11 +303,13 @@ SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0,
 static SCM
 string_upcase_x (SCM v)
 {
-  unsigned long k;
-
-  for (k = 0; k < SCM_I_STRING_LENGTH (v); ++k)
-    SCM_I_STRING_UCHARS (v) [k] = scm_c_upcase (SCM_I_STRING_UCHARS (v) [k]);
+  size_t k, len;
+  char *dst;
 
+  dst = scm_i_string_writable_chars (v);
+  len = scm_i_string_length (v);
+  for (k = 0; k < len; ++k)
+    dst[k] = scm_c_upcase (dst[k]);
   return v;
 }
 
@@ -341,10 +350,13 @@ SCM_DEFINE (scm_string_upcase, "string-upcase", 1, 0, 0,
 static SCM
 string_downcase_x (SCM v)
 {
-  unsigned long k;
+  size_t k, len;
+  char *dst;
 
-  for (k = 0; k < SCM_I_STRING_LENGTH (v); ++k)
-    SCM_I_STRING_UCHARS (v) [k] = scm_c_downcase (SCM_I_STRING_UCHARS (v) [k]);
+  dst = scm_i_string_writable_chars (v);
+  len = scm_i_string_length (v);
+  for (k = 0; k < len; ++k)
+    dst[k] = scm_c_downcase (dst[k]);
 
   return v;
 }
@@ -387,22 +399,28 @@ static SCM
 string_capitalize_x (SCM str)
 {
   unsigned char *sz;
-  long i, len;
+  size_t i, len;
   int in_word=0;
 
-  len = SCM_I_STRING_LENGTH(str);
-  sz = SCM_I_STRING_UCHARS (str);
-  for(i=0; i<len;  i++) {
-    if (scm_is_true (scm_char_alphabetic_p (SCM_MAKE_CHAR (sz[i])))) {
-      if(!in_word) {
-        sz[i] = scm_c_upcase(sz[i]);
-        in_word = 1;
-      } else {
-        sz[i] = scm_c_downcase(sz[i]);
-      }
+  len = scm_i_string_length(str);
+  sz = scm_i_string_writable_chars (str);
+  for (i = 0; i < len; i++)
+    {
+      if (scm_is_true (scm_char_alphabetic_p (SCM_MAKE_CHAR (sz[i])))) 
+	{
+	  if (!in_word) 
+	    {
+	      sz[i] = scm_c_upcase (sz[i]);
+	      in_word = 1;
+	    } 
+	  else
+	    {
+	      sz[i] = scm_c_downcase (sz[i]);
+	    }
+	}
+      else 
+	in_word = 0;
     }
-    else in_word = 0;
-  }
   return str;
 }
 
@@ -463,15 +481,15 @@ SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0,
 #define FUNC_NAME s_scm_string_split
 {
   long idx, last_idx;
-  char * p;
+  const char * p;
   int ch;
   SCM res = SCM_EOL;
 
   SCM_VALIDATE_STRING (1, str);
   SCM_VALIDATE_CHAR (2, chr);
 
-  idx = SCM_I_STRING_LENGTH (str);
-  p = SCM_I_STRING_CHARS (str);
+  idx = scm_i_string_length (str);
+  p = scm_i_string_chars (str);
   ch = SCM_CHAR (chr);
   while (idx >= 0)
     {
@@ -480,7 +498,8 @@ SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0,
 	idx--;
       if (idx >= 0)
 	{
-	  res = scm_cons (scm_mem2string (p + idx, last_idx - idx), res);
+	  res = scm_cons (scm_c_substring (str, idx, last_idx), res);
+	  p = scm_i_string_chars (str);
 	  idx--;
 	}
     }
diff --git a/libguile/strorder.c b/libguile/strorder.c
index 6e8b647d3..3601c90bc 100644
--- a/libguile/strorder.c
+++ b/libguile/strorder.c
@@ -43,11 +43,11 @@ SCM_DEFINE1 (scm_string_equal_p, "string=?", scm_tc7_rpsubr,
   SCM_VALIDATE_STRING (1, s1);
   SCM_VALIDATE_STRING (2, s2);
 
-  length = SCM_I_STRING_LENGTH (s2);
-  if (SCM_I_STRING_LENGTH (s1) == length)
+  length = scm_i_string_length (s2);
+  if (scm_i_string_length (s1) == length)
     {
-      unsigned char *c1 = SCM_I_STRING_UCHARS (s1) + length - 1;
-      unsigned char *c2 = SCM_I_STRING_UCHARS (s2) + length - 1;
+      const unsigned char *c1 = scm_i_string_chars (s1) + length - 1;
+      const unsigned char *c2 = scm_i_string_chars (s2) + length - 1;
       size_t i;
 
       /* comparing from back to front typically finds mismatches faster */
@@ -82,11 +82,11 @@ SCM_DEFINE1 (scm_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr,
   SCM_VALIDATE_STRING (1, s1);
   SCM_VALIDATE_STRING (2, s2);
 
-  length = SCM_I_STRING_LENGTH (s2);
-  if (SCM_I_STRING_LENGTH (s1) == length)
+  length = scm_i_string_length (s2);
+  if (scm_i_string_length (s1) == length)
     {
-      unsigned char *c1 = SCM_I_STRING_UCHARS (s1) + length - 1;
-      unsigned char *c2 = SCM_I_STRING_UCHARS (s2) + length - 1;
+      const unsigned char *c1 = scm_i_string_chars (s1) + length - 1;
+      const unsigned char *c2 = scm_i_string_chars (s2) + length - 1;
       size_t i;
 
       /* comparing from back to front typically finds mismatches faster */
@@ -114,13 +114,13 @@ static SCM
 string_less_p (SCM s1, SCM s2)
 {
   size_t i, length1, length2, lengthm;
-  unsigned char *c1, *c2;
+  const unsigned char *c1, *c2;
 
-  length1 = SCM_I_STRING_LENGTH (s1);
-  length2 = SCM_I_STRING_LENGTH (s2);
+  length1 = scm_i_string_length (s1);
+  length2 = scm_i_string_length (s2);
   lengthm = min (length1, length2);
-  c1 = SCM_I_STRING_UCHARS (s1);
-  c2 = SCM_I_STRING_UCHARS (s2);
+  c1 = scm_i_string_chars (s1);
+  c2 = scm_i_string_chars (s2);
 
   for (i = 0; i != lengthm; ++i, ++c1, ++c2) {
     int c = *c1 - *c2;
@@ -196,13 +196,13 @@ static SCM
 string_ci_less_p (SCM s1, SCM s2)
 {
   size_t i, length1, length2, lengthm;
-  unsigned char *c1, *c2;
+  const unsigned char *c1, *c2;
 
-  length1 = SCM_I_STRING_LENGTH (s1);
-  length2 = SCM_I_STRING_LENGTH (s2);
+  length1 = scm_i_string_length (s1);
+  length2 = scm_i_string_length (s2);
   lengthm = min (length1, length2);
-  c1 = SCM_I_STRING_UCHARS (s1);
-  c2 = SCM_I_STRING_UCHARS (s2);
+  c1 = scm_i_string_chars (s1);
+  c2 = scm_i_string_chars (s2);
 
   for (i = 0; i != lengthm; ++i, ++c1, ++c2) {
     int c = scm_c_upcase (*c1) - scm_c_upcase (*c2);
diff --git a/libguile/strports.c b/libguile/strports.c
index aa9844bc7..12a4542bb 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -79,8 +79,10 @@ static void
 st_resize_port (scm_t_port *pt, off_t new_size)
 {
   SCM old_stream = SCM_PACK (pt->stream);
-  SCM new_stream = scm_allocate_string (new_size);
-  unsigned long int old_size = SCM_I_STRING_LENGTH (old_stream);
+  const char *src = scm_i_string_chars (old_stream);
+  char *dst;
+  SCM new_stream = scm_c_make_string (new_size, &dst);
+  unsigned long int old_size = scm_i_string_length (old_stream);
   unsigned long int min_size = min (old_size, new_size);
   unsigned long int i;
 
@@ -89,14 +91,14 @@ st_resize_port (scm_t_port *pt, off_t new_size)
   pt->write_buf_size = new_size;
 
   for (i = 0; i != min_size; ++i)
-    SCM_I_STRING_CHARS (new_stream) [i] = SCM_I_STRING_CHARS (old_stream) [i];
+    dst[i] = src[i];
 
   scm_remember_upto_here_1 (old_stream);
 
   /* reset buffer. */
   {
     pt->stream = SCM_UNPACK (new_stream);
-    pt->read_buf = pt->write_buf = SCM_I_STRING_UCHARS (new_stream);
+    pt->read_buf = pt->write_buf = dst;
     pt->read_pos = pt->write_pos = pt->write_buf + index;
     pt->write_end = pt->write_buf + pt->write_buf_size;
     pt->read_end = pt->read_buf + pt->read_buf_size;
@@ -254,8 +256,8 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
   scm_t_port *pt;
   size_t str_len, c_pos;
 
-  SCM_ASSERT (SCM_I_STRINGP (str), str, SCM_ARG1, caller);
-  str_len = SCM_I_STRING_LENGTH (str);
+  SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller);
+  str_len = scm_i_string_length (str);
   c_pos = scm_to_unsigned_integer (pos, 0, str_len);
 
   if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
@@ -266,7 +268,7 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
   pt = SCM_PTAB_ENTRY(z);
   SCM_SETSTREAM (z, SCM_UNPACK (str));
   SCM_SET_CELL_TYPE(z, scm_tc16_strport|modes);
-  pt->write_buf = pt->read_buf = SCM_I_STRING_UCHARS (str);
+  pt->write_buf = pt->read_buf = scm_i_string_writable_chars (str);
   pt->read_pos = pt->write_pos = pt->read_buf + c_pos;
   pt->write_buf_size = pt->read_buf_size = str_len;
   pt->write_end = pt->read_end = pt->read_buf + pt->read_buf_size;
@@ -286,11 +288,13 @@ SCM scm_strport_to_string (SCM port)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
   SCM str;
-
+  char *dst;
+  
   if (pt->rw_active == SCM_PORT_WRITE)
     st_flush (port);
 
-  str = scm_mem2string ((char *) pt->read_buf, pt->read_buf_size);
+  str = scm_c_make_string (pt->read_buf_size, &dst);
+  memcpy (dst, (char *) pt->read_buf, pt->read_buf_size);
   scm_remember_upto_here_1 (port);
   return str;
 }
diff --git a/libguile/struct.c b/libguile/struct.c
index efb17d3a4..a00a3c5a3 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -59,16 +59,16 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
   SCM_VALIDATE_STRING (1, fields);
 
   { /* scope */
-    char * field_desc;
+    const char * field_desc;
     size_t len;
     int x;
 
-    len = SCM_I_STRING_LENGTH (fields);
+    len = scm_i_string_length (fields);
     if (len % 2 == 1)
       SCM_MISC_ERROR ("odd length field specification: ~S", 
 		      scm_list_1 (fields));
 
-    field_desc = SCM_I_STRING_CHARS (fields);
+    field_desc = scm_i_string_chars (fields);
 
     for (x = 0; x < len; x += 2)
       {
@@ -240,12 +240,12 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
   layout = SCM_STRUCT_LAYOUT (x);
 
   if (SCM_SYMBOL_LENGTH (layout)
-      < SCM_I_STRING_LENGTH (required_vtable_fields))
+      < scm_i_string_length (required_vtable_fields))
     return SCM_BOOL_F;
 
   tmp = strncmp (SCM_SYMBOL_CHARS (layout),
-		 SCM_I_STRING_CHARS (required_vtable_fields),
-		 SCM_I_STRING_LENGTH (required_vtable_fields));
+		 scm_i_string_chars (required_vtable_fields),
+		 scm_i_string_length (required_vtable_fields));
   scm_remember_upto_here_1 (required_vtable_fields);
   if (tmp)
     return SCM_BOOL_F;
diff --git a/libguile/symbols.c b/libguile/symbols.c
index dc413c369..f3b95fbb8 100644
--- a/libguile/symbols.c
+++ b/libguile/symbols.c
@@ -186,8 +186,8 @@ SCM_DEFINE (scm_make_symbol, "make-symbol", 1, 0, 0,
 {
   SCM sym;
   SCM_VALIDATE_STRING (1, name);
-  sym = scm_mem2uninterned_symbol (SCM_I_STRING_CHARS (name),
-				   SCM_I_STRING_LENGTH (name));
+  sym = scm_mem2uninterned_symbol (scm_i_string_chars (name),
+				   scm_i_string_length (name));
   scm_remember_upto_here_1 (name);
   return sym;
 }
@@ -255,8 +255,8 @@ SCM_DEFINE (scm_string_to_symbol, "string->symbol", 1, 0, 0,
 {
   SCM sym;
   SCM_VALIDATE_STRING (1, string);
-  sym = scm_mem2symbol (SCM_I_STRING_CHARS (string),
-			SCM_I_STRING_LENGTH (string));
+  sym = scm_mem2symbol (scm_i_string_chars (string),
+			scm_i_string_length (string));
   scm_remember_upto_here_1 (string);
   return sym;
 }
@@ -287,10 +287,10 @@ SCM_DEFINE (scm_gensym, "gensym", 0, 1, 0,
   else
     {
       SCM_VALIDATE_STRING (1, prefix);
-      len = SCM_I_STRING_LENGTH (prefix);
+      len = scm_i_string_length (prefix);
       if (len > MAX_PREFIX_LENGTH)
 	name = scm_malloc (len + SCM_INTBUFLEN);
-      memcpy (name, SCM_I_STRING_CHARS (prefix), len);
+      memcpy (name, scm_i_string_chars (prefix), len);
       scm_remember_upto_here_1 (prefix);
     }
   {
diff --git a/libguile/tags.h b/libguile/tags.h
index 08e33a735..911054d98 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -429,6 +429,7 @@ typedef unsigned long scm_t_bits;
 
 #define scm_tc7_string		21
 #define scm_tc7_number		23
+#define scm_tc7_stringbuf       39
 
 /* Many of the following should be turned
  * into structs or smobs.  We need back some
@@ -439,7 +440,6 @@ typedef unsigned long scm_t_bits;
 #if SCM_HAVE_ARRAYS
 #define scm_tc7_llvect          29
 #define scm_tc7_uvect		37
-/* free                         39 */
 #define scm_tc7_fvect		45
 #define scm_tc7_dvect		47
 #define scm_tc7_cvect		53
diff --git a/libguile/unif.c b/libguile/unif.c
index 7936f2491..32c086a77 100644
--- a/libguile/unif.c
+++ b/libguile/unif.c
@@ -220,7 +220,7 @@ SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0,
     case scm_tc7_wvect:
       return scm_from_size_t (SCM_VECTOR_LENGTH (v));
     case scm_tc7_string:
-      return scm_from_size_t (SCM_I_STRING_LENGTH (v));
+      return scm_from_size_t (scm_i_string_length (v));
     case scm_tc7_bvect:
       return scm_from_size_t (SCM_BITVECTOR_LENGTH (v));
     case scm_tc7_byvect:
@@ -880,6 +880,7 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
 #define FUNC_NAME s_scm_enclose_array
 {
   SCM axv, res, ra_inr;
+  char *axv_dst;
   scm_t_array_dim vdim, *s = &vdim;
   int ndim, j, k, ninr, noutr;
 
@@ -928,6 +929,7 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
   if (noutr < 0)
     SCM_WRONG_NUM_ARGS ();
   axv = scm_make_string (scm_from_int (ndim), SCM_MAKE_CHAR (0));
+  axv_dst = scm_i_string_writable_chars (axv);
   res = scm_make_ra (noutr);
   SCM_ARRAY_BASE (res) = SCM_ARRAY_BASE (ra_inr);
   SCM_ARRAY_V (res) = ra_inr;
@@ -939,16 +941,17 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
       SCM_ARRAY_DIMS (ra_inr)[k].lbnd = s[j].lbnd;
       SCM_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd;
       SCM_ARRAY_DIMS (ra_inr)[k].inc = s[j].inc;
-      SCM_I_STRING_CHARS (axv)[j] = 1;
+      axv_dst[j] = 1;
     }
   for (j = 0, k = 0; k < noutr; k++, j++)
     {
-      while (SCM_I_STRING_CHARS (axv)[j])
+      while (axv_dst[j])
 	j++;
       SCM_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd;
       SCM_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd;
       SCM_ARRAY_DIMS (res)[k].inc = s[j].inc;
     }
+  scm_remember_upto_here_1 (axv);
   scm_ra_set_contp (ra_inr);
   scm_ra_set_contp (res);
   return res;
@@ -1109,7 +1112,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
       else
 	return SCM_BOOL_F;
     case scm_tc7_string:
-      return SCM_MAKE_CHAR (SCM_I_STRING_UCHARS (v)[pos]);
+      return scm_c_string_ref (v, pos);
     case scm_tc7_byvect:
       return scm_from_schar (((char *) SCM_UVECTOR_BASE (v))[pos]);
   case scm_tc7_uvect:
@@ -1155,7 +1158,7 @@ scm_cvref (SCM v, unsigned long pos, SCM last)
       else
 	return SCM_BOOL_F;
     case scm_tc7_string:
-      return SCM_MAKE_CHAR (SCM_I_STRING_UCHARS (v)[pos]);
+      return scm_c_string_ref (v, pos);
     case scm_tc7_byvect:
       return scm_from_char (((char *) SCM_UVECTOR_BASE (v))[pos]);
     case scm_tc7_uvect:
@@ -1269,7 +1272,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
       break;
     case scm_tc7_string:
       SCM_ASRTGO (SCM_CHARP (obj), badobj);
-      SCM_I_STRING_UCHARS (v)[pos] = SCM_CHAR (obj);
+      scm_c_string_set_x (v, pos, obj);
       break;
     case scm_tc7_byvect:
       if (SCM_CHARP (obj))
@@ -1478,7 +1481,7 @@ loop:
       v = SCM_ARRAY_V (cra);
       goto loop;
     case scm_tc7_string:
-      base = SCM_I_STRING_CHARS (v);
+      base = scm_i_string_writable_chars (v);
       sz = sizeof (char);
       break;
     case scm_tc7_bvect:
@@ -1615,7 +1618,7 @@ SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0,
   long offset = 0;
   long cstart = 0;
   long cend;
-  char *base;
+  const char *base;
 
   port_or_fd = SCM_COERCE_OUTPORT (port_or_fd);
 
@@ -1644,7 +1647,7 @@ loop:
       v = SCM_ARRAY_V (v);
       goto loop;
     case scm_tc7_string:
-      base = SCM_I_STRING_CHARS (v);
+      base = scm_i_string_chars (v);
       sz = sizeof (char);
       break;
     case scm_tc7_bvect:
@@ -1708,7 +1711,7 @@ loop:
 
   if (SCM_NIMP (port_or_fd))
     {
-      char *source = base + (cstart + offset) * sz;
+      const char *source = base + (cstart + offset) * sz;
 
       ans = cend - offset;
       scm_lfwrite (source, ans * sz, port_or_fd);
@@ -2320,17 +2323,22 @@ tail:
 	}
       break;
     case scm_tc7_string:
-      if (n-- > 0)
-	scm_iprin1 (SCM_MAKE_CHAR (SCM_I_STRING_UCHARS (ra)[j]), port, pstate);
-      if (SCM_WRITINGP (pstate))
-	for (j += inc; n-- > 0; j += inc)
-	  {
-	    scm_putc (' ', port);
-	    scm_iprin1 (SCM_MAKE_CHAR (SCM_I_STRING_UCHARS (ra)[j]), port, pstate);
-	  }
-      else
-	for (j += inc; n-- > 0; j += inc)
-	  scm_putc (SCM_I_STRING_CHARS (ra)[j], port);
+      {
+	const char *src;
+	src = scm_i_string_chars (ra);
+	if (n-- > 0)
+	  scm_iprin1 (SCM_MAKE_CHAR (src[j]), port, pstate);
+	if (SCM_WRITINGP (pstate))
+	  for (j += inc; n-- > 0; j += inc)
+	    {
+	      scm_putc (' ', port);
+	      scm_iprin1 (SCM_MAKE_CHAR (src[j]), port, pstate);
+	    }
+	else
+	  for (j += inc; n-- > 0; j += inc)
+	    scm_putc (src[j], port);
+	scm_remember_upto_here_1 (ra);
+      }
       break;
     case scm_tc7_byvect:
       if (n-- > 0)