mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 09:10:22 +02:00
Code Activity

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

Browse source 
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
Download patch file Download diff file Expand all files Collapse all files

52
libguile/ioext.c
View file

@ -307,6 +307,58 @@ scm_redirect_port (old, new)
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