add scm_c_make_port; the port table is now a weak set
authorAndy Wingo <wingo@pobox.com>
Sun, 23 Oct 2011 18:51:52 +0000 (20:51 +0200)
committerAndy Wingo <wingo@pobox.com>
Sun, 23 Oct 2011 18:52:29 +0000 (20:52 +0200)
* libguile/ports.c (scm_c_make_port_with_encoding, scm_c_make_port): New
  functions, to replace scm_new_port_table_entry.  Use a weak set
  instead of a weak table.
  (scm_i_remove_port):
  (scm_c_port_for_each, scm_port_for_each): Adapt to use weak set.
  (scm_i_void_port): Use scm_c_make_port.
  (scm_init_ports): Make a weak set.

* libguile/fports.c:
* libguile/ioext.c:
* libguile/r6rs-ports.c:
* libguile/strports.c:
* libguile/vports.c: Adapt to use the new scm_c_make_port API.

libguile/fports.c
libguile/ioext.c
libguile/ports.c
libguile/ports.h
libguile/r6rs-ports.c
libguile/strports.c
libguile/vports.c

index 0b84d44..f379db1 100644 (file)
@@ -532,7 +532,7 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name)
 #define FUNC_NAME "scm_fdes_to_port"
 {
   SCM port;
-  scm_t_port *pt;
+  scm_t_fport *fp;
   int flags;
 
   /* test that fdes is valid.  */
@@ -551,26 +551,21 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name)
       SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL);
     }
 
-  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
+  fp = (scm_t_fport *) scm_gc_malloc_pointerless (sizeof (scm_t_fport),
+                                                  "file port");
+  fp->fdes = fdes;
+
+  port = scm_c_make_port (scm_tc16_fport, mode_bits, (scm_t_bits)fp);
+  
+  SCM_PTAB_ENTRY (port)->rw_random = SCM_FDES_RANDOM_P (fdes);
+
+  if (mode_bits & SCM_BUF0)
+    scm_fport_buffer_add (port, 0, 0);
+  else
+    scm_fport_buffer_add (port, -1, -1);
 
-  port = scm_new_port_table_entry (scm_tc16_fport);
-  SCM_SET_CELL_TYPE(port, scm_tc16_fport | mode_bits);
-  pt = SCM_PTAB_ENTRY(port);
-  {
-    scm_t_fport *fp
-      = (scm_t_fport *) scm_gc_malloc_pointerless (sizeof (scm_t_fport),
-                                                  "file port");
-
-    fp->fdes = fdes;
-    pt->rw_random = SCM_FDES_RANDOM_P (fdes);
-    SCM_SETSTREAM (port, fp);
-    if (mode_bits & SCM_BUF0)
-      scm_fport_buffer_add (port, 0, 0);
-    else
-      scm_fport_buffer_add (port, -1, -1);
-  }
   SCM_SET_FILENAME (port, name);
-  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
+
   return port;
 }
 #undef FUNC_NAME
index 6b0c9b8..cb55fb2 100644 (file)
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2006 Free Software Foundation, Inc.
+/*     Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2006, 2011 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
@@ -269,7 +269,7 @@ SCM_DEFINE (scm_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0,
 #undef FUNC_NAME
 
 static SCM
-get_matching_port (void *closure, SCM port, SCM val, SCM result)
+get_matching_port (void *closure, SCM port, SCM result)
 {
   int fd = * (int *) closure;
   scm_t_port *entry = SCM_PTAB_ENTRY (port);
@@ -292,11 +292,9 @@ SCM_DEFINE (scm_fdes_to_ports, "fdes->ports", 1, 0, 0,
   SCM result = SCM_EOL;
   int int_fd = scm_to_int (fd);
 
-  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
-  result = scm_internal_hash_fold (get_matching_port,
-                                  (void*) &int_fd, result, 
-                                  scm_i_port_weak_hash);
-  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
+  result = scm_c_weak_set_fold (get_matching_port,
+                                (void*) &int_fd, result, 
+                                scm_i_port_weak_set);
   return result;
 }
 #undef FUNC_NAME    
index a4d3bd8..6c4561e 100644 (file)
@@ -56,7 +56,7 @@
 #include "libguile/validate.h"
 #include "libguile/ports.h"
 #include "libguile/vectors.h"
-#include "libguile/weaks.h"
+#include "libguile/weak-set.h"
 #include "libguile/fluids.h"
 #include "libguile/eq.h"
 
@@ -508,9 +508,7 @@ scm_i_dynwind_current_load_port (SCM port)
   We need a global registry of ports to flush them all at exit, and to
   get all the ports matching a file descriptor.
  */
