[Guile-commits] 01/01: Elide syscalls in fdes->port

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 69ca2bb2217303b2556b131f3995ca4f6af81234
Author: Andy Wingo <address@hidden>
Date:   Tue Feb 14 21:57:35 2017 +0100

    Elide syscalls in fdes->port
    
    * libguile/fports.h (scm_t_fport): Add options field.
      (SCM_FDES_RANDOM_P): Deprecate.
      (scm_i_fdes_to_port): Add options argument.
    * libguile/fports.c (scm_i_fdes_to_port): Add options argument.  Only
      verify FD if SCM_FPORT_OPTION_VERIFY is there.
      (scm_fdes_to_port, scm_open_file_with_encoding): Adapt to
      scm_i_fdes_to_port changes.
      (fport_random_access_p): Don't try to seek if NOT_SEEKABLE option is
      set.
    * libguile/deprecated.h:
    * libguile/deprecated.c (SCM_FDES_RANDOM_P): Deprecate.
    * NEWS: Add deprecation.
    * libguile/filesys.c:
    * libguile/ioext.c:
    * libguile/posix.c:
    * libguile/read.c:
    * libguile/socket.c: Adapt callers.
---
 NEWS                  | 11 ++++++++++
 libguile/deprecated.c | 14 +++++++++++++
 libguile/deprecated.h |  4 ++++
 libguile/filesys.c    |  2 +-
 libguile/fports.c     | 56 +++++++++++++++++++++++++++++++++------------------
 libguile/fports.h     | 29 +++++++++++++++++---------
 libguile/ioext.c      |  3 ++-
 libguile/posix.c      | 14 +++++++++----
 libguile/read.c       | 16 ++++++---------
 libguile/socket.c     | 14 +++++++++----
 10 files changed, 114 insertions(+), 49 deletions(-)

diff --git a/NEWS b/NEWS
index 5680a20..46b09b9 100644
--- a/NEWS
+++ b/NEWS
@@ -6,6 +6,17 @@ Please send Guile bug reports to address@hidden
 
 
 
+Changes in 2.1.7 (changes since the 2.1.6 alpha release):
+
+* New deprecations
+
+** `SCM_FDES_RANDOM_P'
+
+Instead, use `lseek (fd, 0, SEEK_CUR)' directly.
+
+* FIXME fold in 2.1.6 changes to main NEWS
+
+
 Changes in 2.1.6 (changes since the 2.1.5 alpha release):
 
 * New interfaces
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index c3d4935..cee6b1d 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -26,6 +26,9 @@
 
 #define SCM_BUILDING_DEPRECATED_CODE
 
+#include <sys/types.h>
+#include <unistd.h>
+
 #include "libguile/_scm.h"
 #include "libguile/deprecation.h"
 
@@ -940,6 +943,17 @@ scm_make_dynamic_state (SCM parent)
 
 
 
