mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-09 21:40:33 +02:00
Allow port "write" functions to only write a chunk
* libguile/ports.c (scm_i_write_bytes_unlocked): Allow incomplete writes from the implementation. (scm_c_write_bytes_unlocked): Use scm_i_write_bytes_unlocked helper to call the write function. * libguile/r6rs-ports.c (custom_binary_output_port_write): Don't loop; core Guile will do that.
This commit is contained in:
parent
d83140890f
commit
a9cf9f424f
2 changed files with 14 additions and 27 deletions
|
@ -2614,15 +2614,16 @@ scm_puts (const char *s, SCM port)
|
|||
static void
|
||||
scm_i_write_bytes_unlocked (SCM port, SCM src, size_t start, size_t count)
|
||||
{
|
||||
size_t written;
|
||||
size_t written = 0;
|
||||
scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (port);
|
||||
|
||||
assert (count <= SCM_BYTEVECTOR_LENGTH (src));
|
||||
assert (start + count <= SCM_BYTEVECTOR_LENGTH (src));
|
||||
|
||||
written = ptob->write (port, src, start, count);
|
||||
do
|
||||
written += ptob->write (port, src, start + written, count - written);
|
||||
while (written < count);
|
||||
|
||||
/* FIXME: Allow short writes? */
|
||||
assert (written == count);
|
||||
}
|
||||
|
||||
|
@ -2697,13 +2698,10 @@ scm_c_write_bytes_unlocked (SCM port, SCM src, size_t start, size_t count)
|
|||
{
|
||||
/* Our write would overflow the buffer. Flush buffered bytes (if
|
||||
needed), then write our bytes with just one syscall. */
|
||||
size_t written;
|
||||
|
||||
if (write_buf->cur < write_buf->end)
|
||||
scm_i_write_unlocked (port, write_buf);
|
||||
|
||||
written = SCM_PORT_DESCRIPTOR (port)->write (port, src, start, count);
|
||||
assert (written == count);
|
||||
scm_i_write_bytes_unlocked (port, src, start, count);
|
||||
}
|
||||
|
||||
return count;
|
||||
|
|
|
@ -887,29 +887,18 @@ static size_t
|
|||
custom_binary_output_port_write (SCM port, SCM src, size_t start, size_t count)
|
||||
#define FUNC_NAME "custom_binary_output_port_write"
|
||||
{
|
||||
size_t written;
|
||||
struct custom_binary_port *stream = (void *) SCM_STREAM (port);
|
||||
size_t written;
|
||||
SCM result;
|
||||
|
||||
/* Since the `write' procedure of Guile's ports has type `void', it must
|
||||
try hard to write exactly SIZE bytes, regardless of how many bytes the
|
||||
sink can handle. */
|
||||
written = 0;
|
||||
while (written < count)
|
||||
{
|
||||
long int c_result;
|
||||
SCM result;
|
||||
result = scm_call_3 (stream->write, src, scm_from_size_t (start),
|
||||
scm_from_size_t (count));
|
||||
|
||||
result = scm_call_3 (stream->write, src,
|
||||
scm_from_size_t (start + written),
|
||||
scm_from_size_t (count - written));
|
||||
|
||||
c_result = scm_to_long (result);
|
||||
if (c_result < 0 || (size_t) c_result > (count - written))
|
||||
scm_wrong_type_arg_msg (FUNC_NAME, 0, result,
|
||||
"R6RS custom binary output port `write!' "
|
||||
"returned a incorrect integer");
|
||||
written += c_result;
|
||||
}
|
||||
written = scm_to_size_t (result);
|
||||
if (written > count)
|
||||
scm_wrong_type_arg_msg (FUNC_NAME, 0, result,
|
||||
"R6RS custom binary output port `write!' "
|
||||
"returned a incorrect integer");
|
||||
|
||||
return written;
|
||||
}
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue