Merge remote-tracking branch 'origin/stable-2.0'
[bpt/guile.git] / libguile / ioext.c
index 66e32cb..94b0f4f 100644 (file)
@@ -1,24 +1,25 @@
-/*     Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003 Free Software Foundation, Inc.
+/*     Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2006, 2011 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
 
 \f
 
-#if HAVE_CONFIG_H
+#ifdef HAVE_CONFIG_H
 #  include <config.h>
 #endif
 
 #include <errno.h>
 
 #include "libguile/_scm.h"
-#include "libguile/ioext.h"
-#include "libguile/fports.h"
+#include "libguile/dynwind.h"
 #include "libguile/feature.h"
+#include "libguile/fports.h"
+#include "libguile/hashtab.h"
+#include "libguile/ioext.h"
 #include "libguile/ports.h"
 #include "libguile/strings.h"
 #include "libguile/validate.h"
 SCM_DEFINE (scm_ftell, "ftell", 1, 0, 0, 
             (SCM fd_port),
            "Return an integer representing the current position of\n"
-           "@var{fd/port}, measured from the beginning.  Equivalent to:\n"
+           "@var{fd_port}, measured from the beginning.  Equivalent to:\n"
            "\n"
            "@lisp\n"
            "(seek port 0 SEEK_CUR)\n"
            "@end lisp")
 #define FUNC_NAME s_scm_ftell
 {
-  return scm_seek (fd_port, SCM_INUM0, SCM_MAKINUM (SEEK_CUR));
+  return scm_seek (fd_port, SCM_INUM0, scm_from_int (SEEK_CUR));
 }
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_redirect_port, "redirect-port", 2, 0, 0,
             (SCM old, SCM new),
            "This procedure takes two ports and duplicates the underlying file\n"
-           "descriptor from @var{old-port} into @var{new-port}.  The\n"
-           "current file descriptor in @var{new-port} will be closed.\n"
+           "descriptor from @var{old} into @var{new}.  The\n"
+           "current file descriptor in @var{new} will be closed.\n"
            "After the redirection the two ports will share a file position\n"
            "and file status flags.\n\n"
            "The return value is unspecified.\n\n"
@@ -86,13 +89,13 @@ SCM_DEFINE (scm_redirect_port, "redirect-port", 2, 0, 0,
     {
       scm_t_port *pt = SCM_PTAB_ENTRY (new);
       scm_t_port *old_pt = SCM_PTAB_ENTRY (old);
-      scm_t_ptob_descriptor *ptob = &scm_ptobs[SCM_PTOBNUM (new)];
+      scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (new);
 
       /* must flush to old fdes.  */
       if (pt->rw_active == SCM_PORT_WRITE)
        ptob->flush (new);
       else if (pt->rw_active == SCM_PORT_READ)
-       scm_end_input (new);
+       scm_end_input_unlocked (new);
       ans = dup2 (oldfd, newfd);
       if (ans == -1)
        SCM_SYSERROR;
