X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/1be6b49ccb7b078813668f1decb186116e2e2d18..a9d13d445b1a6a2793d58357a78b4d6623e76dc8:/libguile/rw.c diff --git a/libguile/rw.c b/libguile/rw.c index e0d271cf5..49123b59f 100644 --- a/libguile/rw.c +++ b/libguile/rw.c @@ -1,49 +1,30 @@ /* Copyright (C) 2001 Free Software Foundation, Inc. * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 USA - * - * As a special exception, the Free Software Foundation gives permission - * for additional uses of the text contained in its release of GUILE. + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. * - * The exception is that, if you link the GUILE library with other files - * to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the GUILE library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the - * Free Software Foundation under the name GUILE. If you copy - * code from other Free Software Foundation releases into a copy of - * GUILE, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. * - * If you write modifications of your own for GUILE, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. */ + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + */ /* This is the C part of the (ice-9 rw) module. */ +#if HAVE_CONFIG_H +# include +#endif + #include +#include #include "libguile/_scm.h" #include "libguile/fports.h" @@ -58,6 +39,9 @@ #ifdef HAVE_UNISTD_H #include #endif +#ifdef HAVE_IO_H +#include +#endif @@ -79,9 +63,11 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0, (SCM str, SCM port_or_fdes, SCM start, SCM end), - "Read characters from an fport or file descriptor into a\n" - "string @var{str}. This procedure is scsh-compatible\n" - "and can efficiently read large strings. It will:\n\n" + "Read characters from a port or file descriptor into a\n" + "string @var{str}. A port must have an underlying file\n" + "descriptor --- a so-called fport. This procedure is\n" + "scsh-compatible and can efficiently read large strings.\n" + "It will:\n\n" "@itemize\n" "@item\n" "attempt to fill the entire string, unless the @var{start}\n" @@ -92,11 +78,16 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0, "use the current input port if @var{port_or_fdes} is not\n" "supplied.\n" "@item\n" - "read any characters that are currently available,\n" - "without waiting for the rest (short reads are possible).\n\n" + "return fewer than the requested number of characters in some\n" + "cases, e.g., on end of file, if interrupted by a signal, or if\n" + "not all the characters are immediately available.\n" "@item\n" - "wait for as long as it needs to for the first character to\n" - "become available, unless the port is in non-blocking mode\n" + "wait indefinitely for some input if no characters are\n" + "currently available,\n" + "unless the port is in non-blocking mode.\n" + "@item\n" + "read characters from the port's input buffers if available,\n" + "instead from the underlying file descriptor.\n" "@item\n" "return @code{#f} if end-of-file is encountered before reading\n" "any characters, otherwise return the number of characters\n" @@ -106,27 +97,27 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0, "are immediately available.\n" "@item\n" "return 0 if the request is for 0 bytes, with no\n" - "end-of-file check\n" + "end-of-file check.\n" "@end itemize") #define FUNC_NAME s_scm_read_string_x_partial { char *dest; - scm_bits_t read_len; - scm_bits_t chars_read = 0; + size_t offset; + long read_len; + long chars_read = 0; int fdes; { - scm_bits_t offset; - scm_bits_t last; + size_t last; - SCM_VALIDATE_SUBSTRING_SPEC_COPY (1, str, dest, 3, start, offset, - 4, end, last); - dest += offset; + SCM_VALIDATE_STRING (1, str); + scm_i_get_substring_spec (scm_i_string_length (str), + start, &offset, end, &last); read_len = last - offset; } - if (SCM_INUMP (port_or_fdes)) - fdes = SCM_INUM (port_or_fdes); + if (scm_is_integer (port_or_fdes)) + fdes = scm_to_int (port_or_fdes); else { SCM port = SCM_UNBNDP (port_or_fdes) ? scm_cur_inp : port_or_fdes; @@ -138,14 +129,18 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0, don't touch the file descriptor. otherwise the "return immediately if something is available" rule may be violated. */ + dest = scm_i_string_writable_chars (str) + offset; chars_read = scm_take_from_input_buffers (port, dest, read_len); + scm_i_string_stop_writing (); fdes = SCM_FPORT_FDES (port); } if (chars_read == 0 && read_len > 0) /* don't confuse read_len == 0 with EOF. */ { + dest = scm_i_string_writable_chars (str) + offset; SCM_SYSCALL (chars_read = read (fdes, dest, read_len)); + scm_i_string_stop_writing (); if (chars_read == -1) { if (SCM_EBLOCK (errno)) @@ -154,18 +149,125 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0, SCM_SYSERROR; } else if (chars_read == 0) - return SCM_BOOL_F; + { + scm_remember_upto_here_1 (str); + return SCM_BOOL_F; + } + } + + scm_remember_upto_here_1 (str); + return scm_from_long (chars_read); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0, + (SCM str, SCM port_or_fdes, SCM start, SCM end), + "Write characters from a string @var{str} to a port or file\n" + "descriptor. A port must have an underlying file descriptor\n" + "--- a so-called fport. This procedure is\n" + "scsh-compatible and can efficiently write large strings.\n" + "It will:\n\n" + "@itemize\n" + "@item\n" + "attempt to write the entire string, unless the @var{start}\n" + "and/or @var{end} arguments are supplied. i.e., @var{start}\n" + "defaults to 0 and @var{end} defaults to\n" + "@code{(string-length str)}\n" + "@item\n" + "use the current output port if @var{port_of_fdes} is not\n" + "supplied.\n" + "@item\n" + "in the case of a buffered port, store the characters in the\n" + "port's output buffer, if all will fit. If they will not fit\n" + "then any existing buffered characters will be flushed\n" + "before attempting\n" + "to write the new characters directly to the underlying file\n" + "descriptor. If the port is in non-blocking mode and\n" + "buffered characters can not be flushed immediately, then an\n" + "@code{EAGAIN} system-error exception will be raised (Note:\n" + "scsh does not support the use of non-blocking buffered ports.)\n" + "@item\n" + "write fewer than the requested number of\n" + "characters in some cases, e.g., if interrupted by a signal or\n" + "if not all of the output can be accepted immediately.\n" + "@item\n" + "wait indefinitely for at least one character\n" + "from @var{str} to be accepted by the port, unless the port is\n" + "in non-blocking mode.\n" + "@item\n" + "return the number of characters accepted by the port.\n" + "@item\n" + "return 0 if the port is in non-blocking mode and can not accept\n" + "at least one character from @var{str} immediately\n" + "@item\n" + "return 0 immediately if the request size is 0 bytes.\n" + "@end itemize") +#define FUNC_NAME s_scm_write_string_partial +{ + const char *src; + long write_len; + int fdes; + + { + size_t offset; + size_t last; + + SCM_VALIDATE_STRING (1, str); + src = scm_i_string_chars (str); + scm_i_get_substring_spec (scm_i_string_length (str), + start, &offset, end, &last); + src += offset; + write_len = last - offset; + } + + if (write_len == 0) + return SCM_INUM0; + + if (scm_is_integer (port_or_fdes)) + fdes = scm_to_int (port_or_fdes); + else + { + SCM port = SCM_UNBNDP (port_or_fdes) ? scm_cur_outp : port_or_fdes; + scm_t_port *pt; + off_t space; + + SCM_VALIDATE_OPFPORT (2, port); + SCM_VALIDATE_OUTPUT_PORT (2, port); + pt = SCM_PTAB_ENTRY (port); + /* filling the last character in the buffer would require a flush. */ + space = pt->write_end - pt->write_pos - 1; + if (space >= write_len) + { + memcpy (pt->write_pos, src, write_len); + pt->write_pos += write_len; + return scm_from_long (write_len); + } + if (pt->write_pos > pt->write_buf) + scm_flush (port); + fdes = SCM_FPORT_FDES (port); } - return scm_long2num (chars_read); + { + long rv; + + SCM_SYSCALL (rv = write (fdes, src, write_len)); + if (rv == -1) + { + if (SCM_EBLOCK (errno)) + rv = 0; + else + SCM_SYSERROR; + } + + scm_remember_upto_here_1 (str); + return scm_from_long (rv); + } } #undef FUNC_NAME SCM scm_init_rw_builtins () { -#ifndef SCM_MAGIC_SNARFER #include "libguile/rw.x" -#endif return SCM_UNSPECIFIED; }