2008-01-20 17:07:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2008 Slava Pestov.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-13 19:24:46 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								USING: alien.c-types kernel io.ports io.unix.backend
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-23 01:49:01 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								bit-arrays sequences assocs unix unix.linux.epoll math
							 | 
						
					
						
							
								
									
										
										
										
											2008-10-06 22:17:51 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								namespaces unix.time ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-20 17:07:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: io.unix.epoll
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 13:47:49 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								TUPLE: epoll-mx < mx events ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-20 17:07:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: max-events ( -- n )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    #! We read up to 256 events at a time. This is an arbitrary
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    #! constant...
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    256 ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <epoll-mx> ( -- mx )
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-14 06:07:31 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    epoll-mx new-mx
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-20 17:07:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    max-events epoll_create dup io-error over set-mx-fd
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    max-events "epoll-event" <c-array> over set-epoll-mx-events ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-21 15:33:43 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								GENERIC: io-task-events ( task -- n )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-23 01:49:01 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: input-task io-task-events drop EPOLLIN ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-21 15:33:43 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-23 01:49:01 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: output-task io-task-events drop EPOLLOUT ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-20 17:07:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: make-event ( task -- event )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    "epoll-event" <c-object>
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-21 15:33:43 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    over io-task-events over set-epoll-event-events
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-23 01:49:01 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    swap io-task-fd over set-epoll-event-fd ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-20 17:07:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: do-epoll-ctl ( task mx what -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-23 03:07:15 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    >r mx-fd r> rot dup io-task-fd swap make-event
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-20 17:07:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    epoll_ctl io-error ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: epoll-mx register-io-task ( task mx -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 13:47:49 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ EPOLL_CTL_ADD do-epoll-ctl ] [ call-next-method ] 2bi ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-20 17:07:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: epoll-mx unregister-io-task ( task mx -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 13:47:49 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ call-next-method ] [ EPOLL_CTL_DEL do-epoll-ctl ] 2bi ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-20 17:07:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-23 01:49:01 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: wait-event ( mx timeout -- n )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    >r { mx-fd epoll-mx-events } get-slots max-events
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    r> epoll_wait dup multiplexer-error ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-20 17:07:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: epoll-read-task ( mx fd -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-12 19:53:22 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    over mx-reads at* [ perform-io-task ] [ 2drop ] if ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-20 17:07:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: epoll-write-task ( mx fd -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-12 19:53:22 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    over mx-writes at* [ perform-io-task ] [ 2drop ] if ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-20 17:07:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: handle-event ( mx kevent -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    epoll-event-fd 2dup epoll-read-task epoll-write-task ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: handle-events ( mx n -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-23 01:49:01 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        over epoll-mx-events epoll-event-nth handle-event
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] with each ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-20 17:07:18 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-21 15:33:43 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: epoll-mx wait-for-events ( ms mx -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-23 01:49:01 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup rot wait-event handle-events ;
							 |