changeset 375:f8d80c16abbd

Add epoll module and a basic epoll sample
author Michael Pavone <pavone@retrodev.com>
date Fri, 14 Aug 2015 23:08:54 -0700
parents 368fbc9ea51b
children d61b1f0e1936
files modules/epoll.tp samples/epoll.tp
diffstat 2 files changed, 243 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/modules/epoll.tp	Fri Aug 14 23:08:54 2015 -0700
@@ -0,0 +1,159 @@
+{
+	_helper <- #{
+		includeSystemHeader: "sys/epoll.h"
+		llMessage: create withVars: {
+			efd <- obj_int32 ptr
+		} andCode: {
+			efd <- make_object: (addr_of: obj_int32_meta) NULL 0
+			efd num!: (epoll_create: 8)
+			efd
+		}
+		
+		llMessage: ctl withVars: {
+			oepfd <- object ptr
+			epfd <- obj_int32 ptr
+			oop <- object ptr
+			op <- obj_int32 ptr
+			ofd <- object ptr
+			fd <- obj_int32 ptr
+			omask <- object ptr
+			mask <- obj_uint32 ptr
+			data <- object ptr
+			res <- obj_int32 ptr
+			event <- struct: epoll_event
+		} andCode: :oepfd oop ofd omask data {
+			epfd <- (mcall: int32 1 oepfd) castTo: (obj_int32 ptr)
+			op <- (mcall: int32 1 oop) castTo: (obj_int32 ptr)
+			fd <- (mcall: int32 1 ofd) castTo: (obj_int32 ptr)
+			mask <- (mcall: int32 1 omask) castTo: (obj_int32 ptr)
+			res <- make_object: (addr_of: obj_int32_meta) NULL 0
+			event events!: (mask num)
+			(addr_of: (event data)) ptr!: (data)
+			res num!: (epoll_ctl: (epfd num) (op num) (fd num) (addr_of: event))
+			res
+		}
+	}
+	 _constant <- macro: :name cname {
+		quote: (llMessage: name withVars: {
+				uintret <- obj_uint32 ptr
+		} andCode: {
+				uintret <- make_object: (addr_of: obj_uint32_meta) NULL 0
+				uintret num!: cname
+				uintret
+		})
+	}
+	_controlOps <- #{
+		_constant: add EPOLL_CTL_ADD
+		_constant: mod EPOLL_CTL_MOD
+		_constant: del EPOLL_CTL_DEL
+	}
+	_events <- #{
+		_constant: in      EPOLLIN
+		_constant: out     EPOLLOUT
+		_constant: rdhup   EPOLLRDHUP
+		_constant: pri     EPOLLPRI
+		_constant: err     EPOLLERR
+		_constant: hup     EPOLLHUP
+		_constant: et      EPOLLET
+		_constant: oneshot EPOLLONESHOT
+	}
+	#{
+		events <- { _events }
+		create <- {
+			efd <- _helper create
+			if: efd >= 0 {
+				_pinData <- dict hash
+				eobj <- #{
+					llProperty: _fd withType: int32_t
+					llMessage: _set_fd withVars: {
+						ofd <- object ptr
+						ifd <- obj_int32 ptr
+					} andCode: :ofd {
+						ifd <- (mcall: int32 1 ofd) castTo: (obj_int32 ptr)
+						_fd <- ifd num
+						self
+					}
+					llMessage: fd withVars: {
+						ifd <- obj_int32 ptr
+					} andCode: {
+						ifd <- make_object: (addr_of: obj_int32_meta) NULL 0
+						ifd num!: _fd
+						ifd
+					}
+					
+					addFD:withMask:data <- :nfd :mask :data {
+						if: (_helper ctl: fd (_controlOps add) nfd mask data) = 0 {
+							_pinData set: nfd data
+							true
+						}
+					}
+					deleteFD <- :dfd {
+						if: (_helper ctl: fd (_controlOps del) dfd 0u32 false) = 0 {
+							//HACK: replace data with false since we don't have a delete method on hashes yet
+							_pinData set: dfd false
+							true
+						}
+					}
+					modifyFD:setMask:data <- :mfd  :mask :data {
+						if: (_helper ctl: fd (_controlOps mod) mfd mask data) = 0 {
+							_pinData set: mfd data
+							true
+						}
+					}
+					
+					event:data <- :_event:_data {
+						#{
+							event <- { _event }
+							data <- { _data }
+						}
+					}
+					
+					llMessage: wait:maxEvents withVars: {
+						otimeout <- object ptr
+						omaxevents <- object ptr
+						timeout <- obj_int32 ptr
+						maxevents <- obj_int32 ptr
+						events <- (struct: epoll_event) ptr
+						retarr <- array ptr
+						res <- obj_int32 ptr
+						omask <- obj_uint32 ptr
+						i <- int32_t
+					} andCode: :otimeout omaxevents {
+						timeout <- (mcall: int32 1 otimeout) castTo: (obj_int32 ptr)
+						maxevents <- (mcall: int32 1 omaxevents) castTo: (obj_int32 ptr)
+						events <- GC_MALLOC_ATOMIC: (sizeof: (struct: epoll_event)) * (maxevents num)
+						res <- make_object: (addr_of: obj_int32_meta) NULL 0
+						res num!: (epoll_wait: _fd events (maxevents num) (timeout num))
+						if: (res num) >= 0 {
+							retarr <- make_array: 0
+							mcall: resize 2 retarr res
+							i <- 0
+							while: { i < (res num) } do: {
+								omask <- make_object: (addr_of: obj_uint32_meta) NULL 0
+								omask num!: ((addr_of: (events get: i)) events)
+								mcall: append 2 retarr (mcall: event:data 3 self omask ((addr_of: ((addr_of: (events get: i)) data) ) ptr))
+								i <- i + 1
+							}
+							mcall: value 2 option retarr
+						} else: {
+							mcall: none 1 option
+						}
+					}
+					
+					llMessage: close withVars: {
+					} andCode: {
+						if: (close: _fd) = 0 {
+							true
+						} else: {
+							false
+						}
+					}
+				}
+				eobj _set_fd: efd
+				option value: eobj
+			} else: {
+				option none
+			}
+		}
+	}
+}
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/samples/epoll.tp	Fri Aug 14 23:08:54 2015 -0700
@@ -0,0 +1,84 @@
+#{
+	echo <- :sock {
+		print: "New connection\n"
+		data <- sock recv: 4096
+		while: { (data length) > 0 } do: {
+			sock send: data
+			data <- sock recv: 4096
+		}
+		print: "Connection closed\n"
+	}
+	continue? <- true
+	acceptHandler <- :sock ep {
+		epe <- epoll events
+		:_ {
+			(sock accept) value: :csock {
+				ep addFD: (csock fd) withMask: (epe in) data: (clientHandler: csock ep)
+			} none: {
+				print: "Failed to accept new connection\n"
+			}
+		}
+	}
+	
+	clientHandler <- :sock ep {
+		epe <- epoll events
+		_buffers <- #[]
+		waitingOut <- false
+		_me <- :eventMask {
+			if: eventMask and (epe in) != 0 {
+				_buffers append: (sock recv: 4096)
+			}
+			if: eventMask and (epe out) != 0 && (_buffers length) > 0 {
+				buf <- _buffers join: ""
+				_buffers <- #[]
+				sent <- sock send: buf
+				if: sent < (buf byte_length) {
+					_buffers append: (buf from: sent)
+				}
+			}
+			if: (_buffers length) > 0 {
+				if: (not: waitingOut) {
+					waitingOut <- true
+					ep modifyFD: (sock fd) setMask: (epe in) or (epe out) data: _me
+				}
+			} else: {
+				if: waitingOut {
+					waitingOut <- false
+					ep modifyFD: (sock fd) setMask: (epe in) data: _me
+				}
+			}
+			//TODO: Handle connection close/error
+		}
+		_me
+	}
+	
+	main <- :args {
+		port <- "2323"
+		if: (args length) > 1 {
+			port <- args get: 1
+		}
+		(socket listenOnPort: port) value: :lsock {
+			print: "Listening on port " . port . "\n"
+			
+			epe <- epoll events
+			(epoll create) value: :ep {
+				ep addFD: (lsock fd) withMask: (epe in) data: (acceptHandler: lsock ep)
+				while: { continue? } do: {
+					(ep wait: -1 maxEvents: 16) value: :events {
+						foreach: events :idx ev {
+							handler <- ev data
+							handler: (ev event)
+						}
+					} none: {
+						print: "Failed to wait for events\n"
+						continue? <- false
+					}
+				}
+			} none: {
+				print: "Failed to create epoll file descriptor"
+			}
+		} none: {
+			print: "Failed to listen on port " . port . "\n"
+		}
+	}
+}
\ No newline at end of file