Rollup minor diffs between string_abstraction2 and master branchesstring_abstraction2

* libguile/Makefile.am: don't need to include chars.c

* libguile/deprecated.c: whitespace

* libguile/deprecated.h: scm_i_intern_obarray_soft doesn't exist

* libguile/filesys.c (scm_init_filesys): copy paste error

* libguile/gc-mark.c: unneeded include

* libguile/numbers.c: whitespace

* libguile/socket.c (scm_recv): remember msg
  (scm_send): try to narrow the string before testing it for 8-bitness,
   don't locale convert

* libguile/srfi-13.c (scm_string_map): double call of
  scm_i_string_start_writing

* libguile/stime.c (scm_strftime, scm_strptime): whitespace and
  scm_remember_upto_here calls

* libguile/strings.c: whitespace
  (scm_i_string_set_x): remove pointless double-cast

* libguile/struct.c: whitespace
  (scm_struct_ref): no need to re-call scm_i_symbol_ref

* libguile/symbols.c: unneeded include

* libguile/vm-i-system.c: whitespace

* doc/ref/vm.texi: copy/paste error

* libguile/strings.c (narrow_stringbuf): new function
  (scm_i_is_narrow_string): new function

* libguile/strings.h: new declaration for scm_i_try_narrow_string

16 files changed, 80 insertions, 100 deletions

diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi
index c41fe8d99..43b265596 100644
--- a/doc/ref/vm.texi
+++ b/doc/ref/vm.texi
@@ -1017,38 +1017,3 @@ fast-pathed in Guile's VM.
 @deffnx Instruction bv-f64-set bv n val endianness
 Inlined implementations of the corresponding bytevector operations.
 @end deffn
-@deffnx Instruction bv-s16-native-ref bv n
-@deffnx Instruction bv-u32-native-ref bv n
-@deffnx Instruction bv-s32-native-ref bv n
-@deffnx Instruction bv-u64-native-ref bv n
-@deffnx Instruction bv-s64-native-ref bv n
-@deffnx Instruction bv-f32-native-ref bv n
-@deffnx Instruction bv-f64-native-ref bv n
-@deffnx Instruction bv-u16-ref bv n endianness
-@deffnx Instruction bv-s16-ref bv n endianness
-@deffnx Instruction bv-u32-ref bv n endianness
-@deffnx Instruction bv-s32-ref bv n endianness
-@deffnx Instruction bv-u64-ref bv n endianness
-@deffnx Instruction bv-s64-ref bv n endianness
-@deffnx Instruction bv-f32-ref bv n endianness
-@deffnx Instruction bv-f64-ref bv n endianness
-@deffnx Instruction bv-u8-set bv n val
-@deffnx Instruction bv-s8-set bv n val
-@deffnx Instruction bv-u16-native-set bv n val
-@deffnx Instruction bv-s16-native-set bv n val
-@deffnx Instruction bv-u32-native-set bv n val
-@deffnx Instruction bv-s32-native-set bv n val
-@deffnx Instruction bv-u64-native-set bv n val
-@deffnx Instruction bv-s64-native-set bv n val
-@deffnx Instruction bv-f32-native-set bv n val
-@deffnx Instruction bv-f64-native-set bv n val
-@deffnx Instruction bv-u16-set bv n val endianness
-@deffnx Instruction bv-s16-set bv n val endianness
-@deffnx Instruction bv-u32-set bv n val endianness
-@deffnx Instruction bv-s32-set bv n val endianness
-@deffnx Instruction bv-u64-set bv n val endianness
-@deffnx Instruction bv-s64-set bv n val endianness
-@deffnx Instruction bv-f32-set bv n val endianness
-@deffnx Instruction bv-f64-set bv n val endianness
-Inlined implementations of the corresponding bytevector operations.
-@end deffn
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 691d3ba36..907824c8f 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -127,7 +127,7 @@ libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c	\
 # vm-related sources
 libguile_la_SOURCES += frames.c instructions.c objcodes.c programs.c vm.c
 
-libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_SOURCES = i18n.c chars.c
+libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_SOURCES = i18n.c
 libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_CFLAGS =	\
    $(libguile_la_CFLAGS)
 libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_LIBADD =	\
diff --git a/libguile/chars.c b/libguile/chars.c
index 552a2d9c1..c7cb09c47 100644
--- a/libguile/chars.c
+++ b/libguile/chars.c
@@ -296,20 +296,14 @@ TODO: change name  to scm_i_.. ? --hwn
 scm_t_wchar
 scm_c_upcase (scm_t_wchar c)
 {
-  if (c > 255)
-    return c;
-
-  return toupper ((int) c);
+  return uc_toupper ((int) c);
 }
 
 
 scm_t_wchar
 scm_c_downcase (scm_t_wchar c)
 {
-  if (c > 255)
-    return c;
-
-  return tolower ((int) c);
+  return uc_tolower ((int) c);
 }
 
 
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 7ba63701c..ed3a11eed 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -748,6 +748,7 @@ scm_sym2ovcell (SCM sym, SCM obarray)
    If OBARRAY is SCM_BOOL_F, create a symbol listed in no obarray and
    return (SYMBOL . SCM_UNDEFINED).  */
 
+
 static SCM 
 intern_obarray_soft (SCM symbol, SCM obarray, unsigned int softness)
 {
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 77ba6bb4d..5b443c761 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -242,8 +242,6 @@ SCM_API SCM scm_sym2ovcell_soft (SCM sym, SCM obarray);
 SCM_API SCM scm_sym2ovcell (SCM sym, SCM obarray);
 SCM_API SCM scm_intern_obarray_soft (const char *name, size_t len,
 				     SCM obarray, unsigned int softness);
-SCM_INTERNAL SCM scm_i_intern_obarray_soft (SCM symbol, SCM obarray, 
-					    unsigned int softness);
 SCM_API SCM scm_intern_obarray (const char *name, size_t len, SCM obarray);
 SCM_API SCM scm_symbol_value0 (const char *name);
 
diff --git a/libguile/filesys.c b/libguile/filesys.c
index a3a9fec6e..c602f6735 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -45,7 +45,6 @@
 #include "libguile/vectors.h"
 #include "libguile/lang.h"
 #include "libguile/dynwind.h"
-#include "libguile/eq.h"
 
 #include "libguile/validate.h"
 #include "libguile/filesys.h"
@@ -1785,29 +1784,3 @@ scm_init_filesys ()
   c-file-style: "gnu"
   End:
 */
-  scm_c_define ("F_SETFD", scm_from_int (F_SETFD));
-#endif 
-#ifdef F_GETFL  
-  scm_c_define ("F_GETFL", scm_from_int (F_GETFL));
-#endif 
-#ifdef F_SETFL  
-  scm_c_define ("F_SETFL", scm_from_int (F_SETFL));
-#endif 
-#ifdef F_GETOWN  
-  scm_c_define ("F_GETOWN", scm_from_int (F_GETOWN));
-#endif 
-#ifdef F_SETOWN  
-  scm_c_define ("F_SETOWN", scm_from_int (F_SETOWN));
-#endif 
-#ifdef FD_CLOEXEC  
-  scm_c_define ("FD_CLOEXEC", scm_from_int (FD_CLOEXEC));
-#endif
-
-#include "libguile/filesys.x"
-}
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c
index dba61a916..bb307b4c0 100644
--- a/libguile/gc-mark.c
+++ b/libguile/gc-mark.c
@@ -44,7 +44,6 @@ extern unsigned long * __libc_ia64_register_backing_store_base;
 #include "libguile/ports.h"
 #include "libguile/root.h"
 #include "libguile/strings.h"
-#include "libguile/chars.h"
 #include "libguile/vectors.h"
 #include "libguile/weaks.h"
 #include "libguile/hashtab.h"
diff --git a/libguile/numbers.c b/libguile/numbers.c
index c401b5cbe..02f07020f 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -3104,6 +3104,7 @@ SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0,
     base = 10;
   else
     base = scm_to_unsigned_integer (radix, 2, INT_MAX);
