summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog16
-rwxr-xr-xconfigure26
-rw-r--r--stream.h2
-rw-r--r--sysif.c97
-rw-r--r--txr.151
5 files changed, 191 insertions, 1 deletions
diff --git a/ChangeLog b/ChangeLog
index dddb6c48..d7f9edcd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,19 @@
+2015-04-28 Kaz Kylheku <kaz@kylheku.com>
+
+ Adding poll function.
+
+ * configure: Check for the poll function and set
+ HAVE_POLL accordingly in config.h.
+
+ * stream.h (fd_k): External declaration added.
+
+ * sysif.c (poll_wrap): New function.
+ (sysif_init): Registered poll-in, poll-out, poll-err,
+ poll-pri, poll-rdhup, poll-nval, poll-rdband, poll-wrband
+ variables and poll function.
+
+ * txr.1: Documented poll.
+
2015-04-21 Kaz Kylheku <kaz@kylheku.com>
Version 107.
diff --git a/configure b/configure
index 6763f807..aeb7c820 100755
--- a/configure
+++ b/configure
@@ -1477,6 +1477,32 @@ else
fi
#
+# poll
+#
+
+printf "Checking for poll ... "
+
+cat > conftest.c <<!
+#include <poll.h>
+#include "config.h"
+
+int main(int argc, char **argv)
+{
+ struct pollfd fds[42] = { 0 };
+ nfds_t n = 42;
+ int err = poll(&fds, 42, 1000);
+ return 0;
+}
+!
+
+if conftest ; then
+ printf "yes\n"
+ printf "#define HAVE_POLL 1\n" >> $config_h
+else
+ printf "no\n"
+fi
+
+#
# Check for fields inside struct tm
#
diff --git a/stream.h b/stream.h
index 48432e9f..910cdaec 100644
--- a/stream.h
+++ b/stream.h
@@ -72,7 +72,7 @@ extern val dev_k, ino_k, mode_k, nlink_k, uid_k;
extern val gid_k, rdev_k, size_k, blksize_k, blocks_k;
extern val atime_k, mtime_k, ctime_k;
extern val from_start_k, from_current_k, from_end_k;
-extern val real_time_k, name_k;
+extern val real_time_k, name_k, fd_k;
extern val format_s;
extern val stdin_s, stdout_s, stddebug_s, stderr_s, stdnull_s;
diff --git a/sysif.c b/sysif.c
index 880e4a47..6c0cb547 100644
--- a/sysif.c
+++ b/sysif.c
@@ -52,6 +52,9 @@
#if HAVE_MAKEDEV
#include <sys/types.h>
#endif
+#if HAVE_POLL
+#include <poll.h>
+#endif
#include "lib.h"
#include "stream.h"
#include "hash.h"
@@ -599,6 +602,76 @@ static val unsetenv_wrap(val name)
return name;
}
+#if HAVE_POLL
+
+static val poll_wrap(val poll_list, val timeout_in)
+{
+ nfds_t i, len = c_num(length(poll_list));
+ val iter;
+ struct pollfd *pfd = convert(struct pollfd *,
+ chk_calloc(len, sizeof *pfd));
+ val timeout = default_arg(timeout_in, negone);
+ int res;
+
+ for (i = 0, iter = poll_list; iter; iter = cdr(iter), i++) {
+ cons_bind (obj, events, car(iter));
+
+ pfd[i].events = c_num(events);
+
+ switch (type(obj)) {
+ case NUM:
+ pfd[i].fd = c_num(obj);
+ break;
+ case COBJ:
+ if (obj->co.cls == stream_s) {
+ val fdval = stream_get_prop(obj, fd_k);
+ if (!fdval) {
+ free(pfd);
+ uw_throwf(file_error_s,
+ lit("poll: stream ~s doesn't have a file descriptor"),
+ obj, nao);
+ }
+ pfd[i].fd = c_num(fdval);
+ break;
+ }
+ /* fallthrough */
+ default:
+ free(pfd);
+ uw_throwf(file_error_s,
+ lit("poll: ~s isn't a stream or file descriptor"),
+ obj, nao);
+ break;
+ }
+ }
+
+ res = poll(pfd, len, c_num(timeout));
+
+ if (res < 0) {
+ free(pfd);
+ uw_throwf(file_error_s, lit("poll failed: ~a/~s"),
+ num(errno), string_utf8(strerror(errno)), nao);
+ }
+
+ if (res == 0) {
+ free(pfd);
+ return nil;
+ }
+
+ {
+ list_collect_decl (out, ptail);
+
+ for (i = 0, iter = poll_list; iter; iter = cdr(iter), i++) {
+ val pair = car(iter);
+ if (pfd[i].revents)
+ ptail = list_collect(ptail, cons(car(pair), num(pfd[i].revents)));
+ }
+
+ free(pfd);
+ return out;
+ }
+}
+
+#endif
void sysif_init(void)
{
@@ -729,6 +802,26 @@ void sysif_init(void)
reg_var(intern(lit("s-iwoth"), user_package), num_fast(S_IWOTH));
reg_var(intern(lit("s-ixoth"), user_package), num_fast(S_IXOTH));
#endif
+#if HAVE_POLL
+ reg_var(intern(lit("poll-in"), user_package), num_fast(POLLIN));
+ reg_var(intern(lit("poll-out"), user_package), num_fast(POLLOUT));
+ reg_var(intern(lit("poll-err"), user_package), num_fast(POLLERR));
+#ifdef POLLPRI
+ reg_var(intern(lit("poll-pri"), user_package), num_fast(POLLPRI));
+#endif
+#ifdef POLLRDHUP
+ reg_var(intern(lit("poll-rdhup"), user_package), num_fast(POLLRDHUP));
+#endif
+#ifdef POLLNVAL
+ reg_var(intern(lit("poll-nval"), user_package), num_fast(POLLNVAL));
+#endif
+#ifdef POLLRDBAND
+ reg_var(intern(lit("poll-rdband"), user_package), num_fast(POLLRDBAND));
+#endif
+#ifdef POLLWRBAND
+ reg_var(intern(lit("poll-wrband"), user_package), num_fast(POLLWRBAND));
+#endif
+#endif
#if HAVE_FORK_STUFF
reg_fun(intern(lit("fork"), user_package), func_n0(fork_wrap));
@@ -764,4 +857,8 @@ void sysif_init(void)
reg_fun(intern(lit("getenv"), user_package), func_n1(getenv_wrap));
reg_fun(intern(lit("setenv"), user_package), func_n3o(setenv_wrap, 2));
reg_fun(intern(lit("unsetenv"), user_package), func_n1(unsetenv_wrap));
+
+#if HAVE_POLL
+ reg_fun(intern(lit("poll"), user_package), func_n2o(poll_wrap, 1));
+#endif
}
diff --git a/txr.1 b/txr.1
index 914f0b39..46e244aa 100644
--- a/txr.1
+++ b/txr.1
@@ -25289,6 +25289,57 @@ holds the write end.
If the function fails, it throws an exception of type
.codn file-error .
+.coNP Function @ poll
+.synb
+.mets (poll < poll-list <> [ timeout ])
+.syne
+.desc
+The
+.code poll
+function suspends execution while monitoring one or more file descriptors
+for specified events. It is a wrapper for the same-named POSIX function.
+
+The
+.meta poll-list
+argument is a list of
+.code cons
+pairs. The
+.code car
+of each pair is either an integer file descriptor, or else a stream
+object which has a file descriptor (the
+.code fileno
+function can be applied to that stream to retrieve a descriptor).
+The
+.code cdr
+of each pair is an integer bit mask specifying the events, whose
+occurrence the file descriptor is to be monitored for. The variables
+.codn poll-in ,
+.codn poll-out ,
+.code poll-err
+and several others are available which hold bitmask values corresponding
+to the constants
+.codn POLLIN ,
+.codn POLLOUT ,
+.code POLLERR
+used with the C language
+.code poll
+function.
+
+The
+.meta timeout
+argument, if absent, defaults to the value -1, which specifies an indefinite
+wait. A nonnegative value specifies a wait with a timeout, measured in
+milliseconds.
+
+The function returns a list of pairs representing the descriptors or streams
+which were successfully polled. If the function times out, it returns an
+empty list. If an error occurs, an exception is thrown.
+
+The returned list is similar in structure to the input list. However, it holds
+only entries which polled positive. The
+.code cdr
+of every pair now holds a bitmask of the events which were to have occurred.
+
.SS* Unix Itimers
Itimers ("interval timers") can be used in combination with signal handling to
execute asynchronous actions. Itimers deliver delayed, one-time signals,