@@ -114,8 +117,8 @@ SCM_DEFINE (scm_dup_to_fdes, "dup->fdes", 1, 1, 0,
 
   fd_or_port = SCM_COERCE_OUTPORT (fd_or_port);
 
-  if (SCM_INUMP (fd_or_port))
-    oldfd = SCM_INUM (fd_or_port);
+  if (scm_is_integer (fd_or_port))
+    oldfd = scm_to_int (fd_or_port);
   else
     {
       SCM_VALIDATE_OPFPORT (1, fd_or_port);
@@ -127,11 +130,11 @@ SCM_DEFINE (scm_dup_to_fdes, "dup->fdes", 1, 1, 0,
       newfd = dup (oldfd);
       if (newfd == -1)
        SCM_SYSERROR;
-      fd = SCM_MAKINUM (newfd);
+      fd = scm_from_int (newfd);
     }
   else
     {
-      SCM_VALIDATE_INUM_COPY (2, fd, newfd);
+      newfd = scm_to_int (fd);
       if (oldfd != newfd)
        {
          scm_evict_ports (newfd);      /* see scsh manual.  */
@@ -161,8 +164,8 @@ SCM_DEFINE (scm_dup2, "dup2", 2, 0, 0,
   int c_newfd;
   int rv;
 
-  SCM_VALIDATE_INUM_COPY (1, oldfd, c_oldfd);
-  SCM_VALIDATE_INUM_COPY (2, newfd, c_newfd);
+  c_oldfd = scm_to_int (oldfd);
+  c_newfd = scm_to_int (newfd);
   rv = dup2 (c_oldfd, c_newfd);
   if (rv == -1)
     SCM_SYSERROR;
@@ -178,7 +181,7 @@ SCM_DEFINE (scm_fileno, "fileno", 1, 0, 0,
 {
   port = SCM_COERCE_OUTPORT (port);
   SCM_VALIDATE_OPFPORT (1, port);
-  return SCM_MAKINUM (SCM_FPORT_FDES (port));
+  return scm_from_int (SCM_FPORT_FDES (port));
 }
 #undef FUNC_NAME
 
@@ -204,7 +207,7 @@ SCM_DEFINE (scm_isatty_p, "isatty?", 1, 0, 0,
     return SCM_BOOL_F;
   
   rv = isatty (SCM_FPORT_FDES (port));
-  return  SCM_BOOL(rv);
+  return  scm_from_bool(rv);
 }
 #undef FUNC_NAME
 
@@ -218,10 +221,8 @@ SCM_DEFINE (scm_fdopen, "fdopen", 2, 0, 0,
            "same as that accepted by @ref{File Ports, open-file}.")
 #define FUNC_NAME s_scm_fdopen
 {
-  SCM_VALIDATE_INUM (1, fdes);
-  SCM_VALIDATE_STRING (2, modes);
-
-  return scm_fdes_to_port (SCM_INUM (fdes), SCM_STRING_CHARS (modes), SCM_BOOL_F);
+  return scm_i_fdes_to_port (scm_to_int (fdes),
+                            scm_i_mode_bits (modes), SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
@@ -235,7 +236,7 @@ SCM_DEFINE (scm_fdopen, "fdopen", 2, 0, 0,
 SCM_DEFINE (scm_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0,
             (SCM port, SCM fd),
            "Moves the underlying file descriptor for @var{port} to the integer\n"
-           "value @var{fdes} without changing the revealed count of @var{port}.\n"
+           "value @var{fd} without changing the revealed count of @var{port}.\n"
            "Any other ports already using this descriptor will be automatically\n"
            "shifted to new descriptors and their revealed counts reset to zero.\n"
            "The return value is @code{#f} if the file descriptor already had the\n"
@@ -250,10 +251,9 @@ SCM_DEFINE (scm_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0,
   port = SCM_COERCE_OUTPORT (port);
 
   SCM_VALIDATE_OPFPORT (1, port);
-  SCM_VALIDATE_INUM (2, fd);
   stream = SCM_FSTREAM (port);
   old_fd = stream->fdes;
-  new_fd = SCM_INUM (fd);
+  new_fd = scm_to_int (fd);
   if  (old_fd == new_fd)
     {
       return SCM_BOOL_F;
@@ -268,28 +268,33 @@ SCM_DEFINE (scm_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+static SCM
+get_matching_port (void *closure, SCM port, SCM result)
+{
+  int fd = * (int *) closure;
+  scm_t_port *entry = SCM_PTAB_ENTRY (port);
+  
+  if (SCM_OPFPORTP (port)
+      && ((scm_t_fport *) entry->stream)->fdes == fd)
+    result = scm_cons (port, result);
+
+  return result;
+}
+
 /* Return a list of ports using a given file descriptor.  */
 SCM_DEFINE (scm_fdes_to_ports, "fdes->ports", 1, 0, 0, 
            (SCM fd),
-           "Return a list of existing ports which have @var{fdes} as an\n"
+           "Return a list of existing ports which have @var{fd} as an\n"
            "underlying file descriptor, without changing their revealed\n"
            "counts.")
 #define FUNC_NAME s_scm_fdes_to_ports
 {
   SCM result = SCM_EOL;
-  int int_fd;
-  long i;
-  
-  SCM_VALIDATE_INUM_COPY (1, fd, int_fd);
+  int int_fd = scm_to_int (fd);
 
-  scm_mutex_lock (&scm_i_port_table_mutex);
-  for (i = 0; i < scm_i_port_table_size; i++)
-    {
-      if (SCM_OPFPORTP (scm_i_port_table[i]->port)
-         && ((scm_t_fport *) scm_i_port_table[i]->stream)->fdes == int_fd)
-       result = scm_cons (scm_i_port_table[i]->port, result);
-    }
-  scm_mutex_unlock (&scm_i_port_table_mutex);
+  result = scm_c_weak_set_fold (get_matching_port,
+                                (void*) &int_fd, result, 
+                                scm_i_port_weak_set);
   return result;
 }
 #undef FUNC_NAME