summaryrefslogtreecommitdiff
path: root/libguile/ports.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/ports.c')
-rw-r--r--libguile/ports.c210
1 files changed, 56 insertions, 154 deletions
diff --git a/libguile/ports.c b/libguile/ports.c
index 9db949e4a..464f8f2a9 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -110,88 +110,6 @@ static SCM sym_escape;
-/* The port kind table --- a dynamically resized array of port types. */
-
-
-/* scm_ptobs scm_numptob
- * implement a dynamically resized array of ptob records.
- * Indexes into this table are used when generating type
- * tags for smobjects (if you know a tag you can get an index and conversely).
- */
-static scm_t_ptob_descriptor **scm_ptobs = NULL;
-static long scm_numptob = 0; /* Number of port types. */
-static long scm_ptobs_size = 0; /* Number of slots in the port type
- table. */
-static scm_i_pthread_mutex_t scm_ptobs_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
-
-long
-scm_c_num_port_types (void)
-{
- long ret;
-
- scm_i_pthread_mutex_lock (&scm_ptobs_lock);
- ret = scm_numptob;
- scm_i_pthread_mutex_unlock (&scm_ptobs_lock);
-
- return ret;
-}
-
-scm_t_ptob_descriptor*
-scm_c_port_type_ref (long ptobnum)
-{
- scm_t_ptob_descriptor *ret = NULL;
-
- scm_i_pthread_mutex_lock (&scm_ptobs_lock);
-
- if (0 <= ptobnum && ptobnum < scm_numptob)
- ret = scm_ptobs[ptobnum];
-
- scm_i_pthread_mutex_unlock (&scm_ptobs_lock);
-
- if (!ret)
- scm_out_of_range ("scm_c_port_type_ref", scm_from_long (ptobnum));
-
- return ret;
-}
-
-long
-scm_c_port_type_add_x (scm_t_ptob_descriptor *desc)
-{
- long ret = -1;
-
- scm_i_pthread_mutex_lock (&scm_ptobs_lock);
-
- if (scm_numptob + 1 < SCM_I_MAX_PORT_TYPE_COUNT)
- {
- if (scm_numptob == scm_ptobs_size)
- {
- unsigned long old_size = scm_ptobs_size;
- scm_t_ptob_descriptor **old_ptobs = scm_ptobs;
-
- /* Currently there are only 9 predefined port types, so one
- resize will cover it. */
- scm_ptobs_size = old_size + 10;
-
- if (scm_ptobs_size >= SCM_I_MAX_PORT_TYPE_COUNT)
- scm_ptobs_size = SCM_I_MAX_PORT_TYPE_COUNT;
-
- scm_ptobs = scm_gc_malloc (sizeof (*scm_ptobs) * scm_ptobs_size,
- "scm_ptobs");
-
- memcpy (scm_ptobs, old_ptobs, sizeof (*scm_ptobs) * scm_numptob);
- }
-
- ret = scm_numptob++;
- scm_ptobs[ret] = desc;
- }
-
- scm_i_pthread_mutex_unlock (&scm_ptobs_lock);
-
- if (ret < 0)
- scm_out_of_range ("scm_c_port_type_add_x", scm_from_long (scm_numptob));
-
- return ret;
-}
static SCM trampoline_to_c_read_subr;
static SCM trampoline_to_c_write_subr;
@@ -199,18 +117,17 @@ static SCM trampoline_to_c_write_subr;
static int
default_random_access_p (SCM port)
{
- return SCM_PORT_DESCRIPTOR (port)->seek != NULL;
+ return SCM_PORT_TYPE (port)->seek != NULL;
}
-scm_t_bits
+scm_t_port_type *
scm_make_port_type (char *name,
size_t (*read) (SCM port, SCM dst, size_t start,
size_t count),
size_t (*write) (SCM port, SCM src, size_t start,
size_t count))
{
- scm_t_ptob_descriptor *desc;
- long ptobnum;
+ scm_t_port_type *desc;
desc = scm_gc_malloc_pointerless (sizeof (*desc), "port-type");
memset (desc, 0, sizeof (*desc));
@@ -222,14 +139,9 @@ scm_make_port_type (char *name,
desc->scm_read = read ? trampoline_to_c_read_subr : SCM_BOOL_F;
desc->scm_write = write ? trampoline_to_c_write_subr : SCM_BOOL_F;
desc->random_access_p = default_random_access_p;
+ scm_make_port_classes (desc);
- ptobnum = scm_c_port_type_add_x (desc);
-
- /* Make a class object if GOOPS is present. */
- if (SCM_UNPACK (scm_i_port_class[0]) != 0)
- scm_make_port_classes (ptobnum, name);
-
- return scm_tc7_port + ptobnum * 256;
+ return desc;
}
static SCM
@@ -245,7 +157,7 @@ trampoline_to_c_read (SCM port, SCM dst, SCM start, SCM count)
SCM_ASSERT_RANGE (3, count, c_start+c_count <= scm_c_bytevector_length (dst));
return scm_from_size_t
- (SCM_PORT_DESCRIPTOR (port)->c_read (port, dst, c_start, c_count));
+ (SCM_PORT_TYPE (port)->c_read (port, dst, c_start, c_count));
}
#undef FUNC_NAME
@@ -253,7 +165,7 @@ static size_t
trampoline_to_scm_read (SCM port, SCM dst, size_t start, size_t count)
{
return scm_to_size_t
- (scm_call_4 (SCM_PORT_DESCRIPTOR (port)->scm_read, port, dst,
+ (scm_call_4 (SCM_PORT_TYPE (port)->scm_read, port, dst,
scm_from_size_t (start), scm_from_size_t (count)));
}
@@ -270,7 +182,7 @@ trampoline_to_c_write (SCM port, SCM src, SCM start, SCM count)
SCM_ASSERT_RANGE (3, count, c_start+c_count <= scm_c_bytevector_length (src));
return scm_from_size_t
- (SCM_PORT_DESCRIPTOR (port)->c_write (port, src, c_start, c_count));
+ (SCM_PORT_TYPE (port)->c_write (port, src, c_start, c_count));
}
#undef FUNC_NAME
@@ -278,44 +190,40 @@ static size_t
trampoline_to_scm_write (SCM port, SCM src, size_t start, size_t count)
{
return scm_to_size_t
- (scm_call_4 (SCM_PORT_DESCRIPTOR (port)->scm_write, port, src,
+ (scm_call_4 (SCM_PORT_TYPE (port)->scm_write, port, src,
scm_from_size_t (start), scm_from_size_t (count)));
}
void
-scm_set_port_scm_read (scm_t_bits tc, SCM read)
+scm_set_port_scm_read (scm_t_port_type *ptob, SCM read)
{
- scm_t_ptob_descriptor *desc = scm_c_port_type_ref (SCM_TC2PTOBNUM (tc));
- desc->scm_read = read;
- desc->c_read = trampoline_to_scm_read;
+ ptob->scm_read = read;
+ ptob->c_read = trampoline_to_scm_read;
}
void
-scm_set_port_scm_write (scm_t_bits tc, SCM write)
+scm_set_port_scm_write (scm_t_port_type *ptob, SCM write)
{
- scm_t_ptob_descriptor *desc = scm_c_port_type_ref (SCM_TC2PTOBNUM (tc));
- desc->scm_write = write;
- desc->c_write = trampoline_to_scm_write;
+ ptob->scm_write = write;
+ ptob->c_write = trampoline_to_scm_write;
}
void
-scm_set_port_print (scm_t_bits tc, int (*print) (SCM exp, SCM port,
- scm_print_state *pstate))
+scm_set_port_print (scm_t_port_type *ptob,
+ int (*print) (SCM exp, SCM port, scm_print_state *pstate))
{
- scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->print = print;
+ ptob->print = print;
}
void
-scm_set_port_close (scm_t_bits tc, void (*close) (SCM))
+scm_set_port_close (scm_t_port_type *ptob, void (*close) (SCM))
{
- scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->close = close;
+ ptob->close = close;
}
void
-scm_set_port_needs_close_on_gc (scm_t_bits tc, int needs_close_p)
+scm_set_port_needs_close_on_gc (scm_t_port_type *ptob, int needs_close_p)
{
- scm_t_ptob_descriptor *ptob = scm_c_port_type_ref (SCM_TC2PTOBNUM (tc));
-
if (needs_close_p)
ptob->flags |= SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC;
else
@@ -323,35 +231,36 @@ scm_set_port_needs_close_on_gc (scm_t_bits tc, int needs_close_p)
}
void
-scm_set_port_seek (scm_t_bits tc, scm_t_off (*seek) (SCM, scm_t_off, int))
+scm_set_port_seek (scm_t_port_type *ptob,
+ scm_t_off (*seek) (SCM, scm_t_off, int))
{
- scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->seek = seek;
+ ptob->seek = seek;
}
void
-scm_set_port_truncate (scm_t_bits tc, void (*truncate) (SCM, scm_t_off))
+scm_set_port_truncate (scm_t_port_type *ptob, void (*truncate) (SCM, scm_t_off))
{
- scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->truncate = truncate;
+ ptob->truncate = truncate;
}
void
-scm_set_port_input_waiting (scm_t_bits tc, int (*input_waiting) (SCM))
+scm_set_port_input_waiting (scm_t_port_type *ptob, int (*input_waiting) (SCM))
{
- scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->input_waiting = input_waiting;
+ ptob->input_waiting = input_waiting;
}
void
-scm_set_port_random_access_p (scm_t_bits tc, int (*random_access_p) (SCM))
+scm_set_port_random_access_p (scm_t_port_type *ptob,
+ int (*random_access_p) (SCM))
{
- scm_t_ptob_descriptor *ptob = scm_c_port_type_ref (SCM_TC2PTOBNUM (tc));
ptob->random_access_p = random_access_p;
}
void
scm_set_port_get_natural_buffer_sizes
- (scm_t_bits tc, void (*get_natural_buffer_sizes) (SCM, size_t *, size_t *))
+ (scm_t_port_type *ptob,
+ void (*get_natural_buffer_sizes) (SCM, size_t *, size_t *))
{
- scm_t_ptob_descriptor *ptob = scm_c_port_type_ref (SCM_TC2PTOBNUM (tc));
ptob->get_natural_buffer_sizes = get_natural_buffer_sizes;
}
@@ -684,7 +593,7 @@ static void
initialize_port_buffers (SCM port)
{
scm_t_port *pt = SCM_PORT (port);
- scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (port);
+ scm_t_port_type *ptob = SCM_PORT_TYPE (port);
size_t read_buf_size, write_buf_size;
if (SCM_CELL_WORD_0 (port) & SCM_BUF0)
@@ -711,18 +620,16 @@ initialize_port_buffers (SCM port)
}
SCM
-scm_c_make_port_with_encoding (scm_t_bits tag, unsigned long mode_bits,
+scm_c_make_port_with_encoding (scm_t_port_type *ptob, unsigned long mode_bits,
SCM encoding, SCM conversion_strategy,
scm_t_bits stream)
{
SCM ret;
scm_t_port *pt;
- scm_t_ptob_descriptor *ptob;
pt = scm_gc_typed_calloc (scm_t_port);
- ptob = scm_c_port_type_ref (SCM_TC2PTOBNUM (tag));
- ret = scm_words (tag | mode_bits, 4);
+ ret = scm_words (scm_tc7_port | mode_bits, 4);
SCM_SET_CELL_WORD_1 (ret, stream);
SCM_SET_CELL_WORD_2 (ret, (scm_t_bits) pt);
SCM_SET_CELL_WORD_3 (ret, (scm_t_bits) ptob);
@@ -737,7 +644,7 @@ scm_c_make_port_with_encoding (scm_t_bits tag, unsigned long mode_bits,
pt->alist = SCM_EOL;
- if (SCM_PORT_DESCRIPTOR (ret)->flags & SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC)
+ if (SCM_PORT_TYPE (ret)->flags & SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC)
{
scm_i_set_finalizer (SCM2PTR (ret), finalize_port, NULL);
scm_weak_set_add_x (scm_i_port_weak_set, ret);
@@ -751,20 +658,15 @@ scm_c_make_port_with_encoding (scm_t_bits tag, unsigned long mode_bits,
}
SCM
-scm_c_make_port (scm_t_bits tag, unsigned long mode_bits, scm_t_bits stream)
+scm_c_make_port (scm_t_port_type *ptob,
+ unsigned long mode_bits, scm_t_bits stream)
{
- return scm_c_make_port_with_encoding (tag, mode_bits,
+ return scm_c_make_port_with_encoding (ptob, mode_bits,
scm_i_default_port_encoding (),
scm_i_default_port_conversion_strategy (),
stream);
}
-SCM
-scm_new_port_table_entry (scm_t_bits tag)
-{
- return scm_c_make_port (tag, 0, 0);
-}
-
/* Predicates. */
@@ -860,13 +762,13 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
pt = SCM_PORT (port);
SCM_CLR_PORT_OPEN_FLAG (port);
- if (SCM_PORT_DESCRIPTOR (port)->flags & SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC)
+ if (SCM_PORT_TYPE (port)->flags & SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC)
scm_weak_set_remove_x (scm_i_port_weak_set, port);
- if (SCM_PORT_DESCRIPTOR (port)->close)
+ if (SCM_PORT_TYPE (port)->close)
/* Note! This may throw an exception. Anything after this point
should be resilient to non-local exits. */
- SCM_PORT_DESCRIPTOR (port)->close (port);
+ SCM_PORT_TYPE (port)->close (port);
if (pt->iconv_descriptors)
{
@@ -1418,7 +1320,7 @@ static size_t
scm_i_read_bytes (SCM port, SCM dst, size_t start, size_t count)
{
size_t filled;
- scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (port);
+ scm_t_port_type *ptob = SCM_PORT_TYPE (port);
assert (count <= SCM_BYTEVECTOR_LENGTH (dst));
assert (start + count <= SCM_BYTEVECTOR_LENGTH (dst));
@@ -2107,7 +2009,7 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
{
long csize;
scm_t_port *pt;
- scm_t_ptob_descriptor *ptob;
+ scm_t_port_type *ptob;
scm_t_bits tag_word;
size_t read_buf_size, write_buf_size;
SCM saved_read_buf;
@@ -2116,7 +2018,7 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
SCM_VALIDATE_OPENPORT (1, port);
pt = SCM_PORT (port);
- ptob = SCM_PORT_DESCRIPTOR (port);
+ ptob = SCM_PORT_TYPE (port);
tag_word = SCM_CELL_WORD_0 (port) & ~(SCM_BUF0 | SCM_BUFLINE);
if (scm_is_eq (mode, sym_none))
@@ -2237,7 +2139,7 @@ scm_end_input (SCM port)
discarded = scm_port_buffer_take (buf, NULL, (size_t) -1);
if (discarded != 0)
- SCM_PORT_DESCRIPTOR (port)->seek (port, -discarded, SEEK_CUR);
+ SCM_PORT_TYPE (port)->seek (port, -discarded, SEEK_CUR);
}
SCM_DEFINE (scm_force_output, "force-output", 0, 1, 0,
@@ -2538,7 +2440,7 @@ SCM_DEFINE (scm_port_read, "port-read", 1, 0, 0, (SCM port),
#define FUNC_NAME s_scm_port_read
{
SCM_VALIDATE_OPINPORT (1, port);
- return SCM_PORT_DESCRIPTOR (port)->scm_read;
+ return SCM_PORT_TYPE (port)->scm_read;
}
#undef FUNC_NAME
@@ -2548,7 +2450,7 @@ SCM_DEFINE (scm_port_write, "port-write", 1, 0, 0,
#define FUNC_NAME s_scm_port_write
{
SCM_VALIDATE_OPOUTPORT (1, port);
- return SCM_PORT_DESCRIPTOR (port)->scm_write;
+ return SCM_PORT_TYPE (port)->scm_write;
}
#undef FUNC_NAME
@@ -2595,7 +2497,7 @@ static void
scm_i_write_bytes (SCM port, SCM src, size_t start, size_t count)
{
size_t written = 0;
- scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (port);
+ scm_t_port_type *ptob = SCM_PORT_TYPE (port);
assert (count <= SCM_BYTEVECTOR_LENGTH (src));
assert (start + count <= SCM_BYTEVECTOR_LENGTH (src));
@@ -2787,7 +2689,7 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0,
return SCM_BOOL_T;
else
{
- scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (port);
+ scm_t_port_type *ptob = SCM_PORT_TYPE (port);
if (ptob->input_waiting)
return scm_from_bool (ptob->input_waiting (port));
@@ -2835,7 +2737,7 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
if (SCM_OPPORTP (fd_port))
{
scm_t_port *pt = SCM_PORT (fd_port);
- scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (fd_port);
+ scm_t_port_type *ptob = SCM_PORT_TYPE (fd_port);
off_t_or_off64_t off = scm_to_off_t_or_off64_t (offset);
off_t_or_off64_t rv;
@@ -2943,7 +2845,7 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
else if (SCM_OPOUTPORTP (object))
{
off_t_or_off64_t c_length = scm_to_off_t_or_off64_t (length);
- scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (object);
+ scm_t_port_type *ptob = SCM_PORT_TYPE (object);
if (!ptob->truncate)
SCM_MISC_ERROR ("port is not truncatable", SCM_EOL);
@@ -3085,7 +2987,7 @@ scm_print_port_mode (SCM exp, SCM port)
int
scm_port_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{
- char *type = SCM_PTOBNAME (SCM_PTOBNUM (exp));
+ char *type = SCM_PORT_TYPE (port)->name;
if (!type)
type = "port";
scm_puts ("#<", port);
@@ -3177,7 +3079,7 @@ SCM_DEFINE (scm_flush_all_ports, "flush-all-ports", 0, 0, 0,
/* Void ports. */
-scm_t_bits scm_tc16_void_port = 0;
+scm_t_port_type *scm_void_port_type = 0;
static size_t
void_port_read (SCM port, SCM dst, size_t start, size_t count)
@@ -3194,7 +3096,7 @@ void_port_write (SCM port, SCM src, size_t start, size_t count)
static SCM
scm_i_void_port (long mode_bits)
{
- return scm_c_make_port (scm_tc16_void_port, mode_bits, 0);
+ return scm_c_make_port (scm_void_port_type, mode_bits, 0);
}
SCM
@@ -3261,7 +3163,7 @@ scm_init_ports (void)
scm_c_make_gsubr ("port-write", 4, 0, 0,
(scm_t_subr) trampoline_to_c_write);
- scm_tc16_void_port = scm_make_port_type ("void", void_port_read,
+ scm_void_port_type = scm_make_port_type ("void", void_port_read,
void_port_write);
scm_i_port_weak_set = scm_c_make_weak_set (31);