-SCM scm_i_port_weak_hash;
-
-scm_i_pthread_mutex_t scm_i_port_table_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+SCM scm_i_port_weak_set;
 
 \f
 /* Port finalization.  */
@@ -579,47 +577,51 @@ finalize_port (GC_PTR ptr, GC_PTR data)
 
 \f
 
-/* This function is not and should not be thread safe. */
 SCM
-scm_new_port_table_entry (scm_t_bits tag)
-#define FUNC_NAME "scm_new_port_table_entry"
+scm_c_make_port_with_encoding (scm_t_bits tag, unsigned long mode_bits,
+                               const char *encoding,
+                               scm_t_string_failed_conversion_handler handler,
+                               scm_t_bits stream)
 {
-  /*
-    We initialize the cell to empty, this is in case scm_gc_calloc
-    triggers GC ; we don't want the GC to scan a half-finished Z.
-   */
-  
-  SCM z = scm_cons (SCM_EOL, SCM_EOL);
-  scm_t_port *entry = (scm_t_port *) scm_gc_calloc (sizeof (scm_t_port), "port");
-  const char *enc;
+  SCM ret;
+  scm_t_port *entry;
+
+  entry = (scm_t_port *) scm_gc_calloc (sizeof (scm_t_port), "port");
+  ret = scm_cell (tag | mode_bits, (scm_t_bits)entry);
 
   entry->file_name = SCM_BOOL_F;
   entry->rw_active = SCM_PORT_NEITHER;
-  entry->port = z;
-
-  /* Initialize this port with the thread's current default
-     encoding.  */
-  enc = scm_i_default_port_encoding ();
-  entry->encoding = enc ? scm_gc_strdup (enc, "port") : NULL;
-
+  entry->port = ret;
+  entry->stream = stream;
+  entry->encoding = encoding ? scm_gc_strdup (encoding, "port") : NULL;
   /* The conversion descriptors will be opened lazily.  */
   entry->input_cd = (iconv_t) -1;
   entry->output_cd = (iconv_t) -1;
+  entry->ilseq_handler = handler;
 
-  entry->ilseq_handler = scm_i_get_conversion_strategy (SCM_BOOL_F);
-
-  SCM_SET_CELL_TYPE (z, tag);
-  SCM_SETPTAB_ENTRY (z, entry);
-
-  scm_hashq_set_x (scm_i_port_weak_hash, z, SCM_BOOL_F);
+  scm_weak_set_add_x (scm_i_port_weak_set, ret);
 
   /* For each new port, register a finalizer so that it port type's free
      function can be invoked eventually.  */
-  register_finalizer_for_port (z);
+  register_finalizer_for_port (ret);
 
-  return z;
+  return ret;
+}
+
+SCM
+scm_c_make_port (scm_t_bits tag, unsigned long mode_bits, scm_t_bits stream)
+{
+  return scm_c_make_port_with_encoding (tag, mode_bits,
+                                        scm_i_default_port_encoding (),
+                                        scm_i_get_conversion_strategy (SCM_BOOL_F),
+                                        stream);
+}
+
+SCM
+scm_new_port_table_entry (scm_t_bits tag)
+{
+  return scm_c_make_port (tag, 0, 0);
 }
-#undef FUNC_NAME
 
 /* Remove a port from the table and destroy it.  */
 
@@ -629,10 +631,11 @@ scm_i_remove_port (SCM port)
 {
   scm_t_port *p;
 
-  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
-
   p = SCM_PTAB_ENTRY (port);
   scm_port_non_buffer (p);
+  SCM_SETPTAB_ENTRY (port, 0);
+  scm_weak_set_remove_x (scm_i_port_weak_set, port);
+
   p->putback_buf = NULL;
   p->putback_buf_size = 0;
 
@@ -647,29 +650,10 @@ scm_i_remove_port (SCM port)
       iconv_close (p->output_cd);
       p->output_cd = (iconv_t) -1;
     }
