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

* ioext.h: removed scm_duplicate_port prototype.

Browse source 
* ioext.c (scm_primitive_dup2): return the new file descriptor
instead of SCM_UNSPECIFIED, since similarity to scm_primitive_dup
is convenient.
(scm_fdopen): bug fix: don't try to make port unbuffered until its
stream has been set.
(scm_duplicate_port): deleted, there's now an implementation in
boot-9.scm.
(scm_primitive_dup2): do nothing if newfd == oldfd.

* boot-9.scm (dup->port, dup->inport, dup->outport, dup->fdes,
dup, fdes->inport, fdes->outport, port->fdes): new procedures.
(duplicate-port): was a C primitive, now it's here.
(move->fdes): allow the first argument to be a file descriptor.
Return the modified port or file descriptor (was unspecified.)
This commit is contained in:
Gary Houston 1997-07-21 08:52:26 +00:00
parent a9488d1218
commit e38303a26d
5 changed files with 96 additions and 57 deletions
Download patch file Download diff file Expand all files Collapse all files

8
ice-9/ChangeLog
View file

@ -1,3 +1,11 @@
Mon Jul 21 06:45:45 1997 Gary Houston <ghouston@actrix.gen.nz>
* boot-9.scm (dup->port, dup->inport, dup->outport, dup->fdes,
dup, fdes->inport, fdes->outport, port->fdes): new procedures.
(duplicate-port): was a C primitive, now it's here.
(move->fdes): allow the first argument to be a file descriptor.
Return the modified port or file descriptor (was unspecified.)
Fri Jul 11 00:13:43 1997 Jim Blandy <jimb@floss.red-bean.com>
Changes to compile under gnu-win32, from Marcus Daniels:

71
ice-9/boot-9.scm
View file

@ -766,16 +766,79 @@
(define (open-input-pipe command) (open-pipe command OPEN_READ))
(define (open-output-pipe command) (open-pipe command OPEN_WRITE))
(define (move->fdes port fd)
(primitive-move->fdes port fd)
(set-port-revealed! port 1)
port)
(define (move->fdes fd/port fd)
(cond ((integer? fd/port)
(primitive-dup2 fd/port fd)
(close fd/port)
fd)
(else
(primitive-move->fdes fd/port fd)
(set-port-revealed! fd/port 1)
fd/port)))
(define (release-port-handle port)
(let ((revealed (port-revealed port)))
(if (> revealed 0)
(set-port-revealed! port (- revealed 1)))))
(define (dup->port port/fd mode . maybe-fd)
(let ((port (fdopen (if (pair? maybe-fd)
(primitive-dup2 port/fd (car maybe-fd))
(primitive-dup port/fd))
mode)))
(if (pair? maybe-fd)
(set-port-revealed! port 1))
port))
(define (dup->inport port/fd . maybe-fd)
(apply dup->port port/fd "r" maybe-fd))
(define (dup->outport port/fd . maybe-fd)
(apply dup->port port/fd "w" maybe-fd))
(define (dup->fdes port/fd . maybe-fd)
(if (pair? maybe-fd)
(primitive-dup2 port/fd (car maybe-fd))
(primitive-dup port/fd)))
(define (dup port/fd . maybe-fd)
(if (integer? port/fd)
(apply dup->fdes port/fd maybe-fd)
(apply dup->port port/fd (port-mode port/fd) maybe-fd)))
(define (duplicate-port port modes)
(dup->port port modes))
(define (fdes->inport fdes)
(let loop ((rest-ports (fdes->ports fdes)))
(cond ((null? rest-ports)
(let ((result (fdopen fdes "r")))
(set-port-revealed! result 1)
result))
((input-port? (car rest-ports))
(set-port-revealed! (car rest-ports)
(+ (port-revealed (car rest-ports)) 1))
(car rest-ports))
(else
(loop (cdr rest-ports))))))
(define (fdes->outport fdes)
(let loop ((rest-ports (fdes->ports fdes)))
(cond ((null? rest-ports)
(let ((result (fdopen fdes "w")))
(set-port-revealed! result 1)
result))
((output-port? (car rest-ports))
(set-port-revealed! (car rest-ports)
(+ (port-revealed (car rest-ports)) 1))
(car rest-ports))
(else
(loop (cdr rest-ports))))))
(define (port->fdes port)
(set-port-revealed! port (+ (port-revealed port) 1))
(fileno port))
;;; {Load Paths}
;;;

