diff options
Diffstat (limited to 'modules')
-rw-r--r-- | modules/language/python/module/select.scm | 284 |
1 files changed, 284 insertions, 0 deletions
diff --git a/modules/language/python/module/select.scm b/modules/language/python/module/select.scm new file mode 100644 index 0000000..ae2f9e6 --- /dev/null +++ b/modules/language/python/module/select.scm @@ -0,0 +1,284 @@ +(define-module (languge python module select) + #:use-module (language python module errno) + #:use-module ((language python module os) #:prefix os:) + #:use-module (language python exceptions) + #:use-module (language python list) + #:use-module (language python try) + #:use-module (oop pf-objects) + #:use-module (system foreign) + #:use-module (rnrs bytevectors) + + #:export (select poll epoll devpoll kqueue kevent error PIPE_BUF + EPOLLIN EPOLLOUT EPOLLPRI EPOLLERR EPOLLHUP EPOLLET + EPOLLONESHOT EPOLLWAKEUP EPOLLEXCLUSIVE EPOLLRDHUP + EPOLLRDNORM EPOLLRDBAND EPOLLWRNORM EPOLLWRBAND EPOLLMSG + POLLERR POLLHUP POLLNVAL POLLIN POLLOUT POLLRDHUP + POLLPRI POLLREMOVE POLLMSG) + +(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) + +(define-syntax-rule (ca code) + (catch #t + (lambda () code) + (lambda x (raise error x)))) + +(define-syntax-rule (rm code) + (let ((r (ca code))) + (if (< r 0) + (raise error (errno) ((@ (guile) strerror) (errno))) + r))) + +(define-syntax-rule (defineu f x) + (begin + (define f + (catch #t + (lambda () x) + (lambda z + (let ((message (format #f "could not define ~a" 'f))) + (warn message) + (lambda z (error message)))))))) + +(define error OSError) + +(define devpoll + (lambda () (error "devpoll not supported"))) + +(define kqueue + (lambda () (error "kqueue not supported"))) + +(define kevent + (lambda x (error "kevent not supported"))) + +(define select) + +(define EPOLL_CTL_ADD 1) +(define EPOLL_CTL_MOD 3) +(define EPOLL_CTL_DEL 2) + +(defineu epoll-create + (let* ((f (pointer->procedure + int + (dynamic-func "epoll_create" (dynamic-link)) + (list int)))) + (lambda () (f 0)))) + +(defineu epoll-ctl + (let* ((f (pointer->procedure + int + (dynamic-func "epoll_ctl" (dynamic-link)) + (list int int int '*)))) + (lambda (efd op fd event) + (rm (let ((v (make-bytevector 16))) + (bytevector-i32-set! 0 event (native-endianness)) + (bytevector-i64-set! 4 fd (native-endianness)) + (f efd op fd (bytevector->pointer v))))))) + +(defineu epoll-wait + (let* ((f (pointer->procedure + int + (dynamic-func "epoll_wait" (dynamic-link)) + (list '* int int)))) + (lambda (efd max timout) + (let ((v (make-pointer 0))) + (let ((n (f efd v max timout)) + (v (pointer->bytevector v (* n 12)))) + (let lp ((i 0) (l '())) + (if (< i n) + (let ((op (bytevector-i32-ref v (* i 12) + (nativ-endianness))) + (fd (bytevector-i64-ref v (+ (* i 12) 4) + (nativ-endianness)))) + (lp (+ i 1) (cons (list op fd) l))) + (reverse l)))))))) + + + + + + +(define-python-class epoll () + (define __init__ + (lam (self (= sizehint -1) (= flags 0) (= fd #f)) + (if fd + (set self '__fd fd) + (set self '__fd (epoll-create))) + (set self '__closed #f))) + + (define close + (lambda (self) + (when (not (ref self '__closed)) + (os:close (ref self '__fd)) + (set self '__closed #t)))) + + (define closed + (lambda (self) (ref self '__closed))) + + (define fileno + (lambda (self) (ref self '__fd))) + + (define fromfd + (lambda (fd) + (epoll #:fd fd))) + + (define __enter__ + (lambda (self) #t)) + + (define __exit__ close) + + (define register + (lambda* (self fd #:optional (eventmask 0)) + (if (not (closed self)) + (epoll-ctl (ref self '__fd) + EPOLL_CTL_ADD + fd + eventmask)))) + + (define modify + (lambda (self fd eventmask) + (if (not (closed self)) + (epoll-ctl (ref self '__fd) + EPOLL_CTL_MOD + fd + eventmask)))) + + (define unregister + (lambda (self fd) + (if (not (closed self)) + (epoll-ctl (ref self '__fd) + EPOLL_CTL_DEL + fd + 0)))) + + (define poll + (lam ((= timeout -1) (= maxevents -1)) + (epoll-wait + (ref self '__fd) + maxevents + (if (< timeout 0) + -1 + (inexact->exact (floor (* 1000 timeout)))))))) + + +(define PIPE_BUF 1024) +(define EPOLLIN #x1) +(define EPOLLOUT #x4) +(define EPOLLPRI #x2) +(define EPOLLERR #x8) +(define EPOLLHUP #x10) +(define EPOLLET (ash 1 31)) +(define EPOLLONESHOT (ash 1 30)) +(define EPOLLWAKEUP (ash 1 29)) +(define EPOLLEXCLUSIVE (ash 1 28)) +(define EPOLLRDHUP #x2000) +(define EPOLLRDNORM #x40) +(define EPOLLRDBAND #x80) +(define EPOLLWRNORM #x100) +(define EPOLLWRBAND #x200) +(define EPOLLMSG #x400) + + +(define POLLERR #x8) +(define POLLMSG #x400) +(define POLLREMOVE #x1000) +(define POLLHUP #x10) +(define POLLNVAL #x20) +(define POLLIN #x1) +(define POLLPRI #x2) +(define POLLOUT #x4) +(define POLLRDHUP #x2000) + + +(defineu pollf + (let* ((f (pointer->procedure + int + (dynamic-func "poll" (dynamic-link)) + (list '* int int)))) + (lambda (fds n timespec) + (rm (f fds n (inexact->exact (floor (* 1000 timespac)))))))) + + +(define-python-class poll () + (define __init__ + (lambda (self) + (set self '__data '()))) + + (define register + (lambda* (self fd #:optional (eventmask 0)) + (set self '__cache #f) + (let ((data (ref self '__data))) + (if (assoc fd data) + (raise (error "poll registering of already registered fd")) + (set self '__data (cons (cons fd eventmask) data)))))) + + (define modify + (lambda (self fd eventmask) + (set self '__cache #f) + (let ((data (ref self '__data))) + (aif it (assoc fd data) + (set-cdr! it eventmask) + (begin + (errno_set ENOENT) + (raise (error "modifying non existant fd"))))))) + + (define unregister + (lambda (self fd) + (set self '__cache #f) + (set self '__data + (let lp ((l (ref self '__data))) + (if (pair? l) + (let ((x (car l))) + (if (= (car x) fd) + (cdr l) + (cons x (lp (cdr l))))) + '()))))) + + (define poll + (let ((k 8)) + (lambda* (#:optional (timeout -1)) + (define (make-data-pt data n) + (let ((v (make-bytevector (* n k)))) + (let lp ((i 0) (l data)) + (if (pair? l) + (begin + (bytevector-i32-set! v (* i k) (caar l) + (native-endianness)) + (bytevector-i16-set! v (+ (* i k) 4) (cdar l) + (native-endianness)) + (bytevector-i16-set! v (+ (* i k) 6) 0 + (native-endianness)) + (lp (+ i 1) (cdr l))) + (bytevector->pointer v))))) + + (call-with-values + (lambda () + (aif it (ref self '__cache) + (let ((n (ref self '__n))) + (pollf it n timeout) + (values it n)) + (let* ((data (ref self '__data)) + (n (length data)) + (x (make-data-pt data n))) + (set self '__cache x) + (set self '__n n) + (pollf x n timeout) + (values x n)))) + + (lambda (x n) + (let lp ((i 0)) + (if (< i n) + (let ((fd (bytevector-i32-ref v (* i k) + (nativ-endianness))) + (y (bytevector-i16-ref v (+ (* i k) 6) + (nativ-endianness)))) + (if (not (= y 0)) + (cons (list fd y) (lp (+ i 1))) + (lp (+ i 1)))) + '())))))))) + + +(define* (select rl wl xl #:optional (timout 0)) + (let ((m (inexact->exact (floor timeout))) + (n (modulo (inexact->exact (floor (* 1000000 timeout))) 1000000))) + ((@ (guile) select) (to-list rl) (to-list wl) (to-list xl) m n))) + + |