+
   answer = scm_i_string_to_number (string, base);
   scm_remember_upto_here_1 (string);
   return answer;
diff --git a/libguile/socket.c b/libguile/socket.c
index 18750a35f..e9523743c 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -34,6 +34,7 @@
 #include "libguile/vectors.h"
 #include "libguile/dynwind.h"
 #include "libguile/srfi-13.h"
+#include "libguile/strings.h"
 
 #include "libguile/validate.h"
 #include "libguile/socket.h"
@@ -1450,7 +1451,7 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
   if (rv == -1)
     SCM_SYSERROR;
 
-  scm_remember_upto_here_1 (buf);
+  scm_remember_upto_here_2 (buf, msg);
   return scm_from_int (rv);
 }
 #undef FUNC_NAME
@@ -1482,9 +1483,13 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
   sock = SCM_COERCE_OUTPORT (sock);
   SCM_VALIDATE_OPFPORT (1, sock);
   SCM_VALIDATE_STRING (2, message);
-  if (!scm_i_is_narrow_string (message))
+  
+  /* If the string is wide, see if it can be coerced into
+     a narrow string.  */
+  if (!scm_i_is_narrow_string (message)
+      || scm_i_try_narrow_string (message))
     SCM_MISC_ERROR ("the message string is not 8-bit: ~s", 
-		    scm_list_1 (message));
+                        scm_list_1 (message));
 
   if (SCM_UNBNDP (flags))
     flg = 0;
@@ -1492,9 +1497,11 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
     flg = scm_to_int (flags);
   fd = SCM_FPORT_FDES (sock);
 
-  src = scm_to_locale_stringn (message, &len);
+  len = scm_i_string_length (message);
+  message = scm_i_string_start_writing (message);
+  src = scm_i_string_writable_chars (message);
   SCM_SYSCALL (rv = send (fd, src, len, flg));
-  free (src);
+  scm_i_string_stop_writing ();
 
   if (rv == -1)
     SCM_SYSERROR;
diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c
index 929ee2e6e..c14a55de1 100644
--- a/libguile/srfi-13.c
+++ b/libguile/srfi-13.c
@@ -2461,7 +2461,6 @@ SCM_DEFINE (scm_string_map, "string-map", 2, 2, 0,
 			      3, start, cstart,
 			      4, end, cend);
   result = scm_i_make_string (cend - cstart, NULL);
-  result = scm_i_string_start_writing (result);
   p = 0;
   while (cstart < cend)
     {
diff --git a/libguile/stime.c b/libguile/stime.c
index a5169c1c8..54022c296 100644
--- a/libguile/stime.c
+++ b/libguile/stime.c
@@ -639,7 +639,7 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
   /* Convert string to UTF-8 so that non-ASCII characters in the
      format are passed through unchanged.  */
   fmt = scm_i_to_utf8_string (format);
-  len = strlen ((const char *)fmt);
+  len = strlen ((const char *) fmt);
 
   /* Ugly hack: strftime can return 0 if its buffer is too small,
      but some valid time strings (e.g. "%p") can sometimes produce
@@ -648,9 +648,9 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
      nonzero. */
   myfmt = scm_malloc (len+2);
   *myfmt = (scm_t_uint8) 'x';
-  strncpy((char *)myfmt+1, (const char *)fmt, len);
-  myfmt[len+1] = 0;
-
+  strncpy ((char *) myfmt + 1, (const char *) fmt, len);
+  myfmt[len + 1] = 0;
+  scm_remember_upto_here_1 (format);
   free (fmt);
 
   tbuf = scm_malloc (size);
@@ -686,8 +686,8 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
 
     /* Use `nstrftime ()' from Gnulib, which supports all GNU extensions
        supported by glibc.  */
-    while ((len = nstrftime ((char *)tbuf, size, 
-			     (const char *)myfmt, &t, 0, 0)) == 0)
+    while ((len = nstrftime ((char *) tbuf, size, 
+			     (const char *) myfmt, &t, 0, 0)) == 0)
       {
 	free (tbuf);
 	size *= 2;
@@ -702,11 +702,10 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
       }
 #endif
     }
