altos: Add lisp reader

9 files changed, 792 insertions, 153 deletions

diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
new file mode 100644
index 00000000..6667dcc2
--- /dev/null
+++ b/src/lisp/ao_lisp.h
@@ -0,0 +1,242 @@
+/*
+ * Copyright © 2016 Keith Packard <keithp@keithp.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ */
+
+#ifndef _AO_LISP_H_
+#define _AO_LISP_H_
+
+#include <stdint.h>
+#include <string.h>
+#include <stdio.h>
+
+
+# define AO_LISP_CONS	0
+# define AO_LISP_INT	1
+# define AO_LISP_STRING	2
+# define AO_LISP_OTHER	3
+
+# define AO_LISP_ATOM		4
+# define AO_LISP_BUILTIN	5
+
+# define AO_LISP_NIL	0
+
+#define AO_LISP_POOL	1024
+#define AO_LISP_ROOT	16
+
+static inline void *ao_lisp_set_ref(void *addr) {
+	return (void *) ((intptr_t)addr | 1);
+}
+
+static inline void *ao_lisp_clear_ref(void *addr) {
+	return (void *) ((intptr_t)addr & ~1);
+}
+
+extern uint8_t	ao_lisp_pool[AO_LISP_POOL];
+
+struct ao_lisp_mem_type {
+	void	(*mark)(void *addr);
+	int	(*size)(void *addr);
+	void	(*move)(void *addr);
+};
+
+typedef intptr_t	ao_lisp_poly;
+
+struct ao_lisp_cons {
+	ao_lisp_poly		car;
+	struct ao_lisp_cons	*cdr;
+};
+
+struct ao_lisp_atom {
+	uint8_t			type;
+	ao_lisp_poly		val;
+	struct ao_lisp_atom	*next;
+	char			name[];
+};
+
+#define AO_LISP_ATOM_CONST	((struct ao_lisp_atom *) (intptr_t) 1)
+
+extern const struct ao_lisp_atom *ao_lisp_builtins[];
+
+struct ao_lisp_builtin {
+	uint8_t			type;
+	ao_lisp_poly		(*func)(struct ao_lisp_cons *cons);
+	char			name[];
+};
+
+static inline void *
+ao_lisp_poly_other(ao_lisp_poly poly) {
+	return (void *) (poly - AO_LISP_OTHER);
+}
+
+static const inline ao_lisp_poly
+ao_lisp_other_poly(const void *other)
+{
+	return (ao_lisp_poly) other + AO_LISP_OTHER;
+}
+
+#define AO_LISP_OTHER_POLY(other) ((ao_lisp_poly)(other) + AO_LISP_OTHER)
+
+static inline int ao_lisp_poly_type(ao_lisp_poly poly) {
+	int	type = poly & 3;
+	if (type == AO_LISP_OTHER)
+		return *((uint8_t *) ao_lisp_poly_other(poly));
+	return type;
+}
+
+static inline struct ao_lisp_cons *
+ao_lisp_poly_cons(ao_lisp_poly poly)
+{
+	return (struct ao_lisp_cons *) (poly - AO_LISP_CONS);
+}
+
+static inline ao_lisp_poly
+ao_lisp_cons_poly(struct ao_lisp_cons *cons)
+{
+	return (ao_lisp_poly) cons + AO_LISP_CONS;
+}
+
+static inline int
+ao_lisp_poly_int(ao_lisp_poly poly)
+{
+	return (int) (poly >> 2);
+}
+
+static inline ao_lisp_poly
+ao_lisp_int_poly(int i)
+{
+	return ((ao_lisp_poly) i << 2) + AO_LISP_INT;
+}
+
+static inline char *
+ao_lisp_poly_string(ao_lisp_poly poly)
+{
+	return (char *) (poly - AO_LISP_STRING);
+}
+
+static inline ao_lisp_poly
+ao_lisp_string_poly(char *s) {
+	return (ao_lisp_poly) s + AO_LISP_STRING;
+}
+
+static inline struct ao_lisp_atom *
+ao_lisp_poly_atom(ao_lisp_poly poly)
+{
+	return (struct ao_lisp_atom *) (poly - AO_LISP_OTHER);
+}
+
+static inline ao_lisp_poly
+ao_lisp_atom_poly(struct ao_lisp_atom *a)
+{
+	return (ao_lisp_poly) a + AO_LISP_OTHER;
+}
+
+static inline struct ao_lisp_builtin *
+ao_lisp_poly_builtin(ao_lisp_poly poly)
+{
+	return (struct ao_lisp_builtin *) (poly - AO_LISP_OTHER);
+}
+
+static inline ao_lisp_poly
+ao_lisp_builtin_poly(struct ao_lisp_builtin *b)
+{
+	return (ao_lisp_poly) b + AO_LISP_OTHER;
+}
+
+/* memory functions */
+
+void
+ao_lisp_mark(const struct ao_lisp_mem_type *type, void *addr);
+
+/* returns 1 if the object was already marked */
+int
+ao_lisp_mark_memory(void *addr, int size);
+
+void *
+ao_lisp_move(const struct ao_lisp_mem_type *type, void *addr);
+
+/* returns NULL if the object was already moved */
+void *
+ao_lisp_move_memory(void *addr, int size);
+
+void *
+ao_lisp_alloc(int size);
+
+int
+ao_lisp_root_add(const struct ao_lisp_mem_type *type, void *addr);
+
+void
+ao_lisp_root_clear(void *addr);
+
+/* cons */
+extern const struct ao_lisp_mem_type ao_lisp_cons_type;
+
+struct ao_lisp_cons *
+ao_lisp_cons(ao_lisp_poly car, struct ao_lisp_cons *cdr);
+
+void
+ao_lisp_cons_print(struct ao_lisp_cons *cons);
+
+/* string */
+extern const struct ao_lisp_mem_type ao_lisp_string_type;
+
+char *
+ao_lisp_string_new(int len);
+
+char *
+ao_lisp_string_copy(char *a);
+
+char *
+ao_lisp_string_cat(char *a, char *b);
+
+void
+ao_lisp_string_print(char *s);
+
+/* atom */
+extern const struct ao_lisp_mem_type ao_lisp_atom_type;
+
+void
+ao_lisp_atom_init(void);
+
+void
+ao_lisp_atom_print(struct ao_lisp_atom *atom);
+
+struct ao_lisp_atom *
+ao_lisp_atom_intern(char *name);
+
+/* int */
+void
+ao_lisp_int_print(int i);
+
+/* prim */
+ao_lisp_poly
+ao_lisp_poly_print(ao_lisp_poly p);
+
+void
+ao_lisp_poly_mark(ao_lisp_poly p);
+
+ao_lisp_poly
+ao_lisp_poly_move(ao_lisp_poly p);
+
+/* eval */
+ao_lisp_poly
+ao_lisp_eval(ao_lisp_poly p);
+
+/* builtin */
+void
+ao_lisp_builtin_print(struct ao_lisp_builtin *b);
+
+/* read */
+ao_lisp_poly
+ao_lisp_read(void);
+
+#endif /* _AO_LISP_H_ */
diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c
index 531e3b72..23908e64 100644
--- a/src/lisp/ao_lisp_eval.c
+++ b/src/lisp/ao_lisp_eval.c
@@ -30,6 +30,16 @@ static struct ao_lisp_cons	*formals;
 static struct ao_lisp_cons	*formals_tail;
 static uint8_t been_here;
 
