guile-commits
[Top][All Lists]
Advanced

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

[Guile-commits] GNU Guile branch, master, updated. release_1-9-12-22-g27


From: Ludovic Courtès
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-12-22-g27fdb70
Date: Tue, 14 Sep 2010 14:18:00 +0000

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

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

The branch, master has been updated
       via  27fdb7037330dcf913bfc556bdc419347edda1bf (commit)
       via  07f49ac786e0f1c007eb336e2fb7a572e8405316 (commit)
       via  4ff2b9f4b6fab00e0e982ce6d1b2594c19704d6e (commit)
      from  d773d4c8bcba40da62d3756c92f8ebbb5ed6b5a3 (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 27fdb7037330dcf913bfc556bdc419347edda1bf
Author: Ludovic Courtès <address@hidden>
Date:   Tue Sep 14 16:09:11 2010 +0200

    Remove commented out code from `print.c'.
    
    * libguile/print.c (scm_write, scm_display, scm_write_char): Remove
      `#if 0'-d code.

commit 07f49ac786e0f1c007eb336e2fb7a572e8405316
Author: Ludovic Courtès <address@hidden>
Date:   Tue Sep 14 16:10:52 2010 +0200

    Factorize and optimize `write' for strings and characters.
    
    According to `write.bm', this makes `write' 2.6 times faster for strings.
    
    * libguile/print.c (iprin1): Use `write_character' when
      `SCM_WRITINGP (pstate)' and `SCM_CHARP (exp)' or `scm_is_string (exp)'.
      (scm_i_charprint): Remove.
      (display_character, write_character): New functions.
      (scm_write_char): Use `display_character' instead of
      `scm_i_charprint'.
    
    * libguile/print.h (scm_i_charprint): Remove declaration.
    
    * benchmark-suite/benchmarks/write.bm: New file.
    
    * benchmark-suite/Makefile.am (SCM_BENCHMARKS): Add
      `benchmarks/write.bm'.

commit 4ff2b9f4b6fab00e0e982ce6d1b2594c19704d6e
Author: Ludovic Courtès <address@hidden>
Date:   Tue Sep 14 16:04:26 2010 +0200

    Internally expose `scm_i_unistring_escapes_to_{guile,r6rs}_escapes'.
    
    * libguile/strings.c (unistring_escapes_to_guile_escapes): Rename to...
      (scm_i_unistring_escapes_to_guile_escapes): ... this.  Change `char 
**bufp'
      to `char *buf'; leave realloc responsibility to the caller.  Update 
caller.
      (unistring_escapes_to_r6rs_escapes): Rename to...
      (scm_i_unistring_escapes_to_r6rs_escapes): ... this.  Likewise.

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

Summary of changes:
 benchmark-suite/Makefile.am         |    3 +-
 benchmark-suite/benchmarks/write.bm |   52 +++++
 libguile/print.c                    |  425 ++++++++++++++++-------------------
 libguile/print.h                    |    3 +-
 libguile/strings.c                  |   22 +-
 libguile/strings.h                  |    4 +
 6 files changed, 269 insertions(+), 240 deletions(-)
 create mode 100644 benchmark-suite/benchmarks/write.bm

diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am
index b58219a..9f49f2a 100644
--- a/benchmark-suite/Makefile.am
+++ b/benchmark-suite/Makefile.am
@@ -11,7 +11,8 @@ SCM_BENCHMARKS = benchmarks/0-reference.bm            \
                 benchmarks/subr.bm                     \
                 benchmarks/uniform-vector-read.bm      \
                 benchmarks/vectors.bm                  \
-                benchmarks/vlists.bm
+                benchmarks/vlists.bm                   \
+                benchmarks/write.bm
 
 EXTRA_DIST = guile-benchmark lib.scm $(SCM_BENCHMARKS) \
             ChangeLog-2008
diff --git a/benchmark-suite/benchmarks/write.bm 
b/benchmark-suite/benchmarks/write.bm
new file mode 100644
index 0000000..e96f2ef
--- /dev/null
+++ b/benchmark-suite/benchmarks/write.bm
@@ -0,0 +1,52 @@
+;;; write.bm --- Exercise the printer.               -*- Scheme -*-
+;;;
+;;; Copyright (C) 2008, 2010 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER.  If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks read)
+  #:use-module (benchmark-suite lib))
+
+(define %len 50000)
+
+(define %string-with-escapes
+  (list->string (map integer->char (iota %len))))
+
+(define %string-without-escapes
+  (make-string %len #\a))
+
+;; Use Unicode-capable ports.
+(fluid-set! %default-port-encoding "UTF-8")
+
+(define %null
+  (%make-void-port OPEN_WRITE))
+
+
+(with-benchmark-prefix "write"
+
+  (benchmark "string with escapes" 50
+    (write %string-with-escapes %null))
+
+  (benchmark "string without escapes" 50
+    (write %string-without-escapes %null)))
+
+(with-benchmark-prefix "display"
+
+  (benchmark "string with escapes" 1000
+    (display %string-with-escapes %null))
+
+  (benchmark "string without escapes" 1000
+    (display %string-without-escapes %null)))
diff --git a/libguile/print.c b/libguile/print.c
index 212b70d..ce48f88 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -54,6 +54,14 @@
 
 
 
+/* Character printers.  */
+
+static int display_character (scm_t_wchar, SCM,
+                             scm_t_string_failed_conversion_handler);
+static void write_character (scm_t_wchar, SCM, int);
+
+
+
 /* {Names of immediate symbols}
  * 
  * This table must agree with the declarations in scm.h: {Immediate Symbols}.
@@ -461,79 +469,17 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
     case scm_tc3_imm24:
       if (SCM_CHARP (exp))
        {
-         scm_t_wchar i = SCM_CHAR (exp);
-          const char *name;
-
          if (SCM_WRITINGP (pstate))
+           write_character (SCM_CHAR (exp), port, 0);
+         else
            {
-             scm_puts ("#\\", port);
-             name = scm_i_charname (exp);
-             if (name != NULL)
-               scm_puts (name, port);
-             else if (uc_is_general_category_withtable (i, UC_CATEGORY_MASK_L
-                                                         | UC_CATEGORY_MASK_M 
-                                                         | UC_CATEGORY_MASK_N 
-                                                         | UC_CATEGORY_MASK_P 
-                                                         | UC_CATEGORY_MASK_S))
-                /* Print the character if is graphic character.  */
-                {
-                  scm_t_wchar *wbuf;
-                  SCM wstr;
-                  char *buf;
-                  size_t len;
-                  const char *enc;
-
-                  enc = scm_i_get_port_encoding (port);
-                  if (uc_combining_class (i) == UC_CCC_NR)
-                    {
-                      wstr = scm_i_make_wide_string (1, &wbuf);
-                      wbuf[0] = i;
-                    }
-                  else
-                    {
-                      /* Character is a combining character: print it connected
-                         to a dotted circle instead of connecting it to the 
-                         backslash in '#\'  */
-                      wstr = scm_i_make_wide_string (2, &wbuf);
-                      wbuf[0] = SCM_CODEPOINT_DOTTED_CIRCLE;
-                      wbuf[1] = i;
-                    }
-                  if (enc == NULL)
-                    {
-                      if (i <= 0xFF)
-                        /* Character is graphic and Latin-1.  Print it  */
-                        scm_lfwrite_str (wstr, port);
-                      else
-                        /* Character is graphic but unrepresentable in
-                           this port's encoding.  */
-                        PRINT_CHAR_ESCAPE (i, port);
-                    }
-                  else
-                    {
-                      buf = u32_conv_to_encoding (enc, 
-                                                  iconveh_error,
-                                                  (scm_t_uint32 *) wbuf, 
-                                                  1,
-                                                  NULL,
-                                                  NULL, &len);
-                      if (buf != NULL)
-                        {
-                          /* Character is graphic.  Print it.  */
-                          scm_lfwrite_str (wstr, port);
-                          free (buf);
-                        }
-                      else
-                        /* Character is graphic but unrepresentable in
-                           this port's encoding.  */
-                        PRINT_CHAR_ESCAPE (i, port);
-                    }
-                }
-              else
-                /* Character is a non-graphical character.  */
-                PRINT_CHAR_ESCAPE (i, port);
+             if (!display_character (SCM_CHAR (exp), port,
+                                     scm_i_get_conversion_strategy (port)))
+               scm_encoding_error (__func__, errno,
+                                   "cannot convert to output locale",
+                                   "UTF-32", scm_i_get_port_encoding (port),
+                                   scm_string (scm_list_1 (exp)));
            }
-         else
-           scm_i_charprint (i, port);
        }
       else if (SCM_IFLAGP (exp)
               && ((size_t) SCM_IFLAGNUM (exp) < (sizeof iflagnames / sizeof 
(char *))))
@@ -597,132 +543,13 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
         case scm_tc7_string:
           if (SCM_WRITINGP (pstate))
             {
-              size_t i, len;
-              static char const hex[] = "0123456789abcdef";
-              char buf[9];
-
+              size_t len, i;
 
               scm_putc ('"', port);
               len = scm_i_string_length (exp);
               for (i = 0; i < len; ++i)
-                {
-                  scm_t_wchar ch = scm_i_string_ref (exp, i);
-                  int printed = 0;
-
-                  if (ch == ' ' || ch == '\n')
-                    {
-                      scm_putc (ch, port);
-                      printed = 1;
-                    }
-                  else if (ch == '"' || ch == '\\')
-                    {
-                      scm_putc ('\\', port);
-                      scm_i_charprint (ch, port);
-                      printed = 1;
-                    }
-                  else
-                    if (uc_is_general_category_withtable
-                        (ch,
-                         UC_CATEGORY_MASK_L | UC_CATEGORY_MASK_M |
-                         UC_CATEGORY_MASK_N | UC_CATEGORY_MASK_P |
-                         UC_CATEGORY_MASK_S))
-                    {
-                      /* Print the character since it is a graphic
-                         character.  */
-                      scm_t_wchar *wbuf;
-                      SCM wstr = scm_i_make_wide_string (1, &wbuf);
-                      char *buf;
-                      size_t len;
-                      
-                      if (scm_i_get_port_encoding (port))
-                        {
-                          wstr = scm_i_make_wide_string (1, &wbuf);
-                          wbuf[0] = ch;
-                          buf = u32_conv_to_encoding (scm_i_get_port_encoding 
(port), 
-                                                      iconveh_error,
-                                                      (scm_t_uint32 *) wbuf, 
-                                                      1   ,
-                                                      NULL,
-                                                      NULL, &len);
-                          if (buf != NULL)
-                            {
-                              /* Character is graphic and representable in
-                                 this encoding.  Print it.  */
-                              scm_lfwrite_str (wstr, port);
-                              free (buf);
-                              printed = 1;
-                            }
-                        }
-                      else
-                        if (ch <= 0xFF)
-                          {
-                            scm_putc (ch, port);
-                            printed = 1;
-                          }
-                    }
-
-                  if (!printed)
-                    {
-                      /* Character is graphic but unrepresentable in
-                         this port's encoding or is not graphic.  */
-                      if (!SCM_R6RS_ESCAPES_P)
-                        {
-                          if (ch <= 0xFF)
-                            {
-                              buf[0] = '\\';
-                              buf[1] = 'x';
-                              buf[2] = hex[ch / 16];
-                              buf[3] = hex[ch % 16];
-                              scm_lfwrite (buf, 4, port);
-                            }
-                          else if (ch <= 0xFFFF)
-                            {
-                              buf[0] = '\\';
-                              buf[1] = 'u';
-                              buf[2] = hex[(ch & 0xF000) >> 12];
-                              buf[3] = hex[(ch & 0xF00) >> 8];
-                              buf[4] = hex[(ch & 0xF0) >> 4];
-                              buf[5] = hex[(ch & 0xF)];
-                              scm_lfwrite (buf, 6, port);
-                            }
-                          else if (ch > 0xFFFF)
-                            {
-                              buf[0] = '\\';
-                              buf[1] = 'U';
-                              buf[2] = hex[(ch & 0xF00000) >> 20];
-                              buf[3] = hex[(ch & 0xF0000) >> 16];
-                              buf[4] = hex[(ch & 0xF000) >> 12];
-                              buf[5] = hex[(ch & 0xF00) >> 8];
-                              buf[6] = hex[(ch & 0xF0) >> 4];
-                              buf[7] = hex[(ch & 0xF)];
-                              scm_lfwrite (buf, 8, port);
-                            }
-                        }
-                      else
-                        {
-                          scm_t_wchar ch2 = ch;
-                          
-                          /* Print an R6RS variable-length hex escape: 
"\xNNNN;"
-                          */
-                          int i = 8;
-                          buf[i] = ';';
-                          i --;
-                          if (ch == 0)
-                            buf[i--] = '0';
-                          else
-                            while (ch2 > 0)
-                              {
-                                buf[i] = hex[ch2 & 0xF];
-                                ch2 >>= 4;
-                                i --;
-                              }
-                          buf[i] = 'x';
-                          i --;
-                          buf[i] = '\\';
-                          scm_lfwrite (buf + i, 9 - i, port);
-                        }
-                    }
-                }
+               write_character (scm_i_string_ref (exp, i), port, 1);
+
               scm_putc ('"', port);
               scm_remember_upto_here_1 (exp);
             }
@@ -917,16 +744,179 @@ scm_prin1 (SCM exp, SCM port, int writingp)
     }
 }
 
-/* Print a character.
- */
-void
-scm_i_charprint (scm_t_wchar ch, SCM port)
+/* Attempt to display CH to PORT according to STRATEGY.  Return non-zero
+   if CH was successfully displayed, zero otherwise (e.g., if it was not
+   representable in PORT's encoding.)  */
+static int
+display_character (scm_t_wchar ch, SCM port,
+                  scm_t_string_failed_conversion_handler strategy)
 {
-  scm_t_wchar *wbuf;
-  SCM wstr = scm_i_make_wide_string (1, &wbuf);
+  int printed;
+  const char *encoding;
 
-  wbuf[0] = ch;
-  scm_lfwrite_str (wstr, port);
+  encoding = scm_i_get_port_encoding (port);
+  if (encoding == NULL)
+    {
+      if (ch <= 0xff)
+       {
+         scm_putc (ch, port);
+         printed = 1;
+       }
+      else
+       printed = 0;
+    }
+  else
+    {
+      size_t len;
+      char locale_encoded[sizeof (ch)], *result;
+
+      len = sizeof (locale_encoded);
+      result = u32_conv_to_encoding (encoding, strategy,
+                                    (scm_t_uint32 *) &ch, 1,
+                                    NULL, locale_encoded, &len);
+      if (result != NULL)
+       {
+         /* CH is graphic; print it.  */
+
+         if (strategy == SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE)
+           {
+             /* Apply the same escaping syntax as in `write_character'.  */
+             if (SCM_R6RS_ESCAPES_P)
+               scm_i_unistring_escapes_to_r6rs_escapes (result, &len);
+             else
+               scm_i_unistring_escapes_to_guile_escapes (result, &len);
+           }
+
+         scm_lfwrite (result, len, port);
+         printed = 1;
+
+         if (SCM_UNLIKELY (result != locale_encoded))
+           free (result);
+       }
+      else
+       printed = 0;
+    }
+
+  return printed;
+}
+
+/* Write CH to PORT, escaping it if it's non-graphic or not
+   representable in PORT's encoding.  If STRING_ESCAPES_P is true and CH
+   needs to be escaped, it is escaped using the in-string escape syntax;
+   otherwise the character escape syntax is used.  */
+static void
+write_character (scm_t_wchar ch, SCM port, int string_escapes_p)
+{
+  int printed = 0;
+
+  if (string_escapes_p)
+    {
+      /* Check if CH deserves special treatment.  */
+      if (ch == '"' || ch == '\\')
+       {
+         scm_putc ('\\', port);
+         scm_putc (ch, port);
+         printed = 1;
+       }
+      else if (ch == ' ' || ch == '\n')
+       {
+         scm_putc (ch, port);
+         printed = 1;
+       }
+    }
+  else
+    scm_puts ("#\\", port);
+
+  if (!printed
+      && uc_is_general_category_withtable (ch,
+                                          UC_CATEGORY_MASK_L |
+                                          UC_CATEGORY_MASK_M |
+                                          UC_CATEGORY_MASK_N |
+                                          UC_CATEGORY_MASK_P |
+                                          UC_CATEGORY_MASK_S))
+    /* CH is graphic; attempt to display it.  */
+    printed = display_character (ch, port, iconveh_error);
+
+  if (!printed)
+    {
+      /* CH isn't graphic or cannot be represented in PORT's
+        encoding.  */
+
+      if (string_escapes_p)
+       {
+         /* Represent CH using the in-string escape syntax.  */
+
+         static const char hex[] = "0123456789abcdef";
+         char buf[9];
+
+         if (!SCM_R6RS_ESCAPES_P)
+           {
+             if (ch <= 0xFF)
+               {
+                 buf[0] = '\\';
+                 buf[1] = 'x';
+                 buf[2] = hex[ch / 16];
+                 buf[3] = hex[ch % 16];
+                 scm_lfwrite (buf, 4, port);
+               }
+             else if (ch <= 0xFFFF)
+               {
+                 buf[0] = '\\';
+                 buf[1] = 'u';
+                 buf[2] = hex[(ch & 0xF000) >> 12];
+                 buf[3] = hex[(ch & 0xF00) >> 8];
+                 buf[4] = hex[(ch & 0xF0) >> 4];
+                 buf[5] = hex[(ch & 0xF)];
+                 scm_lfwrite (buf, 6, port);
+               }
+             else if (ch > 0xFFFF)
+               {
+                 buf[0] = '\\';
+                 buf[1] = 'U';
+                 buf[2] = hex[(ch & 0xF00000) >> 20];
+                 buf[3] = hex[(ch & 0xF0000) >> 16];
+                 buf[4] = hex[(ch & 0xF000) >> 12];
+                 buf[5] = hex[(ch & 0xF00) >> 8];
+                 buf[6] = hex[(ch & 0xF0) >> 4];
+                 buf[7] = hex[(ch & 0xF)];
+                 scm_lfwrite (buf, 8, port);
+               }
+           }
+         else
+           {
+             /* Print an R6RS variable-length hex escape: "\xNNNN;".  */
+             scm_t_wchar ch2 = ch;
+
+             int i = 8;
+             buf[i] = ';';
+             i --;
+             if (ch == 0)
+               buf[i--] = '0';
+             else
+               while (ch2 > 0)
+                 {
+                   buf[i] = hex[ch2 & 0xF];
+                   ch2 >>= 4;
+                   i --;
+                 }
+             buf[i] = 'x';
+             i --;
+             buf[i] = '\\';
+             scm_lfwrite (buf + i, 9 - i, port);
+           }
+       }
+      else
+       {
+         /* Represent CH using the character escape syntax.  */
+         const char *name;
+
+         name = scm_i_charname (SCM_MAKE_CHAR (ch));
+         if (name != NULL)
+           scm_puts (name, port);
+         else
+           PRINT_CHAR_ESCAPE (ch, port);
+       }
+    }
 }
 
 /* Print an integer.
@@ -1089,14 +1079,6 @@ scm_write (SCM obj, SCM port)
   SCM_ASSERT (scm_valid_oport_value_p (port), port, SCM_ARG2, s_write);
 
   scm_prin1 (obj, port, 1);
-#if 0
-#ifdef HAVE_PIPE
-# ifdef EPIPE
-  if (EPIPE == errno)
-    scm_close_port (port);
-# endif
-#endif
-#endif
   return SCM_UNSPECIFIED;
 }
 
@@ -1112,14 +1094,6 @@ scm_display (SCM obj, SCM port)
   SCM_ASSERT (scm_valid_oport_value_p (port), port, SCM_ARG2, s_display);
 
   scm_prin1 (obj, port, 0);
-#if 0
-#ifdef HAVE_PIPE
-# ifdef EPIPE
-  if (EPIPE == errno)
-    scm_close_port (port);
-# endif
-#endif
-#endif
   return SCM_UNSPECIFIED;
 }
 
@@ -1248,16 +1222,15 @@ SCM_DEFINE (scm_write_char, "write-char", 1, 1, 0,
 
   SCM_VALIDATE_CHAR (1, chr);
   SCM_VALIDATE_OPORT_VALUE (2, port);
-  
-  scm_i_charprint (SCM_CHAR (chr), SCM_COERCE_OUTPORT (port));
-#if 0
-#ifdef HAVE_PIPE
-# ifdef EPIPE
-  if (EPIPE == errno)
-    scm_close_port (port);
-# endif
-#endif
-#endif
+
+  port = SCM_COERCE_OUTPORT (port);
+  if (!display_character (SCM_CHAR (chr), port,
+                         scm_i_get_conversion_strategy (port)))
+    scm_encoding_error (__func__, errno,
+                       "cannot convert to output locale",
+                       "UTF-32", scm_i_get_port_encoding (port),
+                       scm_string (scm_list_1 (chr)));
+
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
diff --git a/libguile/print.h b/libguile/print.h
index ae2aaef..64d1f4b 100644
--- a/libguile/print.h
+++ b/libguile/print.h
@@ -3,7 +3,7 @@
 #ifndef SCM_PRINT_H
 #define SCM_PRINT_H
 
-/* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2004, 2006, 2008 Free 
Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2004, 2006, 2008, 2010 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
@@ -78,7 +78,6 @@ SCM_API SCM scm_print_options (SCM setting);
 SCM_API SCM scm_make_print_state (void);
 SCM_API void scm_free_print_state (SCM print_state);
 SCM_INTERNAL SCM scm_i_port_with_print_state (SCM port, SCM print_state);
-SCM_INTERNAL void scm_i_charprint (scm_t_wchar c, SCM port);
 SCM_API void scm_intprint (scm_t_intmax n, int radix, SCM port);
 SCM_API void scm_uintprint (scm_t_uintmax n, int radix, SCM port);
 SCM_API void scm_ipruk (char *hdr, SCM ptr, SCM port);
diff --git a/libguile/strings.c b/libguile/strings.c
index 68fa25c..dbff066 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -1577,14 +1577,14 @@ scm_take_locale_string (char *str)
 
 /* Change libunistring escapes (\uXXXX and \UXXXXXXXX) to \xXX \uXXXX
    and \UXXXXXX.  */
-static void
-unistring_escapes_to_guile_escapes (char **bufp, size_t *lenp)
+void
+scm_i_unistring_escapes_to_guile_escapes (char *buf, size_t *lenp)
 {
   char *before, *after;
   size_t i, j;
 
-  before = *bufp;
-  after = *bufp;
+  before = buf;
+  after = buf;
   i = 0;
   j = 0;
   while (i < *lenp)
@@ -1627,12 +1627,11 @@ unistring_escapes_to_guile_escapes (char **bufp, size_t 
*lenp)
         }
     }
   *lenp = j;
-  after = scm_realloc (after, j);
 }
 
 /* Change libunistring escapes (\uXXXX and \UXXXXXXXX) to \xXXXX; */
-static void
-unistring_escapes_to_r6rs_escapes (char **bufp, size_t *lenp)
+void
+scm_i_unistring_escapes_to_r6rs_escapes (char *buf, size_t *lenp)
 {
   char *before, *after;
   size_t i, j;
@@ -1641,7 +1640,7 @@ unistring_escapes_to_r6rs_escapes (char **bufp, size_t 
*lenp)
   size_t max_out_len = (*lenp * 7) / 6 + 1;
   size_t nzeros, ndigits;
 
-  before = *bufp;
+  before = buf;
   after = alloca (max_out_len);
   i = 0;
   j = 0;
@@ -1699,7 +1698,6 @@ unistring_escapes_to_r6rs_escapes (char **bufp, size_t 
*lenp)
         }
     }
   *lenp = j;