13
libguile/ChangeLog
View file

@ -1,3 +1,16 @@
Mon Jul 21 04:03:42 1997 Gary Houston <ghouston@actrix.gen.nz>
* ioext.h: removed scm_duplicate_port prototype.
* ioext.c (scm_primitive_dup2): return the new file descriptor
instead of SCM_UNSPECIFIED, since similarity to scm_primitive_dup
is convenient.
(scm_fdopen): bug fix: don't try to make port unbuffered until its
stream has been set.
(scm_duplicate_port): deleted, there's now an implementation in
boot-9.scm.
(scm_primitive_dup2): do nothing if newfd == oldfd.
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

60
libguile/ioext.c
View file

@ -233,55 +233,6 @@ scm_freopen (filename, modes, port)
return port;
}
SCM_PROC (s_duplicate_port, "duplicate-port", 2, 0, 0, scm_duplicate_port);
SCM
scm_duplicate_port (oldpt, modes)
SCM oldpt;
SCM modes;
{
int oldfd;
int newfd;
FILE *f;
SCM newpt;
SCM_ASSERT (SCM_NIMP (oldpt) && SCM_OPPORTP (oldpt), oldpt, SCM_ARG1,
s_duplicate_port);
SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2,
s_duplicate_port);
SCM_COERCE_SUBSTR (modes);
SCM_NEWCELL (newpt);
SCM_DEFER_INTS;
oldfd = fileno ((FILE *)SCM_STREAM (oldpt));
if (oldfd == -1)
scm_syserror (s_duplicate_port);
SCM_SYSCALL (newfd = dup (oldfd));
if (newfd == -1)
scm_syserror (s_duplicate_port);
f = fdopen (newfd, SCM_ROCHARS (modes));
if (!f)
{
SCM_SYSCALL (close (newfd));
scm_syserror (s_duplicate_port);
}
{
struct scm_port_table * pt;
pt = scm_add_to_port_table (newpt);
SCM_SETPTAB_ENTRY (newpt, pt);
SCM_SETCAR (newpt, scm_tc16_fport | scm_mode_bits (SCM_ROCHARS (modes)));
SCM_SETSTREAM (newpt, (SCM)f);
if (SCM_BUF0 & SCM_CAR (newpt))
scm_setbuf0 (newpt);
SCM_PTAB_ENTRY (newpt)->file_name = SCM_PTAB_ENTRY (oldpt)->file_name;
}
SCM_ALLOW_INTS;
return newpt;
}
SCM_PROC (s_redirect_port, "redirect-port", 2, 0, 0, scm_redirect_port);
SCM
@ -349,14 +300,19 @@ scm_primitive_dup2 (SCM fd_or_port, SCM fd)
scm_syserror (s_primitive_dup2);
}
SCM_ASSERT (SCM_INUMP (newfd), newfd, SCM_ARG2, s_primitive_dup2);
SCM_ASSERT (SCM_INUMP (fd), fd, SCM_ARG2, s_primitive_dup2);
newfd = SCM_INUM (fd);
if (oldfd == newfd)
{
SCM_ALLOW_INTS;
return 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;
return fd;
}
SCM_PROC (s_fileno, "fileno", 1, 0, 0, scm_fileno);
@ -413,9 +369,9 @@ scm_fdopen (fdes, modes)
pt = scm_add_to_port_table (port);
SCM_SETPTAB_ENTRY (port, pt);
SCM_SETCAR (port, scm_tc16_fport | scm_mode_bits (SCM_ROCHARS (modes)));
SCM_SETSTREAM (port, (SCM)f);
if (SCM_BUF0 & SCM_CAR (port))
scm_setbuf0 (port);
SCM_SETSTREAM (port, (SCM)f);
SCM_ALLOW_INTS;
return port;
}

1
libguile/ioext.h
View file

@ -53,7 +53,6 @@ extern SCM scm_write_line SCM_P ((SCM obj, SCM port));
extern SCM scm_ftell SCM_P ((SCM port));
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);