altos/lisp: Change lisp objects to use ao_poly everywhere. Add const
authorKeith Packard <keithp@keithp.com>
Wed, 2 Nov 2016 04:14:45 +0000 (21:14 -0700)
committerKeith Packard <keithp@keithp.com>
Mon, 20 Feb 2017 19:16:49 +0000 (11:16 -0800)
This makes all lisp objects use 16-bit ints for references so we can
hold more stuff in small amounts of memory. Also adds a separate
constant pool of lisp objects for builtins, initial atoms and constant
lisp code.

Now builds (and runs!) on the nucleo-32 boards.

Signed-off-by: Keith Packard <keithp@keithp.com>
22 files changed:
src/lisp/.gitignore [new file with mode: 0644]
src/lisp/Makefile [new file with mode: 0644]
src/lisp/ao_lisp.h
src/lisp/ao_lisp_atom.c
src/lisp/ao_lisp_builtin.c
src/lisp/ao_lisp_cons.c
src/lisp/ao_lisp_const.lisp [new file with mode: 0644]
src/lisp/ao_lisp_eval.c
src/lisp/ao_lisp_int.c
src/lisp/ao_lisp_make_const.c [new file with mode: 0644]
src/lisp/ao_lisp_mem.c
src/lisp/ao_lisp_poly.c
src/lisp/ao_lisp_prim.c
src/lisp/ao_lisp_read.c
src/lisp/ao_lisp_rep.c [new file with mode: 0644]
src/lisp/ao_lisp_string.c
src/nucleao-32/.gitignore [new file with mode: 0644]
src/nucleao-32/Makefile
src/nucleao-32/ao_nucleo.c
src/nucleao-32/flash-loader/.gitignore [new file with mode: 0644]
src/test/Makefile
src/test/ao_lisp_test.c

diff --git a/src/lisp/.gitignore b/src/lisp/.gitignore
new file mode 100644 (file)
index 0000000..76a555e
--- /dev/null
@@ -0,0 +1,2 @@
+ao_lisp_make_const
+ao_lisp_const.h
diff --git a/src/lisp/Makefile b/src/lisp/Makefile
new file mode 100644 (file)
index 0000000..e8c3c02
--- /dev/null
@@ -0,0 +1,32 @@
+all: ao_lisp_const.h
+
+clean:
+       rm -f ao_lisp_const.h $(OBJS) ao_lisp_make_const
+
+ao_lisp_const.h: ao_lisp_const.lisp ao_lisp_make_const
+       ./ao_lisp_make_const < ao_lisp_const.lisp > $@
+
+SRCS=\
+       ao_lisp_make_const.c\
+       ao_lisp_mem.c \
+       ao_lisp_cons.c \
+       ao_lisp_string.c \
+       ao_lisp_atom.c \
+       ao_lisp_int.c \
+       ao_lisp_poly.c \
+       ao_lisp_prim.c \
+       ao_lisp_builtin.c \
+       ao_lisp_read.c
+
+OBJS=$(SRCS:.c=.o)
+
+CFLAGS=-DAO_LISP_MAKE_CONST -O0 -g
+
+HDRS=\
+       ao_lisp.h \
+       ao_lisp_read.h
+
+ao_lisp_make_const:  $(OBJS)
+       $(CC) $(CFLAGS) -o $@ $(OBJS)
+
+$(OBJS): $(HDRS)
index 6667dcc2c05f913da4e8ec14e47f0232d86e30fd..4fac861b555efe0060cd2297704e6289d583e780 100644 (file)
 #ifndef _AO_LISP_H_
 #define _AO_LISP_H_
 
+#if !defined(AO_LISP_TEST) && !defined(AO_LISP_MAKE_CONST)
+#include <ao.h>
+#define AO_LISP_ALTOS  1
+#endif
+
 #include <stdint.h>
 #include <string.h>
 #include <stdio.h>
 
+#ifdef AO_LISP_MAKE_CONST
+#define AO_LISP_POOL_CONST     16384
+extern uint8_t ao_lisp_const[AO_LISP_POOL_CONST];
+#else
+#include "ao_lisp_const.h"
+#endif
+
+/* Primitive types */
+#define AO_LISP_CONS           0
+#define AO_LISP_INT            1
+#define AO_LISP_STRING         2
+#define AO_LISP_OTHER          3
 
-# define AO_LISP_CONS  0
-# define AO_LISP_INT   1
-# define AO_LISP_STRING        2
-# define AO_LISP_OTHER 3
+#define AO_LISP_TYPE_MASK      0x0003
+#define AO_LISP_TYPE_SHIFT     2
+#define AO_LISP_REF_MASK       0x7ffc
+#define AO_LISP_CONST          0x8000
 
-# define AO_LISP_ATOM          4
-# define AO_LISP_BUILTIN       5
+/* These have a type value at the start of the struct */
+#define AO_LISP_ATOM           4
+#define AO_LISP_BUILTIN                5
+#define AO_LISP_NUM_TYPE       6
 
-# define AO_LISP_NIL   0
+#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);
+extern uint8_t         ao_lisp_pool[AO_LISP_POOL];
+extern uint16_t                ao_lisp_top;
+
+#define AO_LISP_OOM            0x01
+#define AO_LISP_DIVIDE_BY_ZERO 0x02
+#define AO_LISP_INVALID                0x04
+
+extern uint8_t         ao_lisp_exception;
+
+typedef uint16_t       ao_poly;
+
+static inline void *
+ao_lisp_ref(ao_poly poly) {
+       if (poly == AO_LISP_NIL)
+               return NULL;
+       if (poly & AO_LISP_CONST)
+               return (void *) ((ao_lisp_const - 4) + (poly & AO_LISP_REF_MASK));
+       else
+               return (void *) ((ao_lisp_pool - 4) + (poly & AO_LISP_REF_MASK));
 }
 
-static inline void *ao_lisp_clear_ref(void *addr) {
-       return (void *) ((intptr_t)addr & ~1);
+static inline ao_poly
+ao_lisp_poly(const void *addr, ao_poly type) {
+       const uint8_t   *a = addr;
+       if (addr == NULL)
+               return AO_LISP_NIL;
+       if (ao_lisp_pool <= a && a < ao_lisp_pool + AO_LISP_POOL)
+               return (a - (ao_lisp_pool - 4)) | type;
+       else if (ao_lisp_const <= a && a <= ao_lisp_const + AO_LISP_POOL_CONST)
+               return AO_LISP_CONST | (a - (ao_lisp_const - 4)) | type;
+       else {
+               ao_lisp_exception |= AO_LISP_INVALID;
+               return AO_LISP_NIL;
+       }
 }
 
-extern uint8_t ao_lisp_pool[AO_LISP_POOL];
+#define AO_LISP_POLY(addr, type) (((ao_lisp_pool <= ((uint8_t *) (a)) && \
+                                   ((uint8_t *) (a)) < ao_lisp_pool + AO_LISP_POOL) ? \
+                                  ((uint8_t *) (a) - (ao_lisp_pool - 4)) : \
+                                  (((uint8_t *) (a) - (ao_lisp_const - 4)) | AO_LISP_POOL_CONST)) | \
+                                 (type))
 