-
-  SCM_SETPTAB_ENTRY (port, 0);
-
-  scm_hashq_remove_x (scm_i_port_weak_hash, port);
-
-  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
 }
 #undef FUNC_NAME
 
 
-/* Functions for debugging.  */
-#ifdef GUILE_DEBUG
-SCM_DEFINE (scm_pt_size, "pt-size", 0, 0, 0,
-            (),
-           "Return the number of ports in the port table.  @code{pt-size}\n"
-           "is only included in @code{--enable-guile-debug} builds.")
-#define FUNC_NAME s_scm_pt_size
-{
-  return scm_from_int (SCM_HASHTABLE_N_ITEMS (scm_i_port_weak_hash));
-}
-#undef FUNC_NAME
-#endif
-
 void
 scm_port_non_buffer (scm_t_port *pt)
 {
@@ -862,30 +846,38 @@ SCM_DEFINE (scm_close_output_port, "close-output-port", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+struct for_each_data 
+{
+  void (*proc) (void *data, SCM p);
+  void *data;
+};
+
 static SCM
-collect_keys (void *unused, SCM key, SCM value, SCM result)
+for_each_trampoline (void *data, SCM port, SCM result)
 {
-  return scm_cons (key, result);
+  struct for_each_data *d = data;
+  
+  d->proc (d->data, port);
+
+  return result;
 }
 
 void
 scm_c_port_for_each (void (*proc)(void *data, SCM p), void *data)
 {
-  SCM ports;
+  struct for_each_data d;
+  
+  d.proc = proc;
+  d.data = data;
 
-  /* Copy out the port table as a list so that we get strong references
-     to all the values.  */
-  scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
-  ports = scm_internal_hash_fold (collect_keys, NULL,
-                                 SCM_EOL, scm_i_port_weak_hash);
-  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
+  scm_c_weak_set_fold (for_each_trampoline, &d, SCM_EOL,
+                       scm_i_port_weak_set);
+}
 
-  for (; scm_is_pair (ports); ports = scm_cdr (ports))
-    {
-      SCM p = scm_car (ports);
-      if (SCM_PORTP (p))
-        proc (data, p);
-    }
+static void
+scm_for_each_trampoline (void *data, SCM port)
+{
+  scm_call_1 (PTR2SCM (data), port);
 }
 
 SCM_DEFINE (scm_port_for_each, "port-for-each", 1, 0, 0,
@@ -898,21 +890,10 @@ SCM_DEFINE (scm_port_for_each, "port-for-each", 1, 0, 0,
            "have no effect as far as @var{port-for-each} is concerned.") 
 #define FUNC_NAME s_scm_port_for_each
 {
-  SCM ports;
-
   SCM_VALIDATE_PROC (1, proc);
 
-  /* Copy out the port table as a list so that we get strong references
-     to all the values.  */
-  scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
-  ports = scm_internal_hash_fold (collect_keys, NULL,
-                                 SCM_EOL, scm_i_port_weak_hash);
-  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
-
-  for (; scm_is_pair (ports); ports = scm_cdr (ports))
-    if (SCM_PORTP (SCM_CAR (ports)))
-      scm_call_1 (proc, SCM_CAR (ports));
-
+  scm_c_port_for_each (scm_for_each_trampoline, SCM2PTR (proc));
+  
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -2470,18 +2451,13 @@ write_void_port (SCM port SCM_UNUSED,
 static SCM
 scm_i_void_port (long mode_bits)
 {
-  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
-  {
-    SCM answer = scm_new_port_table_entry (scm_tc16_void_port);
-    scm_t_port * pt = SCM_PTAB_ENTRY(answer);
+  SCM ret;
+
+  ret = scm_c_make_port (scm_tc16_void_port, mode_bits, 0);
 
-    scm_port_non_buffer (pt);
+  scm_port_non_buffer (SCM_PTAB_ENTRY (ret));
   
-    SCM_SETSTREAM (answer, 0);
-    SCM_SET_CELL_TYPE (answer, scm_tc16_void_port | mode_bits);
-    scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
-    return answer;
-  }
+  return ret;
 }
 
 SCM
@@ -2521,7 +2497,7 @@ scm_init_ports ()
   cur_errport_fluid = scm_make_fluid ();
   cur_loadport_fluid = scm_make_fluid ();
 
-  scm_i_port_weak_hash = scm_make_weak_key_hash_table (SCM_I_MAKINUM(31));
+  scm_i_port_weak_set = scm_c_make_weak_set (31);
 
 #include "libguile/ports.x"
 
index 80da9a0..f5c98ab 100644 (file)
@@ -118,8 +118,7 @@ typedef struct
 } scm_t_port;
 
 
-SCM_INTERNAL scm_i_pthread_mutex_t scm_i_port_table_mutex;
-SCM_INTERNAL SCM scm_i_port_weak_hash;
+SCM_INTERNAL SCM scm_i_port_weak_set;
 
 
 #define SCM_READ_BUFFER_EMPTY_P(c_port) (c_port->read_pos >= c_port->read_end)
@@ -254,6 +253,16 @@ SCM_API SCM scm_set_current_error_port (SCM port);
 SCM_API void scm_dynwind_current_input_port (SCM port);
 SCM_API void scm_dynwind_current_output_port (SCM port);
 SCM_API void scm_dynwind_current_error_port (SCM port);
+
+SCM_API SCM
+scm_c_make_port_with_encoding (scm_t_bits tag,
+                               unsigned long mode_bits,
+                               const char *encoding,
+                               scm_t_string_failed_conversion_handler handler,
+                               scm_t_bits stream);
+SCM_API SCM scm_c_make_port (scm_t_bits tag, unsigned long mode_bits,
+                             scm_t_bits stream);
+
 SCM_API SCM scm_new_port_table_entry (scm_t_bits tag);
 SCM_API void scm_grow_port_cbuf (SCM port, size_t requested);
 SCM_API SCM scm_pt_size (void);
index 7ee56af..06576e9 100644 (file)
@@ -84,17 +84,14 @@ make_bip (SCM bv)
   scm_t_port *c_port;
   const unsigned long mode_bits = SCM_OPN | SCM_RDNG;
 
-  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
+  port = scm_c_make_port_with_encoding (bytevector_input_port_type,
+                                        mode_bits,
+                                        NULL, /* encoding */
+                                        SCM_FAILED_CONVERSION_ERROR,
+                                        SCM_UNPACK (bv));
 
-  port = scm_new_port_table_entry (bytevector_input_port_type);
   c_port = SCM_PTAB_ENTRY (port);
 
-  /* Match the expectation of `binary-port?'.  */
-  c_port->encoding = NULL;
-
-  /* Prevent BV from being GC'd.  */
-  SCM_SETSTREAM (port, SCM_UNPACK (bv));
-
   /* Have the port directly access the bytevector.  */
   c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
   c_len = SCM_BYTEVECTOR_LENGTH (bv);
@@ -103,11 +100,6 @@ make_bip (SCM bv)
   c_port->read_end = (unsigned char *) c_bv + c_len;
   c_port->read_buf_size = c_len;
 
-  /* Mark PORT as open, readable and unbuffered (hmm, how elegant...).  */
-  SCM_SET_CELL_TYPE (port, bytevector_input_port_type | mode_bits);
-
-  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
-
   return port;
 }
 
@@ -312,27 +304,19 @@ make_cbip (SCM read_proc, SCM get_position_proc,
   SCM_SIMPLE_VECTOR_SET (method_vector, 2, set_position_proc);
   SCM_SIMPLE_VECTOR_SET (method_vector, 3, close_proc);
 
-  scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
+  port = scm_c_make_port_with_encoding (custom_binary_input_port_type,
+                                        mode_bits,
+                                        NULL, /* encoding */
+                                        SCM_FAILED_CONVERSION_ERROR,
+                                        SCM_UNPACK (method_vector));
 
-  port = scm_new_port_table_entry (custom_binary_input_port_type);
   c_port = SCM_PTAB_ENTRY (port);
 
-  /* Match the expectation of `binary-port?'.  */
-  c_port->encoding = NULL;
-
-  /* Attach it the method vector.  */
-  SCM_SETSTREAM (port, SCM_UNPACK (method_vector));
-
   /* Have the port directly access the buffer (bytevector).  */
   c_port->read_pos = c_port->read_buf = (unsigned char *) c_bv;
   c_port->read_end = (unsigned char *) c_bv;
   c_port->read_buf_size = c_len;
 
-  /* Mark PORT as open, readable and unbuffered (hmm, how elegant...).  */
-  SCM_SET_CELL_TYPE (port, custom_binary_input_port_type | mode_bits);
-
-  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
-
   return port;
 }
 
@@ -829,26 +813,19 @@ make_bop (void)
   scm_t_bop_buffer *buf;
   const unsigned long mode_bits = SCM_OPN | SCM_WRTNG;
 
-  scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
-
-  port = scm_new_port_table_entry (bytevector_output_port_type);
-  c_port = SCM_PTAB_ENTRY (port);
-
-  /* Match the expectation of `binary-port?'.  */
-  c_port->encoding = NULL;
-
   buf = (scm_t_bop_buffer *) scm_gc_malloc (sizeof (* buf), SCM_GC_BOP);
   bop_buffer_init (buf);
 
-  c_port->write_buf = c_port->write_pos = c_port->write_end = NULL;
-  c_port->write_buf_size = 0;
-
-  SCM_SET_BOP_BUFFER (port, buf);
+  port = scm_c_make_port_with_encoding (bytevector_output_port_type,
+                                        mode_bits,
+                                        NULL, /* encoding */
+                                        SCM_FAILED_CONVERSION_ERROR,
+                                        (scm_t_bits)buf);
 
-  /* Mark PORT as open and writable.  */
-  SCM_SET_CELL_TYPE (port, bytevector_output_port_type | mode_bits);
+  c_port = SCM_PTAB_ENTRY (port);
 
-  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
+  c_port->write_buf = c_port->write_pos = c_port->write_end = NULL;
+  c_port->write_buf_size = 0;
 
   /* Make the bop procedure.  */
   SCM_NEWSMOB (bop_proc, bytevector_output_port_procedure, buf);
@@ -988,26 +965,18 @@ make_cbop (SCM write_proc, SCM get_position_proc,
   SCM_SIMPLE_VECTOR_SET (method_vector, 2, set_position_proc);
   SCM_SIMPLE_VECTOR_SET (method_vector, 3, close_proc);
 
-  scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
+  port = scm_c_make_port_with_encoding (custom_binary_output_port_type,
+                                        mode_bits,
+                                        NULL, /* encoding */
+                                        SCM_FAILED_CONVERSION_ERROR,
+                                        SCM_UNPACK (method_vector));
 
-  port = scm_new_port_table_entry (custom_binary_output_port_type);
   c_port = SCM_PTAB_ENTRY (port);
 
-  /* Match the expectation of `binary-port?'.  */
-  c_port->encoding = NULL;
-
-  /* Attach it the method vector.  */
-  SCM_SETSTREAM (port, SCM_UNPACK (method_vector));
-
   /* Have the port directly access the buffer (bytevector).  */
   c_port->write_buf = c_port->write_pos = c_port->write_end = NULL;
   c_port->write_buf_size = c_port->read_buf_size = 0;
 
-  /* Mark PORT as open, writable and unbuffered.  */
-  SCM_SET_CELL_TYPE (port, custom_binary_output_port_type | mode_bits);
-
-  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
-
   return port;
 }
 
@@ -1105,13 +1074,8 @@ make_tp (SCM binary_port, unsigned long mode)
   scm_t_port *c_port;
   const unsigned long mode_bits = SCM_OPN | mode;
   
-  scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
-
-  port = scm_new_port_table_entry (transcoded_port_type);
-
-  SCM_SETSTREAM (port, SCM_UNPACK (binary_port));
-
-  SCM_SET_CELL_TYPE (port, transcoded_port_type | mode_bits);
+  port = scm_c_make_port (transcoded_port_type, mode_bits,
+                          SCM_UNPACK (binary_port));
 
   if (SCM_INPUT_PORT_P (port))
     {
@@ -1124,8 +1088,6 @@ make_tp (SCM binary_port, unsigned long mode)
       SCM_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~SCM_BUF0);
     }
   
-  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
-
   return port;
 }
 
index b7fec47..2b3a5ea 100644 (file)
@@ -277,17 +277,14 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
 {
   SCM z, buf;
   scm_t_port *pt;
-  size_t str_len, c_pos;
+  const char *encoding;
+  size_t read_buf_size, str_len, c_pos;
   char *c_buf;
 
   if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
     scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL);
 
-  scm_dynwind_begin (0);
-  scm_i_dynwind_pthread_mutex_lock (&scm_i_port_table_mutex);
-
-  z = scm_new_port_table_entry (scm_tc16_strport);
-  pt = SCM_PTAB_ENTRY(z);
+  encoding = scm_i_default_port_encoding ();
 
   if (scm_is_false (str))
     {
@@ -297,8 +294,8 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
       c_buf = (char *) SCM_BYTEVECTOR_CONTENTS (buf);
 
       /* Reset `read_buf_size'.  It will contain the actual number of
-        bytes written to PT.  */
-      pt->read_buf_size = 0;
+        bytes written to the port.  */
+      read_buf_size = 0;
       c_pos = 0;
     }
   else
@@ -308,8 +305,8 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
 
       SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller);
 