-  before = scm_realloc (before, j);
   memcpy (before, after, j);
 }
 
@@ -1817,9 +1815,11 @@ scm_to_stringn (SCM str, size_t *lenp, const char 
*encoding,
   if (handler == SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE)
     {
       if (SCM_R6RS_ESCAPES_P)
-        unistring_escapes_to_r6rs_escapes (&buf, &len);
+        scm_i_unistring_escapes_to_r6rs_escapes (buf, &len);
       else
-        unistring_escapes_to_guile_escapes (&buf, &len);
+        scm_i_unistring_escapes_to_guile_escapes (buf, &len);
+
+      buf = scm_realloc (buf, len);
     }
   if (lenp)
     *lenp = len;
diff --git a/libguile/strings.h b/libguile/strings.h
index 4b120e0..d439259 100644
--- a/libguile/strings.h
+++ b/libguile/strings.h
@@ -204,6 +204,10 @@ SCM_INTERNAL char **scm_i_allocate_string_pointers (SCM 
list);
 SCM_INTERNAL void scm_i_get_substring_spec (size_t len,
                                            SCM start, size_t *cstart,
                                            SCM end, size_t *cend);
+SCM_INTERNAL void scm_i_unistring_escapes_to_guile_escapes (char *buf,
+                                                           size_t *len);
+SCM_INTERNAL void scm_i_unistring_escapes_to_r6rs_escapes (char *buf,
+                                                          size_t *len);
 
 /* Debugging functions */
 


hooks/post-receive
-- 
GNU Guile



reply via email to

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