From 56d46ceaa1413415f25e47e81036426132f99924 Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Mon, 31 Oct 2016 16:43:44 -0700 Subject: [PATCH] Add first lisp bits Signed-off-by: Keith Packard --- src/lisp/ao_lisp_atom.c | 107 +++++++++++++++ src/lisp/ao_lisp_builtin.c | 21 +++ src/lisp/ao_lisp_cons.c | 84 ++++++++++++ src/lisp/ao_lisp_eval.c | 152 +++++++++++++++++++++ src/lisp/ao_lisp_int.c | 21 +++ src/lisp/ao_lisp_lex.c | 146 ++++++++++++++++++++ src/lisp/ao_lisp_mem.c | 246 ++++++++++++++++++++++++++++++++++ src/lisp/ao_lisp_poly.c | 132 ++++++++++++++++++ src/lisp/ao_lisp_prim.c | 71 ++++++++++ src/lisp/ao_lisp_string.c | 87 ++++++++++++ src/stmf0/Makefile-stmf0.defs | 2 +- src/test/Makefile | 13 +- src/test/ao_lisp_test.c | 58 ++++++++ 13 files changed, 1136 insertions(+), 4 deletions(-) create mode 100644 src/lisp/ao_lisp_atom.c create mode 100644 src/lisp/ao_lisp_builtin.c create mode 100644 src/lisp/ao_lisp_cons.c create mode 100644 src/lisp/ao_lisp_eval.c create mode 100644 src/lisp/ao_lisp_int.c create mode 100644 src/lisp/ao_lisp_lex.c create mode 100644 src/lisp/ao_lisp_mem.c create mode 100644 src/lisp/ao_lisp_poly.c create mode 100644 src/lisp/ao_lisp_prim.c create mode 100644 src/lisp/ao_lisp_string.c create mode 100644 src/test/ao_lisp_test.c diff --git a/src/lisp/ao_lisp_atom.c b/src/lisp/ao_lisp_atom.c new file mode 100644 index 00000000..65282142 --- /dev/null +++ b/src/lisp/ao_lisp_atom.c @@ -0,0 +1,107 @@ +/* + * Copyright © 2016 Keith Packard + * + * 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; version 2 of the License. + * + * 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. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA. + */ + +#include "ao_lisp.h" + +static int name_size(char *name) +{ + return sizeof(struct ao_lisp_atom) + strlen(name) + 1; +} + +static int atom_size(void *addr) +{ + struct ao_lisp_atom *atom = addr; + if (!atom) + return 0; + return name_size(atom->name); +} + +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; + if (!atom) + break; + if (ao_lisp_mark_memory(atom, atom_size(atom))) + break; + } +} + +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)); + if (!next) + break; + atom->next = next; + atom = next; + } +} + +const struct ao_lisp_mem_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_atom_intern(char *name) +{ + struct ao_lisp_atom *atom; + int b; + + for (atom = atoms; atom; 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); + atom = ao_lisp_alloc(name_size(name)); + if (atom) { + atom->type = AO_LISP_ATOM; + atom->next = atoms; + atoms = atom; + strcpy(atom->name, name); + atom->val = AO_LISP_NIL; + } + return atom; +} + +void +ao_lisp_atom_print(struct ao_lisp_atom *a) +{ + fputs(a->name, stdout); +} diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c new file mode 100644 index 00000000..3752a2c8 --- /dev/null +++ b/src/lisp/ao_lisp_builtin.c @@ -0,0 +1,21 @@ +/* + * Copyright © 2016 Keith Packard + * + * 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" + +void +ao_lisp_builtin_print(struct ao_lisp_builtin *b) +{ + printf("[builtin %s]", b->name); +} diff --git a/src/lisp/ao_lisp_cons.c b/src/lisp/ao_lisp_cons.c new file mode 100644 index 00000000..60cbb2f3 --- /dev/null +++ b/src/lisp/ao_lisp_cons.c @@ -0,0 +1,84 @@ +/* + * Copyright © 2016 Keith Packard + * + * 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" + +static void cons_mark(void *addr) +{ + struct ao_lisp_cons *cons = addr; + + for (;;) { + ao_lisp_poly_mark(cons->car); + cons = cons->cdr; + if (!cons) + break; + if (ao_lisp_mark_memory(cons, sizeof (struct ao_lisp_cons))) + break; + } +} + +static int cons_size(void *addr) +{ + (void) addr; + return sizeof (struct ao_lisp_cons); +} + +static void cons_move(void *addr) +{ + struct ao_lisp_cons *cons = addr; + + for (;;) { + 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)); + if (!cdr) + break; + cons->cdr = cdr; + cons = cdr; + } +} + +const struct ao_lisp_mem_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) +{ + struct ao_lisp_cons *cons = ao_lisp_alloc(sizeof (struct ao_lisp_cons)); + if (!cons) + return NULL; + cons->car = car; + cons->cdr = cdr; + return cons; +} + +void +ao_lisp_cons_print(struct ao_lisp_cons *cons) +{ + int first = 1; + printf("("); + while (cons) { + if (!first) + printf(" "); + fflush(stdout); + ao_lisp_poly_print(cons->car); + cons = cons->cdr; + first = 0; + } + printf(")"); +} diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c new file mode 100644 index 00000000..531e3b72 --- /dev/null +++ b/src/lisp/ao_lisp_eval.c @@ -0,0 +1,152 @@ +/* + * Copyright © 2016 Keith Packard + * + * 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" + +/* + * Non-recursive eval + * + * Plan: walk actuals, construct formals + * + * stack > save > actuals > actual_1 + * v v + * formals . > actual_2 + */ + +static struct ao_lisp_cons *stack; +static struct ao_lisp_cons *actuals; +static struct ao_lisp_cons *formals; +static struct ao_lisp_cons *formals_tail; +static uint8_t been_here; + +ao_lisp_poly +ao_lisp_eval(ao_lisp_poly v) +{ + struct ao_lisp_cons *formal; + int cons = 0; + + if (!been_here) { + been_here = 1; + ao_lisp_root_add(&ao_lisp_cons_type, &stack); + ao_lisp_root_add(&ao_lisp_cons_type, &actuals); + ao_lisp_root_add(&ao_lisp_cons_type, &formals); + ao_lisp_root_add(&ao_lisp_cons_type, &formals_tail); + } + stack = 0; + actuals = 0; + formals = 0; + formals_tail = 0; + for (;;) { + + /* Build stack frames for each list */ + while (ao_lisp_poly_type(v) == AO_LISP_CONS) { + if (v == AO_LISP_NIL) + break; + + /* Push existing frame on the stack */ + 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); + } + actuals = ao_lisp_poly_cons(v); + formals = NULL; + formals_tail = NULL; + v = actuals->car; + + printf("start: stack"); ao_lisp_cons_print(stack); printf("\n"); + printf("start: actuals"); ao_lisp_cons_print(actuals); printf("\n"); + printf("start: formals"); ao_lisp_cons_print(formals); printf("\n"); + } + + /* Evaluate primitive types */ + + switch (ao_lisp_poly_type(v)) { + case AO_LISP_INT: + case AO_LISP_STRING: + break; + case AO_LISP_ATOM: + v = ao_lisp_poly_atom(v)->val; + break; + } + + for (;;) { + printf("add formal: "); ao_lisp_poly_print(v); printf("\n"); + + formal = ao_lisp_cons(v, NULL); + if (formals_tail) + formals_tail->cdr = formal; + else + formals = formal; + formals_tail = formal; + actuals = actuals->cdr; + + printf("formals: "); + ao_lisp_cons_print(formals); + printf("\n"); + printf("actuals: "); + ao_lisp_cons_print(actuals); + printf("\n"); + + /* Process all of the arguments */ + if (actuals) { + v = actuals->car; + printf ("actual: "); ao_lisp_poly_print(v); printf("\n"); + break; + } + + v = formals->car; + + /* Evaluate the resulting list */ + if (ao_lisp_poly_type(v) == AO_LISP_BUILTIN) { + struct ao_lisp_builtin *b = ao_lisp_poly_builtin(v); + + v = b->func(formals->cdr); + + printf ("eval: "); + ao_lisp_cons_print(formals); + printf(" -> "); + ao_lisp_poly_print(v); + printf ("\n"); + } else { + printf ("invalid eval\n"); + } + + 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; + + /* Recompute the tail of the formals list */ + for (formal = formals; formal->cdr != NULL; formal = formal->cdr); + formals_tail = formal; + + stack = stack->cdr; + printf("stack pop: stack"); ao_lisp_cons_print(stack); printf("\n"); + printf("stack pop: actuals"); ao_lisp_cons_print(actuals); printf("\n"); + printf("stack pop: formals"); ao_lisp_cons_print(formals); printf("\n"); + } else { + printf("done func\n"); + break; + } + } + if (!cons) + break; + } + return v; +} diff --git a/src/lisp/ao_lisp_int.c b/src/lisp/ao_lisp_int.c new file mode 100644 index 00000000..6ee3096d --- /dev/null +++ b/src/lisp/ao_lisp_int.c @@ -0,0 +1,21 @@ +/* + * Copyright © 2016 Keith Packard + * + * 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" + +void +ao_lisp_int_print(int i) +{ + printf("%d", i); +} diff --git a/src/lisp/ao_lisp_lex.c b/src/lisp/ao_lisp_lex.c new file mode 100644 index 00000000..d62db872 --- /dev/null +++ b/src/lisp/ao_lisp_lex.c @@ -0,0 +1,146 @@ +/* + * Copyright © 2016 Keith Packard + * + * 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" + +const uint32_t classTable[256] = { + IGNORE, /* ^@ */ + IGNORE, /* ^A */ + IGNORE, /* ^B */ + IGNORE, /* ^C */ + IGNORE, /* ^D */ + IGNORE, /* ^E */ + IGNORE, /* ^F */ + IGNORE, /* ^G */ + IGNORE, /* ^H */ + WHITE, /* ^I */ + WHITE, /* ^J */ + WHITE, /* ^K */ + WHITE, /* ^L */ + WHITE, /* ^M */ + IGNORE, /* ^N */ + IGNORE, /* ^O */ + IGNORE, /* ^P */ + IGNORE, /* ^Q */ + IGNORE, /* ^R */ + IGNORE, /* ^S */ + IGNORE, /* ^T */ + IGNORE, /* ^U */ + IGNORE, /* ^V */ + IGNORE, /* ^W */ + IGNORE, /* ^X */ + IGNORE, /* ^Y */ + IGNORE, /* ^Z */ + IGNORE, /* ^[ */ + IGNORE, /* ^\ */ + IGNORE, /* ^] */ + IGNORE, /* ^^ */ + IGNORE, /* ^_ */ + PRINTABLE|WHITE, /* */ + PRINTABLE, /* ! */ + PRINTABLE|STRINGC, /* " */ + PRINTABLE|COMMENT, /* # */ + PRINTABLE, /* $ */ + PRINTABLE, /* % */ + PRINTABLE, /* & */ + PRINTABLE|QUOTEC, /* ' */ + PRINTABLE|BRA, /* ( */ + PRINTABLE|KET, /* ) */ + PRINTABLE, /* * */ + PRINTABLE|SIGN, /* + */ + PRINTABLE, /* , */ + PRINTABLE|SIGN, /* - */ + PRINTABLE|DOT, /* . */ + PRINTABLE, /* / */ + PRINTABLE|DIGIT, /* 0 */ + PRINTABLE|DIGIT, /* 1 */ + PRINTABLE|DIGIT, /* 2 */ + PRINTABLE|DIGIT, /* 3 */ + PRINTABLE|DIGIT, /* 4 */ + PRINTABLE|DIGIT, /* 5 */ + PRINTABLE|DIGIT, /* 6 */ + PRINTABLE|DIGIT, /* 7 */ + PRINTABLE|DIGIT, /* 8 */ + PRINTABLE|DIGIT, /* 9 */ + PRINTABLE, /* : */ + PRINTABLE|COMMENT, /* ; */ + PRINTABLE, /* < */ + PRINTABLE, /* = */ + PRINTABLE, /* > */ + PRINTABLE, /* ? */ + PRINTABLE, /* @ */ + PRINTABLE, /* A */ + PRINTABLE, /* B */ + PRINTABLE, /* C */ + PRINTABLE, /* D */ + PRINTABLE|EXP, /* E */ + PRINTABLE, /* F */ + PRINTABLE, /* G */ + PRINTABLE, /* H */ + PRINTABLE, /* I */ + PRINTABLE, /* J */ + PRINTABLE, /* K */ + PRINTABLE, /* L */ + PRINTABLE, /* M */ + PRINTABLE, /* N */ + PRINTABLE, /* O */ + PRINTABLE, /* P */ + PRINTABLE, /* Q */ + PRINTABLE, /* R */ + PRINTABLE, /* S */ + PRINTABLE, /* T */ + PRINTABLE, /* U */ + PRINTABLE, /* V */ + PRINTABLE, /* W */ + PRINTABLE, /* X */ + PRINTABLE, /* Y */ + PRINTABLE, /* Z */ + PRINTABLE|BRA, /* [ */ + PRINTABLE|BACKSLASH, /* \ */ + PRINTABLE|KET, /* ] */ + PRINTABLE, /* ^ */ + PRINTABLE, /* _ */ + PRINTABLE, /* ` */ + PRINTABLE, /* a */ + PRINTABLE, /* b */ + PRINTABLE, /* c */ + PRINTABLE, /* d */ + PRINTABLE|EXP, /* e */ + PRINTABLE, /* f */ + PRINTABLE, /* g */ + PRINTABLE, /* h */ + PRINTABLE, /* i */ + PRINTABLE, /* j */ + PRINTABLE, /* k */ + PRINTABLE, /* l */ + PRINTABLE, /* m */ + PRINTABLE, /* n */ + PRINTABLE, /* o */ + PRINTABLE, /* p */ + PRINTABLE, /* q */ + PRINTABLE, /* r */ + PRINTABLE, /* s */ + PRINTABLE, /* t */ + PRINTABLE, /* u */ + PRINTABLE, /* v */ + PRINTABLE, /* w */ + PRINTABLE, /* x */ + PRINTABLE, /* y */ + PRINTABLE, /* z */ + PRINTABLE|BRA, /* { */ + PRINTABLE|VBAR, /* | */ + PRINTABLE|KET, /* } */ + PRINTABLE|TWIDDLE, /* ~ */ + IGNORE, /* ^? */ +}; diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c new file mode 100644 index 00000000..f6a108e9 --- /dev/null +++ b/src/lisp/ao_lisp_mem.c @@ -0,0 +1,246 @@ +/* + * Copyright © 2016 Keith Packard + * + * 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 + +uint8_t ao_lisp_pool[AO_LISP_POOL]; + +struct ao_lisp_root { + void **addr; + const struct ao_lisp_mem_type *type; +}; + +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; + +static inline void mark(uint8_t *tag, int offset) { + int byte = offset >> 5; + int bit = (offset >> 2) & 7; + tag[byte] |= (1 << bit); +} + +static inline void clear(uint8_t *tag, int offset) { + int byte = offset >> 5; + int bit = (offset >> 2) & 7; + tag[byte] &= ~(1 << bit); +} + +static inline int busy(uint8_t *tag, int offset) { + int byte = offset >> 5; + int bit = (offset >> 2) & 7; + return (tag[byte] >> bit) & 1; +} + +static inline int min(int a, int b) { return a < b ? a : b; } +static inline int max(int a, int b) { return a > b ? a : b; } + +static inline int limit(int offset) { + return min(AO_LISP_POOL, max(offset, 0)); +} + +static int +mark_object(uint8_t *tag, void *addr, int size) { + int base; + int bound; + if (!addr) + return 1; + + base = (uint8_t *) addr - ao_lisp_pool; + bound = base + size; + + base = limit(base); + bound = limit(bound); + if (busy(tag, base)) + return 1; + while (base < bound) { + mark(tag, base); + base += 4; + } + return 0; +} + +static int +clear_object(uint8_t *tag, void *addr, int size) { + int base; + int bound; + if (!addr) + return 1; + + base = (uint8_t *) addr - ao_lisp_pool; + bound = base + size; + + base = limit(base); + bound = limit(bound); + if (!busy(tag, base)) + return 1; + while (base < bound) { + clear(tag, base); + base += 4; + } + return 0; +} + +static void *move_old, *move_new; +static int move_size; + +static void +move_object(void) +{ + int i; + + memset(ao_lisp_moving, '\0', sizeof (ao_lisp_moving)); + for (i = 0; i < AO_LISP_ROOT; i++) + if (ao_lisp_root[i].addr) { + void *new; + new = ao_lisp_move(ao_lisp_root[i].type, *ao_lisp_root[i].addr); + if (new) + *ao_lisp_root[i].addr = new; + } +} + +static void +collect(void) +{ + int i; + + printf("collect\n"); + /* Mark */ + memset(ao_lisp_busy, '\0', sizeof (ao_lisp_busy)); + for (i = 0; i < AO_LISP_ROOT; i++) + if (ao_lisp_root[i].addr) + ao_lisp_mark(ao_lisp_root[i].type, *ao_lisp_root[i].addr); + + /* Compact */ + ao_lisp_top = 0; + for (i = 0; i < AO_LISP_POOL; i += 4) { + if (!busy(ao_lisp_busy, i)) + break; + } + ao_lisp_top = i; + while(i < AO_LISP_POOL) { + if (busy(ao_lisp_busy, i)) { + move_old = &ao_lisp_pool[i]; + move_new = &ao_lisp_pool[ao_lisp_top]; + move_size = 0; + move_object(); + clear_object(ao_lisp_busy, move_old, move_size); + i += move_size; + ao_lisp_top += move_size; + } else { + i += 4; + } + } +} + + +void +ao_lisp_mark(const struct ao_lisp_mem_type *type, void *addr) +{ + if (mark_object(ao_lisp_busy, addr, type->size(addr))) + return; + type->mark(addr); +} + +int +ao_lisp_mark_memory(void *addr, int size) +{ + return mark_object(ao_lisp_busy, addr, size); +} + +static void * +check_move(void *addr, int size) +{ + if (addr == move_old) { + memmove(move_new, move_old, size); + move_size = (size + 3) & ~3; + addr = move_new; + } + return addr; +} + +void * +ao_lisp_move(const struct ao_lisp_mem_type *type, void *addr) +{ + int size = type->size(addr); + + if (!addr) + return NULL; + + addr = check_move(addr, size); + if (mark_object(ao_lisp_moving, addr, size)) + return addr; + type->move(addr); + return addr; +} + +void * +ao_lisp_move_memory(void *addr, int size) +{ + if (!addr) + return NULL; + + addr = check_move(addr, size); + if (mark_object(ao_lisp_moving, addr, size)) + return NULL; + return addr; +} + +void * +ao_lisp_alloc(int size) +{ + void *addr; + + size = (size + 3) & ~3; + if (ao_lisp_top + size > AO_LISP_POOL) { + collect(); + if (ao_lisp_top + size > AO_LISP_POOL) + return NULL; + } + addr = ao_lisp_pool + ao_lisp_top; + ao_lisp_top += size; + return addr; +} + +int +ao_lisp_root_add(const struct ao_lisp_mem_type *type, void *addr) +{ + int i; + for (i = 0; i < AO_LISP_ROOT; i++) { + if (!ao_lisp_root[i].addr) { + ao_lisp_root[i].addr = addr; + ao_lisp_root[i].type = type; + return 1; + } + } + return 0; +} + +void +ao_lisp_root_clear(void *addr) +{ + int i; + for (i = 0; i < AO_LISP_ROOT; i++) { + if (ao_lisp_root[i].addr == addr) { + ao_lisp_root[i].addr = 0; + ao_lisp_root[i].type = 0; + break; + } + } +} diff --git a/src/lisp/ao_lisp_poly.c b/src/lisp/ao_lisp_poly.c new file mode 100644 index 00000000..1855d945 --- /dev/null +++ b/src/lisp/ao_lisp_poly.c @@ -0,0 +1,132 @@ +/* + * Copyright © 2016 Keith Packard + * + * 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" + +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, + .func = ao_lisp_plus, + .name = "+" +}; + +static const struct ao_lisp_atom atom_plus = { + .type = AO_LISP_ATOM, + .val = AO_LISP_OTHER_POLY(&builtin_plus), + .next = AO_LISP_ATOM_CONST, + .name = "plus" +}; + +/* +static const struct ao_lisp_builtin builtin_minus = { + .type = AO_LISP_BUILTIN, + .func = ao_lisp_minus +}; + +static const struct ao_lisp_builtin builtin_times = { + .type = AO_LISP_BUILTIN, + .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 new file mode 100644 index 00000000..ccfd2be4 --- /dev/null +++ b/src/lisp/ao_lisp_prim.c @@ -0,0 +1,71 @@ +/* + * Copyright © 2016 Keith Packard + * + * 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_lisp_poly +ao_lisp_poly_print(ao_lisp_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 +ao_lisp_poly_mark(ao_lisp_poly p) +{ + switch (ao_lisp_poly_type(p)) { + case AO_LISP_CONS: + ao_lisp_mark(&ao_lisp_cons_type, ao_lisp_poly_cons(p)); + break; + case AO_LISP_STRING: + ao_lisp_mark(&ao_lisp_string_type, ao_lisp_poly_string(p)); + break; + case AO_LISP_ATOM: + ao_lisp_mark(&ao_lisp_atom_type, ao_lisp_poly_atom(p)); + break; + } +} + +ao_lisp_poly +ao_lisp_poly_move(ao_lisp_poly p) +{ + switch (ao_lisp_poly_type(p)) { + case AO_LISP_CONS: + p = ao_lisp_cons_poly(ao_lisp_move(&ao_lisp_cons_type, ao_lisp_poly_cons(p))); + break; + case AO_LISP_STRING: + p = ao_lisp_string_poly(ao_lisp_move(&ao_lisp_string_type, ao_lisp_poly_string(p))); + break; + case AO_LISP_ATOM: + p = ao_lisp_atom_poly(ao_lisp_move(&ao_lisp_atom_type, ao_lisp_poly_atom(p))); + break; + } + return p; +} diff --git a/src/lisp/ao_lisp_string.c b/src/lisp/ao_lisp_string.c new file mode 100644 index 00000000..87024271 --- /dev/null +++ b/src/lisp/ao_lisp_string.c @@ -0,0 +1,87 @@ +/* + * Copyright © 2016 Keith Packard + * + * 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; version 2 of the License. + * + * 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. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA. + */ + +#include "ao_lisp.h" + +static void string_mark(void *addr) +{ + (void) addr; +} + +static int string_size(void *addr) +{ + if (!addr) + return 0; + return strlen(addr) + 1; +} + +static void string_move(void *addr) +{ + (void) addr; +} + +char * +ao_lisp_string_new(int len) { + char *a = ao_lisp_alloc(len + 1); + if (!a) + return NULL; + a[len] = '\0'; + return a; +} + +char * +ao_lisp_string_cat(char *a, char *b) +{ + int alen = strlen(a); + int blen = strlen(b); + char *r = ao_lisp_alloc(alen + blen + 1); + if (!r) + return NULL; + strcpy(r, a); + strcpy(r+alen, b); + return r; +} + +const struct ao_lisp_mem_type ao_lisp_string_type = { + .mark = string_mark, + .size = string_size, + .move = string_move, +}; + +void +ao_lisp_string_print(char *s) +{ + char c; + putchar('"'); + while ((c = *s++)) { + switch (c) { + case '\n': + printf ("\\n"); + break; + case '\r': + printf ("\\r"); + break; + case '\t': + printf ("\\t"); + break; + default: + putchar(c); + break; + } + } + putchar('"'); +} diff --git a/src/stmf0/Makefile-stmf0.defs b/src/stmf0/Makefile-stmf0.defs index f3296b69..0ccfbe2a 100644 --- a/src/stmf0/Makefile-stmf0.defs +++ b/src/stmf0/Makefile-stmf0.defs @@ -4,7 +4,7 @@ endif include $(TOPDIR)/Makedefs -vpath % $(TOPDIR)/stmf0:$(TOPDIR)/product:$(TOPDIR)/drivers:$(TOPDIR)/kernel:$(TOPDIR)/util:$(TOPDIR)/kalman:$(TOPDIR/aes):$(TOPDIR):$(TOPDIR)/math +vpath % $(TOPDIR)/stmf0:$(TOPDIR)/product:$(TOPDIR)/drivers:$(TOPDIR)/kernel:$(TOPDIR)/util:$(TOPDIR)/kalman:$(TOPDIR/aes):$(TOPDIR):$(TOPDIR)/math:$(TOPDIR)/lisp vpath make-altitude $(TOPDIR)/util vpath make-kalman $(TOPDIR)/util vpath kalman.5c $(TOPDIR)/kalman diff --git a/src/test/Makefile b/src/test/Makefile index 02e1d22b..a409ae13 100644 --- a/src/test/Makefile +++ b/src/test/Makefile @@ -1,16 +1,16 @@ -vpath % ..:../kernel:../drivers:../util:../micropeak:../aes:../product +vpath % ..:../kernel:../drivers:../util:../micropeak:../aes:../product:../lisp PROGS=ao_flight_test ao_flight_test_baro ao_flight_test_accel ao_flight_test_noisy_accel ao_flight_test_mm \ ao_flight_test_metrum \ ao_gps_test ao_gps_test_skytraq ao_gps_test_ublox ao_convert_test ao_convert_pa_test ao_fec_test \ ao_aprs_test ao_micropeak_test ao_fat_test ao_aes_test ao_int64_test \ - ao_ms5607_convert_test ao_quaternion_test + ao_ms5607_convert_test ao_quaternion_test ao_lisp_test INCS=ao_kalman.h ao_ms5607.h ao_log.h ao_data.h altitude-pa.h altitude.h ao_quaternion.h KALMAN=make-kalman -CFLAGS=-I.. -I. -I../kernel -I../drivers -I../micropeak -I../product -O0 -g -Wall +CFLAGS=-I.. -I. -I../kernel -I../drivers -I../micropeak -I../product -I../lisp -O0 -g -Wall all: $(PROGS) ao_aprs_data.wav @@ -88,3 +88,10 @@ ao_ms5607_convert_test: ao_ms5607_convert_test.c ao_ms5607_convert_8051.c ao_int 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_test: $(AO_LISP_OBJS) + cc $(CFLAGS) -o $@ $(AO_LISP_OBJS) + +$(AO_LISP_OBJS): ao_lisp.h diff --git a/src/test/ao_lisp_test.c b/src/test/ao_lisp_test.c new file mode 100644 index 00000000..bbadfa75 --- /dev/null +++ b/src/test/ao_lisp_test.c @@ -0,0 +1,58 @@ +/* + * Copyright © 2016 Keith Packard + * + * 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 + +static struct ao_lisp_cons *list; +static char *string; + +int +main (int argc, char **argv) +{ + int i, j; + struct ao_lisp_atom *atom; + ao_lisp_root_add(&ao_lisp_cons_type, (void **) &list); + ao_lisp_root_add(&ao_lisp_string_type, (void **) &string); + + /* allocator test */ + for (j = 0; j < 10; j++) { + list = 0; + string = ao_lisp_string_new(0); + for (i = 0; i < 7; 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); + atom = ao_lisp_atom_intern("ant"); + atom->val = ao_lisp_cons_poly(list); + list = ao_lisp_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))); + 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"); +} -- 2.30.2