Merge remote-tracking branch 'origin/stable-2.0'
[bpt/guile.git] / libguile / ports.c
index d3fc453..b453785 100644 (file)
@@ -470,7 +470,8 @@ scm_i_mode_bits_n (SCM modes)
 long
 scm_mode_bits (char *modes)
 {
-  return scm_i_mode_bits (scm_from_locale_string (modes));
+  /* Valid characters are rw+a0l.  So, use latin1.  */
+  return scm_i_mode_bits (scm_from_latin1_string (modes));
 }
 
 long
@@ -532,22 +533,6 @@ SCM scm_i_port_weak_set;
 
 /* Port finalization.  */
 
-static void finalize_port (GC_PTR, GC_PTR);
-
-/* Register a finalizer for PORT.  */
-static SCM_C_INLINE_KEYWORD void
-register_finalizer_for_port (SCM port)
-{
-  GC_finalization_proc prev_finalizer;
-  GC_PTR prev_finalization_data;
-
-  /* Register a finalizer for PORT so that its iconv CDs get freed and
-     optionally its type's `free' function gets called.  */
-  GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (port), finalize_port, 0,
-                                 &prev_finalizer,
-                                 &prev_finalization_data);
-}
-
 struct do_free_data
 {
   scm_t_ptob_descriptor *ptob;
@@ -577,23 +562,17 @@ finalize_port (GC_PTR ptr, GC_PTR data)
 
   if (SCM_OPENP (port))
     {
-      if (SCM_REVEALED (port) > 0)
-       /* Keep "revealed" ports alive and re-register a finalizer.  */
-       register_finalizer_for_port (port);
-      else
-       {
-          struct do_free_data data;
+      struct do_free_data data;
 
-         SCM_CLR_PORT_OPEN_FLAG (port);
+      SCM_CLR_PORT_OPEN_FLAG (port);
 
-          data.ptob = SCM_PORT_DESCRIPTOR (port);
-          data.port = port;
+      data.ptob = SCM_PORT_DESCRIPTOR (port);
+      data.port = port;
 
-          scm_internal_catch (SCM_BOOL_T, do_free, &data,
-                              scm_handle_by_message_noexit, NULL);
+      scm_internal_catch (SCM_BOOL_T, do_free, &data,
+                          scm_handle_by_message_noexit, NULL);
 
-         scm_gc_ports_collected++;
-       }
+      scm_gc_ports_collected++;
     }
 }
 
@@ -627,17 +606,19 @@ scm_c_make_port_with_encoding (scm_t_bits tag, unsigned long mode_bits,
   entry->encoding = encoding ? scm_gc_strdup (encoding, "port") : NULL;
   if (encoding && strcmp (encoding, "UTF-8") == 0)
     entry->encoding_mode = SCM_PORT_ENCODING_MODE_UTF8;
+  else if (!encoding || strcmp (encoding, "ISO-8859-1") == 0)
+    entry->encoding_mode = SCM_PORT_ENCODING_MODE_LATIN1;
   else
     entry->encoding_mode = SCM_PORT_ENCODING_MODE_ICONV;
   entry->ilseq_handler = handler;
   entry->iconv_descriptors = NULL;
 
+  if (SCM_PORT_DESCRIPTOR (ret)->free)
+    scm_i_set_finalizer (SCM2PTR (ret), finalize_port, NULL);
+
   if (SCM_PORT_DESCRIPTOR (ret)->flags & SCM_PORT_TYPE_HAS_FLUSH)
     scm_weak_set_add_x (scm_i_port_weak_set, ret);
 
-  if (SCM_PORT_DESCRIPTOR (ret)->free)
-    register_finalizer_for_port (ret);
-
   return ret;
 }
 
@@ -829,8 +810,20 @@ scm_i_set_default_port_encoding (const char *encoding)
       || !strcmp (encoding, "ISO-8859-1"))
     scm_fluid_set_x (SCM_VARIABLE_REF (default_port_encoding_var), SCM_BOOL_F);
   else