-struct ao_lisp_mem_type {
+struct ao_lisp_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;
+       ao_poly         car;
+       ao_poly         cdr;
 };
 
 struct ao_lisp_atom {
-       uint8_t                 type;
-       ao_lisp_poly            val;
-       struct ao_lisp_atom     *next;
-       char                    name[];
+       uint8_t         type;
+       uint8_t         pad[1];
+       ao_poly         val;
+       ao_poly         next;
+       char            name[];
 };
 
-#define AO_LISP_ATOM_CONST     ((struct ao_lisp_atom *) (intptr_t) 1)
-
-extern const struct ao_lisp_atom *ao_lisp_builtins[];
+#define AO_LISP_LAMBDA 0
+#define AO_LISP_NLAMBDA        1
+#define AO_LISP_MACRO  2
+#define AO_LISP_LEXPR  3
 
 struct ao_lisp_builtin {
-       uint8_t                 type;
-       ao_lisp_poly            (*func)(struct ao_lisp_cons *cons);
-       char                    name[];
+       uint8_t         type;
+       uint8_t         args;
+       uint16_t        func;
 };
 
+enum ao_lisp_builtin_id {
+       builtin_car,
+       builtin_cdr,
+       builtin_cons,
+       builtin_quote,
+       builtin_print,
+       builtin_plus,
+       builtin_minus,
+       builtin_times,
+       builtin_divide,
+       builtin_mod,
+       builtin_last
+};
+
+typedef ao_poly (*ao_lisp_func_t)(struct ao_lisp_cons *cons);
+
+extern ao_lisp_func_t  ao_lisp_builtins[];
+
+static inline ao_lisp_func_t
+ao_lisp_func(struct ao_lisp_builtin *b)
+{
+       return ao_lisp_builtins[b->func];
+}
+
 static inline void *
