summaryrefslogtreecommitdiff
path: root/modules/language/python
diff options
context:
space:
mode:
Diffstat (limited to 'modules/language/python')
-rw-r--r--modules/language/python/module/select.scm284
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)))
+
+
generated by cgit v1.2.3 (git 2.46.0) at 2024-10-19 02:21:12 +0000