-/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2006, 2011 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 3 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 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.
*
- * 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. */
+ * 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., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
- gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
\f
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
#include <stdio.h>
#include <errno.h>
#include "libguile/_scm.h"
-#include "libguile/ioext.h"
-#include "libguile/fports.h"
+#include "libguile/dynwind.h"
#include "libguile/feature.h"
+#include "libguile/fports.h"
+#include "libguile/hashtab.h"
+#include "libguile/ioext.h"
#include "libguile/ports.h"
#include "libguile/strings.h"
#include "libguile/validate.h"
#include <fcntl.h>
+#ifdef HAVE_IO_H
+#include <io.h>
+#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
SCM_DEFINE (scm_ftell, "ftell", 1, 0, 0,
(SCM fd_port),
"Return an integer representing the current position of\n"
- "@var{fd/port}, measured from the beginning. Equivalent to:\n"
+ "@var{fd_port}, measured from the beginning. Equivalent to:\n"
"\n"
"@lisp\n"
"(seek port 0 SEEK_CUR)\n"
"@end lisp")
#define FUNC_NAME s_scm_ftell
{
- return scm_seek (fd_port, SCM_INUM0, SCM_MAKINUM (SEEK_CUR));
+ return scm_seek (fd_port, SCM_INUM0, scm_from_int (SEEK_CUR));
}
#undef FUNC_NAME
SCM_DEFINE (scm_redirect_port, "redirect-port", 2, 0, 0,
(SCM old, SCM new),
"This procedure takes two ports and duplicates the underlying file\n"
- "descriptor from @var{old-port} into @var{new-port}. The\n"
- "current file descriptor in @var{new-port} will be closed.\n"
+ "descriptor from @var{old} into @var{new}. The\n"
+ "current file descriptor in @var{new} will be closed.\n"
"After the redirection the two ports will share a file position\n"
"and file status flags.\n\n"
"The return value is unspecified.\n\n"
old = SCM_COERCE_OUTPORT (old);
new = SCM_COERCE_OUTPORT (new);
- SCM_VALIDATE_OPFPORT (1,old);
- SCM_VALIDATE_OPFPORT (2,new);
+ SCM_VALIDATE_OPFPORT (1, old);
+ SCM_VALIDATE_OPFPORT (2, new);
oldfd = SCM_FPORT_FDES (old);
fp = SCM_FSTREAM (new);
newfd = fp->fdes;
{
scm_t_port *pt = SCM_PTAB_ENTRY (new);
scm_t_port *old_pt = SCM_PTAB_ENTRY (old);
- scm_t_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (new)];
+ scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (new);
/* must flush to old fdes. */
if (pt->rw_active == SCM_PORT_WRITE)
ptob->flush (new);
else if (pt->rw_active == SCM_PORT_READ)
- scm_end_input (new);
+ scm_end_input_unlocked (new);
ans = dup2 (oldfd, newfd);
if (ans == -1)
SCM_SYSERROR;
fd_or_port = SCM_COERCE_OUTPORT (fd_or_port);
- if (SCM_INUMP (fd_or_port))
- oldfd = SCM_INUM (fd_or_port);
+ if (scm_is_integer (fd_or_port))
+ oldfd = scm_to_int (fd_or_port);
else
{
- SCM_VALIDATE_OPFPORT (1,fd_or_port);
+ SCM_VALIDATE_OPFPORT (1, fd_or_port);
oldfd = SCM_FPORT_FDES (fd_or_port);
}
newfd = dup (oldfd);
if (newfd == -1)
SCM_SYSERROR;
- fd = SCM_MAKINUM (newfd);
+ fd = scm_from_int (newfd);
}
else
{
- SCM_VALIDATE_INUM_COPY (2, fd, newfd);
+ newfd = scm_to_int (fd);
if (oldfd != newfd)
{
scm_evict_ports (newfd); /* see scsh manual. */
int c_newfd;
int rv;
- SCM_VALIDATE_INUM_COPY (1, oldfd, c_oldfd);
- SCM_VALIDATE_INUM_COPY (2, newfd, c_newfd);
+ c_oldfd = scm_to_int (oldfd);
+ c_newfd = scm_to_int (newfd);
rv = dup2 (c_oldfd, c_newfd);
if (rv == -1)
SCM_SYSERROR;
#define FUNC_NAME s_scm_fileno
{
port = SCM_COERCE_OUTPORT (port);
- SCM_VALIDATE_OPFPORT (1,port);
- return SCM_MAKINUM (SCM_FPORT_FDES (port));
+ SCM_VALIDATE_OPFPORT (1, port);
+ return scm_from_int (SCM_FPORT_FDES (port));
}
#undef FUNC_NAME
return SCM_BOOL_F;
rv = isatty (SCM_FPORT_FDES (port));
- return SCM_BOOL(rv);
+ return scm_from_bool(rv);
}
#undef FUNC_NAME
"same as that accepted by @ref{File Ports, open-file}.")
#define FUNC_NAME s_scm_fdopen
{
- SCM_VALIDATE_INUM (1,fdes);
- SCM_VALIDATE_STRING (2, modes);
- SCM_STRING_COERCE_0TERMINATION_X (modes);
-
- return scm_fdes_to_port (SCM_INUM (fdes), SCM_STRING_CHARS (modes), SCM_BOOL_F);
+ return scm_i_fdes_to_port (scm_to_int (fdes),
+ scm_i_mode_bits (modes), SCM_BOOL_F);
}
#undef FUNC_NAME
SCM_DEFINE (scm_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0,
(SCM port, SCM fd),
"Moves the underlying file descriptor for @var{port} to the integer\n"
- "value @var{fdes} without changing the revealed count of @var{port}.\n"
+ "value @var{fd} without changing the revealed count of @var{port}.\n"
"Any other ports already using this descriptor will be automatically\n"
"shifted to new descriptors and their revealed counts reset to zero.\n"
"The return value is @code{#f} if the file descriptor already had the\n"
port = SCM_COERCE_OUTPORT (port);
- SCM_VALIDATE_OPFPORT (1,port);
- SCM_VALIDATE_INUM (2,fd);
+ SCM_VALIDATE_OPFPORT (1, port);
stream = SCM_FSTREAM (port);
old_fd = stream->fdes;
- new_fd = SCM_INUM (fd);
+ new_fd = scm_to_int (fd);
if (old_fd == new_fd)
{
return SCM_BOOL_F;
}
#undef FUNC_NAME
+static SCM
+get_matching_port (void *closure, SCM port, SCM result)
+{
+ int fd = * (int *) closure;
+ scm_t_port *entry = SCM_PTAB_ENTRY (port);
+
+ if (SCM_OPFPORTP (port)
+ && ((scm_t_fport *) entry->stream)->fdes == fd)
+ result = scm_cons (port, result);
+
+ return result;
+}
+
/* Return a list of ports using a given file descriptor. */
SCM_DEFINE (scm_fdes_to_ports, "fdes->ports", 1, 0, 0,
(SCM fd),
- "Return a list of existing ports which have @var{fdes} as an\n"
+ "Return a list of existing ports which have @var{fd} as an\n"
"underlying file descriptor, without changing their revealed\n"
"counts.")
#define FUNC_NAME s_scm_fdes_to_ports
{
SCM result = SCM_EOL;
- int int_fd;
- long i;
-
- SCM_VALIDATE_INUM_COPY (1,fd,int_fd);
+ int int_fd = scm_to_int (fd);
- for (i = 0; i < scm_t_portable_size; i++)
- {
- if (SCM_OPFPORTP (scm_t_portable[i]->port)
- && ((scm_t_fport *) scm_t_portable[i]->stream)->fdes == int_fd)
- result = scm_cons (scm_t_portable[i]->port, result);
- }
+ result = scm_c_weak_set_fold (get_matching_port,
+ (void*) &int_fd, result,
+ scm_i_port_weak_set);
return result;
}
#undef FUNC_NAME
{
scm_add_feature ("i/o-extensions");
-#ifndef SCM_MAGIC_SNARFER
#include "libguile/ioext.x"
-#endif
}