+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:
(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))
+
\f
;;; {Load Paths}
;;;
+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
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
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);
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;
}
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);
HCoop / bpt / guile.git / commitdiff