-    scm_fluid_set_x (SCM_VARIABLE_REF (default_port_encoding_var),
-                    scm_from_locale_string (encoding));
+    {
+      SCM str;
+      size_t i;
+
+      str = scm_from_latin1_string (encoding);
+
+      /* Restrict to ASCII.  */
+      for (i = 0; encoding[i]; i++)
+        if (encoding[i] > 127)
+          scm_misc_error ("scm_i_set_default_port_encoding",
+                          "invalid character encoding ~s", scm_list_1 (str));
+
+      scm_fluid_set_x (SCM_VARIABLE_REF (default_port_encoding_var), str);
+    }
 }
 
 /* Return the name of the default encoding for newly created ports; a
@@ -865,10 +858,15 @@ open_iconv_descriptors (const char *encoding, int reading, int writing)
 {
   scm_t_iconv_descriptors *id;
   iconv_t input_cd, output_cd;
+  size_t i;
 
   input_cd = (iconv_t) -1;
   output_cd = (iconv_t) -1;
 
+  for (i = 0; encoding[i]; i++)
+    if (encoding[i] > 127)
+      goto invalid_encoding;
+
   if (reading)
     {
       /* Open an input iconv conversion descriptor, from ENCODING
@@ -905,21 +903,15 @@ open_iconv_descriptors (const char *encoding, int reading, int writing)
   id->input_cd = input_cd;
   id->output_cd = output_cd;
 
-  {
-    GC_finalization_proc prev_finalizer;
-    GC_PTR prev_finalization_data;
-
-    /* Register a finalizer to close the descriptors.  */
-    GC_REGISTER_FINALIZER_NO_ORDER (id, finalize_iconv_descriptors, 0,
-                                    &prev_finalizer, &prev_finalization_data);
-  }
+  /* Register a finalizer to close the descriptors.  */
+  scm_i_set_finalizer (id, finalize_iconv_descriptors, NULL);
 
   return id;
 
  invalid_encoding:
   {
     SCM err;
-    err = scm_from_locale_string (encoding);
+    err = scm_from_latin1_string (encoding);
     scm_misc_error ("open_iconv_descriptors",
                    "invalid or unknown character encoding ~s",
                    scm_list_1 (err));
@@ -959,6 +951,7 @@ scm_i_port_iconv_descriptors (SCM port)
   return pt->iconv_descriptors;
 }
 
