Add first lisp bits
authorKeith Packard <keithp@keithp.com>
Mon, 31 Oct 2016 23:43:44 +0000 (16:43 -0700)
committerKeith Packard <keithp@keithp.com>
Mon, 20 Feb 2017 19:16:49 +0000 (11:16 -0800)
Signed-off-by: Keith Packard <keithp@keithp.com>
13 files changed:
src/lisp/ao_lisp_atom.c [new file with mode: 0644]
src/lisp/ao_lisp_builtin.c [new file with mode: 0644]
src/lisp/ao_lisp_cons.c [new file with mode: 0644]
src/lisp/ao_lisp_eval.c [new file with mode: 0644]
src/lisp/ao_lisp_int.c [new file with mode: 0644]
src/lisp/ao_lisp_lex.c [new file with mode: 0644]
src/lisp/ao_lisp_mem.c [new file with mode: 0644]
src/lisp/ao_lisp_poly.c [new file with mode: 0644]
src/lisp/ao_lisp_prim.c [new file with mode: 0644]
src/lisp/ao_lisp_string.c [new file with mode: 0644]
src/stmf0/Makefile-stmf0.defs
src/test/Makefile
src/test/ao_lisp_test.c [new file with mode: 0644]

diff --git a/src/lisp/ao_lisp_atom.c b/src/lisp/ao_lisp_atom.c
new file mode 100644 (file)
index 0000000..6528214
--- /dev/null
@@ -0,0 +1,107 @@
+/*
+ * 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; 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 (file)
index 0000000..3752a2c
--- /dev/null
@@ -0,0 +1,21 @@
+/*
+ * 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"
+
+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 (file)
index 0000000..60cbb2f
--- /dev/null
@@ -0,0 +1,84 @@
+/*
+ * 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"
+
+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 (file)
index 0000000..531e3b7
--- /dev/null
@@ -0,0 +1,152 @@
+/*
+ * 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"
+
+/*
+ * 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 (file)
index 0000000..6ee3096
--- /dev/null
@@ -0,0 +1,21 @@
+/*
+ * 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"
+
+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 (file)
index 0000000..d62db87
--- /dev/null
@@ -0,0 +1,146 @@
+/*
+ * 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"
+
+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 (file)
index 0000000..f6a108e
--- /dev/null
@@ -0,0 +1,246 @@
+/*
+ * 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 <stdio.h>
+
+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 (file)
index 0000000..1855d94
--- /dev/null
@@ -0,0 +1,132 @@
+/*
+ * 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"
+
+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 (file)
index 0000000..ccfd2be
--- /dev/null
@@ -0,0 +1,71 @@
+/*
+ * 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_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 (file)
index 0000000..8702427
--- /dev/null
@@ -0,0 +1,87 @@
+/*
+ * 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; 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('"');
+}
index f3296b6959628d14951c0e28b28338af4b720b86..0ccfbe2a8a9550139627b9b9f60198ea1dd8bd67 100644 (file)
@@ -4,7 +4,7 @@ endif
 
 include $(TOPDIR)/Makedefs
 
 
 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
 vpath make-altitude $(TOPDIR)/util
 vpath make-kalman $(TOPDIR)/util
 vpath kalman.5c $(TOPDIR)/kalman
index 02e1d22b6c1b502ff92c71a11498084b5ed8c518..a409ae1300fbbac3ff96216e4df737ece7f97f75 100644 (file)
@@ -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 \
 
 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 
 
 
 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
 
 
 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_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 (file)
index 0000000..bbadfa7
--- /dev/null
@@ -0,0 +1,58 @@
+/*
+ * 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 <stdio.h>
+
+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");
+}