1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-01 23:30:28 +02:00
guile/libguile/poll.c
Andy Wingo c79d5bd0f7 Change to be less sloppy as regards functions without prototypes
* libguile/gsubr.h (scm_t_subr_0, scm_t_subr_1, etc): New precise
typedefs.
(SCM_AS_SUBR): Use C11's _Generic to cast subrs to the generic subr
type, while also producing a warning/error if the function isn't
compatible.
(SCM_DEFINE_GSUBR, SCM_PRIMITIVE_GENERIC, SCM_DEFINE_PUBLIC)
(SCM_DEFINE_STATIC, SCM_PROC, SCM_REGISTER_PROC, SCM_GPROC): Use
SCM_AS_SUBR.
* libguile/gsubr-internal.h (scm_t_subr_with_thread_0)
(scm_t_subr_with_thread_1, etc): New precise typedefs.
(SCM_AS_SUBR_WITH_THREAD): Like SCM_AS_SUBR.
* libguile/gsubr.c (scm_apply_subr): Cast callee to the right type
before calling.
* libguile/hash.c (floor): Remove weird unused declaration.
* libguile/init.c (scm_boot_guile): Fix type of main_func in definition.
* libguile/jit.c: Fix type of enter_mcode.
* libguile/smob.c (apply_0, apply_1, apply_2, apply_3): Cast callee to
right type.
(scm_smob_trampoline): Use SCM_AS_SUBR.
* libguile/smob.h (SCM_SMOB_APPLY): Use SCM_AS_SUBR.
* libguile/backtrace.c:
* libguile/control.c:
* libguile/dynl.c:
* libguile/eval.c:
* libguile/exceptions.c:
* libguile/expand.c:
* libguile/finalizers.c:
* libguile/fluids.c:
* libguile/fports.c:
* libguile/frames.c:
* libguile/gc.c:
* libguile/load.c:
* libguile/loader.c:
* libguile/macros.c:
* libguile/memoize.c:
* libguile/pairs.c:
* libguile/poll.c:
* libguile/ports.c:
* libguile/posix.c:
* libguile/rdelim.c:
* libguile/rw.c:
* libguile/vm.c: Adapt scm_c_make_gsubr / scm_c_define_gsubr callers to
use SCM_AS_SUBR.
2025-06-26 15:56:16 +02:00

