prefer compilers earlier in list
[bpt/guile.git] / libguile / strings.c
index 85a6c48..90dc83a 100644 (file)
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -29,6 +29,7 @@
 #include <uninorm.h>
 #include <unistr.h>
 #include <uniconv.h>
+#include <c-strcase.h>
 
 #include "striconveh.h"
 
@@ -36,6 +37,8 @@
 #include "libguile/chars.h"
 #include "libguile/root.h"
 #include "libguile/strings.h"
+#include "libguile/ports.h"
+#include "libguile/ports-internal.h"
 #include "libguile/error.h"
 #include "libguile/generalized-vectors.h"
 #include "libguile/deprecation.h"
@@ -258,8 +261,34 @@ scm_i_pthread_mutex_t stringbuf_write_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 
 #define IS_SH_STRING(str)   (SCM_CELL_TYPE(str)==SH_STRING_TAG)
 
+void
+scm_i_print_stringbuf (SCM exp, SCM port, scm_print_state *pstate) 
+{
+  SCM str;
+
+  scm_i_pthread_mutex_lock (&stringbuf_write_mutex);
+  SET_STRINGBUF_SHARED (exp);
+  scm_i_pthread_mutex_unlock (&stringbuf_write_mutex);
+
+  str =  scm_double_cell (RO_STRING_TAG, SCM_UNPACK(exp),
+                          0, STRINGBUF_LENGTH (exp));
+
+  scm_puts ("#<stringbuf ", port);
+  scm_iprin1 (str, port, pstate);
+  scm_puts (">", port);
+}
+
 SCM scm_nullstr;
 
