summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/fports.c33
-rw-r--r--libguile/ioext.c12
-rw-r--r--libguile/ports.c158
-rw-r--r--libguile/ports.h13
-rw-r--r--libguile/r6rs-ports.c88
-rw-r--r--libguile/strports.c31
-rw-r--r--libguile/vports.c15
7 files changed, 141 insertions, 209 deletions
diff --git a/libguile/fports.c b/libguile/fports.c
index 0b84d4413..f379db1ee 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -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
diff --git a/libguile/ioext.c b/libguile/ioext.c
index 6b0c9b88c..cb55fb2c3 100644
--- a/libguile/ioext.c
+++ b/libguile/ioext.c
@@ -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
diff --git a/libguile/ports.c b/libguile/ports.c
index a4d3bd847..6c4561eac 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -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;
/* Port finalization. */
@@ -579,47 +577,51 @@ finalize_port (GC_PTR ptr, GC_PTR data)
-/* 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"
diff --git a/libguile/ports.h b/libguile/ports.h
index 80da9a02f..f5c98abbc 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -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);
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index 7ee56af71..06576e98e 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -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;
}
diff --git a/libguile/strports.c b/libguile/strports.c
index b7fec4703..2b3a5ea72 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -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;
}
diff --git a/libguile/vports.c b/libguile/vports.c
index 5178d79c7..05d4590aa 100644
--- a/libguile/vports.c
+++ b/libguile/vports.c
@@ -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