libguile/rw.c

   1 /* Copyright (C) 2001, 2006, 2009, 2011, 2014 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public License
   5  * as published by the Free Software Foundation; either version 3 of
   6  * the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  16  * 02110-1301 USA
  17  */
  18
  19 \f
  20
  21 /* This is the C part of the (ice-9 rw) module.  */
  22
  23 #ifdef HAVE_CONFIG_H
  24 #  include <config.h>
  25 #endif
  26
  27 #include <errno.h>
  28 #include <string.h>
  29
  30 #include "libguile/_scm.h"
  31 #include "libguile/fports.h"
  32 #include "libguile/ports.h"
  33 #include "libguile/root.h"
  34 #include "libguile/rw.h"
  35 #include "libguile/strings.h"
  36 #include "libguile/validate.h"
  37 #include "libguile/modules.h"
  38 #include "libguile/strports.h"
  39
  40 #include <unistd.h>
  41 #ifdef HAVE_IO_H
  42 #include <io.h>
  43 #endif
  44
  45 \f
  46
  47 #if defined (EAGAIN)
  48 #define SCM_MAYBE_EAGAIN || errno == EAGAIN
  49 #else
  50 #define SCM_MAYBE_EAGAIN
  51 #endif
  52
  53 #if defined (EWOULDBLOCK)
  54 #define SCM_MAYBE_EWOULDBLOCK || errno == EWOULDBLOCK
  55 #else
  56 #define SCM_MAYBE_EWOULDBLOCK
  57 #endif
  58
  59 /* MAYBE there is EAGAIN way of defining this macro but now I EWOULDBLOCK.  */
  60 #define SCM_EBLOCK(errno) \
  61    (0 SCM_MAYBE_EAGAIN SCM_MAYBE_EWOULDBLOCK)
  62
  63 SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0,
  64             (SCM str, SCM port_or_fdes, SCM start, SCM end),
  65             "Read characters from a port or file descriptor into a\n"
  66             "string @var{str}.  A port must have an underlying file\n"
  67             "descriptor --- a so-called fport.  This procedure is\n"
  68             "scsh-compatible and can efficiently read large strings.\n"
  69             "It will:\n\n"
  70             "@itemize\n"
  71             "@item\n"
  72             "attempt to fill the entire string, unless the @var{start}\n"
  73             "and/or @var{end} arguments are supplied.  i.e., @var{start}\n"
  74             "defaults to 0 and @var{end} defaults to\n"
  75             "@code{(string-length str)}\n"
  76             "@item\n"
  77             "use the current input port if @var{port_or_fdes} is not\n"
  78             "supplied.\n"
  79             "@item\n"
  80             "return fewer than the requested number of characters in some\n"
  81             "cases, e.g., on end of file, if interrupted by a signal, or if\n"
  82             "not all the characters are immediately available.\n"
  83             "@item\n"
  84             "wait indefinitely for some input if no characters are\n"
  85             "currently available,\n"
  86             "unless the port is in non-blocking mode.\n"
  87             "@item\n"
  88             "read characters from the port's input buffers if available,\n"
  89             "instead from the underlying file descriptor.\n"
  90             "@item\n"
  91             "return @code{#f} if end-of-file is encountered before reading\n"
  92             "any characters, otherwise return the number of characters\n"
  93             "read.\n"
  94             "@item\n"
  95             "return 0 if the port is in non-blocking mode and no characters\n"
  96             "are immediately available.\n"
  97             "@item\n"
  98             "return 0 if the request is for 0 bytes, with no\n"
  99             "end-of-file check.\n"
 100             "@end itemize")
 101 #define FUNC_NAME s_scm_read_string_x_partial
 102 {
 103   char *dest;
 104   size_t offset;
 105   long read_len;
 106   long chars_read = 0;
 107   int fdes;
 108
 109   {
 110     size_t last;
 111
 112     SCM_VALIDATE_STRING (1, str);
 113     scm_i_get_substring_spec (scm_i_string_length (str),
 114                               start, &offset, end, &last);
 115     read_len = last - offset;
 116   }
 117
 118   if (scm_is_integer (port_or_fdes))
 119     fdes = scm_to_int (port_or_fdes);
 120   else
 121     {
 122       SCM port = (SCM_UNBNDP (port_or_fdes)?
 123                   scm_current_input_port () : port_or_fdes);
 124
 125       SCM_VALIDATE_OPFPORT (2, port);
 126       SCM_VALIDATE_INPUT_PORT (2, port);
 127
 128       /* if there's anything in the port buffers, use it, but then
 129          don't touch the file descriptor.  otherwise the
 130          "return immediately if something is available" rule may
 131          be violated.  */
 132       str = scm_i_string_start_writing (str);
 133       dest = scm_i_string_writable_chars (str) + offset;
 134       chars_read = scm_take_from_input_buffers (port, dest, read_len);
 135       scm_i_string_stop_writing ();
 136       fdes = SCM_FPORT_FDES (port);
 137     }
 138
 139   if (chars_read == 0 && read_len > 0) /* don't confuse read_len == 0 with
 140                                           EOF.  */
 141     {
 142       str = scm_i_string_start_writing (str);
 143       dest = scm_i_string_writable_chars (str) + offset;
 144       SCM_SYSCALL (chars_read = read (fdes, dest, read_len));
 145       scm_i_string_stop_writing ();
 146       if (chars_read == -1)
 147         {
 148           if (SCM_EBLOCK (errno))
 149             chars_read = 0;
 150           else
 151             SCM_SYSERROR;
 152         }
 153       else if (chars_read == 0)
 154         {
 155           scm_remember_upto_here_1 (str);
 156           return SCM_BOOL_F;
 157         }
 158     }
 159
 160   scm_remember_upto_here_1 (str);
 161   return scm_from_long (chars_read);
 162 }
 163 #undef FUNC_NAME
 164
 165 SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0,
 166             (SCM str, SCM port_or_fdes, SCM start, SCM end),
 167             "Write characters from a string @var{str} to a port or file\n"
 168             "descriptor.  A port must have an underlying file descriptor\n"
 169             "--- a so-called fport.  This procedure is\n"
 170             "scsh-compatible and can efficiently write large strings.\n"
 171             "It will:\n\n"
 172             "@itemize\n"
 173             "@item\n"
 174             "attempt to write the entire string, unless the @var{start}\n"
 175             "and/or @var{end} arguments are supplied.  i.e., @var{start}\n"
 176             "defaults to 0 and @var{end} defaults to\n"
 177             "@code{(string-length str)}\n"
 178             "@item\n"
 179             "use the current output port if @var{port_of_fdes} is not\n"
 180             "supplied.\n"
 181             "@item\n"
 182             "in the case of a buffered port, store the characters in the\n"
 183             "port's output buffer, if all will fit.  If they will not fit\n"
 184             "then any existing buffered characters will be flushed\n"
 185             "before attempting\n"
 186             "to write the new characters directly to the underlying file\n"
 187             "descriptor.  If the port is in non-blocking mode and\n"
 188             "buffered characters can not be flushed immediately, then an\n"
 189             "@code{EAGAIN} system-error exception will be raised (Note:\n"
 190             "scsh does not support the use of non-blocking buffered ports.)\n"
 191             "@item\n"
 192             "write fewer than the requested number of\n"
 193             "characters in some cases, e.g., if interrupted by a signal or\n"
 194             "if not all of the output can be accepted immediately.\n"
 195             "@item\n"
 196             "wait indefinitely for at least one character\n"
 197             "from @var{str} to be accepted by the port, unless the port is\n"
 198             "in non-blocking mode.\n"
 199             "@item\n"
 200             "return the number of characters accepted by the port.\n"
 201             "@item\n"
 202             "return 0 if the port is in non-blocking mode and can not accept\n"
 203             "at least one character from @var{str} immediately\n"
 204             "@item\n"
 205             "return 0 immediately if the request size is 0 bytes.\n"
 206             "@end itemize")
 207 #define FUNC_NAME s_scm_write_string_partial
 208 {
 209   const char *src;
 210   scm_t_off write_len;
 211   int fdes;
 212
 213   {
 214     size_t offset;
 215     size_t last;
 216
 217     SCM_VALIDATE_STRING (1, str);
 218     src = scm_i_string_chars (str);
 219     scm_i_get_substring_spec (scm_i_string_length (str),
 220                               start, &offset, end, &last);
 221     src += offset;
 222     write_len = last - offset;
 223   }
 224
 225   if (write_len == 0)
 226     return SCM_INUM0;
 227
 228   if (scm_is_integer (port_or_fdes))
 229     fdes = scm_to_int (port_or_fdes);
 230   else
 231     {
 232       SCM port = (SCM_UNBNDP (port_or_fdes)?
 233                   scm_current_output_port () : port_or_fdes);
 234       scm_t_port *pt;
 235       scm_t_off space;
 236
 237       SCM_VALIDATE_OPFPORT (2, port);
 238       SCM_VALIDATE_OUTPUT_PORT (2, port);
 239       pt = SCM_PTAB_ENTRY (port);
 240       /* filling the last character in the buffer would require a flush.  */
 241       space = pt->write_end - pt->write_pos - 1;
 242       if (space >= write_len)
 243         {
 244           memcpy (pt->write_pos, src, write_len);
 245           pt->write_pos += write_len;
 246           return scm_from_long (write_len);
 247         }
 248       if (pt->write_pos > pt->write_buf)
 249         scm_flush_unlocked (port);
 250       fdes = SCM_FPORT_FDES (port);
 251     }
 252   {
 253     long rv;
 254
 255     SCM_SYSCALL (rv = write (fdes, src, write_len));
 256     if (rv == -1)
 257       {
 258         if (SCM_EBLOCK (errno))
 259           rv = 0;
 260         else
 261           SCM_SYSERROR;
 262       }
 263
 264     scm_remember_upto_here_1 (str);
 265     return scm_from_long (rv);
 266   }
 267 }
 268 #undef FUNC_NAME
 269
 270 SCM
 271 scm_init_rw_builtins ()
 272 {
 273 #include "libguile/rw.x"
 274
 275   return SCM_UNSPECIFIED;
 276 }
 277
 278 void
 279 scm_init_rw ()
 280 {
 281   scm_c_define_gsubr ("%init-rw-builtins", 0, 0, 0, scm_init_rw_builtins);
 282 }
 283
 284 /*
 285   Local Variables:
 286   c-file-style: "gnu"
 287   End:
 288 */