Re: Reducing iconv-induced memory usage

[Ludovic Courtès]

Hi!

So, here’s the patch.

It also makes UTF-8 input ~30% faster according to ports.bm (which
doesn’t benchmark output):

  * before:

    ("ports.bm: peek-char: latin-1 port" 700000 user 0.36)
    ("ports.bm: peek-char: utf-8 port, ascii character" 700000 user 0.35)
    ("ports.bm: peek-char: utf-8 port, Korean character" 700000 user 0.61)
    ("ports.bm: read-char: latin-1 port" 10000000 user 3.32)
    ("ports.bm: read-char: utf-8 port, ascii character" 10000000 user 3.33)
    ("ports.bm: read-char: utf-8 port, Korean character" 10000000 user 3.39)
    ("ports.bm: char-ready?: latin-1 port" 10000000 user 2.95)
    ("ports.bm: char-ready?: utf-8 port, ascii character" 10000000 user 2.96)
    ("ports.bm: char-ready?: utf-8 port, Korean character" 10000000 user 3.01)
    ("ports.bm: rdelim: read-line" 1000 user 3.1)

  * after:

    ("ports.bm: peek-char: latin-1 port" 700000 user 0.31)
    ("ports.bm: peek-char: utf-8 port, ascii character" 700000 user 0.24)
    ("ports.bm: peek-char: utf-8 port, Korean character" 700000 user 0.3)
    ("ports.bm: read-char: latin-1 port" 10000000 user 2.73)
    ("ports.bm: read-char: utf-8 port, ascii character" 10000000 user 3.38)
    ("ports.bm: read-char: utf-8 port, Korean character" 10000000 user 3.37)
    ("ports.bm: char-ready?: latin-1 port" 10000000 user 2.42)
    ("ports.bm: char-ready?: utf-8 port, ascii character" 10000000 user 2.41)
    ("ports.bm: char-ready?: utf-8 port, Korean character" 10000000 user 2.43)
    ("ports.bm: rdelim: read-line" 1000 user 1.91)

Comments?  OK to apply?

Thanks,
Ludo’.

diff --git a/libguile/ports.c b/libguile/ports.c
index 6e0ae6c..d728356 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -1057,6 +1057,7 @@ update_port_lf (scm_t_wchar c, SCM port)
   switch (c)
     {
     case '\a':
+    case EOF:
       break;
     case '\b':
       SCM_DECCOL (port);
@@ -1115,23 +1116,113 @@ utf8_to_codepoint (const scm_t_uint8 *utf8_buf, size_t 
size)
   return codepoint;
 }
 
-/* Read a codepoint from PORT and return it in *CODEPOINT.  Fill BUF
-   with the byte representation of the codepoint in PORT's encoding, and
-   set *LEN to the length in bytes of that representation.  Return 0 on
-   success and an errno value on error.  */
+/* Read a UTF-8 sequence from PORT.  On success, return 0 and set
+   *CODEPOINT to the codepoint that was read, fill BUF with its UTF-8
+   representation, and set *LEN to the length in bytes.  Return
+   `EILSEQ' on error.  */
 static int
