Mercurial > repos > tabletprog

changeset 377:93c28eee141e default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge
author Michael Pavone <pavone@retrodev.com>
date Sat, 15 Aug 2015 22:45:33 -0700
parents d61b1f0e1936 (diff) 0673ccbc7379 (current diff)
children
files modules/array.tp
diffstat 8 files changed, 416 insertions(+), 6 deletions(-) [+]
line wrap: on
line diff
--- a/.hgignore	Sun Aug 09 20:00:08 2015 -0700
+++ b/.hgignore	Sat Aug 15 22:45:33 2015 -0700
@@ -1,3 +1,7 @@
 syntax: glob
 
 *.tp.c
+
+syntax: regexp
+^samples/[^.]*$
+^modules/[^.]*$
--- a/cbackend.js	Sun Aug 09 20:00:08 2015 -0700
+++ b/cbackend.js	Sat Aug 15 22:45:33 2015 -0700
@@ -127,6 +127,11 @@
 		symbols = symbols.parent;
 		info = symbols.find(name, false, true);
 	}
+	if (info && info.type == 'parent') {
+		//parent reference are not currently supported in the LL dialect
+		//but parent might refer to a module
+		info = toplevel.find(name);
+	}
 	if (!info) {
 		return this.cSafeName();
 	}
@@ -405,6 +410,8 @@
 		throw new Error('while:do not allowed in expression context in llMessage block');
 	case 'addr_of':
 		return '(&(' + args[0].toCLLExpr(vars) + '))';
+	case 'struct':
+		return 'struct ' + args[0].toCTypeName();
 	case 'sizeof':
 		return 'sizeof(' + args[0].toCTypeName() + ')';
 	case 'get':
--- a/modules/array.tp	Sun Aug 09 20:00:08 2015 -0700
+++ b/modules/array.tp	Sat Aug 15 22:45:33 2015 -0700
@@ -81,6 +81,23 @@
 		}
 		self
 	}
+	
+	llMessage: reverse withVars: {
+		front <- int32_t
+		back <- int32_t
+		tmpo <- object ptr
+	} andCode: {
+		front <- 0
+		back <- size
+		while: { front < back } do: {
+			tmpo <- data get: front
+			data set: front (data get: back)
+			data set: back tmpo
+			front <- front + 1
+			back <- back - 1
+		}
+		self
+	}
 
 	llMessage: length withVars: {
 		intret <- obj_int32 ptr
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/modules/epoll.tp	Sat Aug 15 22:45:33 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
--- a/modules/socket.tp	Sun Aug 09 20:00:08 2015 -0700
+++ b/modules/socket.tp	Sat Aug 15 22:45:33 2015 -0700
@@ -41,9 +41,8 @@
 		fd num!: (socket: (domain num) (type num) (protocol num))
 		fd
 	}
-
-	new <- :domain type protocol {
-		sfd <- socket: domain type protocol
+	
+	_sock_obj <- :sfd {
 		#{
 			fd <- {sfd}
 
@@ -113,6 +112,41 @@
 			}
 		}
 	}
+	
+	_accept_sock <- :domain type protocol {
+		sfd <- socket: domain type protocol
+		#{
+			fd <- {sfd}
+
+			llMessage: close withVars: {
+				sfd <- obj_int32 ptr
+			} andCode: {
+				sfd <- mcall: fd 1 self
+				close: (sfd num)
+				self
+			}
+			
+			llMessage: accept withVars: {
+				sfd <- obj_int32 ptr
+				newfd <- obj_int32 ptr
+			} andCode: {
+				sfd <- mcall: fd 1 self
+				newfd <- make_object: (addr_of: obj_int32_meta) NULL 0
+				//TODO: expose peer address
+				newfd num!: (accept: (sfd num) NULL NULL)
+				if: (newfd num) >= 0 {
+					mcall: value 2 option (mcall: _sock_obj 2 socket newfd)
+				} else: {
+					mcall: none 1 option
+				}
+			}
+		}
+	}
+
+	new <- :domain type protocol {
+		sfd <- socket: domain type protocol
+		_sock_obj: sfd
+	}
 
 	llMessage: _connectTo:onPort withVars: {
 		host <- string ptr
@@ -145,12 +179,78 @@
 		freeaddrinfo: info
 		sock
 	}
+	
 
 	connectTo:onPort <- :host :port {
 		_connectTo: host onPort: (string: port)
 	}