+static SCM null_stringbuf;
+
+static void
+init_null_stringbuf (void)
+{
+  null_stringbuf = make_stringbuf (0);
+  SET_STRINGBUF_SHARED (null_stringbuf);
+}
+
 /* Create a scheme string with space for LEN 8-bit Latin-1-encoded
    characters.  CHARSP, if not NULL, will be set to location of the
    char array.  If READ_ONLY_P, the returned string is read-only;
@@ -267,17 +296,13 @@ SCM scm_nullstr;
 SCM
 scm_i_make_string (size_t len, char **charsp, int read_only_p)
 {
-  static SCM null_stringbuf = SCM_BOOL_F;
   SCM buf;
   SCM res;
 
   if (len == 0)
     {
-      if (SCM_UNLIKELY (scm_is_false (null_stringbuf)))
-        {
-          null_stringbuf = make_stringbuf (0);
-          SET_STRINGBUF_SHARED (null_stringbuf);
-        }
+      static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+      scm_i_pthread_once (&once, init_null_stringbuf);
       buf = null_stringbuf;
     }
   else
@@ -1401,7 +1426,8 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
 #define FUNC_NAME s_scm_string_append
 {
   SCM res;
-  size_t len = 0;
+  size_t total = 0;
+  size_t len;
   int wide = 0;
   SCM l, s;
   size_t i;
@@ -1416,15 +1442,18 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
     {
       s = SCM_CAR (l);
       SCM_VALIDATE_STRING (SCM_ARGn, s);
-      len += scm_i_string_length (s);
+      len = scm_i_string_length (s);
+      if (((size_t) -1) - total < len)
+        scm_num_overflow (s_scm_string_append);
+      total += len;
       if (!scm_i_is_narrow_string (s))
         wide = 1;
     }
   data.narrow = NULL;
   if (!wide)
-    res = scm_i_make_string (len, &data.narrow, 0);
+    res = scm_i_make_string (total, &data.narrow, 0);
   else
-    res = scm_i_make_wide_string (len, &data.wide, 0);
+    res = scm_i_make_wide_string (total, &data.wide, 0);
 
   for (l = args; !scm_is_null (l); l = SCM_CDR (l))
     {
@@ -1432,6 +1461,8 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
       s = SCM_CAR (l);
       SCM_VALIDATE_STRING (SCM_ARGn, s);
       len = scm_i_string_length (s);
+      if (len > total)
+        SCM_MISC_ERROR ("list changed during string-append", SCM_EOL);
       if (!wide)
         {
           memcpy (data.narrow, scm_i_string_chars (s), len);
@@ -1441,16 +1472,20 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
         {
           if (scm_i_is_narrow_string (s))
             {
-              for (i = 0; i < scm_i_string_length (s); i++)
-                data.wide[i] = (unsigned char) scm_i_string_chars (s)[i];
+              const char *src = scm_i_string_chars (s);
+              for (i = 0; i < len; i++)
+                data.wide[i] = (unsigned char) src[i];
             }
           else
             u32_cpy ((scm_t_uint32 *) data.wide,
                      (scm_t_uint32 *) scm_i_string_wide_chars (s), len);
           data.wide += len;
         }
+      total -= len;
       scm_remember_upto_here_1 (s);
     }
+  if (total != 0)
+    SCM_MISC_ERROR ("list changed during string-append", SCM_EOL);
   return res;
 }
 #undef FUNC_NAME
@@ -1524,9 +1559,9 @@ scm_from_stringn (const char *str, size_t len, const char *encoding,
   if (len == (size_t) -1)
     len = strlen (str);
 
-  if (strcmp (encoding, "ISO-8859-1") == 0 || len == 0)
+  if (c_strcasecmp (encoding, "ISO-8859-1") == 0 || len == 0)
     return scm_from_latin1_stringn (str, len);
-  else if (strcmp (encoding, "UTF-8") == 0
+  else if (c_strcasecmp (encoding, "UTF-8") == 0
            && handler == SCM_FAILED_CONVERSION_ERROR)
     return scm_from_utf8_stringn (str, len);
 
@@ -1722,11 +1757,13 @@ SCM
 scm_from_port_stringn (const char *str, size_t len, SCM port)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  scm_t_port_internal *pti = SCM_PORT_GET_INTERNAL (port);
 
-  if (pt->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1)
+  if (pti->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1)
     return scm_from_latin1_stringn (str, len);
-  else if (pt->encoding_mode == SCM_PORT_ENCODING_MODE_UTF8
-           && pt->ilseq_handler == SCM_FAILED_CONVERSION_ERROR)
+  else if (pti->encoding_mode == SCM_PORT_ENCODING_MODE_UTF8
+           && (pt->ilseq_handler == SCM_FAILED_CONVERSION_ERROR
+               || (u8_check ((uint8_t *) str, len) == NULL)))
     return scm_from_utf8_stringn (str, len);
   else
     return scm_from_stringn (str, len, pt->encoding, pt->ilseq_handler);
@@ -2127,11 +2164,12 @@ char *
 scm_to_port_stringn (SCM str, size_t *lenp, SCM port)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
+  scm_t_port_internal *pti = SCM_PORT_GET_INTERNAL (port);
 
-  if (pt->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1
+  if (pti->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1
       && pt->ilseq_handler == SCM_FAILED_CONVERSION_ERROR)
     return scm_to_latin1_stringn (str, lenp);
-  else if (pt->encoding_mode == SCM_PORT_ENCODING_MODE_UTF8)
+  else if (pti->encoding_mode == SCM_PORT_ENCODING_MODE_UTF8)
     return scm_to_utf8_stringn (str, lenp);
   else
     return scm_to_stringn (str, lenp, pt->encoding, pt->ilseq_handler);
@@ -2170,7 +2208,8 @@ scm_to_stringn (SCM str, size_t *lenp, const char *encoding,
                         "string contains #\\nul character: ~S",
                         scm_list_1 (str));
 
-  if (scm_i_is_narrow_string (str) && strcmp (encoding, "ISO-8859-1") == 0)
+  if (scm_i_is_narrow_string (str)
+      && c_strcasecmp (encoding, "ISO-8859-1") == 0)
     {
       /* If using native Latin-1 encoding, just copy the string
          contents.  */
@@ -2426,34 +2465,6 @@ scm_i_get_substring_spec (size_t len,
     *cend = scm_to_unsigned_integer (end, *cstart, len);
 }
                  
-static SCM
-string_handle_ref (scm_t_array_handle *h, size_t index)
-{
-  return scm_c_string_ref (h->array, index);
-}
-
-static void
-string_handle_set (scm_t_array_handle *h, size_t index, SCM val)
-{
-  scm_c_string_set_x (h->array, index, val);
-}
-
-static void
-string_get_handle (SCM v, scm_t_array_handle *h)
-{
-  h->array = v;
-  h->ndims = 1;
-  h->dims = &h->dim0;
-  h->dim0.lbnd = 0;
-  h->dim0.ubnd = scm_c_string_length (v) - 1;
-  h->dim0.inc = 1;
-  h->element_type = SCM_ARRAY_ELEMENT_TYPE_CHAR;
-  h->elements = h->writable_elements = NULL;
-}
-
-SCM_ARRAY_IMPLEMENTATION (scm_tc7_string, 0x7f,
-                          string_handle_ref, string_handle_set,
-                          string_get_handle)
 SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_CHAR, scm_make_string)
 
 void