+int
+SCM_FDES_RANDOM_P (int fdes)
+{
+  scm_c_issue_deprecation_warning
+    ("SCM_FDES_RANDOM_P is deprecated.  Use lseek (fd, 0, SEEK_CUR).");
+
+  return (lseek (fdes, 0, SEEK_CUR) == -1) ? 0 : 1;
+}
+
+
+
 void
 scm_i_init_deprecated ()
 {
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index b1e455a..2c49076 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -270,6 +270,10 @@ SCM_DEPRECATED SCM scm_from_contiguous_array (SCM bounds, 
const SCM *elts,
 
 
 
+SCM_DEPRECATED int SCM_FDES_RANDOM_P (int fdes);
+
+
+
 void scm_i_init_deprecated (void);
 
 #endif
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 9f665c1..40d5a41 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1509,7 +1509,7 @@ SCM_DEFINE (scm_i_mkstemp, "mkstemp!", 1, 1, 0,
 
   scm_dynwind_end ();
 
-  port = scm_i_fdes_to_port (rv, mode_bits, tmpl);
+  port = scm_i_fdes_to_port (rv, mode_bits, tmpl, 0);
   if (is_binary)
     /* Use the binary-friendly ISO-8859-1 encoding. */
     scm_i_set_port_encoding_x (port, NULL);
diff --git a/libguile/fports.c b/libguile/fports.c
index 8fa6993..f79b4a3 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -264,7 +264,8 @@ scm_open_file_with_encoding (SCM filename, SCM mode,
   /* Create a port from this file descriptor.  The port's encoding is initially
      %default-port-encoding.  */
   port = scm_i_fdes_to_port (fdes, scm_i_mode_bits (mode),
-                             fport_canonicalize_filename (filename));
+                             fport_canonicalize_filename (filename),
+                             0);
 
   if (binary)
     {
@@ -391,35 +392,41 @@ SCM_DEFINE (scm_i_open_file, "open-file", 2, 0, 1,
    NAME is a string to be used as the port's filename.
 */
 SCM
-scm_i_fdes_to_port (int fdes, long mode_bits, SCM name)
+scm_i_fdes_to_port (int fdes, long mode_bits, SCM name, unsigned options)
 #define FUNC_NAME "scm_fdes_to_port"
 {
   SCM port;
   scm_t_fport *fp;
 
-  /* Test that fdes is valid.  */
-#ifdef F_GETFL
-  int flags = fcntl (fdes, F_GETFL, 0);
-  if (flags == -1)
-    SCM_SYSERROR;
-  flags &= O_ACCMODE;
-  if (flags != O_RDWR
-      && ((flags != O_WRONLY && (mode_bits & SCM_WRTNG))
-         || (flags != O_RDONLY && (mode_bits & SCM_RDNG))))
+  if (options & SCM_FPORT_OPTION_VERIFY)
     {
-      SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL);
-    }
+      /* Check that the foreign FD is valid and matches the mode
+         bits.  */
+#ifdef F_GETFL
+      int flags = fcntl (fdes, F_GETFL, 0);
+      if (flags == -1)
+        SCM_SYSERROR;
+      flags &= O_ACCMODE;
+      if (flags != O_RDWR
+          && ((flags != O_WRONLY && (mode_bits & SCM_WRTNG))
+              || (flags != O_RDONLY && (mode_bits & SCM_RDNG))))
+        {
+          SCM_MISC_ERROR ("requested file mode not available on fdes",
+                          SCM_EOL);
+        }
 #else
-  /* If we don't have F_GETFL, as on mingw, at least we can test that
-     it is a valid file descriptor.  */
-  struct stat st;
-  if (fstat (fdes, &st) != 0)
-    SCM_SYSERROR;
+      /* If we don't have F_GETFL, as on mingw, at least we can test that
+         it is a valid file descriptor.  */
+      struct stat st;
+      if (fstat (fdes, &st) != 0)
+        SCM_SYSERROR;
 #endif
+    }
 
   fp = (scm_t_fport *) scm_gc_malloc_pointerless (sizeof (scm_t_fport),
                                                   "file port");
   fp->fdes = fdes;
+  fp->options = options;
 
   port = scm_c_make_port (scm_file_port_type, mode_bits, (scm_t_bits)fp);
   
@@ -432,7 +439,8 @@ scm_i_fdes_to_port (int fdes, long mode_bits, SCM name)
 SCM
 scm_fdes_to_port (int fdes, char *mode, SCM name)
 {
-  return scm_i_fdes_to_port (fdes, scm_mode_bits (mode), name);
+  return scm_i_fdes_to_port (fdes, scm_mode_bits (mode), name,
+                             SCM_FPORT_OPTION_VERIFY);
 }
 
 /* Return a lower bound on the number of bytes available for input.  */
@@ -669,7 +677,15 @@ fport_close (SCM port)
 static int
 fport_random_access_p (SCM port)
 {
-  return SCM_FDES_RANDOM_P (SCM_FSTREAM (port)->fdes);
+  scm_t_fport *fp = SCM_FSTREAM (port);
+
+  if (fp->options & SCM_FPORT_OPTION_NOT_SEEKABLE)
+    return 0;
+
+  if (lseek (fp->fdes, 0, SEEK_CUR) == -1)
+    return 0;
+
+  return 1;
 }
 
 static int
diff --git a/libguile/fports.h b/libguile/fports.h
index ee9bf7c..afb8ba7 100644
--- a/libguile/fports.h
+++ b/libguile/fports.h
@@ -31,10 +31,13 @@
 
 /* struct allocated for each buffered FPORT.  */
 typedef struct scm_t_fport {
-  int fdes;                    /* file descriptor.  */
-  int revealed;                        /* 0 not revealed, > 1 revealed.
-                                * Revealed ports do not get GC'd.
-                                */
+  /* The file descriptor.  */
+  int fdes;
+  /* Revealed count; 0 indicates not revealed, > 1 revealed. Revealed
+     ports do not get garbage-collected.  */
+  int revealed;
+  /* Set of scm_fport_option flags.  */
+  unsigned options;
 } scm_t_fport;
 
 SCM_API scm_t_port_type *scm_file_port_type;
@@ -48,9 +51,6 @@ SCM_API scm_t_port_type *scm_file_port_type;
 #define SCM_OPINFPORTP(x) (SCM_OPFPORTP (x) && (SCM_CELL_WORD_0 (x) & 
SCM_RDNG))
 #define SCM_OPOUTFPORTP(x) (SCM_OPFPORTP (x) && (SCM_CELL_WORD_0 (x) & 
SCM_WRTNG))
 