+#if 0
+#define DBG(...) printf(__VA_ARGS__)
+#define DBG_CONS(a)	ao_lisp_cons_print(a)
+#define DBG_POLY(a)	ao_lisp_poly_print(a)
+#else
+#define DBG(...)
+#define DBG_CONS(a)
+#define DBG_POLY(a)
+#endif
+
 ao_lisp_poly
 ao_lisp_eval(ao_lisp_poly v)
 {
@@ -66,9 +76,9 @@ ao_lisp_eval(ao_lisp_poly v)
 			formals_tail = NULL;
 			v = actuals->car;
 
-			printf("start: stack"); ao_lisp_cons_print(stack); printf("\n");
-			printf("start: actuals"); ao_lisp_cons_print(actuals); printf("\n");
-			printf("start: formals"); ao_lisp_cons_print(formals); printf("\n");
+			DBG("start: stack"); DBG_CONS(stack); DBG("\n");
+			DBG("start: actuals"); DBG_CONS(actuals); DBG("\n");
+			DBG("start: formals"); DBG_CONS(formals); DBG("\n");
 		}
 
 		/* Evaluate primitive types */
@@ -83,7 +93,7 @@ ao_lisp_eval(ao_lisp_poly v)
 		}
 
 		for (;;) {
-			printf("add formal: "); ao_lisp_poly_print(v); printf("\n");
+			DBG("add formal: "); DBG_POLY(v); DBG("\n");
 
 			formal = ao_lisp_cons(v, NULL);
 			if (formals_tail)
@@ -93,17 +103,17 @@ ao_lisp_eval(ao_lisp_poly v)
 			formals_tail = formal;
 			actuals = actuals->cdr;
 
-			printf("formals: ");
-			ao_lisp_cons_print(formals);
-			printf("\n");
-			printf("actuals: ");
-			ao_lisp_cons_print(actuals);
-			printf("\n");
+			DBG("formals: ");
+			DBG_CONS(formals);
+			DBG("\n");
+			DBG("actuals: ");
+			DBG_CONS(actuals);
+			DBG("\n");
 
 			/* Process all of the arguments */
 			if (actuals) {
 				v = actuals->car;
-				printf ("actual: "); ao_lisp_poly_print(v); printf("\n");
+				DBG ("actual: "); DBG_POLY(v); DBG("\n");
 				break;
 			}
 
@@ -115,13 +125,13 @@ ao_lisp_eval(ao_lisp_poly v)
 
 				v = b->func(formals->cdr);
 
-				printf ("eval: ");
-				ao_lisp_cons_print(formals);
-				printf(" -> ");
-				ao_lisp_poly_print(v);
-				printf ("\n");
+				DBG ("eval: ");
+				DBG_CONS(formals);
+				DBG(" -> ");
+				DBG_POLY(v);
+				DBG ("\n");
 			} else {
-				printf ("invalid eval\n");
+				DBG ("invalid eval\n");
 			}
 
 			if (--cons) {
@@ -137,11 +147,11 @@ ao_lisp_eval(ao_lisp_poly v)
 				formals_tail = formal;
 
 				stack = stack->cdr;
-				printf("stack pop: stack"); ao_lisp_cons_print(stack); printf("\n");
-				printf("stack pop: actuals"); ao_lisp_cons_print(actuals); printf("\n");
-				printf("stack pop: formals"); ao_lisp_cons_print(formals); printf("\n");
+				DBG("stack pop: stack"); DBG_CONS(stack); DBG("\n");
+				DBG("stack pop: actuals"); DBG_CONS(actuals); DBG("\n");
+				DBG("stack pop: formals"); DBG_CONS(formals); DBG("\n");
 			} else {
-				printf("done func\n");
+				DBG("done func\n");
 				break;
 			}
 		}
