diff options
author | Andy Wingo <wingo@pobox.com> | 2016-04-30 11:59:33 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-04-30 11:59:33 +0200 |
commit | 8bad621fec65d58768a38661278165ae259fabce (patch) | |
tree | 630e965ecc17105ab68f23fdf4f6b6e2e1ea7624 | |
parent | 2b47043052565eb780ef5600e4968fc333643b0c (diff) | |
download | guile-8bad621fec65d58768a38661278165ae259fabce.tar.gz |
Add SCM port read/write functions
* libguile/ports.h (scm_t_ptob_descriptor): Add "scm_read" and
"scm_write" members, for calling from Scheme.
(scm_set_port_scm_read, scm_set_port_scm_write): New procedures.
* libguile/ports.c (trampoline_to_c_read_subr)
(trampoline_to_c_write_subr): New static variables.
* libguile/ports.c (scm_make_port_type): Initialize scm_read and
scm_write members to trampoline to C.
(trampoline_to_c_read, trampoline_to_scm_read)
(trampoline_to_c_write, trampoline_to_scm_write): New helpers.
(scm_set_port_scm_read, scm_set_port_scm_write): New functions.
(default_buffer_size): Move definition down.
(scm_i_read_bytes, scm_i_write_bytes): Use new names for read and
write procedures.
(scm_init_ports): Initialize trampolines.
-rw-r--r-- | libguile/ports.c | 72 | ||||
-rw-r--r-- | libguile/ports.h | 9 |
2 files changed, 73 insertions, 8 deletions
diff --git a/libguile/ports.c b/libguile/ports.c index 75bd1dd81..8c8276b26 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -224,8 +224,8 @@ scm_c_port_type_add_x (scm_t_ptob_descriptor *desc) return ret; } -/* Default buffer size. Used if the port type won't supply a value. */ -static const size_t default_buffer_size = 1024; +static SCM trampoline_to_c_read_subr; +static SCM trampoline_to_c_write_subr; scm_t_bits scm_make_port_type (char *name, @@ -242,8 +242,10 @@ scm_make_port_type (char *name, desc->name = name; desc->print = scm_port_print; - desc->read = read; - desc->write = write; + desc->c_read = read; + desc->c_write = write; + desc->scm_read = read ? trampoline_to_c_read_subr : SCM_BOOL_F; + desc->scm_write = write ? trampoline_to_c_write_subr : SCM_BOOL_F; ptobnum = scm_c_port_type_add_x (desc); @@ -254,6 +256,54 @@ scm_make_port_type (char *name, return scm_tc7_port + ptobnum * 256; } +static SCM +trampoline_to_c_read (SCM port, SCM dst, SCM start, SCM count) +{ + return scm_from_size_t + (SCM_PORT_DESCRIPTOR (port)->c_read + (port, dst, scm_to_size_t (start), scm_to_size_t (count))); +} + +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_from_size_t (start), scm_from_size_t (count))); +} + +static SCM +trampoline_to_c_write (SCM port, SCM src, SCM start, SCM count) +{ + return scm_from_size_t + (SCM_PORT_DESCRIPTOR (port)->c_write + (port, src, scm_to_size_t (start), scm_to_size_t (count))); +} + +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_from_size_t (start), scm_from_size_t (count))); +} + +void +scm_set_port_scm_read (scm_t_bits tc, 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; +} + +void +scm_set_port_scm_write (scm_t_bits tc, 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; +} + void scm_set_port_print (scm_t_bits tc, int (*print) (SCM exp, SCM port, scm_print_state *pstate)) @@ -637,6 +687,9 @@ finalize_port (void *ptr, void *data) +/* Default buffer size. Used if the port type won't supply a value. */ +static const size_t default_buffer_size = 1024; + static void initialize_port_buffers (SCM port) { @@ -1417,7 +1470,7 @@ scm_i_read_bytes (SCM port, SCM dst, size_t start, size_t count) assert (count <= SCM_BYTEVECTOR_LENGTH (dst)); assert (start + count <= SCM_BYTEVECTOR_LENGTH (dst)); - filled = ptob->read (port, dst, start, count); + filled = ptob->c_read (port, dst, start, count); assert (filled <= count); @@ -2473,7 +2526,7 @@ scm_i_write_bytes (SCM port, SCM src, size_t start, size_t count) assert (start + count <= SCM_BYTEVECTOR_LENGTH (src)); do - written += ptob->write (port, src, start + written, count - written); + written += ptob->c_write (port, src, start + written, count - written); while (written < count); assert (written == count); @@ -3108,6 +3161,13 @@ scm_init_ice_9_ports (void) void scm_init_ports (void) { + trampoline_to_c_read_subr = + scm_c_make_gsubr ("port-read", 4, 0, 0, + (scm_t_subr) trampoline_to_c_read); + trampoline_to_c_write_subr = + 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, void_port_write); diff --git a/libguile/ports.h b/libguile/ports.h index 230137f68..ba4bc2c3a 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -181,8 +181,11 @@ typedef struct scm_t_ptob_descriptor char *name; int (*print) (SCM exp, SCM port, scm_print_state *pstate); - 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); + size_t (*c_read) (SCM port, SCM dst, size_t start, size_t count); + size_t (*c_write) (SCM port, SCM src, size_t start, size_t count); + SCM scm_read; + SCM scm_write; + scm_t_off (*seek) (SCM port, scm_t_off OFFSET, int WHENCE); void (*close) (SCM port); @@ -209,6 +212,8 @@ SCM_API scm_t_bits 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_API void scm_set_port_scm_read (scm_t_bits tc, SCM read); +SCM_API void scm_set_port_scm_write (scm_t_bits tc, SCM write); SCM_API void scm_set_port_print (scm_t_bits tc, int (*print) (SCM exp, SCM port, |