[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-190-g6347911

[Ludovic Courtès]

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=63479112d6176515850fcbf72cbe5f64b633f564

The branch, master has been updated
       via  63479112d6176515850fcbf72cbe5f64b633f564 (commit)
       via  d14418a535049f9be9c29db65c9e267bb303ae9c (commit)
       via  88e41e94d3b80de5f96f7044ed35f0e1137377fc (commit)
       via  736aff00863dc9e12a26e01aba63d29499c073ea (commit)
      from  d286c8ce342abc6b647ccf5a68b292fe13ec5cb8 (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 63479112d6176515850fcbf72cbe5f64b633f564
Author: Ludovic Courtès <address@hidden>
Date:   Thu Jul 15 18:49:12 2010 +0200

    Remove heap allocations in `scm_getc', `scm_ungetc', and 
`find_valid_encoding'.
    
    * libguile/ports.c (scm_getc): Provide `u32_conv_from_encoding' with the
      RESULT_BUF stack-allocated buffer to avoid heap allocation.
      (find_valid_encoding): Likewise.
      (scm_ungetc): Ditto with `u32_conv_to_encoding'.

commit d14418a535049f9be9c29db65c9e267bb303ae9c
Author: Ludovic Courtès <address@hidden>
Date:   Thu Jul 15 18:45:29 2010 +0200

    Expose `scm_encoding_error'.
    
    * libguile/strings.c (scm_encoding_error): Make public.
    
    * libguile/strings.h (scm_encoding_error): New internal declaration.

commit 88e41e94d3b80de5f96f7044ed35f0e1137377fc
Author: Ludovic Courtès <address@hidden>
Date:   Thu Jul 15 18:39:49 2010 +0200

    sxml-match: Always use the same prompt tag.
    
    * module/sxml/match.scm (%call/ec-prompt): New variable.
      (call/ec): Use it instead of creating a new prompt tag.

commit 736aff00863dc9e12a26e01aba63d29499c073ea
Author: Ludovic Courtès <address@hidden>
Date:   Thu Jul 15 18:38:39 2010 +0200

    Declare `ice-9/psyntax-pp.scm.gen' as a phony target.
    
    * module/Makefile.am (.PHONY): Add `ice-9/psyntax-pp.scm.gen'.

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

Summary of changes:
 libguile/ports.c      |   72 ++++++++++++++++++++++++++++++++++++-------------
 libguile/strings.c    |    2 +-
 libguile/strings.h    |    4 +++
 module/Makefile.am    |    2 +
 module/sxml/match.scm |   18 +++++++-----
 5 files changed, 70 insertions(+), 28 deletions(-)

diff --git a/libguile/ports.c b/libguile/ports.c
index 7328767..7c3791d 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -1030,6 +1030,7 @@ scm_getc (SCM port)
   int c;
   unsigned int bufcount = 0;
   char buf[SCM_MBCHAR_BUF_SIZE];
+  scm_t_uint32 result_buf;
   scm_t_wchar codepoint = 0;
   scm_t_uint32 *u32;
   size_t u32len;
@@ -1043,7 +1044,7 @@ scm_getc (SCM port)
   bufcount++;
 
   if (pt->encoding == NULL)
-    { 
+    {
       /* The encoding is Latin-1: bytes are characters.  */
       codepoint = (unsigned char) buf[0];
       goto success;
@@ -1051,22 +1052,29 @@ scm_getc (SCM port)
 
   for (;;)
     {
-      u32 = u32_conv_from_encoding (pt->encoding, 
-                                    (enum iconv_ilseq_handler) 
pt->ilseq_handler, 
-                                   buf, bufcount, NULL, NULL, &u32len);
+      u32len = sizeof (result_buf) / sizeof (scm_t_uint32);
+      u32 = u32_conv_from_encoding (pt->encoding,
+                                    (enum iconv_ilseq_handler) 
pt->ilseq_handler,
+                                   buf, bufcount, NULL, &result_buf, &u32len);
       if (u32 == NULL || u32len == 0)
        {
          if (errno == ENOMEM)
            scm_memory_error ("Input decoding");
-          
+
          /* Otherwise errno is EILSEQ or EINVAL, so perhaps more
              bytes are needed.  Keep looping.  */
        }
-      else 
+      else
        {
          /* Complete codepoint found. */
          codepoint = u32[0];
-         free (u32);
+
+         if (SCM_UNLIKELY (u32 != &result_buf))
+           /* libunistring up to 0.9.3 (included) would always heap-allocate
+              the result even when a large-enough RESULT_BUF is supplied, see
+              
<http://lists.gnu.org/archive/html/bug-libunistring/2010-07/msg00003.html>.  */
+           free (u32);
+
          goto success;
        }
 
@@ -1543,22 +1551,44 @@ scm_unget_byte (int c, SCM port)
 }
 #undef FUNC_NAME
 
-void 
+void
 scm_ungetc (scm_t_wchar c, SCM port)
 #define FUNC_NAME "scm_ungetc"
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
-  scm_t_wchar *wbuf;
-  SCM str = scm_i_make_wide_string (1, &wbuf);
-  char *buf;
+  char *result;
+  char result_buf[10];
+  const char *encoding;
   size_t len;
   int i;
 
-  wbuf[0] = c;
-  buf = scm_to_stringn (str, &len, pt->encoding, pt->ilseq_handler);
-    
+  if (pt->encoding != NULL)
+    encoding = pt->encoding;
+  else
+    encoding = "ISO-8859-1";
+
+  len = sizeof (result_buf);
+  result = u32_conv_to_encoding (encoding,
+                                (enum iconv_ilseq_handler) pt->ilseq_handler,
+                                (uint32_t *) &c, 1, NULL,
+                                result_buf, &len);
+
+  if (SCM_UNLIKELY (result == NULL || len == 0))
+    {
+      SCM chr;
+
+      chr = scm_integer_to_char (scm_from_uint32 (c));
+      scm_encoding_error (FUNC_NAME, errno,
+                         "conversion to port encoding failed",
+                         "UTF-32", encoding,
+                         scm_string (scm_list_1 (chr)));
+    }
+
   for (i = len - 1; i >= 0; i--)
-    scm_unget_byte (buf[i], port);
+    scm_unget_byte (result[i], port);
+
+  if (SCM_UNLIKELY (result != result_buf))
+    free (result);
 
   if (c == '\n')
     {
@@ -1963,14 +1993,18 @@ find_valid_encoding (const char *enc)
 {
   int isvalid = 0;
   const char str[] = " ";
+  scm_t_uint32 result_buf;
   scm_t_uint32 *u32;
   size_t u32len;
-    
+
+  u32len = sizeof (result_buf) / sizeof (scm_t_uint32);
   u32 = u32_conv_from_encoding (enc, iconveh_error, str, 1,
-                                NULL, NULL, &u32len);
+                                NULL, &result_buf, &u32len);
   isvalid = (u32 != NULL);
-  free (u32);
-    
+
+  if (SCM_UNLIKELY (u32 != &result_buf))
+    free (u32);
+
   if (isvalid)
     return enc;
 
diff --git a/libguile/strings.c b/libguile/strings.c
index 6d2b7c0..52dfb53 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -1410,7 +1410,7 @@ scm_is_string (SCM obj)
 /* Conversion to/from other encodings.  */
 
 SCM_SYMBOL (scm_encoding_error_key, "encoding-error");
-static void
+void
 scm_encoding_error (const char *subr, int err, const char *message,
                    const char *from, const char *to, SCM string_or_bv)
 {
diff --git a/libguile/strings.h b/libguile/strings.h
index ad9518c..734ac62 100644
--- a/libguile/strings.h
+++ b/libguile/strings.h
@@ -195,6 +195,10 @@ SCM_INTERNAL int scm_i_is_narrow_symbol (SCM str);
 SCM_INTERNAL int scm_i_try_narrow_string (SCM str);
 SCM_INTERNAL SCM scm_i_symbol_substring (SCM sym, size_t start, size_t end);
 SCM_INTERNAL scm_t_wchar scm_i_symbol_ref (SCM sym, size_t x);
+SCM_INTERNAL void scm_encoding_error (const char *subr, int err,
+                                     const char *message,
+                                     const char *from, const char *to,
+                                     SCM string_or_bv);
 
 /* internal utility functions. */
 
diff --git a/module/Makefile.am b/module/Makefile.am
index 2099dda..87e7bbb 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -78,6 +78,8 @@ ice-9/psyntax-pp.scm.gen:
                $(srcdir)/ice-9/psyntax.scm $(srcdir)/ice-9/psyntax-pp.scm
        touch -r "$(srcdir)/ice-9/psyntax.scm" "$(srcdir)/ice-9/psyntax-pp.scm"
 
+.PHONY: ice-9/psyntax-pp.scm.gen
+
 ice-9/psyntax-pp.go: ice-9/psyntax.scm
        GUILE_AUTO_COMPILE=0                                    \
        $(top_builddir)/meta/uninstalled-env                    \
diff --git a/module/sxml/match.scm b/module/sxml/match.scm
index d9d0285..9aebc01 100644
--- a/module/sxml/match.scm
+++ b/module/sxml/match.scm
@@ -49,18 +49,20 @@
   (syntax-rules ()
     ((_) *unspecified*)))
 
+(define %call/ec-prompt
+  (make-prompt-tag))
+
 (define-syntax call/ec
   ;; aka. `call-with-escape-continuation'
   (syntax-rules ()
     ((_ proc)
-     (let ((prompt (make-prompt-tag)))
-       (call-with-prompt prompt
-                         (lambda ()
-                           (proc (lambda args
-                                   (apply abort-to-prompt
-                                          prompt args))))
-                         (lambda (_ . args)
-                           (apply values args)))))))
+     (call-with-prompt %call/ec-prompt
+                       (lambda ()
+                         (proc (lambda args
+                                 (apply abort-to-prompt
+                                        %call/ec-prompt args))))
+                       (lambda (_ . args)
+                         (apply values args))))))
 
 (define-syntax let/ec
   (syntax-rules ()


hooks/post-receive
-- 
GNU Guile