-  free (myfmt);
 
-  result = scm_i_from_utf8_string ((const scm_t_uint8 *)(tbuf + 1));
+  result = scm_i_from_utf8_string ((const scm_t_uint8 *) tbuf + 1);
   free (tbuf);
-
+  free (myfmt);
 #if HAVE_STRUCT_TM_TM_ZONE
   free ((char *) t.tm_zone);
 #endif
@@ -762,7 +761,8 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
      fields, hence the use of SCM_CRITICAL_SECTION_START.  */
   t.tm_isdst = -1;
   SCM_CRITICAL_SECTION_START;
-  rest = (scm_t_uint8 *)strptime ((const char *)str, (const char *)fmt, &t);
+  rest = (scm_t_uint8 *) strptime ((const char *) str, 
+                                   (const char *) fmt, &t);
   SCM_CRITICAL_SECTION_END;
   if (rest == NULL)
     {
@@ -770,6 +770,7 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
          instance it doesn't.  Force a sensible value for our error
          message.  */
       errno = EINVAL;
+      scm_remember_upto_here_2 (format, string);
       free (str);
       free (fmt);
       SCM_SYSERROR;
@@ -785,6 +786,7 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
 
   /* Compute the number of UTF-8 characters.  */
   used_len = u8_strnlen (str, rest-str);
+  scm_remember_upto_here_2 (format, string);
   free (str);
   free (fmt);
 
diff --git a/libguile/strings.c b/libguile/strings.c
index 29509dcbb..e6865a730 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -38,6 +38,7 @@
 #include "libguile/eq.h"
 #include "libguile/fluids.h"
 
+#include "striconveh.h"
 
 
 
@@ -242,6 +243,36 @@ widen_stringbuf (SCM buf)
     }
 }
 
+/* Convert a stringbuf of 32-bit UCS-4-encoded characters to one
+   containing 8-bit Latin-1-encoded characters, if possible.  */
+static void
+narrow_stringbuf (SCM buf)
+{
+  size_t i, len;
+  scm_t_wchar *wmem;
+  char *mem;
+
+  if (!STRINGBUF_WIDE (buf))
+    return;
+
+  len = STRINGBUF_OUTLINE_LENGTH (buf);
+  i = 0;
+  wmem = STRINGBUF_WIDE_CHARS (buf);
+  while (i < len)
+    if (wmem[i++] > 0xFF)
+      return;
+
+  mem = scm_gc_malloc (sizeof (char) * (len + 1), "string");
+  for (i = 0; i < len; i++)
+    mem[i] = (unsigned char) wmem[i];
+
+  scm_gc_free (wmem, sizeof (scm_t_wchar) * (len + 1), "string");
+
+  SCM_SET_CELL_WORD_0 (buf, SCM_CELL_WORD_0 (buf) ^ STRINGBUF_F_WIDE);
+  SCM_SET_CELL_WORD_1 (buf, mem);
+  SCM_SET_CELL_WORD_2 (buf, len);
+}
+
 scm_i_pthread_mutex_t stringbuf_write_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 
 /* Copy-on-write strings.
@@ -462,6 +493,18 @@ scm_i_is_narrow_string (SCM str)
   return !STRINGBUF_WIDE (STRING_STRINGBUF (str));
 }
 
+/* Try to coerce a string to be narrow.  It if is narrow already, do
+   nothing.  If it is wide, shrink it to narrow if none of its
+   characters are above 0xFF.  Return true if the string is narrow or
+   was made to be narrow.  */
+int
+scm_i_try_narrow_string (SCM str)
+{
+  narrow_stringbuf (STRING_STRINGBUF (str));
+
+  return scm_i_is_narrow_string (str);
+}
+
 /* Returns a pointer to the 8-bit Latin-1 encoded character array of
    STR.  */
 const char *
