[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-264-g786ab42

[Mark H Weaver]

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

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

The branch, stable-2.0 has been updated
       via  786ab4258fbf605f46287da5e7550d3ab4b68589 (commit)
       via  2f13a46672a347be0f7bb1b360a213f6d6ce0288 (commit)
       via  3b80c3585221a899c9a6b87e742d267655bb0abc (commit)
      from  47f2bce5ae332c274270882c259776b8e4ea12f7 (commit)

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

- Log -----------------------------------------------------------------
commit 786ab4258fbf605f46287da5e7550d3ab4b68589
Author: Mark H Weaver <address@hidden>
Date:   Mon Apr 1 03:47:29 2013 -0400

    Optimize 'string-join'.
    
    * libguile/srfi-13.c (string-join): Rewrite to call 'scm_string_append'
      only once.

commit 2f13a46672a347be0f7bb1b360a213f6d6ce0288
Author: Mark H Weaver <address@hidden>
Date:   Mon Apr 1 03:37:36 2013 -0400

    Make 'string-append' more efficient and robust.
    
    * libguile/strings.c (scm_string_append): Check for numerical overflow
      while computing the length of the result.  Double-check that we don't
      overflow the result string, and that it is the correct length in the
      end (in case another thread changed the list).  When copying a narrow
      string to a wide result, avoid calling 'scm_i_string_length' and
      'scm_i_string_chars' on each character.

commit 3b80c3585221a899c9a6b87e742d267655bb0abc
Author: Mark H Weaver <address@hidden>
Date:   Mon Apr 1 01:21:30 2013 -0400

    Fix typos in 'string-join' docs: 'string-infix' -> 'strict-infix'.
    
    * doc/ref/api-data.texi (String Constructors): In definition of
      'string-join', change 'string-infix' -> 'strict-infix'.
    
    * libguile/srfi-13.c (scm_string_join): In docstring, change
      'string-infix' -> 'strict-infix'.

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

Summary of changes:
 doc/ref/api-data.texi |    2 +-
 libguile/srfi-13.c    |  123 +++++++++++++++++++++++--------------------------
 libguile/strings.c    |   22 ++++++--
 3 files changed, 75 insertions(+), 72 deletions(-)

diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index 17baed2..0a5a2de 100644
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -3148,7 +3148,7 @@ placed between the strings, and defaults to the symbol
 @item infix
 Insert the separator between list elements.  An empty string
 will produce an empty list.
address@hidden string-infix
address@hidden strict-infix
 Like @code{infix}, but will raise an error if given the empty
 list.
 @item suffix
diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c
index 97c5a1d..e426887 100644
--- a/libguile/srfi-13.c
+++ b/libguile/srfi-13.c
@@ -384,7 +384,7 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
            "@item infix\n"
            "Insert the separator between list elements.  An empty string\n"
            "will produce an empty list.\n"
-           "@item string-infix\n"
+           "@item strict-infix\n"
            "Like @code{infix}, but will raise an error if given the empty\n"
            "list.\n"
            "@item suffix\n"
@@ -394,91 +394,84 @@ SCM_DEFINE (scm_string_join, "string-join", 1, 2, 0,
            "@end table")
 #define FUNC_NAME s_scm_string_join
 {
-#define GRAM_INFIX        0
-#define GRAM_STRICT_INFIX 1
-#define GRAM_SUFFIX       2
-#define GRAM_PREFIX       3
-  SCM tmp;
-  SCM result;
-  int gram = GRAM_INFIX;
-  size_t del_len = 0;
-  long strings = scm_ilength (ls);
+  SCM append_list = SCM_EOL;
+  long list_len = scm_ilength (ls);
+  size_t delimiter_len = 0;
 
   /* Validate the string list.  */
-  if (strings < 0)
+  if (list_len < 0)
     SCM_WRONG_TYPE_ARG (1, ls);
 
   /* Validate the delimiter and record its length.  */
   if (SCM_UNBNDP (delimiter))
     {
       delimiter = scm_from_locale_string (" ");
-      del_len = 1;
+      delimiter_len = 1;
     }
   else
     {
       SCM_VALIDATE_STRING (2, delimiter);
-      del_len = scm_i_string_length (delimiter);
+      delimiter_len = scm_i_string_length (delimiter);
     }
 
-  /* Validate the grammar symbol and remember the grammar.  */
+  /* Validate the grammar symbol.  */
   if (SCM_UNBNDP (grammar))
-    gram = GRAM_INFIX;
-  else if (scm_is_eq (grammar, scm_sym_infix))
-    gram = GRAM_INFIX;
-  else if (scm_is_eq (grammar, scm_sym_strict_infix))
-    gram = GRAM_STRICT_INFIX;
-  else if (scm_is_eq (grammar, scm_sym_suffix))
-    gram = GRAM_SUFFIX;
-  else if (scm_is_eq (grammar, scm_sym_prefix))
-    gram = GRAM_PREFIX;
-  else
+    grammar = scm_sym_infix;
+  else if (!(scm_is_eq (grammar, scm_sym_infix)
+             || scm_is_eq (grammar, scm_sym_strict_infix)
+             || scm_is_eq (grammar, scm_sym_suffix)
+             || scm_is_eq (grammar, scm_sym_prefix)))
     SCM_WRONG_TYPE_ARG (3, grammar);
 
-  /* Check grammar constraints.  */
-  if (strings == 0 && gram == GRAM_STRICT_INFIX)
-    SCM_MISC_ERROR ("strict-infix grammar requires non-empty list",
-                   SCM_EOL);
+  if (list_len == 0)
+    {
+      if (scm_is_eq (grammar, scm_sym_strict_infix))
+        SCM_MISC_ERROR ("strict-infix grammar requires non-empty list",
+                        SCM_EOL);
+      else
+        /* Handle empty lists specially */
+        append_list = SCM_EOL;
+    }
+  else if (delimiter_len == 0)
+    /* Handle empty delimiters specially */
+    append_list = ls;
+  else
+    {
+      SCM *last_cdr_p = &append_list;
 
-  result = scm_i_make_string (0, NULL, 0);
+#define ADD_TO_APPEND_LIST(x) \
+  (last_cdr_p = SCM_CDRLOC (*last_cdr_p = scm_list_1 (x)))
 
-  tmp = ls;
-  switch (gram)
-    {
-    case GRAM_INFIX:
-    case GRAM_STRICT_INFIX:
-      while (scm_is_pair (tmp))
-       {
-         result = scm_string_append (scm_list_2 (result, SCM_CAR (tmp)));
-         if (!scm_is_null (SCM_CDR (tmp)) && del_len > 0)
-           result = scm_string_append (scm_list_2 (result, delimiter));
-         tmp = SCM_CDR (tmp);
-       }
-      break;
-    case GRAM_SUFFIX:
-      while (scm_is_pair (tmp))
-       {
-         result = scm_string_append (scm_list_2 (result, SCM_CAR (tmp)));
-         if (del_len > 0)
-           result = scm_string_append (scm_list_2 (result, delimiter));
-         tmp = SCM_CDR (tmp);
-       }
-      break;
-    case GRAM_PREFIX:
-      while (scm_is_pair (tmp))
-       {
-         if (del_len > 0)
-           result = scm_string_append (scm_list_2 (result, delimiter));
-         result = scm_string_append (scm_list_2 (result, SCM_CAR (tmp)));
-         tmp = SCM_CDR (tmp);
-       }
-      break;
+      /* Build a list of strings to pass to 'string-append'.
+         Here we assume that 'ls' has at least one element. */
+
+      /* If using the 'prefix' grammar, start with the delimiter. */
+      if (scm_is_eq (grammar, scm_sym_prefix))
+        ADD_TO_APPEND_LIST (delimiter);
+
+      /* Handle the first element of 'ls' specially, so that in the loop
+         that follows we can unconditionally insert the delimiter before
+         every remaining element. */
+      ADD_TO_APPEND_LIST (SCM_CAR (ls));
+      ls = SCM_CDR (ls);
+
+      /* Insert the delimiter before every remaining element. */
+      while (scm_is_pair (ls))
+        {
+          ADD_TO_APPEND_LIST (delimiter);
+          ADD_TO_APPEND_LIST (SCM_CAR (ls));
+          ls = SCM_CDR (ls);
+        }
+
+      /* If using the 'suffix' grammar, add the delimiter to the end. */
+      if (scm_is_eq (grammar, scm_sym_suffix))
+        ADD_TO_APPEND_LIST (delimiter);
+
+#undef ADD_TO_APPEND_LIST
     }
 
-  return result;
-#undef GRAM_INFIX
-#undef GRAM_STRICT_INFIX
-#undef GRAM_SUFFIX
-#undef GRAM_PREFIX
+  /* Construct the final result. */
+  return scm_string_append (append_list);
 }
 #undef FUNC_NAME
 
diff --git a/libguile/strings.c b/libguile/strings.c
index 5d0db23..1b241e5 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -1401,7 +1401,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 +1417,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 +1436,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 +1447,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


hooks/post-receive
-- 
GNU Guile