-ao_lisp_poly_other(ao_lisp_poly poly) {
-       return (void *) (poly - AO_LISP_OTHER);
+ao_lisp_poly_other(ao_poly poly) {
+       return ao_lisp_ref(poly);
 }
 
-static const inline ao_lisp_poly
+static inline ao_poly
 ao_lisp_other_poly(const void *other)
 {
-       return (ao_lisp_poly) other + AO_LISP_OTHER;
+       return ao_lisp_poly(other, AO_LISP_OTHER);
+}
+
+static inline int
+ao_lisp_mem_round(int size)
+{
+       return (size + 3) & ~3;
 }
 
-#define AO_LISP_OTHER_POLY(other) ((ao_lisp_poly)(other) + AO_LISP_OTHER)
+#define AO_LISP_OTHER_POLY(other) ((ao_poly)(other) + AO_LISP_OTHER)
 
-static inline int ao_lisp_poly_type(ao_lisp_poly poly) {
+static inline int ao_lisp_poly_type(ao_poly poly) {
        int     type = poly & 3;
        if (type == AO_LISP_OTHER)
                return *((uint8_t *) ao_lisp_poly_other(poly));
@@ -94,75 +174,75 @@ static inline int ao_lisp_poly_type(ao_lisp_poly poly) {
 }
 
 static inline struct ao_lisp_cons *
-ao_lisp_poly_cons(ao_lisp_poly poly)
+ao_lisp_poly_cons(ao_poly poly)
 {
-       return (struct ao_lisp_cons *) (poly - AO_LISP_CONS);
+       return ao_lisp_ref(poly);
 }
 
-static inline ao_lisp_poly
+static inline ao_poly
 ao_lisp_cons_poly(struct ao_lisp_cons *cons)
 {
-       return (ao_lisp_poly) cons + AO_LISP_CONS;
+       return ao_lisp_poly(cons, AO_LISP_CONS);
 }
 
 static inline int
-ao_lisp_poly_int(ao_lisp_poly poly)
+ao_lisp_poly_int(ao_poly poly)
 {
-       return (int) (poly >> 2);
+       return (int) poly >> AO_LISP_TYPE_SHIFT;
 }
 
-static inline ao_lisp_poly
+static inline ao_poly
 ao_lisp_int_poly(int i)
 {
-       return ((ao_lisp_poly) i << 2) + AO_LISP_INT;
+       return ((ao_poly) i << 2) + AO_LISP_INT;
 }
 
 static inline char *
-ao_lisp_poly_string(ao_lisp_poly poly)
+ao_lisp_poly_string(ao_poly poly)
 {
-       return (char *) (poly - AO_LISP_STRING);
+       return ao_lisp_ref(poly);
 }
 
-static inline ao_lisp_poly
-ao_lisp_string_poly(char *s) {
-       return (ao_lisp_poly) s + AO_LISP_STRING;
+static inline ao_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)
+ao_lisp_poly_atom(ao_poly poly)
 {
-       return (struct ao_lisp_atom *) (poly - AO_LISP_OTHER);
+       return ao_lisp_ref(poly);
 }
 
-static inline ao_lisp_poly
+static inline ao_poly
 ao_lisp_atom_poly(struct ao_lisp_atom *a)
 {
-       return (ao_lisp_poly) a + AO_LISP_OTHER;
+       return ao_lisp_poly(a, AO_LISP_OTHER);
 }
 
 static inline struct ao_lisp_builtin *
-ao_lisp_poly_builtin(ao_lisp_poly poly)
+ao_lisp_poly_builtin(ao_poly poly)
 {
-       return (struct ao_lisp_builtin *) (poly - AO_LISP_OTHER);
+       return ao_lisp_ref(poly);
 }
 
-static inline ao_lisp_poly
+static inline ao_poly
 ao_lisp_builtin_poly(struct ao_lisp_builtin *b)
 {
-       return (ao_lisp_poly) b + AO_LISP_OTHER;
+       return ao_lisp_poly(b, AO_LISP_OTHER);
 }
 
 /* memory functions */
-
 void
-ao_lisp_mark(const struct ao_lisp_mem_type *type, void *addr);
+ao_lisp_mark(const struct ao_lisp_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);
+ao_lisp_move(const struct ao_lisp_type *type, void *addr);
 
 /* returns NULL if the object was already moved */
 void *
@@ -172,22 +252,22 @@ void *
 ao_lisp_alloc(int size);
 
 int
-ao_lisp_root_add(const struct ao_lisp_mem_type *type, void *addr);
+ao_lisp_root_add(const struct ao_lisp_type *type, void *addr);
 
 void
 ao_lisp_root_clear(void *addr);
 
 /* cons */
-extern const struct ao_lisp_mem_type ao_lisp_cons_type;
+extern const struct ao_lisp_type ao_lisp_cons_type;
 
 struct ao_lisp_cons *
-ao_lisp_cons(ao_lisp_poly car, struct ao_lisp_cons *cdr);
+ao_lisp_cons_cons(ao_poly car, struct ao_lisp_cons *cdr);
 
 void
-ao_lisp_cons_print(struct ao_lisp_cons *cons);
+ao_lisp_cons_print(ao_poly);
 
 /* string */
-extern const struct ao_lisp_mem_type ao_lisp_string_type;
+extern const struct ao_lisp_type ao_lisp_string_type;
 
 char *
 ao_lisp_string_new(int len);
@@ -199,44 +279,50 @@ char *
 ao_lisp_string_cat(char *a, char *b);
 
 void
-ao_lisp_string_print(char *s);
+ao_lisp_string_print(ao_poly s);
 
 /* atom */
-extern const struct ao_lisp_mem_type ao_lisp_atom_type;
+extern const struct ao_lisp_type ao_lisp_atom_type;
+
+extern struct ao_lisp_atom *ao_lisp_atoms;
 
 void
 ao_lisp_atom_init(void);
 
 void
-ao_lisp_atom_print(struct ao_lisp_atom *atom);
+ao_lisp_atom_print(ao_poly a);
 
 struct ao_lisp_atom *
 ao_lisp_atom_intern(char *name);
 
 /* int */
 void
-ao_lisp_int_print(int i);
+ao_lisp_int_print(ao_poly i);
 
 /* prim */
-ao_lisp_poly
-ao_lisp_poly_print(ao_lisp_poly p);
+ao_poly
+ao_lisp_poly_print(ao_poly p);
 
 void
-ao_lisp_poly_mark(ao_lisp_poly p);
+ao_lisp_poly_mark(ao_poly p);
 
-ao_lisp_poly
-ao_lisp_poly_move(ao_lisp_poly p);
+ao_poly
+ao_lisp_poly_move(ao_poly p);
 
 /* eval */
-ao_lisp_poly
-ao_lisp_eval(ao_lisp_poly p);
+ao_poly
+ao_lisp_eval(ao_poly p);
 
 /* builtin */
 void
-ao_lisp_builtin_print(struct ao_lisp_builtin *b);
+ao_lisp_builtin_print(ao_poly b);
 
 /* read */
-ao_lisp_poly
+ao_poly
 ao_lisp_read(void);
 
+/* rep */
+ao_poly
+ao_lisp_read_eval_print(void);
+
 #endif /* _AO_LISP_H_ */
index 65282142cdb4ca64e85a8fad5c22642b575c358b..aaa84b8d1bcf872554548251429fb075ff9c777e 100644 (file)
@@ -34,12 +34,9 @@ static void atom_mark(void *addr)
 {
        struct ao_lisp_atom     *atom = addr;
 
-       if (atom->next == AO_LISP_ATOM_CONST)
-               return;
-
        for (;;) {
                ao_lisp_poly_mark(atom->val);
-               atom = atom->next;
+               atom = ao_lisp_poly_atom(atom->next);
                if (!atom)
                        break;
                if (ao_lisp_mark_memory(atom, atom_size(atom)))
@@ -51,49 +48,50 @@ static void atom_move(void *addr)
 {
        struct ao_lisp_atom     *atom = addr;
 
-       if (atom->next == AO_LISP_ATOM_CONST)
-               return;
-
        for (;;) {
                struct ao_lisp_atom     *next;
 
                atom->val = ao_lisp_poly_move(atom->val);
-               next = ao_lisp_move_memory(atom->next, atom_size(atom->next));
+               next = ao_lisp_poly_atom(atom->next);
+               next = ao_lisp_move_memory(next, atom_size(next));
                if (!next)
                        break;
-               atom->next = next;
+               atom->next = ao_lisp_atom_poly(next);
                atom = next;
        }
 }
 
-const struct ao_lisp_mem_type ao_lisp_atom_type = {
+const struct ao_lisp_type ao_lisp_atom_type = {
        .mark = atom_mark,
        .size = atom_size,
        .move = atom_move,
 };
 
-struct ao_lisp_atom    *atoms;
+struct ao_lisp_atom    *ao_lisp_atoms;
 
 struct ao_lisp_atom *
 ao_lisp_atom_intern(char *name)
 {
        struct ao_lisp_atom     *atom;
-       int                     b;
+//     int                     b;
 
-       for (atom = atoms; atom; atom = atom->next) {
+       for (atom = ao_lisp_atoms; atom; atom = ao_lisp_poly_atom(atom->next)) {
+               if (!strcmp(atom->name, name))
+                       return atom;
+       }
+#ifdef ao_builtin_atoms
+       for (atom = ao_lisp_poly_atom(ao_builtin_atoms); atom; atom = ao_lisp_poly_atom(atom->next)) {
                if (!strcmp(atom->name, name))
                        return atom;
        }
-       for (b = 0; ao_lisp_builtins[b]; b++)
-               if (!strcmp(ao_lisp_builtins[b]->name, name))
-                       return (struct ao_lisp_atom *) ao_lisp_builtins[b];
-       if (!atoms)
-               ao_lisp_root_add(&ao_lisp_atom_type, (void **) &atoms);
+#endif
+       if (!ao_lisp_atoms)
+               ao_lisp_root_add(&ao_lisp_atom_type, (void **) &ao_lisp_atoms);
        atom = ao_lisp_alloc(name_size(name));
        if (atom) {
                atom->type = AO_LISP_ATOM;
-               atom->next = atoms;
-               atoms = atom;
+               atom->next = ao_lisp_atom_poly(ao_lisp_atoms);
+               ao_lisp_atoms = atom;
                strcpy(atom->name, name);
                atom->val = AO_LISP_NIL;
        }
@@ -101,7 +99,8 @@ ao_lisp_atom_intern(char *name)
 }
 
 void
-ao_lisp_atom_print(struct ao_lisp_atom *a)
+ao_lisp_atom_print(ao_poly a)
 {
-       fputs(a->name, stdout);
+       struct ao_lisp_atom *atom = ao_lisp_poly_atom(a);
+       printf("%s", atom->name);
 }
index 3752a2c8b7d798db1bd4b7a1083784d354ef020d..e6d55797ce17fdf2b09a8c2c24b231bcd4782c90 100644 (file)
 #include "ao_lisp.h"
 
 void
-ao_lisp_builtin_print(struct ao_lisp_builtin *b)
+ao_lisp_builtin_print(ao_poly b)
 {
-       printf("[builtin %s]", b->name);
+       (void) b;
+       printf("[builtin]");
 }
+
+enum math_op { math_plus, math_minus, math_times, math_divide, math_mod };
+
+ao_poly
+ao_lisp_car(struct ao_lisp_cons *cons)
+{
+       if (!cons) {
+               ao_lisp_exception |= AO_LISP_INVALID;
+               return AO_LISP_NIL;
+       }
+       if (!cons->car) {
+               ao_lisp_exception |= AO_LISP_INVALID;
+               return AO_LISP_NIL;
+       }
+       if (ao_lisp_poly_type(cons->car) != AO_LISP_CONS) {
+               ao_lisp_exception |= AO_LISP_INVALID;
+               return AO_LISP_NIL;
+       }
+       return ao_lisp_poly_cons(cons->car)->car;
+}
+
+ao_poly
+ao_lisp_cdr(struct ao_lisp_cons *cons)
+{
+       if (!cons) {
+               ao_lisp_exception |= AO_LISP_INVALID;
+               return AO_LISP_NIL;
+       }
+       if (!cons->car) {
+               ao_lisp_exception |= AO_LISP_INVALID;
+               return AO_LISP_NIL;
+       }
+       if (ao_lisp_poly_type(cons->car) != AO_LISP_CONS) {
+               ao_lisp_exception |= AO_LISP_INVALID;
+               return AO_LISP_NIL;
+       }
+       return ao_lisp_poly_cons(cons->car)->cdr;
+}
+
+ao_poly
+ao_lisp_cons(struct ao_lisp_cons *cons)
+{
+       ao_poly car, cdr;
+       if (!cons) {
+               ao_lisp_exception |= AO_LISP_INVALID;
+               return AO_LISP_NIL;
+       }
+       car = cons->car;
+       cdr = cons->cdr;
+       if (!car || !cdr) {
+               ao_lisp_exception |= AO_LISP_INVALID;
+               return AO_LISP_NIL;
+       }
+       cdr = ao_lisp_poly_cons(cdr)->car;
+       if (ao_lisp_poly_type(cdr) != AO_LISP_CONS) {
+               ao_lisp_exception |= AO_LISP_INVALID;
+               return AO_LISP_NIL;
+       }
+       return ao_lisp_cons_poly(ao_lisp_cons_cons(car, ao_lisp_poly_cons(cdr)));
+}
+
+ao_poly
+ao_lisp_quote(struct ao_lisp_cons *cons)
+{
+       if (!cons) {
+               ao_lisp_exception |= AO_LISP_INVALID;
+               return AO_LISP_NIL;
+       }
+       return cons->car;
+}
+
+ao_poly
+ao_lisp_print(struct ao_lisp_cons *cons)
+{
+       ao_poly val = AO_LISP_NIL;
+       while (cons) {
+               val = cons->car;
+               ao_lisp_poly_print(val);
+               cons = ao_lisp_poly_cons(cons->cdr);
+       }
+       return val;
+}
+
+ao_poly
+ao_lisp_math(struct ao_lisp_cons *cons, enum math_op op)
+{
+       ao_poly ret = AO_LISP_NIL;
+
+       while (cons) {
+               ao_poly         car = cons->car;
+               uint8_t         rt = ao_lisp_poly_type(ret);
+               uint8_t         ct = ao_lisp_poly_type(car);
+
+               cons = ao_lisp_poly_cons(cons->cdr);
+
+               if (rt == AO_LISP_NIL)
+                       ret = car;
+
+               else if (rt == AO_LISP_INT && ct == AO_LISP_INT) {
+                       int     r = ao_lisp_poly_int(ret);
+                       int     c = ao_lisp_poly_int(car);
+
+                       switch(op) {
+                       case math_plus:
+                               r += c;
+                               break;
+                       case math_minus:
+                               r -= c;
+                               break;
+                       case math_times:
+                               r *= c;
+                               break;
+                       case math_divide:
+                               if (c == 0) {
+                                       ao_lisp_exception |= AO_LISP_DIVIDE_BY_ZERO;
+                                       return AO_LISP_NIL;
+                               }
+                               r /= c;
+                               break;
+                       case math_mod:
+                               if (c == 0) {
+                                       ao_lisp_exception |= AO_LISP_DIVIDE_BY_ZERO;
+                                       return AO_LISP_NIL;
+                               }
+                               r %= c;
+                               break;
+                       }
+                       ret = ao_lisp_int_poly(r);
+               }
+
+               else if (rt == AO_LISP_STRING && ct == AO_LISP_STRING && op == math_plus)
+                       ret = ao_lisp_string_poly(ao_lisp_string_cat(ao_lisp_poly_string(ret),
+                                                                    ao_lisp_poly_string(car)));
+               else {
+                       ao_lisp_exception |= AO_LISP_INVALID;
+                       return AO_LISP_NIL;
+               }
+       }
+       return ret;
+}
+
+ao_poly
+ao_lisp_plus(struct ao_lisp_cons *cons)
+{
+       return ao_lisp_math(cons, math_plus);
+}
+
+ao_poly
+ao_lisp_minus(struct ao_lisp_cons *cons)
+{
+       return ao_lisp_math(cons, math_minus);
+}
+
+ao_poly
+ao_lisp_times(struct ao_lisp_cons *cons)
+{
+       return ao_lisp_math(cons, math_times);
+}
+
+ao_poly
+ao_lisp_divide(struct ao_lisp_cons *cons)
+{
+       return ao_lisp_math(cons, math_divide);
+}
+
+ao_poly
+ao_lisp_mod(struct ao_lisp_cons *cons)
+{
+       return ao_lisp_math(cons, math_mod);
+}
+
+ao_lisp_func_t ao_lisp_builtins[] = {
+       [builtin_car] = ao_lisp_car,
+       [builtin_cdr] = ao_lisp_cdr,
+       [builtin_cons] = ao_lisp_cons,
+       [builtin_quote] = ao_lisp_quote,
+       [builtin_print] = ao_lisp_print,
+       [builtin_plus] = ao_lisp_plus,
+       [builtin_minus] = ao_lisp_minus,
+       [builtin_times] = ao_lisp_times,
+       [builtin_divide] = ao_lisp_divide,
+       [builtin_mod] = ao_lisp_mod
+};
+
index 60cbb2f35cd1ae5d95bcf1e3eed72e6eeb12cd0c..65908e30a610ea0f2b706eb17e314a9db1b2866d 100644 (file)
@@ -20,7 +20,7 @@ static void cons_mark(void *addr)
 
        for (;;) {
                ao_lisp_poly_mark(cons->car);
-               cons = cons->cdr;
+               cons = ao_lisp_poly_cons(cons->cdr);
                if (!cons)
                        break;
                if (ao_lisp_mark_memory(cons, sizeof (struct ao_lisp_cons)))
@@ -42,42 +42,43 @@ static void cons_move(void *addr)
                struct ao_lisp_cons     *cdr;
 
                cons->car = ao_lisp_poly_move(cons->car);
-               cdr = ao_lisp_move_memory(cons->cdr, sizeof (struct ao_lisp_cons));
+               cdr = ao_lisp_poly_cons(cons->cdr);
+               cdr = ao_lisp_move_memory(cdr, sizeof (struct ao_lisp_cons));
                if (!cdr)
                        break;
-               cons->cdr = cdr;
+               cons->cdr = ao_lisp_cons_poly(cdr);
                cons = cdr;
        }
 }
 
-const struct ao_lisp_mem_type ao_lisp_cons_type = {
+const struct ao_lisp_type ao_lisp_cons_type = {
        .mark = cons_mark,
        .size = cons_size,
        .move = cons_move,
 };
 
 struct ao_lisp_cons *
-ao_lisp_cons(ao_lisp_poly car, struct ao_lisp_cons *cdr)
+ao_lisp_cons_cons(ao_poly car, struct ao_lisp_cons *cdr)
 {
        struct ao_lisp_cons     *cons = ao_lisp_alloc(sizeof (struct ao_lisp_cons));
        if (!cons)
                return NULL;
        cons->car = car;
-       cons->cdr = cdr;
+       cons->cdr = ao_lisp_cons_poly(cdr);
        return cons;
 }
 
 void
-ao_lisp_cons_print(struct ao_lisp_cons *cons)
+ao_lisp_cons_print(ao_poly c)
 {
+       struct ao_lisp_cons *cons = ao_lisp_poly_cons(c);
        int     first = 1;
        printf("(");
        while (cons) {
                if (!first)
                        printf(" ");
-               fflush(stdout);
                ao_lisp_poly_print(cons->car);
-               cons = cons->cdr;
+               cons = ao_lisp_poly_cons(cons->cdr);
                first = 0;
        }
        printf(")");
diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp
new file mode 100644 (file)
index 0000000..aa356d4
--- /dev/null
@@ -0,0 +1 @@
+cadr (lambda (l) (car (cdr l)))
index 23908e649db1a0ded8d7b707272e305e3cd09cb6..b13d4681480b74b96e2bad5e75260e9e5c1dc459 100644 (file)
@@ -40,8 +40,8 @@ static uint8_t been_here;
 #define DBG_POLY(a)
 #endif
 
-ao_lisp_poly
-ao_lisp_eval(ao_lisp_poly v)
+ao_poly
+ao_lisp_eval(ao_poly v)
 {
        struct ao_lisp_cons     *formal;
        int                     cons = 0;
@@ -59,6 +59,7 @@ ao_lisp_eval(ao_lisp_poly v)
        formals_tail = 0;
        for (;;) {
 
+       restart:
                /* Build stack frames for each list */
                while (ao_lisp_poly_type(v) == AO_LISP_CONS) {
                        if (v == AO_LISP_NIL)
@@ -68,8 +69,8 @@ ao_lisp_eval(ao_lisp_poly v)
                        if (cons++) {
                                struct ao_lisp_cons *frame;
 
-                               frame = ao_lisp_cons(ao_lisp_cons_poly(actuals), formals);
-                               stack = ao_lisp_cons(ao_lisp_cons_poly(frame), stack);
+                               frame = ao_lisp_cons_cons(ao_lisp_cons_poly(actuals), formals);
+                               stack = ao_lisp_cons_cons(ao_lisp_cons_poly(frame), stack);
                        }
                        actuals = ao_lisp_poly_cons(v);
                        formals = NULL;
@@ -83,6 +84,8 @@ ao_lisp_eval(ao_lisp_poly v)
 
                /* Evaluate primitive types */
 
+               DBG ("actual: "); DBG_POLY(v); DBG("\n");
+
                switch (ao_lisp_poly_type(v)) {
                case AO_LISP_INT:
                case AO_LISP_STRING:
@@ -92,16 +95,42 @@ ao_lisp_eval(ao_lisp_poly v)
                        break;
                }
 
+               if (!cons)
+                       break;
+
                for (;;) {
                        DBG("add formal: "); DBG_POLY(v); DBG("\n");
 
-                       formal = ao_lisp_cons(v, NULL);
+                       if (formals == NULL) {
+                               if (ao_lisp_poly_type(v) == AO_LISP_BUILTIN) {
+                                       struct ao_lisp_builtin *b = ao_lisp_poly_builtin(v);
+                                       switch (b->args) {
+                                       case AO_LISP_NLAMBDA:
+                                               v = ao_lisp_func(b)(ao_lisp_poly_cons(actuals->cdr));
+                                               goto done_eval;
+
+                                       case AO_LISP_MACRO:
+                                               v = ao_lisp_func(b)(ao_lisp_poly_cons(actuals->cdr));
+                                               if (ao_lisp_poly_type(v) != AO_LISP_CONS) {
+                                                       ao_lisp_exception |= AO_LISP_INVALID;
+                                                       return AO_LISP_NIL;
+                                               }
+
+                                               /* Reset frame to the new list */
+                                               actuals = ao_lisp_poly_cons(v);
+                                               v = actuals->car;
+                                               goto restart;
+                                       }
+                               }
+                       }
+
+                       formal = ao_lisp_cons_cons(v, NULL);
                        if (formals_tail)
-                               formals_tail->cdr = formal;
+                               formals_tail->cdr = ao_lisp_cons_poly(formal);
                        else
                                formals = formal;
                        formals_tail = formal;
-                       actuals = actuals->cdr;
+                       actuals = ao_lisp_poly_cons(actuals->cdr);
 
                        DBG("formals: ");
                        DBG_CONS(formals);
@@ -113,7 +142,6 @@ ao_lisp_eval(ao_lisp_poly v)
                        /* Process all of the arguments */
                        if (actuals) {
                                v = actuals->car;
-                               DBG ("actual: "); DBG_POLY(v); DBG("\n");
                                break;
                        }
 
@@ -123,7 +151,7 @@ ao_lisp_eval(ao_lisp_poly v)
                        if (ao_lisp_poly_type(v) == AO_LISP_BUILTIN) {
                                struct ao_lisp_builtin *b = ao_lisp_poly_builtin(v);
 
-                               v = b->func(formals->cdr);
+                               v = ao_lisp_func(b) (ao_lisp_poly_cons(formals->cdr));
 
                                DBG ("eval: ");
                                DBG_CONS(formals);
@@ -131,22 +159,23 @@ ao_lisp_eval(ao_lisp_poly v)
                                DBG_POLY(v);
                                DBG ("\n");
                        } else {
-                               DBG ("invalid eval\n");
+                               ao_lisp_exception |= AO_LISP_INVALID;
+                               return AO_LISP_NIL;
                        }
-
+               done_eval:
                        if (--cons) {
                                struct ao_lisp_cons     *frame;
 
                                /* Pop the previous frame off the stack */
                                frame = ao_lisp_poly_cons(stack->car);
                                actuals = ao_lisp_poly_cons(frame->car);
-                               formals = frame->cdr;
+                               formals = ao_lisp_poly_cons(frame->cdr);
 
                                /* Recompute the tail of the formals list */
-                               for (formal = formals; formal->cdr != NULL; formal = formal->cdr);
+                               for (formal = formals; formal->cdr != AO_LISP_NIL; formal = ao_lisp_poly_cons(formal->cdr));
                                formals_tail = formal;
 
-                               stack = stack->cdr;
+                               stack = ao_lisp_poly_cons(stack->cdr);
                                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");
index 6ee3096df1ca7d17f3fc24cf616a70e6b4ed2492..77f65e95ed2b189254f429cd1d8662da54227654 100644 (file)
@@ -15,7 +15,8 @@
 #include "ao_lisp.h"
 
 void
-ao_lisp_int_print(int i)
+ao_lisp_int_print(ao_poly p)
 {
+       int i = ao_lisp_poly_int(p);
        printf("%d", i);
 }
diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c
new file mode 100644 (file)
index 0000000..21e000b
--- /dev/null
@@ -0,0 +1,90 @@
+/*
+ * 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 <stdlib.h>
+
+static struct ao_lisp_builtin *
+ao_lisp_make_builtin(enum ao_lisp_builtin_id func, int args) {
+       struct ao_lisp_builtin *b = ao_lisp_alloc(sizeof (struct ao_lisp_builtin));
+
+       b->type = AO_LISP_BUILTIN;
+       b->func = func;
+       b->args = args;
+       return b;
+}
+
+struct builtin_func {
+       char    *name;
+       int     args;
+       int     func;
+};
+
+struct builtin_func funcs[] = {
+       "car",          AO_LISP_LEXPR,  builtin_car,
+       "cdr",          AO_LISP_LEXPR,  builtin_cdr,
+       "cons",         AO_LISP_LEXPR,  builtin_cons,
+       "quote",        AO_LISP_NLAMBDA,builtin_quote,
+       "print",        AO_LISP_LEXPR,  builtin_print,
+       "+",            AO_LISP_LEXPR,  builtin_plus,
+       "-",            AO_LISP_LEXPR,  builtin_minus,
+       "*",            AO_LISP_LEXPR,  builtin_times,
+       "/",            AO_LISP_LEXPR,  builtin_divide,
+       "%",            AO_LISP_LEXPR,  builtin_mod
+};
+
+#define N_FUNC (sizeof funcs / sizeof funcs[0])
+
+int
+main(int argc, char **argv)
+{
+       int     f, o;
+       ao_poly atom, val;
+
+       for (f = 0; f < N_FUNC; f++) {
+               struct ao_lisp_builtin  *b = ao_lisp_make_builtin(funcs[f].func, funcs[f].args);
+               struct ao_lisp_atom     *a = ao_lisp_atom_intern(funcs[f].name);
+               a->val = ao_lisp_builtin_poly(b);
+       }
+
+       for (;;) {
+               atom = ao_lisp_read();
+               if (!atom)
+                       break;
+               val = ao_lisp_read();
+               if (!val)
+                       break;
+               if (ao_lisp_poly_type(atom) != AO_LISP_ATOM) {
+                       fprintf(stderr, "input must be atom val pairs\n");
+                       exit(1);
+               }
+               ao_lisp_poly_atom(atom)->val = val;
+       }
+
+       printf("/* constant objects, all referenced from atoms */\n\n");
+       printf("#define AO_LISP_POOL_CONST %d\n", ao_lisp_top);
+       printf("extern const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4)));\n");
+       printf("#define ao_builtin_atoms 0x%04x\n", ao_lisp_atom_poly(ao_lisp_atoms));
+       printf("#ifdef AO_LISP_CONST_BITS\n");
+       printf("const uint8_t ao_lisp_const[] = {");
+       for (o = 0; o < ao_lisp_top; o++) {
+               if ((o & 0xf) == 0)
+                       printf("\n\t");
+               else
+                       printf(" ");
+               printf("0x%02x,", ao_lisp_const[o]);
+       }
+       printf("\n};\n");
+       printf("#endif /* AO_LISP_CONST_BITS */\n");
+}
index d008519b2ccf56c0c30074fb030f4e6d30c5eb76..7295d1508967f4b4c95ff0abffa349037c2f4f7f 100644 (file)
  * General Public License for more details.
  */
 
+#define AO_LISP_CONST_BITS
+
 #include "ao_lisp.h"
 #include <stdio.h>
 
-uint8_t        ao_lisp_pool[AO_LISP_POOL];
+uint8_t        ao_lisp_pool[AO_LISP_POOL] __attribute__((aligned(4)));
+
+#ifdef AO_LISP_MAKE_CONST
+#include <stdlib.h>
+uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4)));
+#endif
+
+uint8_t        ao_lisp_exception;
 
 struct ao_lisp_root {
        void                            **addr;
-       const struct ao_lisp_mem_type   *type;
+       const struct ao_lisp_type       *type;
 };
 
+#define AO_LISP_ROOT   16
+
 static struct ao_lisp_root     ao_lisp_root[AO_LISP_ROOT];
 
 static uint8_t ao_lisp_busy[AO_LISP_POOL / 32];
 
 static uint8_t ao_lisp_moving[AO_LISP_POOL / 32];
 
-static uint16_t        ao_lisp_top;
+uint16_t       ao_lisp_top;
 
 static inline void mark(uint8_t *tag, int offset) {
        int     byte = offset >> 5;
@@ -59,9 +70,13 @@ static int
 mark_object(uint8_t *tag, void *addr, int size) {
        int     base;
        int     bound;
+
        if (!addr)
                return 1;
 
+       if ((uint8_t *) addr < ao_lisp_pool || ao_lisp_pool + AO_LISP_POOL <= (uint8_t*) addr)
+               return 1;
+
        base = (uint8_t *) addr - ao_lisp_pool;
        bound = base + size;
 
@@ -150,7 +165,7 @@ collect(void)
 
 
 void
-ao_lisp_mark(const struct ao_lisp_mem_type *type, void *addr)
+ao_lisp_mark(const struct ao_lisp_type *type, void *addr)
 {
        if (mark_object(ao_lisp_busy, addr, type->size(addr)))
                return;
@@ -175,7 +190,7 @@ check_move(void *addr, int size)
 }
 
 void *
-ao_lisp_move(const struct ao_lisp_mem_type *type, void *addr)
+ao_lisp_move(const struct ao_lisp_type *type, void *addr)
 {
        int     size = type->size(addr);
 
@@ -206,19 +221,29 @@ ao_lisp_alloc(int size)
 {
        void    *addr;
 
-       size = (size + 3) & ~3;
+       size = ao_lisp_mem_round(size);
+#ifdef AO_LISP_MAKE_CONST
+       if (ao_lisp_top + size > AO_LISP_POOL_CONST) {
+               fprintf(stderr, "Too much constant data, increase AO_LISP_POOL_CONST\n");
+               exit(1);
+       }
+       addr = ao_lisp_const + ao_lisp_top;
+#else
        if (ao_lisp_top + size > AO_LISP_POOL) {
                collect();
-               if (ao_lisp_top + size > AO_LISP_POOL)
+               if (ao_lisp_top + size > AO_LISP_POOL) {
+                       ao_lisp_exception |= AO_LISP_OOM;
                        return NULL;
+               }
        }
        addr = ao_lisp_pool + ao_lisp_top;
+#endif
        ao_lisp_top += size;
        return addr;
 }
 
 int
-ao_lisp_root_add(const struct ao_lisp_mem_type *type, void *addr)
+ao_lisp_root_add(const struct ao_lisp_type *type, void *addr)
 {
        int     i;
        for (i = 0; i < AO_LISP_ROOT; i++) {
index 1855d945d6a920abbe35fabc0de74ddd17a5747d..c6ca0a975f0d1077a133a3de7b0087dc4dac53f0 100644 (file)
 
 #include "ao_lisp.h"
 
-enum math_op { math_plus, math_minus, math_times, math_divide, math_mod };
-
-ao_lisp_poly
-ao_lisp_math(struct ao_lisp_cons *cons, enum math_op op)
-{
-       ao_lisp_poly    ret = AO_LISP_NIL;
-
-       while (cons) {
-               ao_lisp_poly    car = cons->car;
-               uint8_t         rt = ao_lisp_poly_type(ret);
-               uint8_t         ct = ao_lisp_poly_type(car);
-
-               cons = cons->cdr;
-
-               if (rt == AO_LISP_NIL)
-                       ret = car;
-
-               else if (rt == AO_LISP_INT && ct == AO_LISP_INT) {
-                       int     r = ao_lisp_poly_int(ret);
-                       int     c = ao_lisp_poly_int(car);
-
-                       switch(op) {
-                       case math_plus:
-                               r += c;
-                               break;
-                       case math_minus:
-                               r -= c;
-                               break;
-                       case math_times:
-                               r *= c;
-                               break;
-                       case math_divide:
-                               if (c == 0)
-                                       return AO_LISP_NIL;
-                               r /= c;
-                               break;
-                       case math_mod:
-                               if (c == 0)
-                                       return AO_LISP_NIL;
-                               r %= c;
-                               break;
-                       }
-                       ret = ao_lisp_int_poly(r);
-               }
-
-               else if (rt == AO_LISP_STRING && ct == AO_LISP_STRING && op == math_plus)
-                       ret = ao_lisp_string_poly(ao_lisp_string_cat(ao_lisp_poly_string(ret),
-                                                                    ao_lisp_poly_string(car)));
-               else {
-                       /* XXX exception */
-                       return AO_LISP_NIL;
-               }
-       }
-       return ret;
-}
-
-ao_lisp_poly
-ao_lisp_plus(struct ao_lisp_cons *cons)
-{
-       return ao_lisp_math(cons, math_plus);
-}
-
-ao_lisp_poly
-ao_lisp_minus(struct ao_lisp_cons *cons)
-{
-       return ao_lisp_math(cons, math_minus);
-}
-
-ao_lisp_poly
-ao_lisp_times(struct ao_lisp_cons *cons)
-{
-       return ao_lisp_math(cons, math_times);
-}
-
-ao_lisp_poly
-ao_lisp_divide(struct ao_lisp_cons *cons)
-{
-       return ao_lisp_math(cons, math_divide);
-}
-
-ao_lisp_poly
-ao_lisp_mod(struct ao_lisp_cons *cons)
-{
-       return ao_lisp_math(cons, math_mod);
-}
+/*
 
 static const struct ao_lisp_builtin builtin_plus = {
        .type = AO_LISP_BUILTIN,
@@ -113,7 +29,6 @@ static const struct ao_lisp_atom atom_plus = {
        .name = "plus"
 };
 
-/*
 static const struct ao_lisp_builtin builtin_minus = {
        .type = AO_LISP_BUILTIN,
        .func = ao_lisp_minus
@@ -124,9 +39,9 @@ static const struct ao_lisp_builtin builtin_times = {
        .func = ao_lisp_times
 };
 
-*/
 
 const struct ao_lisp_atom const *ao_lisp_builtins[] = {
        &atom_plus,
        0
 };
+*/
index ccfd2be4e6dfb88fd9b6098eb9471c73cb904600..38dcb9616aa8f028fc3b35b4c361fdae697ad5c5 100644 (file)
 
 #include "ao_lisp.h"
 
-ao_lisp_poly
-ao_lisp_poly_print(ao_lisp_poly p)
+static void (*const ao_lisp_print_funcs[AO_LISP_NUM_TYPE])(ao_poly) = {
+       [AO_LISP_CONS] = ao_lisp_cons_print,
+       [AO_LISP_STRING] = ao_lisp_string_print,
+       [AO_LISP_INT] = ao_lisp_int_print,
+       [AO_LISP_ATOM] = ao_lisp_atom_print,
+       [AO_LISP_BUILTIN] = ao_lisp_builtin_print
+};
+
+ao_poly
+ao_lisp_poly_print(ao_poly p)
 {
-       switch (ao_lisp_poly_type(p)) {
-       case AO_LISP_CONS:
-               ao_lisp_cons_print(ao_lisp_poly_cons(p));
-               break;
-       case AO_LISP_STRING:
-               ao_lisp_string_print(ao_lisp_poly_string(p));
-               break;
-       case AO_LISP_INT:
-               ao_lisp_int_print(ao_lisp_poly_int(p));
-               break;
-       case AO_LISP_ATOM:
-               ao_lisp_atom_print(ao_lisp_poly_atom(p));
-               break;
-       case AO_LISP_BUILTIN:
-               ao_lisp_builtin_print(ao_lisp_poly_builtin(p));
-               break;
-       }
-       return AO_LISP_NIL;
+       void (*print)(ao_poly) = ao_lisp_print_funcs[ao_lisp_poly_type(p)];
+       if (print)
+               print(p);
+       return p;
 }
 
 void
-ao_lisp_poly_mark(ao_lisp_poly p)
+ao_lisp_poly_mark(ao_poly p)
 {
        switch (ao_lisp_poly_type(p)) {
        case AO_LISP_CONS:
@@ -53,8 +47,8 @@ ao_lisp_poly_mark(ao_lisp_poly p)
        }
 }
 
-ao_lisp_poly
-ao_lisp_poly_move(ao_lisp_poly p)
+ao_poly
+ao_lisp_poly_move(ao_poly p)
 {
        switch (ao_lisp_poly_type(p)) {
        case AO_LISP_CONS:
index ccb4ba3a896deacfacb0f00b361489700fb264d6..ea98b9767cb59882ca13e34ffeb343b623995c46 100644 (file)
@@ -155,8 +155,21 @@ lex_get()
        if (lex_unget_c) {
                c = lex_unget_c;
                lex_unget_c = 0;
-       } else
+       } else {
+#if AO_LISP_ALTOS
+               static uint8_t  at_eol;
+
+               if (at_eol) {
+                       ao_cmd_readline();
+                       at_eol = 0;
+               }
+               c = ao_cmd_lex();
+               if (c == '\n')
+                       at_eol = 1;
+#else
                c = getchar();
+#endif
+       }
        return c;
 }
 
@@ -362,13 +375,13 @@ 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
+static ao_poly
 read_item(void)
 {
        struct ao_lisp_atom     *atom;
        char                    *string;
        int                     cons;
-       ao_lisp_poly            v;
+       ao_poly                 v;
 
        if (!been_here) {
                ao_lisp_root_add(&ao_lisp_cons_type, &read_cons);
@@ -381,7 +394,7 @@ read_item(void)
        for (;;) {
                while (parse_token == OPEN) {
                        if (cons++)
-                               read_stack = ao_lisp_cons(ao_lisp_cons_poly(read_cons), read_stack);
+                               read_stack = ao_lisp_cons_cons(ao_lisp_cons_poly(read_cons), read_stack);
                        read_cons = NULL;
                        read_cons_tail = NULL;
                        parse_token = lex();
@@ -416,10 +429,10 @@ read_item(void)
                                v = AO_LISP_NIL;
                        if (--cons) {
                                read_cons = ao_lisp_poly_cons(read_stack->car);
-                               read_stack = read_stack->cdr;
+                               read_stack = ao_lisp_poly_cons(read_stack->cdr);
                                for (read_cons_tail = read_cons;
                                     read_cons_tail && read_cons_tail->cdr;
-                                    read_cons_tail = read_cons_tail->cdr)
+                                    read_cons_tail = ao_lisp_poly_cons(read_cons_tail->cdr))
                                        ;
                        }
                        break;
@@ -428,9 +441,9 @@ read_item(void)
                if (!cons)
                        break;
 
-               struct ao_lisp_cons     *read = ao_lisp_cons(v, NULL);
+               struct ao_lisp_cons     *read = ao_lisp_cons_cons(v, NULL);
                if (read_cons_tail)
-                       read_cons_tail->cdr = read;
+                       read_cons_tail->cdr = ao_lisp_cons_poly(read);
                else
                        read_cons = read;
                read_cons_tail = read;
@@ -440,7 +453,7 @@ read_item(void)
        return v;
 }
 
-ao_lisp_poly
+ao_poly
 ao_lisp_read(void)
 {
        parse_token = lex();
diff --git a/src/lisp/ao_lisp_rep.c b/src/lisp/ao_lisp_rep.c
new file mode 100644 (file)
index 0000000..d26d270
--- /dev/null
@@ -0,0 +1,40 @@
+/*
+ * 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"
+
+ao_poly
+ao_lisp_read_eval_print(void)
+{
+       ao_poly in, out = AO_LISP_NIL;
+       for(;;) {
+               in = ao_lisp_read();
+               if (!in)
+                       break;
+               out = ao_lisp_eval(in);
+               if (ao_lisp_exception) {
+                       if (ao_lisp_exception & AO_LISP_OOM)
+                               printf("out of memory\n");
+                       if (ao_lisp_exception & AO_LISP_DIVIDE_BY_ZERO)
+                               printf("divide by zero\n");
+                       if (ao_lisp_exception & AO_LISP_INVALID)
+                               printf("invalid operation\n");
+                       ao_lisp_exception = 0;
+               } else {
+                       ao_lisp_poly_print(out);
+                       putchar ('\n');
+               }
+       }
+       return out;
+}
index 1ab569332cc378a05d24a2dac63f865d2bb81d8c..39c3dc816ddd45dae08a6d6a83d3e876ec6bdd76 100644 (file)
@@ -68,16 +68,18 @@ ao_lisp_string_cat(char *a, char *b)
        return r;
 }
 
-const struct ao_lisp_mem_type ao_lisp_string_type = {
+const struct ao_lisp_type ao_lisp_string_type = {
        .mark = string_mark,
        .size = string_size,
        .move = string_move,
 };
 
 void
-ao_lisp_string_print(char *s)
+ao_lisp_string_print(ao_poly p)
 {
+       char    *s = ao_lisp_poly_string(p);
        char    c;
+
        putchar('"');
        while ((c = *s++)) {
                switch (c) {
diff --git a/src/nucleao-32/.gitignore b/src/nucleao-32/.gitignore
new file mode 100644 (file)
index 0000000..cb8f78e
--- /dev/null
@@ -0,0 +1,2 @@
+ao_product.h
+nucleo-32*
index a160fd2ffe2e59bf177a4674849ca50a065e8c72..0df4431761600a6dfba3f76f007fe33f3e8d30e3 100644 (file)
@@ -32,6 +32,17 @@ ALTOS_SRC = \
        ao_mutex.c \
        ao_usb_stm.c \
        ao_serial_stm.c \
+       ao_lisp_lex.c \
+       ao_lisp_mem.c \
+       ao_lisp_cons.c \
+       ao_lisp_eval.c \
+       ao_lisp_string.c \
+       ao_lisp_atom.c \
+       ao_lisp_int.c \
+       ao_lisp_prim.c \
+       ao_lisp_builtin.c \
+       ao_lisp_read.c \
+       ao_lisp_rep.c \
        ao_exti_stm.c
 
 PRODUCT=Nucleo-32
index cda889c6eef25c0eeb43d39a0bb19d36bb5e7707..113e2399aaebc7fe962186a8a19469835960c76c 100644 (file)
@@ -13,6 +13,7 @@
  */
 
 #include <ao.h>
+#include <ao_lisp.h>
 
 static uint16_t        blink_delay, blink_running;
 
@@ -41,11 +42,17 @@ static void blink_cmd() {
                        ao_sleep(&blink_running);
 }
 
+static void lisp_cmd() {
+       ao_lisp_read_eval_print();
+}
+
 static const struct ao_cmds blink_cmds[] = {
        { blink_cmd,    "b <delay, 0 off>\0Blink the green LED" },
+       { lisp_cmd,     "l\0Run lisp interpreter" },
        { 0, 0 }
 };
 
+
 void main(void)
 {
        ao_led_init(LEDS_AVAILABLE);
diff --git a/src/nucleao-32/flash-loader/.gitignore b/src/nucleao-32/flash-loader/.gitignore
new file mode 100644 (file)
index 0000000..cb8f78e
--- /dev/null
@@ -0,0 +1,2 @@
+ao_product.h
+nucleo-32*
index e841bfdef168bdbaa5c31a13dd383d3f744b43d1..6c51c421dd3ce53176394471ff1a1190d3939841 100644 (file)
@@ -10,7 +10,7 @@ INCS=ao_kalman.h ao_ms5607.h ao_log.h ao_data.h altitude-pa.h altitude.h ao_quat
 
 KALMAN=make-kalman 
 
-CFLAGS=-I.. -I. -I../kernel -I../drivers -I../micropeak -I../product -I../lisp -O0 -g -Wall
+CFLAGS=-I.. -I. -I../kernel -I../drivers -I../micropeak -I../product -I../lisp -O0 -g -Wall -DAO_LISP_TEST
 
 all: $(PROGS) ao_aprs_data.wav
 
@@ -89,9 +89,11 @@ 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_read.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_OBJS = ao_lisp_test.o ao_lisp_mem.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_rep.o
 
 ao_lisp_test: $(AO_LISP_OBJS)
        cc $(CFLAGS) -o $@ $(AO_LISP_OBJS)
 
-$(AO_LISP_OBJS): ao_lisp.h
+$(AO_LISP_OBJS): ao_lisp.h ao_lisp_const.h
index 96f1fd726e8109bc63fddf9a7cb292fd39561e9d..810a152819ad2dd3594e59fd6792c7c7329b1772 100644 (file)
@@ -21,9 +21,9 @@ static char                   *string;
 int
 main (int argc, char **argv)
 {
-       int     i, j;
+       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);
 
@@ -31,37 +31,35 @@ main (int argc, char **argv)
        for (j = 0; j < 10; j++) {
                list = 0;
                string = ao_lisp_string_new(0);
-               for (i = 0; i < 7; i++) {
+               for (i = 0; i < 2; i++) {
                        string = ao_lisp_string_cat(string, "a");
-                       list = ao_lisp_cons(ao_lisp_string_poly(string), list);
-                       list = ao_lisp_cons(ao_lisp_int_poly(i), list);
+                       list = ao_lisp_cons_cons(ao_lisp_string_poly(string), list);
+                       list = ao_lisp_cons_cons(ao_lisp_int_poly(i), list);
                        atom = ao_lisp_atom_intern("ant");
                        atom->val = ao_lisp_cons_poly(list);
-                       list = ao_lisp_cons(ao_lisp_atom_poly(atom), list);
+                       list = ao_lisp_cons_cons(ao_lisp_atom_poly(atom), list);
                }
                ao_lisp_poly_print(ao_lisp_cons_poly(list));
                printf("\n");
        }
 
-       atom = ao_lisp_atom_intern("ant");
-       atom->val = ao_lisp_string_poly(ao_lisp_string_cat("hello world", ""));
-
-       list = ao_lisp_cons(ao_lisp_atom_poly(ao_lisp_atom_intern("plus")),
-                           ao_lisp_cons(ao_lisp_cons_poly(ao_lisp_cons(ao_lisp_atom_poly(ao_lisp_atom_intern("plus")),
-                                                                       ao_lisp_cons(ao_lisp_int_poly(3),
-                                                                                    ao_lisp_cons(ao_lisp_int_poly(4), NULL)))),
-                                        ao_lisp_cons(ao_lisp_int_poly(2), NULL)));
+       for (atom = ao_lisp_poly_atom(ao_builtin_atoms); atom; atom = ao_lisp_poly_atom(atom->next)) {
+               printf("%s = ", atom->name);
+               ao_lisp_poly_print(atom->val);
+               printf("\n");
+       }
+#if 1
+       list = ao_lisp_cons_cons(ao_lisp_atom_poly(ao_lisp_atom_intern("+")),
+                                ao_lisp_cons_cons(ao_lisp_cons_poly(ao_lisp_cons_cons(ao_lisp_atom_poly(ao_lisp_atom_intern("+")),
+                                                                                      ao_lisp_cons_cons(ao_lisp_int_poly(3),
+                                                                                                        ao_lisp_cons_cons(ao_lisp_int_poly(4), NULL)))),
+                                                  ao_lisp_cons_cons(ao_lisp_int_poly(2), NULL)));
        printf("list: ");
        ao_lisp_poly_print(ao_lisp_cons_poly(list));
        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);
-       }
-
+       ao_lisp_read_eval_print();
+#endif
 }