* 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.

* 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.)

ice-9/ChangeLog

@@ -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:

ice-9/boot-9.scm

@@ -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)
+(define (move->fdes fd/port fd)
-  (primitive-move->fdes port fd)
+  (cond ((integer? fd/port)
-  (set-port-revealed! port 1)
+	 (primitive-dup2 fd/port fd)
-  port)
+	 (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}
 ;;;

libguile/ChangeLog

@@ -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

libguile/ioext.c

@@ -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;
 }

libguile/ioext.h

@@ -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);