altos/lisp: Split out read debug, add memory validation

[fw/altos] / src / lisp / ao_lisp_read.c

diff --git a/src/lisp/ao_lisp_read.c b/src/lisp/ao_lisp_read.c
index c5a238cc5513132bbbda6107173995d3335e3dfa..0ca12a81f6fcc843c24ba2f046970f7e8a83a37c 100644 (file)
--- a/src/lisp/ao_lisp_read.c
+++ b/src/lisp/ao_lisp_read.c
@@ -15,6 +15,7 @@
 #include "ao_lisp.h"
 #include "ao_lisp_read.h"
 #include <math.h>
+#include <stdlib.h>
 
 static const uint16_t  lex_classes[128] = {
        IGNORE,         /* ^@ */
@@ -61,7 +62,7 @@ static const uint16_t lex_classes[128] = {
        PRINTABLE|SPECIAL,      /* ) */
        PRINTABLE,              /* * */
        PRINTABLE|SIGN,         /* + */
-       PRINTABLE,              /* , */
+       PRINTABLE|SPECIAL,      /* , */
        PRINTABLE|SIGN,         /* - */
        PRINTABLE|DOTC|FLOATC,  /* . */
        PRINTABLE,              /* / */
@@ -113,7 +114,7 @@ static const uint16_t       lex_classes[128] = {
        PRINTABLE,              /*  ] */
        PRINTABLE,              /*  ^ */
        PRINTABLE,              /*  _ */
-       PRINTABLE,              /*  ` */
+       PRINTABLE|SPECIAL,      /*  ` */
        PRINTABLE,              /*  a */
        PRINTABLE,              /*  b */
        PRINTABLE,              /*  c */
@@ -314,6 +315,18 @@ _lex(void)
                                return QUOTE;
                        case '.':
                                return DOT;
+                       case '`':
+                               return QUASIQUOTE;
+                       case ',':
+                               c = lexc();
+                               if (c == '@') {
+                                       add_token(c);
+                                       end_token();
+                                       return UNQUOTE_SPLICING;
+                               } else {
+                                       lex_unget(c);
+                                       return UNQUOTE;
+                               }
                        }
                }
                if (lex_class & POUND) {
@@ -433,7 +446,7 @@ _lex(void)
                                                return NUM;
                                        }
                                        if (isfloat && hasdigit) {
-                                               token_float = atof(token_string);
+                                               token_float = strtof(token_string, NULL);
                                                return FLOAT;
                                        }
                                        for (u = 0; u < NUM_NAMED_FLOATS; u++)
@@ -451,7 +464,7 @@ _lex(void)
 static inline int lex(void)
 {
        int     parse_token = _lex();
-       DBGI("token %d (%s)\n", parse_token, token_string);
+       RDBGI("token %d (%s)\n", parse_token, token_string);
        return parse_token;
 }
 
@@ -468,8 +481,8 @@ struct ao_lisp_cons *ao_lisp_read_stack;
 static int
 push_read_stack(int cons, int read_state)
 {
-       DBGI("push read stack %p 0x%x\n", ao_lisp_read_cons, read_state);
-       DBG_IN();
+       RDBGI("push read stack %p 0x%x\n", ao_lisp_read_cons, read_state);
+       RDBG_IN();
        if (cons) {
                ao_lisp_read_stack = ao_lisp_cons_cons(ao_lisp_cons_poly(ao_lisp_read_cons),
                                                       ao_lisp__cons(ao_lisp_int_poly(read_state),
@@ -500,8 +513,8 @@ pop_read_stack(int cons)
                ao_lisp_read_cons_tail = 0;
                ao_lisp_read_stack = 0;
        }
-       DBG_OUT();
-       DBGI("pop read stack %p %d\n", ao_lisp_read_cons, read_state);
+       RDBG_OUT();
+       RDBGI("pop read stack %p %d\n", ao_lisp_read_cons, read_state);
        return read_state;
 }
 
@@ -512,8 +525,7 @@ ao_lisp_read(void)
        char                    *string;
        int                     cons;
        int                     read_state;
-       ao_poly                 v;
-
+       ao_poly                 v = AO_LISP_NIL;
 
        cons = 0;
        read_state = 0;
@@ -562,11 +574,27 @@ ao_lisp_read(void)
                                v = AO_LISP_NIL;
                        break;
                case QUOTE:
+               case QUASIQUOTE:
+               case UNQUOTE:
+               case UNQUOTE_SPLICING:
                        if (!push_read_stack(cons, read_state))
                                return AO_LISP_NIL;
                        cons++;
                        read_state = READ_IN_QUOTE;
-                       v = _ao_lisp_atom_quote;
+                       switch (parse_token) {
+                       case QUOTE:
+                               v = _ao_lisp_atom_quote;
+                               break;
+                       case QUASIQUOTE:
+                               v = _ao_lisp_atom_quasiquote;
+                               break;
+                       case UNQUOTE:
+                               v = _ao_lisp_atom_unquote;
+                               break;
+                       case UNQUOTE_SPLICING:
+                               v = _ao_lisp_atom_unquote2dsplicing;
+                               break;
+                       }
                        break;
                case CLOSE:
                        if (!cons) {