-	listenOn <- :port {
+	llMessage: listenAt:onPort withVars: {
+		ohost <- object ptr
+		host <- string ptr
+		oport <- object ptr
+		port <- string ptr
+		hints <- struct: addrinfo
+		info <- (struct: addrinfo) ptr
+		curinfo <- (struct: addrinfo) ptr
+		domain <- obj_int32 ptr
+		type <- obj_int32 ptr
+		protocol <- obj_int32 ptr
+		sock <- object ptr
+		sfd <- obj_int32 ptr
+		result <- int32_t
+		hstr <- uint8_t ptr
+	} andCode: :ohost :oport {
+		host <- (mcall: string 1 ohost) castTo: (string ptr)
+		port <- (mcall: string 1 oport) castTo: (string ptr)
+		memset: (addr_of: hints) 0 (sizeof: hints)
+		hints ai_family!: AF_UNSPEC
+		hints ai_socktype!: SOCK_STREAM
+		hints ai_flags!: AI_PASSIVE
+		hints ai_protocol!: 0
+		hints ai_canonname!: NULL
+		hints ai_addr!: NULL
+		hints ai_next!: NULL
+		result <- getaddrinfo
+		if: (host bytes) = 0 {
+			hstr <- NULL
+		} else: {
+			hstr <- host data
+		}
+		result <- getaddrinfo: hstr (port data) (addr_of: hints) (addr_of: info)
+		if: result = 0 {
+			curinfo <- info
+			domain <- make_object: (addr_of: obj_int32_meta) NULL 0
+			type <- make_object: (addr_of: obj_int32_meta) NULL 0
+			protocol <- make_object: (addr_of: obj_int32_meta) NULL 0
+			while: { curinfo != NULL } do: {
+				domain num!: (curinfo ai_family)
+				type num!: (curinfo ai_socktype)
+				protocol num!: (curinfo ai_protocol)
+				sock <- mcall: _accept_sock 4 self domain type protocol
+				sfd <- (mcall: fd 1 sock) castTo: (obj_int32 ptr)
+				if: (sfd num) != -1 {
+					result <- bind: (sfd num) (curinfo ai_addr) (curinfo ai_addrlen)
+					if: result = 0 {
+						curinfo <- NULL
+					} else: {
+						//failed to bind, close this socket so we can try again
+						close: (sfd num)
+						sock <- NULL
+					}
+				}
+			}
+			if: sock {
+				listen: (sfd num) 8
+				mcall: value 2 option sock
+			} else: {
+				mcall: none 1 option
+			}
+		} else: {
+			mcall: none 1 option
+		}
 	}
-	listenAt:onPort <- :host :port {
+	
+	listenOnPort <- :port {
+		listenAt: "" onPort: port
 	}
 }
--- a/modules/ui.tp	Sun Aug 09 20:00:08 2015 -0700
+++ b/modules/ui.tp	Sat Aug 15 22:45:33 2015 -0700
@@ -232,6 +232,7 @@
                     if: (_checkInitSDL: ) {
                         _wind <- sdl createWindow: title pos: x y size: width height flags: 0u32
                         _wind value: :window {
+							_visibleWindows <- self | _visibleWindows
                             _renderer <- window createRenderer: -1 flags: ((window renderOpts) accelerated)
 							layout:
                             draw:
@@ -407,7 +408,12 @@
 					_handlers ifget: (event type) :handler {
 						handler: event
 					} else: {
-						print: "Unhandled event type: " . (event type) . "\n"
+						
+						if: (event type) = ((sdl eventTypes) mouseMotion) {
+							print: "Window ID: " . (event windowID) . ", x: " . (event x) . ", y: " . (event y) . "\n"
+						} else: {
+							print: "Unhandled event type: " . (event type) . "\n"
+						}
 					}
 				} none: {}
             }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/samples/echo.tp	Sat Aug 15 22:45:33 2015 -0700
@@ -0,0 +1,33 @@
+#{
+	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"
+	}
+	
+	main <- :args {
+		port <- "2323"
+		if: (args length) > 1 {
+			port <- args get: 1
+		}
+		(socket listenOnPort: port) value: :lsock {
+			print: "Listening on port " . port . "\n"
+			continue? <- true
+			while: { continue? } do: {
+				(lsock accept) value: :csock {
+					echo: csock
+				} none: {
+					print: "Failed to accept new connection\n"
+					continue? <- false
+				}
+			}
+		} none: {
+			print: "Failed to listen on port " . port . "\n"
+		}
+		
+	}
+}
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/samples/epoll.tp	Sat Aug 15 22:45:33 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