mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

add scm_c_make_port; the port table is now a weak set

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2011-10-23 20:51:52 +02:00
parent 7887be7df5
commit 2721f9182d
7 changed files with 140 additions and 208 deletions
Download patch file Download diff file Expand all files Collapse all files

31
libguile/fports.c
View file

@ -532,7 +532,7 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name)
#define FUNC_NAME "scm_fdes_to_port" #define FUNC_NAME "scm_fdes_to_port"
{ {
SCM port; SCM port;
scm_t_port *pt; scm_t_fport *fp;
int flags; int flags;
/* test that fdes is valid. */ /* 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_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_new_port_table_entry (scm_tc16_fport); port = scm_c_make_port (scm_tc16_fport, mode_bits, (scm_t_bits)fp);
SCM_SET_CELL_TYPE(port, scm_tc16_fport | mode_bits);
pt = SCM_PTAB_ENTRY(port); SCM_PTAB_ENTRY (port)->rw_random = SCM_FDES_RANDOM_P (fdes);
{
scm_t_fport *fp if (mode_bits & SCM_BUF0)
= (scm_t_fport *) scm_gc_malloc_pointerless (sizeof (scm_t_fport), scm_fport_buffer_add (port, 0, 0);
"file port"); else
scm_fport_buffer_add (port, -1, -1);
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_SET_FILENAME (port, name);
scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
return port; return port;
} }
#undef FUNC_NAME #undef FUNC_NAME

12
libguile/ioext.c
View 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * 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 #undef FUNC_NAME
static SCM 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; int fd = * (int *) closure;
scm_t_port *entry = SCM_PTAB_ENTRY (port); 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; SCM result = SCM_EOL;
int int_fd = scm_to_int (fd); int int_fd = scm_to_int (fd);
scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex); result = scm_c_weak_set_fold (get_matching_port,
result = scm_internal_hash_fold (get_matching_port, (void*) &int_fd, result,
(void*) &int_fd, result, scm_i_port_weak_set);
scm_i_port_weak_hash);
scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
return result; return result;
} }
#undef FUNC_NAME #undef FUNC_NAME

160
libguile/ports.c
View file

@ -56,7 +56,7 @@
#include "libguile/validate.h" #include "libguile/validate.h"
#include "libguile/ports.h" #include "libguile/ports.h"
#include "libguile/vectors.h" #include "libguile/vectors.h"
#include "libguile/weaks.h" #include "libguile/weak-set.h"
#include "libguile/fluids.h" #include "libguile/fluids.h"
#include "libguile/eq.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 We need a global registry of ports to flush them all at exit, and to
get all the ports matching a file descriptor. get all the ports matching a file descriptor.
*/ */
SCM scm_i_port_weak_hash; SCM scm_i_port_weak_set;
scm_i_pthread_mutex_t scm_i_port_table_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
/* Port finalization. */ /* 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
scm_new_port_table_entry (scm_t_bits tag) scm_c_make_port_with_encoding (scm_t_bits tag, unsigned long mode_bits,
#define FUNC_NAME "scm_new_port_table_entry" const char *encoding,
scm_t_string_failed_conversion_handler handler,
scm_t_bits stream)
{ {
/* SCM ret;
We initialize the cell to empty, this is in case scm_gc_calloc scm_t_port *entry;
triggers GC ; we don't want the GC to scan a half-finished Z.
*/ entry = (scm_t_port *) scm_gc_calloc (sizeof (scm_t_port), "port");
ret = scm_cell (tag | mode_bits, (scm_t_bits)entry);
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;
entry->file_name = SCM_BOOL_F; entry->file_name = SCM_BOOL_F;
entry->rw_active = SCM_PORT_NEITHER; entry->rw_active = SCM_PORT_NEITHER;
entry->port = z; entry->port = ret;
entry->stream = stream;
/* Initialize this port with the thread's current default entry->encoding = encoding ? scm_gc_strdup (encoding, "port") : NULL;
encoding. */
enc = scm_i_default_port_encoding ();
entry->encoding = enc ? scm_gc_strdup (enc, "port") : NULL;
/* The conversion descriptors will be opened lazily. */ /* The conversion descriptors will be opened lazily. */
entry->input_cd = (iconv_t) -1; entry->input_cd = (iconv_t) -1;
entry->output_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_weak_set_add_x (scm_i_port_weak_set, ret);
SCM_SET_CELL_TYPE (z, tag);
SCM_SETPTAB_ENTRY (z, entry);
scm_hashq_set_x (scm_i_port_weak_hash, z, SCM_BOOL_F);
/* For each new port, register a finalizer so that it port type's free /* For each new port, register a finalizer so that it port type's free
function can be invoked eventually. */ 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. */ /* Remove a port from the table and destroy it. */
@ -629,10 +631,11 @@ scm_i_remove_port (SCM port)
{ {
scm_t_port *p; scm_t_port *p;
scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
p = SCM_PTAB_ENTRY (port); p = SCM_PTAB_ENTRY (port);
scm_port_non_buffer (p); 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 = NULL;
p->putback_buf_size = 0; p->putback_buf_size = 0;
@ -647,29 +650,10 @@ scm_i_remove_port (SCM port)
iconv_close (p->output_cd); iconv_close (p->output_cd);
p->output_cd = (iconv_t) -1; 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 #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 void
scm_port_non_buffer (scm_t_port *pt) 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 #undef FUNC_NAME
static SCM struct for_each_data
collect_keys (void *unused, SCM key, SCM value, SCM result)
{ {
return scm_cons (key, result); void (*proc) (void *data, SCM p);
void *data;
};
static SCM
for_each_trampoline (void *data, SCM port, SCM result)
{
struct for_each_data *d = data;
d->proc (d->data, port);
return result;
} }
void void
scm_c_port_for_each (void (*proc)(void *data, SCM p), void *data) 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 scm_c_weak_set_fold (for_each_trampoline, &d, SCM_EOL,
to all the values. */ scm_i_port_weak_set);
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)) static void
{ scm_for_each_trampoline (void *data, SCM port)
SCM p = scm_car (ports); {
if (SCM_PORTP (p)) scm_call_1 (PTR2SCM (data), port);
proc (data, p);
}
} }
SCM_DEFINE (scm_port_for_each, "port-for-each", 1, 0, 0, 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.") "have no effect as far as @var{port-for-each} is concerned.")
#define FUNC_NAME s_scm_port_for_each #define FUNC_NAME s_scm_port_for_each
{ {
SCM ports;
SCM_VALIDATE_PROC (1, proc); SCM_VALIDATE_PROC (1, proc);
/* Copy out the port table as a list so that we get strong references scm_c_port_for_each (scm_for_each_trampoline, SCM2PTR (proc));
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));
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -2470,18 +2451,13 @@ write_void_port (SCM port SCM_UNUSED,
static SCM static SCM
scm_i_void_port (long mode_bits) scm_i_void_port (long mode_bits)
{ {
scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex); SCM ret;
{
SCM answer = scm_new_port_table_entry (scm_tc16_void_port);
scm_t_port * pt = SCM_PTAB_ENTRY(answer);
scm_port_non_buffer (pt); ret = scm_c_make_port (scm_tc16_void_port, mode_bits, 0);
scm_port_non_buffer (SCM_PTAB_ENTRY (ret));
SCM_SETSTREAM (answer, 0); return ret;
SCM_SET_CELL_TYPE (answer, scm_tc16_void_port | mode_bits);
scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
return answer;
}
} }
SCM SCM
@ -2521,7 +2497,7 @@ scm_init_ports ()
cur_errport_fluid = scm_make_fluid (); cur_errport_fluid = scm_make_fluid ();
cur_loadport_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" #include "libguile/ports.x"

13
libguile/ports.h
View file

@ -118,8 +118,7 @@ typedef struct
} scm_t_port; } scm_t_port;
SCM_INTERNAL scm_i_pthread_mutex_t scm_i_port_table_mutex; SCM_INTERNAL SCM scm_i_port_weak_set;
SCM_INTERNAL SCM scm_i_port_weak_hash;
#define SCM_READ_BUFFER_EMPTY_P(c_port) (c_port->read_pos >= c_port->read_end) #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_input_port (SCM port);
SCM_API void scm_dynwind_current_output_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 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 SCM scm_new_port_table_entry (scm_t_bits tag);
SCM_API void scm_grow_port_cbuf (SCM port, size_t requested); SCM_API void scm_grow_port_cbuf (SCM port, size_t requested);
SCM_API SCM scm_pt_size (void); SCM_API SCM scm_pt_size (void);

88
libguile/r6rs-ports.c
View file

@ -84,17 +84,14 @@ make_bip (SCM bv)
scm_t_port *c_port; scm_t_port *c_port;
const unsigned long mode_bits = SCM_OPN | SCM_RDNG; 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); 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. */ /* Have the port directly access the bytevector. */
c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv); c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
c_len = SCM_BYTEVECTOR_LENGTH (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_end = (unsigned char *) c_bv + c_len;
c_port->read_buf_size = 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; 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, 2, set_position_proc);
SCM_SIMPLE_VECTOR_SET (method_vector, 3, close_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); 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). */ /* Have the port directly access the buffer (bytevector). */
c_port->read_pos = c_port->read_buf = (unsigned char *) c_bv; c_port->read_pos = c_port->read_buf = (unsigned char *) c_bv;
c_port->read_end = (unsigned char *) c_bv; c_port->read_end = (unsigned char *) c_bv;
c_port->read_buf_size = c_len; 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; return port;
} }
@ -829,27 +813,20 @@ make_bop (void)
scm_t_bop_buffer *buf; scm_t_bop_buffer *buf;
const unsigned long mode_bits = SCM_OPN | SCM_WRTNG; 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); buf = (scm_t_bop_buffer *) scm_gc_malloc (sizeof (* buf), SCM_GC_BOP);
bop_buffer_init (buf); bop_buffer_init (buf);
port = scm_c_make_port_with_encoding (bytevector_output_port_type,
mode_bits,
NULL, /* encoding */
SCM_FAILED_CONVERSION_ERROR,
(scm_t_bits)buf);
c_port = SCM_PTAB_ENTRY (port);
c_port->write_buf = c_port->write_pos = c_port->write_end = NULL; c_port->write_buf = c_port->write_pos = c_port->write_end = NULL;
c_port->write_buf_size = 0; c_port->write_buf_size = 0;
SCM_SET_BOP_BUFFER (port, buf);
/* Mark PORT as open and writable. */
SCM_SET_CELL_TYPE (port, bytevector_output_port_type | mode_bits);
scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
/* Make the bop procedure. */ /* Make the bop procedure. */
SCM_NEWSMOB (bop_proc, bytevector_output_port_procedure, buf); 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, 2, set_position_proc);
SCM_SIMPLE_VECTOR_SET (method_vector, 3, close_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); 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). */ /* 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 = c_port->write_pos = c_port->write_end = NULL;
c_port->write_buf_size = c_port->read_buf_size = 0; 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; return port;
} }
@ -1105,13 +1074,8 @@ make_tp (SCM binary_port, unsigned long mode)
scm_t_port *c_port; scm_t_port *c_port;
const unsigned long mode_bits = SCM_OPN | mode; const unsigned long mode_bits = SCM_OPN | mode;
scm_i_pthread_mutex_lock (&scm_i_port_table_mutex); port = scm_c_make_port (transcoded_port_type, mode_bits,
SCM_UNPACK (binary_port));
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);
if (SCM_INPUT_PORT_P (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_SET_CELL_WORD_0 (port, SCM_CELL_WORD_0 (port) & ~SCM_BUF0);
} }
scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
return port; return port;
} }

31
libguile/strports.c
View file

@ -277,17 +277,14 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
{ {
SCM z, buf; SCM z, buf;
scm_t_port *pt; 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; char *c_buf;
if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG))) if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL); scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL);
scm_dynwind_begin (0); encoding = scm_i_default_port_encoding ();
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);
if (scm_is_false (str)) 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); c_buf = (char *) SCM_BYTEVECTOR_CONTENTS (buf);
/* Reset `read_buf_size'. It will contain the actual number of /* Reset `read_buf_size'. It will contain the actual number of
bytes written to PT. */ bytes written to the port. */
pt->read_buf_size = 0; read_buf_size = 0;
c_pos = 0; c_pos = 0;
} }
else 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); SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller);
/* Create a copy of STR in the encoding of PT. */ /* Create a copy of STR in ENCODING. */
copy = scm_to_stringn (str, &str_len, pt->encoding, copy = scm_to_stringn (str, &str_len, encoding,
SCM_FAILED_CONVERSION_ERROR); SCM_FAILED_CONVERSION_ERROR);
buf = scm_c_make_bytevector (str_len); buf = scm_c_make_bytevector (str_len);
c_buf = (char *) SCM_BYTEVECTOR_CONTENTS (buf); c_buf = (char *) SCM_BYTEVECTOR_CONTENTS (buf);
@ -317,26 +314,26 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
free (copy); free (copy);
c_pos = scm_to_unsigned_integer (pos, 0, str_len); 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)); z = scm_c_make_port_with_encoding (scm_tc16_strport, modes,
SCM_SET_CELL_TYPE (z, 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->write_buf = pt->read_buf = (unsigned char *) c_buf;
pt->read_pos = pt->write_pos = pt->read_buf + c_pos; 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_buf_size = str_len;
pt->write_end = pt->read_end = pt->read_buf + pt->read_buf_size; pt->write_end = pt->read_end = pt->read_buf + pt->read_buf_size;
pt->rw_random = 1; pt->rw_random = 1;
scm_dynwind_end ();
/* Ensure WRITE_POS is writable. */ /* Ensure WRITE_POS is writable. */
if ((modes & SCM_WRTNG) && pt->write_pos == pt->write_end) if ((modes & SCM_WRTNG) && pt->write_pos == pt->write_end)
st_flush (z); st_flush (z);
scm_i_set_conversion_strategy_x (z, SCM_FAILED_CONVERSION_ERROR);
return z; return z;
} }

13
libguile/vports.c
View 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * 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 #define FUNC_NAME s_scm_make_soft_port
{ {
int vlen; int vlen;
scm_t_port *pt;
SCM z; SCM z;
SCM_VALIDATE_VECTOR (1, pv); 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_ASSERT ((vlen == 5) || (vlen == 6), pv, 1, FUNC_NAME);
SCM_VALIDATE_STRING (2, modes); SCM_VALIDATE_STRING (2, modes);
scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex); z = scm_c_make_port (scm_tc16_sfport, scm_i_mode_bits (modes),
z = scm_new_port_table_entry (scm_tc16_sfport); SCM_UNPACK (pv));
pt = SCM_PTAB_ENTRY (z); scm_port_non_buffer (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);
return z; return z;
} }
#undef FUNC_NAME #undef FUNC_NAME