+/* The name of the encoding is itself encoded in ASCII.  */
 void
 scm_i_set_port_encoding_x (SCM port, const char *encoding)
 {
@@ -969,15 +962,18 @@ scm_i_set_port_encoding_x (SCM port, const char *encoding)
   pt = SCM_PTAB_ENTRY (port);
   prev = pt->iconv_descriptors;
 
-  if (encoding == NULL)
-    encoding = "ISO-8859-1";
-
-  if (strcmp (encoding, "UTF-8") == 0)
+  if (encoding && strcmp (encoding, "UTF-8") == 0)
     {
       pt->encoding = "UTF-8";
       pt->encoding_mode = SCM_PORT_ENCODING_MODE_UTF8;
       pt->iconv_descriptors = NULL;
     }
+  else if (!encoding || strcmp (encoding, "ISO-8859-1") == 0)
+    {
+      pt->encoding = "ISO-8859-1";
+      pt->encoding_mode = SCM_PORT_ENCODING_MODE_LATIN1;
+      pt->iconv_descriptors = NULL;
+    }
   else
     {
       /* Open descriptors before mutating the port. */
@@ -1007,7 +1003,7 @@ SCM_DEFINE (scm_port_encoding, "port-encoding", 1, 0, 0,
   pt = SCM_PTAB_ENTRY (port);
   enc = pt->encoding;
   if (enc)
-    return scm_from_locale_string (pt->encoding);
+    return scm_from_latin1_string (pt->encoding);
   else
     return SCM_BOOL_F;
 }
@@ -1027,7 +1023,7 @@ SCM_DEFINE (scm_set_port_encoding_x, "set-port-encoding!", 2, 0, 0,
   SCM_VALIDATE_PORT (1, port);
   SCM_VALIDATE_STRING (2, enc);
 
-  enc_str = scm_to_locale_string (enc);
+  enc_str = scm_to_latin1_string (enc);
   scm_i_set_port_encoding_x (port, enc_str);
   free (enc_str);
 
@@ -1226,83 +1222,6 @@ scm_dynwind_lock_port (SCM port)
 
 \f
 
-/* Revealed counts --- an oddity inherited from SCSH.  */
-
-/* Find a port in the table and return its revealed count.
-   Also used by the garbage collector.
- */
-int
-scm_revealed_count (SCM port)
-{
-  scm_i_pthread_mutex_t *lock;
-  int ret;
-  
-  scm_c_lock_port (port, &lock);
-  ret = SCM_REVEALED (port);
-  if (lock)
-    scm_i_pthread_mutex_unlock (lock);
-  
-  return ret;
-}
-
-SCM_DEFINE (scm_port_revealed, "port-revealed", 1, 0, 0,
-           (SCM port),
-           "Return the revealed count for @var{port}.")
-#define FUNC_NAME s_scm_port_revealed
-{
-  port = SCM_COERCE_OUTPORT (port);
-  SCM_VALIDATE_OPENPORT (1, port);
-  return scm_from_int (scm_revealed_count (port));
-}
-#undef FUNC_NAME
-
-/* Set the revealed count for a port.  */
-SCM_DEFINE (scm_set_port_revealed_x, "set-port-revealed!", 2, 0, 0,
-           (SCM port, SCM rcount),
-           "Sets the revealed count for a port to a given value.\n"
-           "The return value is unspecified.")
-#define FUNC_NAME s_scm_set_port_revealed_x
-{
-  int r;
-  scm_i_pthread_mutex_t *lock;
-  
-  /* FIXME: It doesn't make sense to manipulate revealed counts on ports
-     without a free function.  */
-
-  port = SCM_COERCE_OUTPORT (port);
-  SCM_VALIDATE_OPENPORT (1, port);
-  r = scm_to_int (rcount);
-  scm_c_lock_port (port, &lock);
-  SCM_REVEALED (port) = r;
-  if (lock)
-    scm_i_pthread_mutex_unlock (lock);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-/* Set the revealed count for a port.  */
-SCM_DEFINE (scm_adjust_port_revealed_x, "adjust-port-revealed!", 2, 0, 0,
-           (SCM port, SCM addend),
-           "Add @var{addend} to the revealed count of @var{port}.\n"
-           "The return value is unspecified.")
-#define FUNC_NAME s_scm_adjust_port_revealed_x
-{
-  scm_i_pthread_mutex_t *lock;
-  int a;
-  port = SCM_COERCE_OUTPORT (port);
-  SCM_VALIDATE_OPENPORT (1, port);
-  a = scm_to_int (addend);
-  scm_c_lock_port (port, &lock);
-  SCM_REVEALED (port) += a;
-  if (lock)
-    scm_i_pthread_mutex_unlock (lock);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-\f
-
 /* Input.  */
 
 int
@@ -1687,6 +1606,26 @@ get_utf8_codepoint (SCM port, scm_t_wchar *codepoint,
 #undef ASSERT_NOT_EOF
 }
 
+/* Read an ISO-8859-1 codepoint (a byte) 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_latin1_codepoint (SCM port, scm_t_wchar *codepoint,
+                      char buf[SCM_MBCHAR_BUF_SIZE], size_t *len)
+{
+  *codepoint = scm_get_byte_or_eof_unlocked (port);
+
+  if (*codepoint == EOF)
+    *len = 0;
+  else
+    {
+      *len = 1;
+      buf[0] = *codepoint;
+    }
+  return 0;
+}
+
 /* Likewise, read a byte sequence from PORT, passing it through its
    input conversion descriptor.  */
 static int
@@ -1758,7 +1697,7 @@ get_iconv_codepoint (SCM port, scm_t_wchar *codepoint,
    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
+static SCM_C_INLINE int
 get_codepoint (SCM port, scm_t_wchar *codepoint,
               char buf[SCM_MBCHAR_BUF_SIZE], size_t *len)
 {
@@ -1767,6 +1706,8 @@ get_codepoint (SCM port, scm_t_wchar *codepoint,
 
   if (pt->encoding_mode == SCM_PORT_ENCODING_MODE_UTF8)
     err = get_utf8_codepoint (port, codepoint, (scm_t_uint8 *) buf, len);
+  else if (pt->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1)
+    err = get_latin1_codepoint (port, codepoint, buf, len);
   else
     err = get_iconv_codepoint (port, codepoint, buf, len);
 
@@ -2160,20 +2101,21 @@ scm_fill_input (SCM port)
   return ret;
 }
 
-/* move up to read_len chars from port's putback and/or read buffers
-   into memory starting at dest.  returns the number of chars moved.  */
+/* Move up to READ_LEN bytes from PORT's putback and/or read buffers
+   into memory starting at DEST.  Return the number of bytes moved.
+   PORT's line/column numbers are left unchanged.  */
 size_t
 scm_take_from_input_buffers (SCM port, char *dest, size_t read_len)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
-  size_t chars_read = 0;
+  size_t bytes_read = 0;
   size_t from_buf = min (pt->read_end - pt->read_pos, read_len);
 
   if (from_buf > 0)
     {
       memcpy (dest, pt->read_pos, from_buf);
       pt->read_pos += from_buf;
-      chars_read += from_buf;
+      bytes_read += from_buf;
       read_len -= from_buf;
       dest += from_buf;
     }
@@ -2186,10 +2128,11 @@ scm_take_from_input_buffers (SCM port, char *dest, size_t read_len)
        {
          memcpy (dest, pt->saved_read_pos, from_buf);
          pt->saved_read_pos += from_buf;
-         chars_read += from_buf;
+         bytes_read += from_buf;
        }
     }
-  return chars_read;
+
+  return bytes_read;
 }
 
 /* Clear a port's read buffers, returning the contents.  */