From 2721f9182da74cf98426cc335f3f39c265cc412d Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sun, 23 Oct 2011 20:51:52 +0200 Subject: [PATCH] add scm_c_make_port; the port table is now a weak set * 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 | 33 ++++----- libguile/ioext.c | 12 ++-- libguile/ports.c | 158 ++++++++++++++++++------------------------ libguile/ports.h | 13 +++- libguile/r6rs-ports.c | 88 +++++++---------------- libguile/strports.c | 31 ++++----- libguile/vports.c | 15 ++-- 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 -- 2.20.1