wingo pushed a commit to branch wip-whippet
in repository guile.
commit 9e26907885ee824575075adf53566626bedfb667
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Tue Jul 15 10:59:08 2025 +0200
Move private fports things to fports-internal.h
* libguile/fports-internal.h: New file.
* libguile/Makefile.am: Add new file.
* libguile/filesys.c:
* libguile/fports.c:
* libguile/fports.h:
* libguile/init.c:
* libguile/ioext.c:
* libguile/posix.c:
* libguile/socket.c: Adapt.
---
libguile/Makefile.am | 1 +
libguile/filesys.c | 2 +-
libguile/fports-internal.h | 78 ++++++++++++++++++++++++++++++++++++++++++++++
libguile/fports.c | 53 +++++++++++++++++++++++--------
libguile/fports.h | 28 ++---------------
libguile/init.c | 2 +-
libguile/ioext.c | 2 +-
libguile/posix.c | 2 +-
libguile/socket.c | 2 +-
9 files changed, 126 insertions(+), 44 deletions(-)
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index b7c97ec76..208fecde2 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -522,6 +522,7 @@ noinst_HEADERS = atomic.h
\
dynstack.h \
filesys-internal.h \
fluids-internal.h \
+ fports-internal.h \
frames-internal.h \
gc-inline.h \
gc-internal.h \
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 441708290..131439131 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -78,7 +78,7 @@
#include "dynwind.h"
#include "fdes-finalizers.h"
#include "feature.h"
-#include "fports.h"
+#include "fports-internal.h"
#include "gsubr.h"
#include "iselect.h"
#include "keywords.h"
diff --git a/libguile/fports-internal.h b/libguile/fports-internal.h
new file mode 100644
index 000000000..7576aca6e
--- /dev/null
+++ b/libguile/fports-internal.h
@@ -0,0 +1,78 @@
+#ifndef SCM_FPORTS_INTERNAL_H
+#define SCM_FPORTS_INTERNAL_H
+
+/* Copyright 1995-2001,2006,2008-2009,2011-2012,2017-2019,2025
+ Free Software Foundation, Inc.
+
+ This file is part of Guile.
+
+ Guile 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 3 of the License, or
+ (at your option) any later version.
+
+ Guile 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 Guile. If not, see
+ <https://www.gnu.org/licenses/>. */
+
+
+
+#include "libguile/atomics-internal.h"
+#include "libguile/fports.h"
+
+
+
+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,
+ /* If reading or writing on this fd returns -1, then we set this
+ flag to record that it's nonblocking and we can avoid leaving GC
+ around those syscalls. Similarly we can set this flag in
+ response to an explicit request that the port be nonblocking. */
+ SCM_FPORT_OPTION_NONBLOCKING = 1U<<2
+ };
+
+static inline int
+scm_fport_has_option (scm_t_fport *fp, enum scm_fport_option opt)
+{
+ return (scm_atomic_ref_bits (&fp->options) & opt) != 0;
+}
+
+static inline void
+scm_fport_set_option (scm_t_fport *fp, enum scm_fport_option opt)
+{
+ scm_atomic_set_flags (&fp->options, opt);
+}
+
+static inline int
+scm_fport_is_nonblocking (scm_t_fport *fp)
+{
+ return scm_fport_has_option (fp, SCM_FPORT_OPTION_NONBLOCKING);
+}
+
+static inline void
+scm_fport_set_nonblocking (scm_t_fport *fp)
+{
+ scm_fport_set_option (fp, SCM_FPORT_OPTION_NONBLOCKING);
+}
+
+SCM_INTERNAL int scm_i_mode_to_open_flags (SCM mode, int *is_binary,
+ const char *FUNC_NAME);
+SCM_INTERNAL void scm_init_fports_keywords (void);
+SCM_INTERNAL void scm_init_fports (void);
+
+SCM_INTERNAL int scm_i_fdes_is_valid (int fdes, long mode_bits);
+SCM_INTERNAL SCM scm_i_fdes_to_port (int fdes, long mode_bits, SCM name,
+ unsigned options);
+
+#endif /* SCM_FPORTS_INTERNAL_H */
diff --git a/libguile/fports.c b/libguile/fports.c
index b51f3b219..d95b5a62f 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -51,6 +51,7 @@
#include "filesys-internal.h"
#include "fluids.h"
#include "gc.h"
+#include "gc-internal.h"
#include "gsubr.h"
#include "hashtab.h"
#include "keywords.h"
@@ -70,7 +71,7 @@
#include "variable.h"
#include "version.h"
-#include "fports.h"
+#include "fports-internal.h"
#if SIZEOF_OFF_T == SIZEOF_INT
@@ -621,20 +622,33 @@ static size_t
fport_read (SCM port, SCM dst, size_t start, size_t count)
{
scm_t_fport *fp = SCM_FSTREAM (port);
+ scm_thread *thr = SCM_I_CURRENT_THREAD;
signed char *ptr = SCM_BYTEVECTOR_CONTENTS (dst) + start;
- ssize_t ret;
+ int blocking = !scm_fport_is_nonblocking (fp);
retry:
- ret = read (fp->fdes, ptr, count);
+ if (blocking)
+ gc_deactivate (thr->mutator);
+ ssize_t ret = read (fp->fdes, ptr, count);
+ int saved_errno = errno;
+ if (blocking)
+ gc_reactivate (thr->mutator);
+
if (ret < 0)
{
- if (errno == EINTR)
+ if (saved_errno == EINTR)
{
scm_async_tick ();
goto retry;
}
- if (errno == EWOULDBLOCK || errno == EAGAIN)
- return -1;
+ if (saved_errno == EWOULDBLOCK || saved_errno == EAGAIN)
+ {
+ if (blocking)
+ /* We just found out the FD was actually nonblocking. */
+ scm_fport_set_nonblocking (fp);
+ return -1;
+ }
+ errno = saved_errno;
scm_syserror ("fport_read");
}
return ret;
@@ -643,21 +657,34 @@ fport_read (SCM port, SCM dst, size_t start, size_t count)
static size_t
fport_write (SCM port, SCM src, size_t start, size_t count)
{
- int fd = SCM_FPORT_FDES (port);
+ scm_t_fport *fp = SCM_FSTREAM (port);
+ scm_thread *thr = SCM_I_CURRENT_THREAD;
signed char *ptr = SCM_BYTEVECTOR_CONTENTS (src) + start;
- ssize_t ret;
+ int blocking = !scm_fport_is_nonblocking (fp);
retry:
- ret = write (fd, ptr, count);
+ if (blocking)
+ gc_deactivate (thr->mutator);
+ ssize_t ret = write (fp->fdes, ptr, count);
+ int saved_errno = errno;
+ if (blocking)
+ gc_reactivate (thr->mutator);
+
if (ret < 0)
{
- if (errno == EINTR)
+ if (saved_errno == EINTR)
{
scm_async_tick ();
goto retry;
}
- if (errno == EWOULDBLOCK || errno == EAGAIN)
- return -1;
+ if (saved_errno == EWOULDBLOCK || saved_errno == EAGAIN)
+ {
+ if (blocking)
+ /* We just found out the FD was actually nonblocking. */
+ scm_fport_set_nonblocking (fp);
+ return -1;
+ }
+ errno = saved_errno;
scm_syserror ("fport_write");
}
@@ -711,7 +738,7 @@ fport_random_access_p (SCM port)
{
scm_t_fport *fp = SCM_FSTREAM (port);
- if (fp->options & SCM_FPORT_OPTION_NOT_SEEKABLE)
+ if (scm_fport_has_option (fp, SCM_FPORT_OPTION_NOT_SEEKABLE))
return 0;
if (lseek (fp->fdes, 0, SEEK_CUR) == -1)
diff --git a/libguile/fports.h b/libguile/fports.h
index 3a895775f..7c2629e05 100644
--- a/libguile/fports.h
+++ b/libguile/fports.h
@@ -1,7 +1,7 @@
#ifndef SCM_FPORTS_H
#define SCM_FPORTS_H
-/* Copyright 1995-2001,2006,2008-2009,2011-2012,2017-2019
+/* Copyright 1995-2001,2006,2008-2009,2011-2012,2017-2019,2025
Free Software Foundation, Inc.
This file is part of Guile.
@@ -34,7 +34,7 @@ typedef struct scm_t_fport {
/* Revealed count; 0 indicates not revealed, > 1 revealed. */
unsigned int revealed;
/* Set of scm_fport_option flags. */
- unsigned options;
+ scm_t_bits options;
} scm_t_fport;
SCM_API scm_t_port_type *scm_file_port_type;
@@ -55,8 +55,6 @@ SCM_API scm_t_port_type *scm_file_port_type;
SCM_API void scm_evict_ports (int fd);
-SCM_INTERNAL int scm_i_mode_to_open_flags (SCM mode, int *is_binary,
- const char *FUNC_NAME);
SCM_API SCM scm_open_file_with_encoding (SCM filename, SCM modes,
SCM guess_encoding, SCM encoding);
SCM_API SCM scm_open_file (SCM filename, SCM modes);
@@ -70,26 +68,4 @@ SCM_API SCM scm_port_revealed (SCM port);
SCM_API SCM scm_set_port_revealed_x (SCM port, SCM rcount);
SCM_API SCM scm_adjust_port_revealed_x (SCM port, SCM addend);
-
-SCM_INTERNAL void scm_init_fports_keywords (void);
-SCM_INTERNAL void scm_init_fports (void);
-
-/* internal functions */
-
-#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 int scm_i_fdes_is_valid (int fdes, long mode_bits);
-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/init.c b/libguile/init.c
index dc1769af5..f5d500afc 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -72,7 +72,7 @@
#include "fluids-internal.h"
#include "foreign-object.h"
#include "foreign.h"
-#include "fports.h"
+#include "fports-internal.h"
#include "frames-internal.h"
#include "gc.h"
#include "gc-internal.h"
diff --git a/libguile/ioext.c b/libguile/ioext.c
index e5553575e..9ba8a0693 100644
--- a/libguile/ioext.c
+++ b/libguile/ioext.c
@@ -38,7 +38,7 @@
#include "extensions.h"
#include "fdes-finalizers.h"
#include "feature.h"
-#include "fports.h"
+#include "fports-internal.h"
#include "gsubr.h"
#include "hashtab.h"
#include "numbers.h"
diff --git a/libguile/posix.c b/libguile/posix.c
index 39efe213f..f51cae6f6 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -62,7 +62,7 @@
#include "extensions.h"
#include "feature.h"
#include "finalizers.h"
-#include "fports.h"
+#include "fports-internal.h"
#include "gettext.h"
#include "gsubr.h"
#include "keywords.h"
diff --git a/libguile/socket.c b/libguile/socket.c
index 0ba1058e6..9571a334c 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -61,7 +61,7 @@
#include "bytevectors.h"
#include "dynwind.h"
#include "feature.h"
-#include "fports.h"
+#include "fports-internal.h"
#include "gsubr.h"
#include "list.h"
#include "modules.h"