diff --git a/src/lisp/ao_lisp_lex.c b/src/lisp/ao_lisp_lex.c
index d62db872..fe7c47f4 100644
--- a/src/lisp/ao_lisp_lex.c
+++ b/src/lisp/ao_lisp_lex.c
@@ -14,133 +14,3 @@
 
 #include "ao_lisp.h"
 
-const uint32_t	classTable[256] = {
-	IGNORE,		/* ^@ */
-	IGNORE,		/* ^A */
-	IGNORE,		/* ^B */
-	IGNORE,		/* ^C */
-	IGNORE,		/* ^D */
-	IGNORE,		/* ^E */
-	IGNORE,		/* ^F */
-	IGNORE,		/* ^G */
-	IGNORE,		/* ^H */
-	WHITE,		/* ^I */
-	WHITE,		/* ^J */
-	WHITE,		/* ^K */
-	WHITE,		/* ^L */
-	WHITE,		/* ^M */
-	IGNORE,		/* ^N */
-	IGNORE,		/* ^O */
-	IGNORE,		/* ^P */
-	IGNORE,		/* ^Q */
-	IGNORE,		/* ^R */
-	IGNORE,		/* ^S */
-	IGNORE,		/* ^T */
-	IGNORE,		/* ^U */
-	IGNORE,		/* ^V */
-	IGNORE,		/* ^W */
-	IGNORE,		/* ^X */
-	IGNORE,		/* ^Y */
-	IGNORE,		/* ^Z */
-	IGNORE,		/* ^[ */
-	IGNORE,		/* ^\ */
-	IGNORE,		/* ^] */
-	IGNORE,		/* ^^ */
-	IGNORE,		/* ^_ */
-	PRINTABLE|WHITE,	/*    */
- 	PRINTABLE,		/* ! */
- 	PRINTABLE|STRINGC,	/* " */
- 	PRINTABLE|COMMENT,	/* # */
- 	PRINTABLE,		/* $ */
- 	PRINTABLE,		/* % */
- 	PRINTABLE,		/* & */
- 	PRINTABLE|QUOTEC,	/* ' */
- 	PRINTABLE|BRA,		/* ( */
- 	PRINTABLE|KET,		/* ) */
- 	PRINTABLE,		/* * */
- 	PRINTABLE|SIGN,		/* + */
- 	PRINTABLE,		/* , */
- 	PRINTABLE|SIGN,		/* - */
- 	PRINTABLE|DOT,		/* . */
- 	PRINTABLE,		/* / */
- 	PRINTABLE|DIGIT,	/* 0 */
- 	PRINTABLE|DIGIT,	/* 1 */
- 	PRINTABLE|DIGIT,	/* 2 */
- 	PRINTABLE|DIGIT,	/* 3 */
- 	PRINTABLE|DIGIT,	/* 4 */
- 	PRINTABLE|DIGIT,	/* 5 */
- 	PRINTABLE|DIGIT,	/* 6 */
- 	PRINTABLE|DIGIT,	/* 7 */
- 	PRINTABLE|DIGIT,	/* 8 */
- 	PRINTABLE|DIGIT,	/* 9 */
- 	PRINTABLE,		/* : */
- 	PRINTABLE|COMMENT,	/* ; */
- 	PRINTABLE,		/* < */
- 	PRINTABLE,		/* = */
- 	PRINTABLE,		/* > */
- 	PRINTABLE,		/* ? */
-  	PRINTABLE,		/*  @ */
-	PRINTABLE,		/*  A */
-	PRINTABLE,		/*  B */
-	PRINTABLE,		/*  C */
-	PRINTABLE,		/*  D */
-	PRINTABLE|EXP,		/*  E */
-	PRINTABLE,		/*  F */
-	PRINTABLE,		/*  G */
-	PRINTABLE,		/*  H */
-	PRINTABLE,		/*  I */
-	PRINTABLE,		/*  J */
-	PRINTABLE,		/*  K */
-	PRINTABLE,		/*  L */
-	PRINTABLE,		/*  M */
-	PRINTABLE,		/*  N */
-	PRINTABLE,		/*  O */
-	PRINTABLE,		/*  P */
-	PRINTABLE,		/*  Q */
-	PRINTABLE,		/*  R */
-	PRINTABLE,		/*  S */
-	PRINTABLE,		/*  T */
-	PRINTABLE,		/*  U */
-	PRINTABLE,		/*  V */
-	PRINTABLE,		/*  W */
-	PRINTABLE,		/*  X */
-	PRINTABLE,		/*  Y */
-	PRINTABLE,		/*  Z */
-	PRINTABLE|BRA,		/*  [ */
-	PRINTABLE|BACKSLASH,	/*  \ */
-	PRINTABLE|KET,		/*  ] */
-	PRINTABLE,		/*  ^ */
-	PRINTABLE,		/*  _ */
-  	PRINTABLE,		/*  ` */
-	PRINTABLE,		/*  a */
-	PRINTABLE,		/*  b */
-	PRINTABLE,		/*  c */
-	PRINTABLE,		/*  d */
-	PRINTABLE|EXP,		/*  e */
-	PRINTABLE,		/*  f */
-	PRINTABLE,		/*  g */
-	PRINTABLE,		/*  h */
-	PRINTABLE,		/*  i */
-	PRINTABLE,		/*  j */
-	PRINTABLE,		/*  k */
-	PRINTABLE,		/*  l */
-	PRINTABLE,		/*  m */
-	PRINTABLE,		/*  n */
-	PRINTABLE,		/*  o */
-	PRINTABLE,		/*  p */
-	PRINTABLE,		/*  q */
-	PRINTABLE,		/*  r */
-	PRINTABLE,		/*  s */
-	PRINTABLE,		/*  t */
-	PRINTABLE,		/*  u */
-	PRINTABLE,		/*  v */
-	PRINTABLE,		/*  w */
-	PRINTABLE,		/*  x */
-	PRINTABLE,		/*  y */
-	PRINTABLE,		/*  z */
-	PRINTABLE|BRA,		/*  { */
-	PRINTABLE|VBAR,		/*  | */
-	PRINTABLE|KET,		/*  } */
-	PRINTABLE|TWIDDLE,	/*  ~ */
-	IGNORE,			/*  ^? */
-};
diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c
index f6a108e9..d008519b 100644
--- a/src/lisp/ao_lisp_mem.c
+++ b/src/lisp/ao_lisp_mem.c
@@ -120,7 +120,6 @@ collect(void)
 {
 	int	i;
 
-	printf("collect\n");
 	/* Mark */
 	memset(ao_lisp_busy, '\0', sizeof (ao_lisp_busy));
 	for (i = 0; i < AO_LISP_ROOT; i++)
diff --git a/src/lisp/ao_lisp_read.c b/src/lisp/ao_lisp_read.c
new file mode 100644
index 00000000..ccb4ba3a
--- /dev/null
+++ b/src/lisp/ao_lisp_read.c
@@ -0,0 +1,448 @@
+/*
+ * Copyright © 2016 Keith Packard <keithp@keithp.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ */
+
+#include "ao_lisp.h"
+#include "ao_lisp_read.h"
+
+static const uint16_t	lex_classes[128] = {
+	IGNORE,		/* ^@ */
+	IGNORE,		/* ^A */
+	IGNORE,		/* ^B */
+	IGNORE,		/* ^C */
+	IGNORE,		/* ^D */
+	IGNORE,		/* ^E */
+	IGNORE,		/* ^F */
+	IGNORE,		/* ^G */
+	IGNORE,		/* ^H */
+	WHITE,		/* ^I */
+	WHITE,		/* ^J */
+	WHITE,		/* ^K */
+	WHITE,		/* ^L */
+	WHITE,		/* ^M */
+	IGNORE,		/* ^N */
+	IGNORE,		/* ^O */
+	IGNORE,		/* ^P */
+	IGNORE,		/* ^Q */
+	IGNORE,		/* ^R */
+	IGNORE,		/* ^S */
+	IGNORE,		/* ^T */
+	IGNORE,		/* ^U */
+	IGNORE,		/* ^V */
+	IGNORE,		/* ^W */
+	IGNORE,		/* ^X */
+	IGNORE,		/* ^Y */
+	IGNORE,		/* ^Z */
+	IGNORE,		/* ^[ */
+	IGNORE,		/* ^\ */
+	IGNORE,		/* ^] */
+	IGNORE,		/* ^^ */
+	IGNORE,		/* ^_ */
+	PRINTABLE|WHITE,	/*    */
+ 	PRINTABLE,		/* ! */
+ 	PRINTABLE|STRINGC,	/* " */
+ 	PRINTABLE|COMMENT,	/* # */
+ 	PRINTABLE,		/* $ */
+ 	PRINTABLE,		/* % */
+ 	PRINTABLE,		/* & */
+ 	PRINTABLE|QUOTEC,	/* ' */
+ 	PRINTABLE|BRA,		/* ( */
+ 	PRINTABLE|KET,		/* ) */
+ 	PRINTABLE,		/* * */
+ 	PRINTABLE|SIGN,		/* + */
+ 	PRINTABLE,		/* , */
+ 	PRINTABLE|SIGN,		/* - */
+ 	PRINTABLE,		/* . */
+ 	PRINTABLE,		/* / */
+ 	PRINTABLE|DIGIT,	/* 0 */
+ 	PRINTABLE|DIGIT,	/* 1 */
+ 	PRINTABLE|DIGIT,	/* 2 */
+ 	PRINTABLE|DIGIT,	/* 3 */
+ 	PRINTABLE|DIGIT,	/* 4 */
+ 	PRINTABLE|DIGIT,	/* 5 */
+ 	PRINTABLE|DIGIT,	/* 6 */
+ 	PRINTABLE|DIGIT,	/* 7 */
+ 	PRINTABLE|DIGIT,	/* 8 */
+ 	PRINTABLE|DIGIT,	/* 9 */
+ 	PRINTABLE,		/* : */
+ 	PRINTABLE|COMMENT,	/* ; */
+ 	PRINTABLE,		/* < */
+ 	PRINTABLE,		/* = */
+ 	PRINTABLE,		/* > */
+ 	PRINTABLE,		/* ? */
+  	PRINTABLE,		/*  @ */
+	PRINTABLE,		/*  A */
+	PRINTABLE,		/*  B */
+	PRINTABLE,		/*  C */
+	PRINTABLE,		/*  D */
+	PRINTABLE,		/*  E */
+	PRINTABLE,		/*  F */
+	PRINTABLE,		/*  G */
+	PRINTABLE,		/*  H */
+	PRINTABLE,		/*  I */
+	PRINTABLE,		/*  J */
+	PRINTABLE,		/*  K */
+	PRINTABLE,		/*  L */
+	PRINTABLE,		/*  M */
+	PRINTABLE,		/*  N */
+	PRINTABLE,		/*  O */
+	PRINTABLE,		/*  P */
+	PRINTABLE,		/*  Q */
+	PRINTABLE,		/*  R */
+	PRINTABLE,		/*  S */
+	PRINTABLE,		/*  T */
+	PRINTABLE,		/*  U */
+	PRINTABLE,		/*  V */
+	PRINTABLE,		/*  W */
+	PRINTABLE,		/*  X */
+	PRINTABLE,		/*  Y */
+	PRINTABLE,		/*  Z */
+	PRINTABLE,		/*  [ */
+	PRINTABLE|BACKSLASH,	/*  \ */
+	PRINTABLE,		/*  ] */
+	PRINTABLE,		/*  ^ */
+	PRINTABLE,		/*  _ */
+  	PRINTABLE,		/*  ` */
+	PRINTABLE,		/*  a */
+	PRINTABLE,		/*  b */
+	PRINTABLE,		/*  c */
+	PRINTABLE,		/*  d */
+	PRINTABLE,		/*  e */
+	PRINTABLE,		/*  f */
+	PRINTABLE,		/*  g */
+	PRINTABLE,		/*  h */
+	PRINTABLE,		/*  i */
+	PRINTABLE,		/*  j */
+	PRINTABLE,		/*  k */
+	PRINTABLE,		/*  l */
+	PRINTABLE,		/*  m */
+	PRINTABLE,		/*  n */
+	PRINTABLE,		/*  o */
+	PRINTABLE,		/*  p */
+	PRINTABLE,		/*  q */
+	PRINTABLE,		/*  r */
+	PRINTABLE,		/*  s */
+	PRINTABLE,		/*  t */
+	PRINTABLE,		/*  u */
+	PRINTABLE,		/*  v */
+	PRINTABLE,		/*  w */
+	PRINTABLE,		/*  x */
+	PRINTABLE,		/*  y */
+	PRINTABLE,		/*  z */
+	PRINTABLE,		/*  { */
+	PRINTABLE|VBAR,		/*  | */
+	PRINTABLE,		/*  } */
+	PRINTABLE|TWIDDLE,	/*  ~ */
+	IGNORE,			/*  ^? */
+};
+
+static int lex_unget_c;
+
+static inline int
+lex_get()
+{
+	int	c;
+	if (lex_unget_c) {
+		c = lex_unget_c;
+		lex_unget_c = 0;
+	} else
+		c = getchar();
+	return c;
+}
+
+static inline void
+lex_unget(int c)
+{
+	if (c != EOF)
+		lex_unget_c = c;
+}
+
+static int
+lex_quoted (void)
+{
+	int	c;
+	int	v;
+	int	count;
+
+	c = lex_get();
+//	if (jumping)
+//		return nil;
+	if (c == EOF)
+		return EOF;
+	c &= 0x7f;
+ 	switch (c) {
+	case 'n':
+		return '\n';
+	case 'f':
+		return '\f';
+	case 'b':
+		return '\b';
+	case 'r':
+		return '\r';
+	case 'v':
+		return '\v';
+	case 't':
+		return '\t';
+	case '0':
+	case '1':
+	case '2':
+	case '3':
+	case '4':
+	case '5':
+	case '6':
+	case '7':
+		v = c - '0';
+		count = 1;
+		while (count <= 3) {
+			c = lex_get();
+//			if (jumping)
+//				return nil;
+			if (c == EOF)
+				return EOF;
+			c &= 0x7f;
+			if (c < '0' || '7' < c) {
+				lex_unget(c);
+				break;
+			}
+			v = (v << 3) + c - '0';
+			++count;
+		}
+		return v;
+	default:
+		return c;
+	}
+}
+
+static uint16_t	lex_class;
+
+static int
+lexc(void)
+{
+	int	c;
+	do {
+		c = lex_get();
+		if (c == EOF) {
+			lex_class = ENDOFFILE;
+			c = 0;
+		} else {
+			c &= 0x7f;
+			lex_class = lex_classes[c];
+			if (lex_class & BACKSLASH) {
+				c = lex_quoted();
+				if (c == EOF)
+					lex_class = ENDOFFILE;
+				else
+					lex_class = PRINTABLE;
+			}
+		}
+	} while (lex_class & IGNORE);
+	return c;
+}
+
+#define AO_LISP_TOKEN_MAX	32
+
+static char	token_string[AO_LISP_TOKEN_MAX];
+static int	token_int;
+static int	token_len;
+
+static inline void add_token(int c) {
+	if (c && token_len < AO_LISP_TOKEN_MAX - 1)
+		token_string[token_len++] = c;
+}
+
+static inline void end_token(void) {
+	token_string[token_len] = '\0';
+}
+
+static int
+lex(void)
+{
+	int	c;
+
+	token_len = 0;
+	for (;;) {
+		c = lexc();
+		if (lex_class & ENDOFFILE)
+			return AO_LISP_NIL;
+
+//		if (jumping)
+//			return nil;
+		if (lex_class & WHITE)
+			continue;
+
+		if (lex_class & (BRA|KET|QUOTEC)) {
+			add_token(c);
+			end_token();
+			switch (c) {
+			case '(':
+				return OPEN;
+			case ')':
+				return CLOSE;
+			case '\'':
+				return QUOTE;
+			}
+		}
+		if (lex_class & TWIDDLE) {
+			token_int = lexc();
+			return NUM;
+		}
+		if (lex_class & STRINGC) {
+			for (;;) {
+				c = lexc();
+//				if (jumping)
+//					return nil;
+				if (lex_class & (STRINGC|ENDOFFILE)) {
+					end_token();
+					return STRING;
+				}
+				add_token(c);
+			}
+		}
+		if (lex_class & PRINTABLE) {
+			int	isnum;
+			int	hasdigit;
+			int	isneg;
+
+			isnum = 1;
+			hasdigit = 0;
+			token_int = 0;
+			isneg = 0;
+			for (;;) {
+				if (!(lex_class & NUMBER)) {
+					isnum = 0;
+				} else {
+ 					if (token_len != 0 &&
+					    (lex_class & SIGN))
+					{
+						isnum = 0;
+					}
+					if (c == '-')
+						isneg = 1;
+					if (lex_class & DIGIT) {
+						hasdigit = 1;
+						if (isnum)
+							token_int = token_int * 10 + c - '0';
+					}
+				}
+				add_token (c);
+				c = lexc ();
+//				if (jumping)
+//					return nil;
+				if (lex_class & (NOTNAME)) {
+//					if (lex_class & ENDOFFILE)
+//						clearerr (f);
+					lex_unget(c);
+					end_token ();
+					if (isnum && hasdigit) {
+						if (isneg)
+							token_int = -token_int;
+						return NUM;
+					}
+					return NAME;
+				}
+			}
+
+		}
+	}
+}
+
+static int parse_token;
+static uint8_t			been_here;
+static struct ao_lisp_cons	*read_cons;
+static struct ao_lisp_cons	*read_cons_tail;
+static struct ao_lisp_cons	*read_stack;
+
+static ao_lisp_poly
+read_item(void)
+{
+	struct ao_lisp_atom	*atom;
+	char			*string;
+	int			cons;
+	ao_lisp_poly		v;
+
+	if (!been_here) {
+		ao_lisp_root_add(&ao_lisp_cons_type, &read_cons);
+		ao_lisp_root_add(&ao_lisp_cons_type, &read_cons_tail);
+		ao_lisp_root_add(&ao_lisp_cons_type, &read_stack);
+	}
+
+	cons = 0;
+	read_cons = read_cons_tail = read_stack = 0;
+	for (;;) {
+		while (parse_token == OPEN) {
+			if (cons++)
+				read_stack = ao_lisp_cons(ao_lisp_cons_poly(read_cons), read_stack);
+			read_cons = NULL;
+			read_cons_tail = NULL;
+			parse_token = lex();
+		}
+
+		switch (parse_token) {
+		case ENDOFFILE:
+		default:
+			v = AO_LISP_NIL;
+			break;
+		case NAME:
+			atom = ao_lisp_atom_intern(token_string);
+			if (atom)
+				v = ao_lisp_atom_poly(atom);
+			else
+				v = AO_LISP_NIL;
+			break;
+		case NUM:
+			v = ao_lisp_int_poly(token_int);
+			break;
+		case STRING:
+			string = ao_lisp_string_copy(token_string);
+			if (string)
+				v = ao_lisp_string_poly(string);
+			else
+				v = AO_LISP_NIL;
+			break;
+		case CLOSE:
+			if (cons)
+				v = ao_lisp_cons_poly(read_cons);
+			else
+				v = AO_LISP_NIL;
+			if (--cons) {
+				read_cons = ao_lisp_poly_cons(read_stack->car);
+				read_stack = read_stack->cdr;
+				for (read_cons_tail = read_cons;
+				     read_cons_tail && read_cons_tail->cdr;
+				     read_cons_tail = read_cons_tail->cdr)
+					;
+			}
+			break;
+		}
+
+		if (!cons)
+			break;
+
+		struct ao_lisp_cons	*read = ao_lisp_cons(v, NULL);
+		if (read_cons_tail)
+			read_cons_tail->cdr = read;
+		else
+			read_cons = read;
+		read_cons_tail = read;
+
+		parse_token = lex();
+	}
+	return v;
+}
+
+ao_lisp_poly
+ao_lisp_read(void)
+{
+	parse_token = lex();
+	return read_item();
+}
diff --git a/src/lisp/ao_lisp_read.h b/src/lisp/ao_lisp_read.h
new file mode 100644
index 00000000..1c994d56
--- /dev/null
+++ b/src/lisp/ao_lisp_read.h
@@ -0,0 +1,49 @@
+/*
+ * Copyright © 2016 Keith Packard <keithp@keithp.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * General Public License for more details.
+ */
+
+#ifndef _AO_LISP_READ_H_
+#define _AO_LISP_READ_H_
+
+# define END	0
+# define NAME	1
+# define OPEN  	2
+# define CLOSE	3
+# define QUOTE	4
+# define STRING	5
+# define NUM	6
+
+/*
+ * character classes
+ */
+
+# define PRINTABLE	0x00000001	/* \t \n ' ' - '~' */
+# define QUOTED		0x00000002	/* \ anything */
+# define BRA		0x00000004	/* ( [ { */
+# define KET		0x00000008	/* ) ] } */
+# define WHITE		0x00000010	/* ' ' \t \n */
+# define DIGIT		0x00000020	/* [0-9] */
+# define SIGN		0x00000040	/* +- */
+# define ENDOFFILE	0x00000080	/* end of file */
+# define COMMENT	0x00000100	/* ; # */
+# define IGNORE		0x00000200	/* \0 - ' ' */
+# define QUOTEC		0x00000400	/* ' */
+# define BACKSLASH	0x00000800	/* \ */
+# define VBAR		0x00001000	/* | */
+# define TWIDDLE	0x00002000	/* ~ */
+# define STRINGC	0x00004000	/* " */
+
+# define NOTNAME	(STRINGC|TWIDDLE|VBAR|QUOTEC|COMMENT|ENDOFFILE|WHITE|KET|BRA)
+# define NUMBER		(DIGIT|SIGN)
+
+#endif /* _AO_LISP_READ_H_ */
diff --git a/src/lisp/ao_lisp_string.c b/src/lisp/ao_lisp_string.c
index 87024271..1ab56933 100644
--- a/src/lisp/ao_lisp_string.c
+++ b/src/lisp/ao_lisp_string.c
@@ -44,6 +44,18 @@ ao_lisp_string_new(int len) {
 }
 
 char *
+ao_lisp_string_copy(char *a)
+{
+	int	alen = strlen(a);
+
+	char	*r = ao_lisp_alloc(alen + 1);
+	if (!r)
+		return NULL;
+	strcpy(r, a);
+	return r;
+}
+
+char *
 ao_lisp_string_cat(char *a, char *b)
 {
 	int	alen = strlen(a);
diff --git a/src/test/Makefile b/src/test/Makefile
index a409ae13..e841bfde 100644
--- a/src/test/Makefile
+++ b/src/test/Makefile
@@ -89,7 +89,7 @@ ao_quaternion_test: ao_quaternion_test.c ao_quaternion.h
 	cc $(CFLAGS) -o $@ ao_quaternion_test.c -lm
 
 
-AO_LISP_OBJS = ao_lisp_test.o ao_lisp_mem.o ao_lisp_lex.o ao_lisp_cons.o ao_lisp_string.o ao_lisp_atom.o ao_lisp_int.o ao_lisp_prim.o ao_lisp_eval.o ao_lisp_poly.o ao_lisp_builtin.o
+AO_LISP_OBJS = ao_lisp_test.o ao_lisp_mem.o ao_lisp_lex.o ao_lisp_cons.o ao_lisp_string.o ao_lisp_atom.o ao_lisp_int.o ao_lisp_prim.o ao_lisp_eval.o ao_lisp_poly.o ao_lisp_builtin.o ao_lisp_read.o
 
 ao_lisp_test: $(AO_LISP_OBJS)
 	cc $(CFLAGS) -o $@ $(AO_LISP_OBJS)
diff --git a/src/test/ao_lisp_test.c b/src/test/ao_lisp_test.c
index bbadfa75..96f1fd72 100644
--- a/src/test/ao_lisp_test.c
+++ b/src/test/ao_lisp_test.c
@@ -23,6 +23,7 @@ main (int argc, char **argv)
 {
 	int	i, j;
 	struct ao_lisp_atom	*atom;
+	ao_lisp_poly		poly;
 	ao_lisp_root_add(&ao_lisp_cons_type, (void **) &list);
 	ao_lisp_root_add(&ao_lisp_string_type, (void **) &string);
 
@@ -55,4 +56,12 @@ main (int argc, char **argv)
 	printf ("\n");
 	ao_lisp_poly_print(ao_lisp_eval(ao_lisp_cons_poly(list)));
 	printf ("\n");
+
+	while ((poly = ao_lisp_read())) {
+		poly = ao_lisp_eval(poly);
+		ao_lisp_poly_print(poly);
+		putchar ('\n');
+		fflush(stdout);
+	}
+
 }