-/* test whether fdes supports random access.  */
-#define SCM_FDES_RANDOM_P(fdes) ((lseek (fdes, 0, SEEK_CUR) == -1) ? 0 : 1)
-
 
 SCM_API void scm_evict_ports (int fd);
 SCM_INTERNAL int scm_i_mode_to_open_flags (SCM mode, int *is_binary,
@@ -74,8 +74,19 @@ SCM_INTERNAL void scm_init_fports (void);
 
 /* internal functions */
 
-SCM_INTERNAL SCM scm_i_fdes_to_port (int fdes, long mode_bits, SCM name);
-
+#ifdef BUILDING_LIBGUILE
+enum scm_fport_option
+  {
+    /* FD's that aren't created by Guile probably need to be checked for
+       validity.  We also check that the open mode is valid.  */
+    SCM_FPORT_OPTION_VERIFY = 1U<<0,
+    /* We know some ports aren't seekable and can elide a syscall in
+       that case.  */
+    SCM_FPORT_OPTION_NOT_SEEKABLE = 1U<<1
+  };
+SCM_INTERNAL SCM scm_i_fdes_to_port (int fdes, long mode_bits, SCM name,
+                                     unsigned options);
+#endif /* BUILDING_LIBGUILE */
 
 #endif  /* SCM_FPORTS_H */
 
diff --git a/libguile/ioext.c b/libguile/ioext.c
index 43c915a..4038fd5 100644
--- a/libguile/ioext.c
+++ b/libguile/ioext.c
@@ -226,7 +226,8 @@ SCM_DEFINE (scm_fdopen, "fdopen", 2, 0, 0,
 #define FUNC_NAME s_scm_fdopen
 {
   return scm_i_fdes_to_port (scm_to_int (fdes),
-                            scm_i_mode_bits (modes), SCM_BOOL_F);
+                            scm_i_mode_bits (modes), SCM_BOOL_F,
+                             SCM_FPORT_OPTION_VERIFY);
 }
 #undef FUNC_NAME
 
diff --git a/libguile/posix.c b/libguile/posix.c
index 495bfbb..686b801 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -242,8 +242,10 @@ SCM_DEFINE (scm_pipe, "pipe", 0, 0, 0,
   if (rv)
     SCM_SYSERROR;
   
-  p_rd = scm_fdes_to_port (fd[0], "r", sym_read_pipe);
-  p_wt = scm_fdes_to_port (fd[1], "w", sym_write_pipe);
+  p_rd = scm_i_fdes_to_port (fd[0], scm_mode_bits ("r"), sym_read_pipe,
+                             SCM_FPORT_OPTION_NOT_SEEKABLE);
+  p_wt = scm_i_fdes_to_port (fd[1], scm_mode_bits ("w"), sym_write_pipe,
+                             SCM_FPORT_OPTION_NOT_SEEKABLE);
   return scm_cons (p_rd, p_wt);
 }
 #undef FUNC_NAME
@@ -1418,12 +1420,16 @@ scm_open_process (SCM mode, SCM prog, SCM args)
   if (reading)
     {
       close (c2p[1]);
-      read_port = scm_fdes_to_port (c2p[0], "r0", sym_read_pipe);
+      read_port = scm_i_fdes_to_port (c2p[0], scm_mode_bits ("r0"),
+                                      sym_read_pipe,
+                                      SCM_FPORT_OPTION_NOT_SEEKABLE);
     }
   if (writing)
     {
       close (p2c[0]);
-      write_port = scm_fdes_to_port (p2c[1], "w0", sym_write_pipe);
+      write_port = scm_i_fdes_to_port (p2c[1], scm_mode_bits ("w0"),
+                                       sym_write_pipe,
+                                       SCM_FPORT_OPTION_NOT_SEEKABLE);
     }
 
   return scm_values (scm_list_3 (read_port,
diff --git a/libguile/read.c b/libguile/read.c
index 5c436e2..085cdb9 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -2105,21 +2105,17 @@ scm_i_scan_for_encoding (SCM port)
       memcpy (header, scm_port_buffer_take_pointer (buf, cur), bytes_read);
       header[bytes_read] = '\0';
     }
-  else
+  else if (pt->rw_random)
     {
-      /* Try to read some bytes and then seek back.  Not all ports
-         support seeking back; and indeed some file ports (like
-         /dev/urandom) will succeed on an lseek (fd, 0, SEEK_CUR)---the
-         check performed by SCM_FPORT_FDES---but fail to seek
-         backwards.  Hence this block comes second.  We prefer to use
-         the read buffer in-place.  */
-      if (SCM_FPORTP (port) && !SCM_FDES_RANDOM_P (SCM_FPORT_FDES (port)))
-        return NULL;
-
+      /* The port is seekable.  This is OK but grubbing in the read
+         buffer is better, so this case is just a fallback.  */
       bytes_read = scm_c_read (port, header, SCM_ENCODING_SEARCH_SIZE);
       header[bytes_read] = '\0';
       scm_seek (port, scm_from_int (0), scm_from_int (SEEK_SET));
     }
+  else
+    /* No input available and not seekable; scan fails.  */
+    return NULL;
 
   /* search past "coding[:=]" */
   pos = header;
diff --git a/libguile/socket.c b/libguile/socket.c
index 37e9f52..4f2acff 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -367,7 +367,12 @@ SCM_DEFINE (scm_inet_pton, "inet-pton", 2, 0, 0,
 
 SCM_SYMBOL (sym_socket, "socket");
 
-#define SCM_SOCK_FD_TO_PORT(fd) scm_fdes_to_port (fd, "r+0", sym_socket)
+static SCM
+scm_socket_fd_to_port (int fd)
+{
+  return scm_i_fdes_to_port (fd, scm_mode_bits ("r+0"), sym_socket,
+                             SCM_FPORT_OPTION_NOT_SEEKABLE);
+}
 
 SCM_DEFINE (scm_socket, "socket", 3, 0, 0,
             (SCM family, SCM style, SCM proto),
@@ -391,7 +396,7 @@ SCM_DEFINE (scm_socket, "socket", 3, 0, 0,
               scm_to_int (proto));
   if (fd == -1)
     SCM_SYSERROR;
-  return SCM_SOCK_FD_TO_PORT (fd);
+  return scm_socket_fd_to_port (fd);
 }
 #undef FUNC_NAME
 
@@ -413,7 +418,8 @@ SCM_DEFINE (scm_socketpair, "socketpair", 3, 0, 0,
   if (socketpair (fam, scm_to_int (style), scm_to_int (proto), fd) == -1)
     SCM_SYSERROR;
 
-  return scm_cons (SCM_SOCK_FD_TO_PORT (fd[0]), SCM_SOCK_FD_TO_PORT (fd[1]));
+  return scm_cons (scm_socket_fd_to_port (fd[0]),
+                   scm_socket_fd_to_port (fd[1]));
 }
 #undef FUNC_NAME
 #endif
@@ -1269,7 +1275,7 @@ SCM_DEFINE (scm_accept, "accept", 1, 0, 0,
         return SCM_BOOL_F;
       SCM_SYSERROR;
     }
-  newsock = SCM_SOCK_FD_TO_PORT (newfd);
+  newsock = scm_socket_fd_to_port (newfd);
   address = _scm_from_sockaddr (&addr, addr_size,
                                FUNC_NAME);