diff modules/epoll.tp @ 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
children
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