@@ -656,7 +699,7 @@ scm_i_string_set_x (SCM str, size_t p, scm_t_wchar chr)
   if (scm_i_is_narrow_string (str))
     {
       char *dst = scm_i_string_writable_chars (str);
-      dst[p] = (char) (unsigned char) chr;
+      dst[p] = chr;
     }
   else
     {
@@ -666,7 +709,7 @@ scm_i_string_set_x (SCM str, size_t p, scm_t_wchar chr)
 }
 
 /* Symbols.
- 
+
    Basic symbol creation and accessing is done here, the rest is in
    symbols.[hc].  This has been done to keep stringbufs and the
    internals of strings and string-like objects confined to this file.
@@ -917,7 +960,7 @@ SCM_DEFINE (scm_sys_string_dump, "%string-dump", 1, 0, 0, (SCM str),
   else
     e5 = scm_cons (scm_from_locale_symbol ("read-only"),
                    SCM_BOOL_F);
-      
+
   /* Stringbuf info */
   if (!STRINGBUF_WIDE (buf))
     {
diff --git a/libguile/strings.h b/libguile/strings.h
index 111180849..b824fb83d 100644
--- a/libguile/strings.h
+++ b/libguile/strings.h
@@ -155,6 +155,7 @@ SCM_INTERNAL const scm_t_wchar *scm_i_string_wide_chars (SCM str);
 SCM_INTERNAL SCM scm_i_string_start_writing (SCM str);
 SCM_INTERNAL void scm_i_string_stop_writing (void);
 SCM_INTERNAL int scm_i_is_narrow_string (SCM str);
+SCM_INTERNAL int scm_i_try_narrow_string (SCM str);
 SCM_INTERNAL scm_t_wchar scm_i_string_ref (SCM str, size_t x);
 SCM_INTERNAL int scm_i_string_contains_char (SCM str, char c);
 SCM_INTERNAL int scm_i_string_strcmp (SCM sstr, size_t start_x, const char *cstr);
diff --git a/libguile/struct.c b/libguile/struct.c
index a486896e9..3ee0d009c 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -151,7 +151,6 @@ scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM in
 	  if (SCM_LAYOUT_TAILP (prot))
 	    {
 	      tailp = 1;
-
 	      prot = prot == 'R' ? 'r' : prot == 'W' ? 'w' : 'o';
 	      *mem++ = tail_elts;
 	      n_fields += tail_elts - 1;
@@ -159,7 +158,6 @@ scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM in
 		break;
 	    }
 	}
-
       switch (scm_i_symbol_ref (layout, i))
 	{
 #if 0
@@ -709,7 +707,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
 
     default:
       SCM_MISC_ERROR ("unrecognized field type: ~S",
-		      scm_list_1 (SCM_MAKE_CHAR (scm_i_symbol_ref (layout, layout_len - 2))));
+		      scm_list_1 (SCM_MAKE_CHAR (field_type)));
     }
 
   return answer;
@@ -755,9 +753,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
 	SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
     }
   else if (scm_i_symbol_ref (layout, layout_len - 1) == 'W')    
-    {
-      field_type = scm_i_symbol_ref (layout, layout_len - 2);
-    }
+    field_type = scm_i_symbol_ref (layout, layout_len - 2);
   else
     SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
   
diff --git a/libguile/symbols.c b/libguile/symbols.c
index c50a2e330..a9320163a 100644
--- a/libguile/symbols.c
+++ b/libguile/symbols.c
@@ -37,7 +37,6 @@
 #include "libguile/modules.h"
 #include "libguile/read.h"
 #include "libguile/srfi-13.h"
-#include "libguile/eq.h"
 
 #include "libguile/validate.h"
 #include "libguile/symbols.h"
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index debd7e335..0662f8188 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -186,6 +186,8 @@ VM_DEFINE_INSTRUCTION (16, make_char32, "make-char32", 4, 0, 1)
   NEXT;
 }
 
+
+
 VM_DEFINE_INSTRUCTION (17, list, "list", 2, -1, 1)
 {
   unsigned h = FETCH ();