1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 17:20:29 +02:00

* filesys.c (scm_close): oops, don't call SCM_INUM twice on the

argument.

* ioext.h: new prototypes.
* ioext.c (scm_primitive_dup, scm_primitive_dup2): new procedures.
This commit is contained in:
Gary Houston 1997-07-20 10:03:26 +00:00
parent eadd48de2b
commit a9488d1218
4 changed files with 61 additions and 1 deletions

View file

@ -1,5 +1,11 @@
Sun Jul 20 03:55:49 1997 Gary Houston <ghouston@actrix.gen.nz> Sun Jul 20 03:55:49 1997 Gary Houston <ghouston@actrix.gen.nz>
* filesys.c (scm_close): oops, don't call SCM_INUM twice on the
argument.
* ioext.h: new prototypes.
* ioext.c (scm_primitive_dup, scm_primitive_dup2): new procedures.
* fluids.c (next_fluid_num): don't do * fluids.c (next_fluid_num): don't do
SCM_THREAD_CRITICAL_SECTION_START/END unless USE_THREADS is defined. SCM_THREAD_CRITICAL_SECTION_START/END unless USE_THREADS is defined.

View file

@ -274,7 +274,7 @@ scm_close (SCM fd_or_port)
fd = SCM_INUM (fd_or_port); fd = SCM_INUM (fd_or_port);
SCM_DEFER_INTS; SCM_DEFER_INTS;
scm_evict_ports (fd); /* see scsh manual. */ scm_evict_ports (fd); /* see scsh manual. */
SCM_SYSCALL (rv = close (SCM_INUM (fd))); SCM_SYSCALL (rv = close (fd));
/* following scsh, closing an already closed file descriptor is /* following scsh, closing an already closed file descriptor is
not an error. */ not an error. */
if (rv < 0 && errno != EBADF) if (rv < 0 && errno != EBADF)

View file

@ -307,6 +307,58 @@ scm_redirect_port (old, new)
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
SCM_PROC (s_primitive_dup, "primitive-dup", 1, 0, 0, scm_primitive_dup);
SCM
scm_primitive_dup (SCM fd_or_port)
{
int fd, newfd;
SCM_DEFER_INTS;
if (SCM_INUMP (fd_or_port))
fd = SCM_INUM (fd_or_port);
else
{
SCM_ASSERT (SCM_NIMP (fd_or_port) && SCM_OPPORTP (fd_or_port),
fd_or_port, SCM_ARG1, s_primitive_dup);
fd = fileno ((FILE *)SCM_STREAM (fd_or_port));
if (fd == -1)
scm_syserror (s_primitive_dup);
}
SCM_SYSCALL (newfd = dup (fd));
if (newfd == -1)
scm_syserror (s_primitive_dup);
SCM_ALLOW_INTS;
return SCM_MAKINUM (newfd);
}
SCM_PROC (s_primitive_dup2, "primitive-dup2", 2, 0, 0, scm_primitive_dup2);
SCM
scm_primitive_dup2 (SCM fd_or_port, SCM fd)
{
int oldfd, newfd, rv;
SCM_DEFER_INTS;
if (SCM_INUMP (fd_or_port))
oldfd = SCM_INUM (fd_or_port);
else
{
SCM_ASSERT (SCM_NIMP (fd_or_port) && SCM_OPPORTP (fd_or_port),
fd_or_port, SCM_ARG1, s_primitive_dup2);
oldfd = fileno ((FILE *)SCM_STREAM (fd_or_port));
if (oldfd == -1)
scm_syserror (s_primitive_dup2);
}
SCM_ASSERT (SCM_INUMP (newfd), newfd, SCM_ARG2, s_primitive_dup2);
newfd = SCM_INUM (fd);
scm_evict_ports (newfd); /* see scsh manual. */
SCM_SYSCALL (rv = dup2 (oldfd, newfd));
if (rv == -1)
scm_syserror (s_primitive_dup2);
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
SCM_PROC (s_fileno, "fileno", 1, 0, 0, scm_fileno); SCM_PROC (s_fileno, "fileno", 1, 0, 0, scm_fileno);
SCM SCM

View file

@ -55,6 +55,8 @@ extern SCM scm_fseek SCM_P ((SCM port, SCM offset, SCM whence));
extern SCM scm_freopen SCM_P ((SCM filename, SCM modes, SCM port)); extern SCM scm_freopen SCM_P ((SCM filename, SCM modes, SCM port));
extern SCM scm_duplicate_port SCM_P ((SCM oldpt, SCM modes)); extern SCM scm_duplicate_port SCM_P ((SCM oldpt, SCM modes));
extern SCM scm_redirect_port SCM_P ((SCM into_pt, SCM from_pt)); extern SCM scm_redirect_port SCM_P ((SCM into_pt, SCM from_pt));
extern SCM scm_primitive_dup (SCM fd_or_port);
extern SCM scm_primitive_dup2 (SCM fd_or_port, SCM newfd);
extern SCM scm_fileno SCM_P ((SCM port)); extern SCM scm_fileno SCM_P ((SCM port));
extern SCM scm_isatty_p SCM_P ((SCM port)); extern SCM scm_isatty_p SCM_P ((SCM port));
extern SCM scm_fdopen SCM_P ((SCM fdes, SCM modes)); extern SCM scm_fdopen SCM_P ((SCM fdes, SCM modes));