[bpt/guile.git] / libguile / rw.c

/* 	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.
 *
 * 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.
 *
 * 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.  */

\f

/* This is the C part of the (ice-9 rw) module.  */

#include <errno.h>

#include "libguile/_scm.h"
#include "libguile/fports.h"
#include "libguile/ports.h"
#include "libguile/root.h"
#include "libguile/rw.h"
#include "libguile/strings.h"
#include "libguile/validate.h"
#include "libguile/modules.h"
#include "libguile/strports.h"

#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

\f

#if defined (EAGAIN)
#define SCM_MAYBE_EAGAIN || errno == EAGAIN
#else
#define SCM_MAYBE_EAGAIN
#endif

#if defined (EWOULDBLOCK)
#define SCM_MAYBE_EWOULDBLOCK || errno == EWOULDBLOCK
#else
#define SCM_MAYBE_EWOULDBLOCK
#endif

/* MAYBE there is EAGAIN way of defining this macro but now I EWOULDBLOCK.  */
#define SCM_EBLOCK(errno) \
   (0 SCM_MAYBE_EAGAIN SCM_MAYBE_EWOULDBLOCK)

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 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"
	    "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 input port if @var{port_or_fdes} is not\n"
	    "supplied.\n" 
	    "@item\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 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"
	    "read.\n"
	    "@item\n"
	    "return 0 if the port is in non-blocking mode and no characters\n"
	    "are immediately available.\n"
	    "@item\n"
	    "return 0 if the request is for 0 bytes, with no\n"
	    "end-of-file check.\n"
	    "@end itemize")
#define FUNC_NAME s_scm_read_string_x_partial
{
  char *dest;
  long read_len;
  long chars_read = 0;
  int fdes;

  {
    long offset;
    long last;

    SCM_VALIDATE_SUBSTRING_SPEC_COPY (1, str, dest, 3, start, offset,
				      4, end, last);
    dest += offset;
    read_len = last - offset;
  }

  if (SCM_INUMP (port_or_fdes))
    fdes = SCM_INUM (port_or_fdes);
  else
    {
      SCM port = SCM_UNBNDP (port_or_fdes) ? scm_cur_inp : port_or_fdes;

      SCM_VALIDATE_OPFPORT (2, port);
      SCM_VALIDATE_INPUT_PORT (2, port);

      /* if there's anything in the port buffers, use it, but then
	 don't touch the file descriptor.  otherwise the
	 "return immediately if something is available" rule may
	 be violated.  */
      chars_read = scm_take_from_input_buffers (port, dest, read_len);
      fdes = SCM_FPORT_FDES (port);
    }

  if (chars_read == 0 && read_len > 0) /* don't confuse read_len == 0 with
					  EOF.  */
    {
      SCM_SYSCALL (chars_read = read (fdes, dest, read_len));
      if (chars_read == -1)
	{
	  if (SCM_EBLOCK (errno))
	    chars_read = 0;
	  else
	    SCM_SYSERROR;
        }
      else if (chars_read == 0)
	return SCM_BOOL_F;
    }
  return scm_long2num (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
{
  char *src;
  long write_len;
  int fdes;

  {
    long offset;
    long last;

    SCM_VALIDATE_SUBSTRING_SPEC_COPY (1, str, src, 3, start, offset,
				      4, end, last);
    src += offset;
    write_len = last - offset;
  }

  if (write_len == 0)
    return SCM_INUM0;

  if (SCM_INUMP (port_or_fdes))
    fdes = SCM_INUM (port_or_fdes);
  else
    {
      SCM port = SCM_UNBNDP (port_or_fdes) ? scm_cur_outp : port_or_fdes;
      scm_port_t *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_long2num (write_len);
	}
      if (pt->write_pos > pt->write_buf)
	scm_flush (port);
      fdes = SCM_FPORT_FDES (port);
    }
  {
    long rv;

    SCM_SYSCALL (rv = write (fdes, src, write_len));
    if (rv == -1)
      {
	if (SCM_EBLOCK (errno))
	  rv = 0;
	else
	  SCM_SYSERROR;
      }
    
    return scm_long2num (rv);
  }
}
#undef FUNC_NAME

SCM 
scm_init_rw_builtins ()
{
#ifndef SCM_MAGIC_SNARFER
#include "libguile/rw.x"
#endif

  return SCM_UNSPECIFIED;
}

void
scm_init_rw ()
{
  scm_c_define_gsubr ("%init-rw-builtins", 0, 0, 0, scm_init_rw_builtins);
}

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