-      /* Create a copy of STR in the encoding of PT.  */
-      copy = scm_to_stringn (str, &str_len, pt->encoding,
+      /* Create a copy of STR in ENCODING.  */
+      copy = scm_to_stringn (str, &str_len, encoding,
                             SCM_FAILED_CONVERSION_ERROR);
       buf = scm_c_make_bytevector (str_len);
       c_buf = (char *) SCM_BYTEVECTOR_CONTENTS (buf);
@@ -317,26 +314,26 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
       free (copy);
 
       c_pos = scm_to_unsigned_integer (pos, 0, str_len);
-      pt->read_buf_size = str_len;
+      read_buf_size = str_len;
     }
 
-  SCM_SETSTREAM (z, SCM_UNPACK (buf));
-  SCM_SET_CELL_TYPE (z, scm_tc16_strport | modes);
+  z = scm_c_make_port_with_encoding (scm_tc16_strport, modes,
+                                     encoding,
+                                     SCM_FAILED_CONVERSION_ERROR,
+                                     (scm_t_bits)buf);
 
+  pt = SCM_PTAB_ENTRY (z);
   pt->write_buf = pt->read_buf = (unsigned char *) c_buf;
   pt->read_pos = pt->write_pos = pt->read_buf + c_pos;
+  pt->read_buf_size = read_buf_size;
   pt->write_buf_size = str_len;
   pt->write_end = pt->read_end = pt->read_buf + pt->read_buf_size;
