diff --git a/libguile/ChangeLog b/libguile/ChangeLog index e08e98456..d9e6b7be8 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,11 @@ Sun Jul 20 03:55:49 1997 Gary Houston + * 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 SCM_THREAD_CRITICAL_SECTION_START/END unless USE_THREADS is defined. diff --git a/libguile/filesys.c b/libguile/filesys.c index f9d4c4070..b2b13244a 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -274,7 +274,7 @@ scm_close (SCM fd_or_port) fd = SCM_INUM (fd_or_port); SCM_DEFER_INTS; 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 not an error. */ if (rv < 0 && errno != EBADF) diff --git a/libguile/ioext.c b/libguile/ioext.c index 0f094f349..ae2f5903b 100644 --- a/libguile/ioext.c +++ b/libguile/ioext.c @@ -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 diff --git a/libguile/ioext.h b/libguile/ioext.h index 194c74a23..5e8302427 100644 --- a/libguile/ioext.h +++ b/libguile/ioext.h @@ -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_duplicate_port SCM_P ((SCM oldpt, SCM modes)); 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_isatty_p SCM_P ((SCM port)); extern SCM scm_fdopen SCM_P ((SCM fdes, SCM modes));