summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lisp/.gitignore2
-rw-r--r--src/lisp/Makefile32
-rw-r--r--src/lisp/ao_lisp.h238
-rw-r--r--src/lisp/ao_lisp_atom.c43
-rw-r--r--src/lisp/ao_lisp_builtin.c189
-rw-r--r--src/lisp/ao_lisp_cons.c19
-rw-r--r--src/lisp/ao_lisp_const.lisp1
-rw-r--r--src/lisp/ao_lisp_eval.c57
-rw-r--r--src/lisp/ao_lisp_int.c3
-rw-r--r--src/lisp/ao_lisp_make_const.c90
-rw-r--r--src/lisp/ao_lisp_mem.c41
-rw-r--r--src/lisp/ao_lisp_poly.c89
-rw-r--r--src/lisp/ao_lisp_prim.c40
-rw-r--r--src/lisp/ao_lisp_read.c31
-rw-r--r--src/lisp/ao_lisp_rep.c40
-rw-r--r--src/lisp/ao_lisp_string.c6
-rw-r--r--src/nucleao-32/.gitignore2
-rw-r--r--src/nucleao-32/Makefile11
-rw-r--r--src/nucleao-32/ao_nucleo.c7
-rw-r--r--src/nucleao-32/flash-loader/.gitignore2
-rw-r--r--src/test/Makefile8
-rw-r--r--src/test/ao_lisp_test.c40
22 files changed, 714 insertions, 277 deletions
diff --git a/src/lisp/.gitignore b/src/lisp/.gitignore
new file mode 100644
index 00000000..76a555ea
--- /dev/null
+++ b/src/lisp/.gitignore
@@ -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
index 00000000..e8c3c02c
--- /dev/null
+++ b/src/lisp/Makefile
@@ -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)
diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index 6667dcc2..4fac861b 100644
--- a/src/lisp/ao_lisp.h
+++ b/src/lisp/ao_lisp.h
@@ -15,78 +15,158 @@
#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_ */
diff --git a/src/lisp/ao_lisp_atom.c b/src/lisp/ao_lisp_atom.c
index 65282142..aaa84b8d 100644
--- a/src/lisp/ao_lisp_atom.c
+++ b/src/lisp/ao_lisp_atom.c
@@ -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);
}
diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c
index 3752a2c8..e6d55797 100644
--- a/src/lisp/ao_lisp_builtin.c
+++ b/src/lisp/ao_lisp_builtin.c
@@ -15,7 +15,192 @@
#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
+};
+
diff --git a/src/lisp/ao_lisp_cons.c b/src/lisp/ao_lisp_cons.c
index 60cbb2f3..65908e30 100644
--- a/src/lisp/ao_lisp_cons.c
+++ b/src/lisp/ao_lisp_cons.c
@@ -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
index 00000000..aa356d45
--- /dev/null
+++ b/src/lisp/ao_lisp_const.lisp
@@ -0,0 +1 @@
+cadr (lambda (l) (car (cdr l)))
diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c
index 23908e64..b13d4681 100644
--- a/src/lisp/ao_lisp_eval.c
+++ b/src/lisp/ao_lisp_eval.c
@@ -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");
diff --git a/src/lisp/ao_lisp_int.c b/src/lisp/ao_lisp_int.c
index 6ee3096d..77f65e95 100644
--- a/src/lisp/ao_lisp_int.c
+++ b/src/lisp/ao_lisp_int.c
@@ -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
index 00000000..21e000bf
--- /dev/null
+++ b/src/lisp/ao_lisp_make_const.c
@@ -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");
+}
diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c
index d008519b..7295d150 100644
--- a/src/lisp/ao_lisp_mem.c
+++ b/src/lisp/ao_lisp_mem.c
@@ -12,23 +12,34 @@
* 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++) {
diff --git a/src/lisp/ao_lisp_poly.c b/src/lisp/ao_lisp_poly.c
index 1855d945..c6ca0a97 100644
--- a/src/lisp/ao_lisp_poly.c
+++ b/src/lisp/ao_lisp_poly.c
@@ -14,91 +14,7 @@
#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
};
+*/
diff --git a/src/lisp/ao_lisp_prim.c b/src/lisp/ao_lisp_prim.c
index ccfd2be4..38dcb961 100644
--- a/src/lisp/ao_lisp_prim.c
+++ b/src/lisp/ao_lisp_prim.c
@@ -14,31 +14,25 @@
#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:
diff --git a/src/lisp/ao_lisp_read.c b/src/lisp/ao_lisp_read.c
index ccb4ba3a..ea98b976 100644
--- a/src/lisp/ao_lisp_read.c
+++ b/src/lisp/ao_lisp_read.c
@@ -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
index 00000000..d26d270c
--- /dev/null
+++ b/src/lisp/ao_lisp_rep.c
@@ -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;
+}
diff --git a/src/lisp/ao_lisp_string.c b/src/lisp/ao_lisp_string.c
index 1ab56933..39c3dc81 100644
--- a/src/lisp/ao_lisp_string.c
+++ b/src/lisp/ao_lisp_string.c
@@ -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
index 00000000..cb8f78e5
--- /dev/null
+++ b/src/nucleao-32/.gitignore
@@ -0,0 +1,2 @@
+ao_product.h
+nucleo-32*
diff --git a/src/nucleao-32/Makefile b/src/nucleao-32/Makefile
index a160fd2f..0df44317 100644
--- a/src/nucleao-32/Makefile
+++ b/src/nucleao-32/Makefile
@@ -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
diff --git a/src/nucleao-32/ao_nucleo.c b/src/nucleao-32/ao_nucleo.c
index cda889c6..113e2399 100644
--- a/src/nucleao-32/ao_nucleo.c
+++ b/src/nucleao-32/ao_nucleo.c
@@ -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
index 00000000..cb8f78e5
--- /dev/null
+++ b/src/nucleao-32/flash-loader/.gitignore
@@ -0,0 +1,2 @@
+ao_product.h
+nucleo-32*
diff --git a/src/test/Makefile b/src/test/Makefile
index e841bfde..6c51c421 100644
--- a/src/test/Makefile
+++ b/src/test/Makefile
@@ -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
diff --git a/src/test/ao_lisp_test.c b/src/test/ao_lisp_test.c
index 96f1fd72..810a1528 100644
--- a/src/test/ao_lisp_test.c
+++ b/src/test/ao_lisp_test.c
@@ -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
}
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-31 19:58:55 +0000