230 lines
6.5 KiB
C
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/* Copyright 2010,2013,2018,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/>. */
#define _GNU_SOURCE
#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include <errno.h>
#include <poll.h>
#include "async.h"
#include "bytevectors.h"
#include "error.h"
#include "extensions.h"
#include "gsubr.h"
#include "modules.h"
#include "numbers.h"
#include "ports-internal.h"
#include "syscalls.h"
#include "vectors.h"
#include "version.h"
#include "poll.h"
/* {Poll}
*/
/* Poll a set of file descriptors, waiting until one or more of them is
ready to perform input or output.
This is a low-level interface. See the `(ice-9 poll)' module for a more
usable wrapper.
`pollfds' is expected to be a bytevector, laid out in contiguous blocks of 64
bits. Each block has the format of one `struct pollfd': a 32-bit int file
descriptor, a 16-bit int events mask, and a 16-bit int revents mask.
The number of pollfd structures in `pollfds' is specified in
`nfds'. `pollfds' must be at least long enough to support that number of
structures. It may be longer, in which case the trailing entries are left
untouched.
The pollfds bytevector is modified directly, setting the returned events in
the final two bytes (the revents member).
Since Scheme ports can buffer input or output in userspace, a Scheme
poll interface needs to take that into account as well. The `ports'
argument, a vector big enough for `nfds' elements, is given for this
purpose. If a pollfd entry has a corresponding open port, that port
is scanned for available input or output before dropping into the
poll. If any port has buffered I/O available, the poll syscall is
still issued, but with a timeout of 0 milliseconds, and a full port
scan occurs after the poll returns.
If timeout is given and is non-negative, the poll will return after that
number of milliseconds if no fd became active.
*/
static SCM
scm_primitive_poll (SCM pollfds, SCM nfds, SCM ports, SCM timeout)
#define FUNC_NAME "primitive-poll"
{
int rv = 0;
nfds_t i;
nfds_t c_nfds;
int c_timeout;
int have_buffered_io = 0;
struct pollfd *fds;
SCM_VALIDATE_BYTEVECTOR (SCM_ARG1, pollfds);
c_nfds = scm_to_uint32 (nfds);
c_timeout = scm_to_int (timeout);
if (SCM_UNLIKELY (SCM_BYTEVECTOR_LENGTH (pollfds)
< c_nfds * sizeof(struct pollfd)))
SCM_OUT_OF_RANGE (SCM_ARG2, nfds);
SCM_VALIDATE_VECTOR (SCM_ARG3, ports);
if (SCM_UNLIKELY (scm_c_vector_length (ports) < c_nfds))
SCM_OUT_OF_RANGE (SCM_ARG3, ports);
fds = (struct pollfd*)SCM_BYTEVECTOR_CONTENTS (pollfds);
for (i = 0; i < c_nfds; i++)
{
SCM port = scm_c_vector_ref (ports, i);
short int revents = 0;
if (SCM_PORTP (port))
{
if (SCM_CLOSEDP (port))
revents |= POLLERR;
else
{
scm_t_port *pt = SCM_PORT (port);
size_t tmp;
if (scm_port_buffer_can_take (pt->read_buf, &tmp) > 0)
/* Buffered input waiting to be read. */
revents |= POLLIN;
if (SCM_OUTPUT_PORT_P (port)
&& scm_port_buffer_can_put (pt->write_buf, &tmp) > 1)
/* Buffered output possible. The "> 1" is because
writing the last byte would flush the port. */
revents |= POLLOUT;
}
}
if (revents & fds[i].events)
{
have_buffered_io = 1;
c_timeout = 0;
break;
}
}
SCM_SYSCALL (rv = poll (fds, c_nfds, c_timeout));
if (rv == -1)
SCM_SYSERROR;
if (have_buffered_io)
for (i = 0; i < c_nfds; i++)
{
SCM port = scm_c_vector_ref (ports, i);
short int revents = 0;
if (SCM_PORTP (port))
{
if (SCM_CLOSEDP (port))
revents |= POLLERR;
else
{
scm_t_port *pt = SCM_PORT (port);
size_t tmp;
if (scm_port_buffer_can_take (pt->read_buf, &tmp) > 0)
/* Buffered input waiting to be read. */
revents |= POLLIN;
if (SCM_OUTPUT_PORT_P (port)
&& scm_port_buffer_can_put (pt->write_buf, &tmp) > 1)
/* Buffered output possible. The "> 1" is because
writing the last byte would flush the port. */
revents |= POLLOUT;
}
}
/* Mask in the events we are interested, and test if any are
interesting. */
if ((revents &= fds[i].events))
{
/* Could be the underlying fd is also ready for reading. */
if (!fds[i].revents)
rv++;
/* In any case, add these events to whatever the syscall
set. */
fds[i].revents |= revents;
}
}
return scm_from_int (rv);
}
#undef FUNC_NAME
static void
scm_init_poll (void)
{
scm_c_define_gsubr ("primitive-poll", 4, 0, 0,
SCM_AS_SUBR (scm_primitive_poll));
scm_c_define ("%sizeof-struct-pollfd", scm_from_size_t (sizeof (struct pollfd)));
#ifdef POLLIN
scm_c_define ("POLLIN", scm_from_int (POLLIN));
#endif
#ifdef POLLPRI
scm_c_define ("POLLPRI", scm_from_int (POLLPRI));
#endif
#ifdef POLLOUT
scm_c_define ("POLLOUT", scm_from_int (POLLOUT));
#endif
#ifdef POLLRDHUP
scm_c_define ("POLLRDHUP", scm_from_int (POLLRDHUP));
#endif
#ifdef POLLERR
scm_c_define ("POLLERR", scm_from_int (POLLERR));
#endif
#ifdef POLLHUP
scm_c_define ("POLLHUP", scm_from_int (POLLHUP));
#endif
#ifdef POLLNVAL
scm_c_define ("POLLNVAL", scm_from_int (POLLNVAL));
#endif
}
void
scm_register_poll (void)
{
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
"scm_init_poll",
(scm_t_extension_init_func) scm_init_poll,
NULL);
}