-
   pt->rw_random = 1;
 
-  scm_dynwind_end ();
-
   /* Ensure WRITE_POS is writable.  */
   if ((modes & SCM_WRTNG) && pt->write_pos == pt->write_end)
     st_flush (z);
 
-  scm_i_set_conversion_strategy_x (z, SCM_FAILED_CONVERSION_ERROR);
   return z;
 }
 
index 5178d79..05d4590 100644 (file)
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2006, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2006, 2009, 2010, 2011 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
@@ -198,7 +198,6 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0,
 #define FUNC_NAME s_scm_make_soft_port
 {
   int vlen;
-  scm_t_port *pt;
   SCM z;
 
   SCM_VALIDATE_VECTOR (1, pv);
@@ -206,14 +205,10 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0,
   SCM_ASSERT ((vlen == 5) || (vlen == 6), pv, 1, FUNC_NAME);
   SCM_VALIDATE_STRING (2, modes);
   
-  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
-  z = scm_new_port_table_entry (scm_tc16_sfport);
-  pt = SCM_PTAB_ENTRY (z);
-  scm_port_non_buffer (pt);
-  SCM_SET_CELL_TYPE (z, scm_tc16_sfport | scm_i_mode_bits (modes));
-
-  SCM_SETSTREAM (z, SCM_UNPACK (pv));
-  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
+  z = scm_c_make_port (scm_tc16_sfport, scm_i_mode_bits (modes),
+                       SCM_UNPACK (pv));
+  scm_port_non_buffer (SCM_PTAB_ENTRY (z));
+
   return z;
 }
 #undef FUNC_NAME