-get_codepoint (SCM port, scm_t_wchar *codepoint,
-              char buf[SCM_MBCHAR_BUF_SIZE], size_t *len)
+get_utf8_codepoint (SCM port, scm_t_wchar *codepoint,
+                   scm_t_uint8 buf[SCM_MBCHAR_BUF_SIZE], size_t *len)
+{
+  int byte;
+
+  *len = 0;
+
+  byte = scm_get_byte_or_eof (port);
+  if (byte == EOF)
+    {
+      *codepoint = EOF;
+      return 0;
+    }
+
+  buf[0] = (scm_t_uint8) byte;
+  *len = 1;
+
+  if (buf[0] <= 0x7f)
+    *codepoint = buf[0];
+  else if ((buf[0] & 0xe0) == 0xc0)
+    {
+      byte = scm_get_byte_or_eof (port);
+      if (byte == EOF || ((byte & 0xc0) != 0x80))
+       goto invalid_seq;
+
+      buf[1] = (scm_t_uint8) byte;
+      *len = 2;
+
+      *codepoint = ((scm_t_wchar) buf[0] & 0x1f) << 6UL
+       | (buf[1] & 0x3f);
+    }
+  else if ((buf[0] & 0xf0) == 0xe0)
+    {
+      byte = scm_get_byte_or_eof (port);
+      if (byte == EOF || ((byte & 0xc0) != 0x80))
+       goto invalid_seq;
+
+      buf[1] = (scm_t_uint8) byte;
+      *len = 2;
+
+      byte = scm_get_byte_or_eof (port);
+      if (byte == EOF || ((byte & 0xc0) != 0x80))
+       goto invalid_seq;
+
+      buf[2] = (scm_t_uint8) byte;
+      *len = 3;
+
+      *codepoint = ((scm_t_wchar) buf[0] & 0x0f) << 12UL
+       | ((scm_t_wchar) buf[1] & 0x3f) << 6UL
+       | (buf[2] & 0x3f);
+    }
+  else
+    {
+      byte = scm_get_byte_or_eof (port);
+      if (byte == EOF || ((byte & 0xc0) != 0x80))
+       goto invalid_seq;
+
+      buf[1] = (scm_t_uint8) byte;
+      *len = 2;
+
+      byte = scm_get_byte_or_eof (port);
+      if (byte == EOF || ((byte & 0xc0) != 0x80))
+       goto invalid_seq;
+
+      buf[2] = (scm_t_uint8) byte;
+      *len = 3;
+
+      byte = scm_get_byte_or_eof (port);
+      if (byte == EOF || ((byte & 0xc0) != 0x80))
+       goto invalid_seq;
+
+      buf[3] = (scm_t_uint8) byte;
+      *len = 4;
+
+      *codepoint = ((scm_t_wchar) buf[0] & 0x07) << 18UL
+       | ((scm_t_wchar) buf[1] & 0x3f) << 12UL
+       | ((scm_t_wchar) buf[2] & 0x3f) << 6UL
+       | (buf[3] & 0x3f);
+    }
+
+  return 0;
+
+ invalid_seq:
+  /* Return the faulty byte.  */
+  scm_unget_byte (byte, port);
+
+  return EILSEQ;
+}
+
+/* Likewise, read a byte sequence from PORT, passing it through its
+   input conversion descriptor.  */
+static int
+get_iconv_codepoint (SCM port, scm_t_wchar *codepoint,
+                    char buf[SCM_MBCHAR_BUF_SIZE], size_t *len)
 {
+  scm_t_port *pt;
   int err, byte_read;
   size_t bytes_consumed, output_size;
   char *output;
   scm_t_uint8 utf8_buf[SCM_MBCHAR_BUF_SIZE];
-  scm_t_port *pt = SCM_PTAB_ENTRY (port);
 
-  if (SCM_UNLIKELY (pt->input_cd == (iconv_t) -1))
-    /* Initialize the conversion descriptors.  */
-    scm_i_set_port_encoding_x (port, pt->encoding);
+  pt = SCM_PTAB_ENTRY (port);
 
   for (output_size = 0, output = (char *) utf8_buf,
         bytes_consumed = 0, err = 0;
@@ -1174,10 +1265,44 @@ get_codepoint (SCM port, scm_t_wchar *codepoint,
        output_size = sizeof (utf8_buf) - output_left;
     }
 
-  if (SCM_UNLIKELY (err != 0))
+
+  if (SCM_LIKELY (err == 0))
+    {
+      /* Convert the UTF8_BUF sequence to a Unicode code point.  */
+      *codepoint = utf8_to_codepoint (utf8_buf, output_size);
+      *len = bytes_consumed;
+    }
+
+  return err;
+}
+
+/* Read a codepoint from PORT and return it in *CODEPOINT.  Fill BUF
+   with the byte representation of the codepoint in PORT's encoding, and
+   set *LEN to the length in bytes of that representation.  Return 0 on
+   success and an errno value on error.  */
+static int
+get_codepoint (SCM port, scm_t_wchar *codepoint,
+              char buf[SCM_MBCHAR_BUF_SIZE], size_t *len)
+{
+  int err;
+  scm_t_port *pt = SCM_PTAB_ENTRY (port);
+
+  if (pt->input_cd == (iconv_t) -1)
+    /* Initialize the conversion descriptors, if needed.  */
+    scm_i_set_port_encoding_x (port, pt->encoding);
+
+  if (pt->input_cd == (iconv_t) -1)
+    err = get_utf8_codepoint (port, codepoint, (scm_t_uint8 *) buf, len);
+  else
+    err = get_iconv_codepoint (port, codepoint, buf, len);
+
+  if (SCM_LIKELY (err == 0))
+    update_port_lf (*codepoint, port);
+  else
     {
-      /* Reset the `iconv' state.  */
-      iconv (pt->input_cd, NULL, NULL, NULL, NULL);
+      if (pt->input_cd != (iconv_t) -1)
+       /* Reset the `iconv' state.  */
+       iconv (pt->input_cd, NULL, NULL, NULL, NULL);
 
       if (pt->ilseq_handler == SCM_ICONVEH_QUESTION_MARK)
        {
@@ -1189,14 +1314,6 @@ get_codepoint (SCM port, scm_t_wchar *codepoint,
         SCM_ICONVEH_ESCAPE_SEQUENCE (the latter doesn't make sense for
         input encoding errors.)  */
     }
-  else
-    /* Convert the UTF8_BUF sequence to a Unicode code point.  */
-    *codepoint = utf8_to_codepoint (utf8_buf, output_size);
-
-  if (SCM_LIKELY (err == 0))
-    update_port_lf (*codepoint, port);
-
-  *len = bytes_consumed;
 
   return err;
 }
@@ -2027,28 +2144,35 @@ scm_i_set_port_encoding_x (SCM port, const char 
*encoding)
   if (encoding == NULL)
     encoding = "ISO-8859-1";
 
-  pt->encoding = scm_gc_strdup (encoding, "port");
+  if (pt->encoding != encoding)
+    pt->encoding = scm_gc_strdup (encoding, "port");
 
-  if (SCM_CELL_WORD_0 (port) & SCM_RDNG)
+  /* If ENCODING is UTF-8, then no conversion descriptor is opened
+     because we do I/O ourselves.  This saves 100+ KiB for each
+     descriptor.  */
+  if (strcmp (encoding, "UTF-8"))
     {
-      /* Open an input iconv conversion descriptor, from ENCODING
-        to UTF-8.  We choose UTF-8, not UTF-32, because iconv
-        implementations can typically convert from anything to
-        UTF-8, but not to UTF-32 (see
-        
<http://lists.gnu.org/archive/html/bug-libunistring/2010-09/msg00007.html>).  */
-      new_input_cd = iconv_open ("UTF-8", encoding);
-      if (new_input_cd == (iconv_t) -1)
-       goto invalid_encoding;
-    }
+      if (SCM_CELL_WORD_0 (port) & SCM_RDNG)
+       {
+         /* Open an input iconv conversion descriptor, from ENCODING
+            to UTF-8.  We choose UTF-8, not UTF-32, because iconv
+            implementations can typically convert from anything to
+            UTF-8, but not to UTF-32 (see
+            
<http://lists.gnu.org/archive/html/bug-libunistring/2010-09/msg00007.html>).  */
+         new_input_cd = iconv_open ("UTF-8", encoding);
+         if (new_input_cd == (iconv_t) -1)
+           goto invalid_encoding;
+       }
 
-  if (SCM_CELL_WORD_0 (port) & SCM_WRTNG)
-    {
-      new_output_cd = iconv_open (encoding, "UTF-8");
-      if (new_output_cd == (iconv_t) -1)
+      if (SCM_CELL_WORD_0 (port) & SCM_WRTNG)
        {
-         if (new_input_cd != (iconv_t) -1)
-           iconv_close (new_input_cd);
-         goto invalid_encoding;
+         new_output_cd = iconv_open (encoding, "UTF-8");
+         if (new_output_cd == (iconv_t) -1)
+           {
+             if (new_input_cd != (iconv_t) -1)
+               iconv_close (new_input_cd);
+             goto invalid_encoding;
+           }
        }
     }
 
diff --git a/libguile/print.c b/libguile/print.c
index 1399566..d18c054 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -821,33 +821,58 @@ codepoint_to_utf8 (scm_t_wchar ch, scm_t_uint8 utf8[4])
   return len;
 }
 
-/* Display the LEN codepoints in STR to PORT according to STRATEGY;
-   return the number of codepoints successfully displayed.  If NARROW_P,
-   then STR is interpreted as a sequence of `char', denoting a Latin-1
-   string; otherwise it's interpreted as a sequence of
-   `scm_t_wchar'.  */
-static size_t
-display_string (const void *str, int narrow_p,
-               size_t len, SCM port,
-               scm_t_string_failed_conversion_handler strategy)
-
-{
 #define STR_REF(s, x)                          \
   (narrow_p                                    \
    ? (scm_t_wchar) ((unsigned char *) (s))[x]  \
    : ((scm_t_wchar *) (s))[x])
 
+/* Write STR to PORT as UTF-8.  STR is a LEN-codepoint string; it is
+   narrow if NARROW_P is true, wide otherwise.  Return LEN.  */
+static size_t
+display_string_as_utf8 (const void *str, int narrow_p, size_t len,
+                       SCM port)
+{
+  size_t printed = 0;
+
+  while (len > printed)
+    {
+      size_t utf8_len, i;
+      char *input, utf8_buf[256];
+
+      /* Convert STR to UTF-8.  */
+      for (i = printed, utf8_len = 0, input = utf8_buf;
+          i < len && utf8_len + 4 < sizeof (utf8_buf);
+          i++)
+       {
+         utf8_len += codepoint_to_utf8 (STR_REF (str, i),
+                                        (scm_t_uint8 *) input);
+         input = utf8_buf + utf8_len;
+       }
+
+      /* INPUT was successfully converted, entirely; print the
+        result.  */
+      scm_lfwrite (utf8_buf, utf8_len, port);
+      printed += i - printed;
+    }
+
+  assert (printed == len);
+
+  return len;
+}
+
+/* Convert STR through PORT's output conversion descriptor and write the
+   output to PORT.  Return the number of codepoints written.  */
+static size_t
+display_string_using_iconv (const void *str, int narrow_p, size_t len,
+                           SCM port,
+                           scm_t_string_failed_conversion_handler strategy)
+{
   size_t printed;
   scm_t_port *pt;
 
   pt = SCM_PTAB_ENTRY (port);
 
-  if (SCM_UNLIKELY (pt->output_cd == (iconv_t) -1))
-    /* Initialize the conversion descriptors.  */
-    scm_i_set_port_encoding_x (port, pt->encoding);
-
   printed = 0;
-
   while (len > printed)
     {
       size_t done, utf8_len, input_left, output_left, i;
@@ -880,7 +905,7 @@ display_string (const void *str, int narrow_p,
 
       if (SCM_UNLIKELY (done == (size_t) -1))
        {
-          int errno_save = errno;
+         int errno_save = errno;
 
          /* Reset the `iconv' state.  */
          iconv (pt->output_cd, NULL, NULL, NULL, NULL);
@@ -928,7 +953,34 @@ display_string (const void *str, int narrow_p,
     }
 
   return printed;
+}
+
 #undef STR_REF
+
+/* Display the LEN codepoints in STR to PORT according to STRATEGY;
+   return the number of codepoints successfully displayed.  If NARROW_P,
+   then STR is interpreted as a sequence of `char', denoting a Latin-1
+   string; otherwise it's interpreted as a sequence of
+   `scm_t_wchar'.  */
+static size_t
+display_string (const void *str, int narrow_p,
+               size_t len, SCM port,
+               scm_t_string_failed_conversion_handler strategy)
+
+{
+  scm_t_port *pt;
+
+  pt = SCM_PTAB_ENTRY (port);
+
+  if (pt->output_cd == (iconv_t) -1)
+    /* Initialize the conversion descriptors, if needed.  */
+    scm_i_set_port_encoding_x (port, pt->encoding);
+
+  if (pt->output_cd == (iconv_t) -1)
+    return display_string_as_utf8 (str, narrow_p, len, port);
+  else
+    return display_string_using_cd (str, narrow_p, len,
+                                   port, strategy);
 }
 
 /* Attempt to display CH to PORT according to STRATEGY.  Return non-zero
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 9d3000c..d5b1b60 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -391,7 +391,8 @@
                      (with-fluids ((%default-port-encoding e))
                        (call-with-output-string
                          (lambda (p)
-                           (display (port-encoding p) p)))))
+                           (and (string=? e (port-encoding p))
+                                (display (port-encoding p) p))))))
                    encodings)
               encodings)))
 
@@ -462,6 +463,15 @@
            (= (port-line p) 0)
            (= (port-column p) 0))))
 
+  (pass-if "peek-char [utf-16]"
+    (let ((p (with-fluids ((%default-port-encoding "UTF-16BE"))
+               (open-input-string "안녕하세요"))))
+      (and (char=? (peek-char p) #\안)
+           (char=? (peek-char p) #\안)
+           (char=? (peek-char p) #\안)
+           (= (port-line p) 0)
+           (= (port-column p) 0))))
+
   (pass-if "read-char, wrong encoding, error"
     (let ((p (open-bytevector-input-port #vu8(255 65 66 67))))
       (catch 'decoding-error