mirror of
https://github.com/Ponce/slackbuilds
synced 2024-10-22 22:27:28 +02:00
162 lines
6.4 KiB
Diff
162 lines
6.4 KiB
Diff
|
From 9e2022652258e8a30e5cedbf0abc9cd85a0f6af7 Mon Sep 17 00:00:00 2001
|
||
|
From: Peter Bex <peter.bex@xs4all.nl>
|
||
|
Date: Thu, 18 Apr 2013 00:31:08 +0200
|
||
|
Subject: [PATCH] Implement file-select in terms of POSIX poll() for UNIX
|
||
|
|
||
|
Signed-off-by: felix <felix@call-with-current-continuation.org>
|
||
|
---
|
||
|
posixunix.scm | 116 ++++++++++++++++++++++++++------------------------------
|
||
|
1 files changed, 54 insertions(+), 62 deletions(-)
|
||
|
|
||
|
diff --git a/posixunix.scm b/posixunix.scm
|
||
|
index 15cb535..90e0176 100644
|
||
|
--- a/posixunix.scm
|
||
|
+++ b/posixunix.scm
|
||
|
@@ -67,6 +67,7 @@ static C_TLS int C_wait_status;
|
||
|
#endif
|
||
|
|
||
|
#include <sys/mman.h>
|
||
|
+#include <sys/poll.h>
|
||
|
#include <time.h>
|
||
|
|
||
|
#ifndef O_FSYNC
|
||
|
@@ -136,7 +137,6 @@ static C_TLS struct {
|
||
|
static C_TLS int C_pipefds[ 2 ];
|
||
|
static C_TLS time_t C_secs;
|
||
|
static C_TLS struct tm C_tm;
|
||
|
-static C_TLS fd_set C_fd_sets[ 2 ];
|
||
|
static C_TLS struct timeval C_timeval;
|
||
|
static C_TLS char C_hostbuf[ 256 ];
|
||
|
static C_TLS struct stat C_statbuf;
|
||
|
@@ -303,13 +303,6 @@ static C_TLS sigset_t C_sigset;
|
||
|
#define C_fseek(p, n, w) C_mk_nbool(fseek(C_port_file(p), C_num_to_int(n), C_unfix(w)))
|
||
|
#define C_lseek(fd, o, w) C_fix(lseek(C_unfix(fd), C_unfix(o), C_unfix(w)))
|
||
|
|
||
|
-#define C_zero_fd_set(i) FD_ZERO(&C_fd_sets[ i ])
|
||
|
-#define C_set_fd_set(i, fd) FD_SET(fd, &C_fd_sets[ i ])
|
||
|
-#define C_test_fd_set(i, fd) FD_ISSET(fd, &C_fd_sets[ i ])
|
||
|
-#define C_C_select(m) C_fix(select(C_unfix(m), &C_fd_sets[ 0 ], &C_fd_sets[ 1 ], NULL, NULL))
|
||
|
-#define C_C_select_t(m, t) (C_set_timeval(t, &C_timeval), \
|
||
|
- C_fix(select(C_unfix(m), &C_fd_sets[ 0 ], &C_fd_sets[ 1 ], NULL, &C_timeval)))
|
||
|
-
|
||
|
#define C_ctime(n) (C_secs = (n), ctime(&C_secs))
|
||
|
|
||
|
#if defined(__SVR4) || defined(C_MACOSX)
|
||
|
@@ -656,60 +649,59 @@ EOF
|
||
|
|
||
|
;;; I/O multiplexing:
|
||
|
|
||
|
-(define file-select
|
||
|
- (let ([fd_zero (foreign-lambda void "C_zero_fd_set" int)]
|
||
|
- [fd_set (foreign-lambda void "C_set_fd_set" int int)]
|
||
|
- [fd_test (foreign-lambda bool "C_test_fd_set" int int)] )
|
||
|
- (lambda (fdsr fdsw . timeout)
|
||
|
- (let ([fdmax 0]
|
||
|
- [tm (if (pair? timeout) (car timeout) #f)] )
|
||
|
- (fd_zero 0)
|
||
|
- (fd_zero 1)
|
||
|
- (cond [(not fdsr)]
|
||
|
- [(fixnum? fdsr)
|
||
|
- (set! fdmax fdsr)
|
||
|
- (fd_set 0 fdsr) ]
|
||
|
- [else
|
||
|
- (##sys#check-list fdsr 'file-select)
|
||
|
- (for-each
|
||
|
- (lambda (fd)
|
||
|
- (##sys#check-exact fd 'file-select)
|
||
|
- (set! fdmax (##core#inline "C_i_fixnum_max" fdmax fd))
|
||
|
- (fd_set 0 fd) )
|
||
|
- fdsr) ] )
|
||
|
- (cond [(not fdsw)]
|
||
|
- [(fixnum? fdsw)
|
||
|
- (set! fdmax fdsw)
|
||
|
- (fd_set 1 fdsw) ]
|
||
|
- [else
|
||
|
- (##sys#check-list fdsw 'file-select)
|
||
|
- (for-each
|
||
|
- (lambda (fd)
|
||
|
- (##sys#check-exact fd 'file-select)
|
||
|
- (set! fdmax (##core#inline "C_i_fixnum_max" fdmax fd))
|
||
|
- (fd_set 1 fd) )
|
||
|
- fdsw) ] )
|
||
|
- (let ([n (cond [tm
|
||
|
- (##sys#check-number tm 'file-select)
|
||
|
- (##core#inline "C_C_select_t" (fx+ fdmax 1) tm) ]
|
||
|
- [else (##core#inline "C_C_select" (fx+ fdmax 1))] ) ] )
|
||
|
- (cond [(fx< n 0)
|
||
|
- (posix-error #:file-error 'file-select "failed" fdsr fdsw) ]
|
||
|
- [(fx= n 0) (values (if (pair? fdsr) '() #f) (if (pair? fdsw) '() #f))]
|
||
|
- [else
|
||
|
- (values
|
||
|
- (and fdsr
|
||
|
- (if (fixnum? fdsr)
|
||
|
- (fd_test 0 fdsr)
|
||
|
- (let ([lstr '()])
|
||
|
- (for-each (lambda (fd) (when (fd_test 0 fd) (set! lstr (cons fd lstr)))) fdsr)
|
||
|
- lstr) ) )
|
||
|
- (and fdsw
|
||
|
- (if (fixnum? fdsw)
|
||
|
- (fd_test 1 fdsw)
|
||
|
- (let ([lstw '()])
|
||
|
- (for-each (lambda (fd) (when (fd_test 1 fd) (set! lstw (cons fd lstw)))) fdsw)
|
||
|
- lstw) ) ) ) ] ) ) ) ) ) )
|
||
|
+(define (file-select fdsr fdsw . timeout)
|
||
|
+ (let* ((tm (if (pair? timeout) (car timeout) #f))
|
||
|
+ (fdsrl (cond ((not fdsr) '())
|
||
|
+ ((fixnum? fdsr) (list fdsr))
|
||
|
+ (else (##sys#check-list fdsr 'file-select)
|
||
|
+ fdsr)))
|
||
|
+ (fdswl (cond ((not fdsw) '())
|
||
|
+ ((fixnum? fdsw) (list fdsw))
|
||
|
+ (else (##sys#check-list fdsw 'file-select)
|
||
|
+ fdsw)))
|
||
|
+ (nfdsr (##sys#length fdsrl))
|
||
|
+ (nfdsw (##sys#length fdswl))
|
||
|
+ (nfds (fx+ nfdsr nfdsw))
|
||
|
+ (fds-blob (##sys#make-blob
|
||
|
+ (fx* nfds (foreign-value "sizeof(struct pollfd)" int)))))
|
||
|
+ (when tm (##sys#check-number tm))
|
||
|
+ (do ((i 0 (fx+ i 1))
|
||
|
+ (fdsrl fdsrl (cdr fdsrl)))
|
||
|
+ ((null? fdsrl))
|
||
|
+ ((foreign-lambda* void ((int i) (int fd) (scheme-pointer p))
|
||
|
+ "struct pollfd *fds = p;"
|
||
|
+ "fds[i].fd = fd; fds[i].events = POLLIN;") i (car fdsrl) fds-blob))
|
||
|
+ (do ((i nfdsr (fx+ i 1))
|
||
|
+ (fdswl fdswl (cdr fdswl)))
|
||
|
+ ((null? fdswl))
|
||
|
+ ((foreign-lambda* void ((int i) (int fd) (scheme-pointer p))
|
||
|
+ "struct pollfd *fds = p;"
|
||
|
+ "fds[i].fd = fd; fds[i].events = POLLOUT;") i (car fdswl) fds-blob))
|
||
|
+ (let ((n ((foreign-lambda int "poll" scheme-pointer int int)
|
||
|
+ fds-blob nfds (if tm (inexact->exact (* (max 0 tm) 1000)) -1))))
|
||
|
+ (cond ((fx< n 0)
|
||
|
+ (posix-error #:file-error 'file-select "failed" fdsr fdsw) )
|
||
|
+ ((fx= n 0) (values (if (pair? fdsr) '() #f) (if (pair? fdsw) '() #f)))
|
||
|
+ (else
|
||
|
+ (let ((rl (let lp ((i 0) (res '()) (fds fdsrl))
|
||
|
+ (cond ((null? fds) (##sys#fast-reverse res))
|
||
|
+ (((foreign-lambda* bool ((int i) (scheme-pointer p))
|
||
|
+ "struct pollfd *fds = p;"
|
||
|
+ "C_return(fds[i].revents & (POLLIN|POLLERR|POLLHUP|POLLNVAL));")
|
||
|
+ i fds-blob)
|
||
|
+ (lp (fx+ i 1) (cons (car fds) res) (cdr fds)))
|
||
|
+ (else (lp (fx+ i 1) res (cdr fds))))))
|
||
|
+ (wl (let lp ((i nfdsr) (res '()) (fds fdswl))
|
||
|
+ (cond ((null? fds) (##sys#fast-reverse res))
|
||
|
+ (((foreign-lambda* bool ((int i) (scheme-pointer p))
|
||
|
+ "struct pollfd *fds = p;"
|
||
|
+ "C_return(fds[i].revents & (POLLOUT|POLLERR|POLLHUP|POLLNVAL));")
|
||
|
+ i fds-blob)
|
||
|
+ (lp (fx+ i 1) (cons (car fds) res) (cdr fds)))
|
||
|
+ (else (lp (fx+ i 1) res (cdr fds)))))))
|
||
|
+ (values
|
||
|
+ (and fdsr (if (fixnum? fdsr) (and (memq fdsr rl) fdsr) rl))
|
||
|
+ (and fdsw (if (fixnum? fdsw) (and (memq fdsw wl) fdsw) wl)))))))))
|
||
|
|
||
|
|
||
|
;;; File attribute access:
|
||
|
--
|
||
|
1.7.2.1
|
||
|
|