altos/scheme: Fix macro-detection debugging

[fw/altos] / src / scheme / ao_scheme_read.c

diff --git a/src/scheme/ao_scheme_read.c b/src/scheme/ao_scheme_read.c
index dce480ab1745197f0b858be9ef25b1bd57b6b846..7d540aa5af22f26991dacd194371bbc9673215a6 100644 (file)
--- a/src/scheme/ao_scheme_read.c
+++ b/src/scheme/ao_scheme_read.c
@@ -53,7 +53,7 @@ static const uint16_t lex_classes[128] = {
        PRINTABLE|WHITE,        /*    */
        PRINTABLE,              /* ! */
        PRINTABLE|STRINGC,      /* " */
-       PRINTABLE|POUND,        /* # */
+       PRINTABLE,              /* # */
        PRINTABLE,              /* $ */
        PRINTABLE,              /* % */
        PRINTABLE,              /* & */
@@ -83,12 +83,12 @@ static const uint16_t       lex_classes[128] = {
        PRINTABLE,              /* > */
        PRINTABLE,              /* ? */
        PRINTABLE,              /*  @ */
-       PRINTABLE,              /*  A */
-       PRINTABLE,              /*  B */
-       PRINTABLE,              /*  C */
-       PRINTABLE,              /*  D */
-       PRINTABLE|FLOATC,       /*  E */
-       PRINTABLE,              /*  F */
+       PRINTABLE|HEX_LETTER,   /*  A */
+       PRINTABLE|HEX_LETTER,   /*  B */
+       PRINTABLE|HEX_LETTER,   /*  C */
+       PRINTABLE|HEX_LETTER,   /*  D */
+       PRINTABLE|FLOATC|HEX_LETTER,/*  E */
+       PRINTABLE|HEX_LETTER,   /*  F */
        PRINTABLE,              /*  G */
        PRINTABLE,              /*  H */
        PRINTABLE,              /*  I */
@@ -115,12 +115,12 @@ static const uint16_t     lex_classes[128] = {
        PRINTABLE,              /*  ^ */
        PRINTABLE,              /*  _ */
        PRINTABLE|SPECIAL_QUASI,        /*  ` */
-       PRINTABLE,              /*  a */
-       PRINTABLE,              /*  b */
-       PRINTABLE,              /*  c */
-       PRINTABLE,              /*  d */
-       PRINTABLE|FLOATC,       /*  e */
-       PRINTABLE,              /*  f */
+       PRINTABLE|HEX_LETTER,   /*  a */
+       PRINTABLE|HEX_LETTER,   /*  b */
+       PRINTABLE|HEX_LETTER,   /*  c */
+       PRINTABLE|HEX_LETTER,   /*  d */
+       PRINTABLE|FLOATC|HEX_LETTER,/*  e */
+       PRINTABLE|HEX_LETTER,   /*  f */
        PRINTABLE,              /*  g */
        PRINTABLE,              /*  h */
        PRINTABLE,              /*  i */
@@ -284,6 +284,30 @@ static const struct namedfloat namedfloats[] = {
 #define NUM_NAMED_FLOATS       (sizeof namedfloats / sizeof namedfloats[0])
 #endif
 
+static int
+parse_int(int base)
+{
+       int     cval;
+       int     c;
+
+       token_int = 0;
+       for (;;) {
+               c = lexc();
+               if ((lex_class & HEX_DIGIT) == 0) {
+                       lex_unget(c);
+                       end_token();
+                       return NUM;
+               }
+               add_token(c);
+               if ('0' <= c && c <= '9')
+                       cval = c - '0';
+               else
+                       cval = (c | ('a' - 'A')) - 'a' + 10;
+               token_int = token_int * base + cval;
+       }
+       return NUM;
+}
+
 static int
 _lex(void)
 {
@@ -336,7 +360,7 @@ _lex(void)
 #endif
                        }
                }
-               if (lex_class & POUND) {
+               if (c == '#') {
                        c = lexc();
                        switch (c) {
                        case 't':
@@ -387,6 +411,12 @@ _lex(void)
                                        continue;
                                }
                                return NUM;
+                       case 'x':
+                               return parse_int(16);
+                       case 'o':
+                               return parse_int(8);
+                       case 'b':
+                               return parse_int(2);
                        }
                }
                if (lex_class & STRINGC) {
@@ -486,7 +516,7 @@ _lex(void)
 static inline int lex(void)
 {
        int     parse_token = _lex();
-       RDBGI("token %d (%s)\n", parse_token, token_string);
+       RDBGI("token %d \"%s\"\n", parse_token, token_string);
        return parse_token;
 }
 
@@ -510,7 +540,7 @@ push_read_stack(int read_state)
        RDBG_IN();
        if (ao_scheme_read_list) {
                ao_scheme_read_stack = ao_scheme_cons_cons(ao_scheme_cons_poly(ao_scheme_read_cons),
-                                                      ao_scheme__cons(ao_scheme_int_poly(read_state),
+                                                      ao_scheme_cons(ao_scheme_int_poly(read_state),
                                                                     ao_scheme_cons_poly(ao_scheme_read_stack)));
                if (!ao_scheme_read_stack)
                        return 0;
@@ -535,10 +565,11 @@ pop_read_stack(void)
                     ao_scheme_read_cons_tail = ao_scheme_poly_cons(ao_scheme_read_cons_tail->cdr))
                        ;
        } else {
-               ao_scheme_read_cons = 0;
-               ao_scheme_read_cons_tail = 0;
-               ao_scheme_read_stack = 0;
                read_state = ao_scheme_read_state;
+               ao_scheme_read_cons = NULL;
+               ao_scheme_read_cons_tail = NULL;
+               ao_scheme_read_stack = NULL;
+               ao_scheme_read_state = 0;
        }
        RDBG_OUT();
        RDBGI("pop read stack %p %d\n", ao_scheme_read_cons, read_state);
@@ -555,13 +586,13 @@ ao_poly
 ao_scheme_read(void)
 {
        struct ao_scheme_atom   *atom;
-       char                    *string;
+       struct ao_scheme_string *string;
        int                     read_state;
        ao_poly                 v = AO_SCHEME_NIL;
 
        ao_scheme_read_list = 0;
        read_state = 0;
-       ao_scheme_read_cons = ao_scheme_read_cons_tail = ao_scheme_read_stack = 0;
+       ao_scheme_read_cons = ao_scheme_read_cons_tail = ao_scheme_read_stack = NULL;
        for (;;) {
                parse_token = lex();
                while (is_open(parse_token)) {
@@ -605,7 +636,7 @@ ao_scheme_read(void)
                                v = _ao_scheme_bool_false;
                        break;
                case STRING:
-                       string = ao_scheme_string_copy(token_string);
+                       string = ao_scheme_string_make(token_string);
                        if (string)
                                v = ao_scheme_string_poly(string);
                        else
@@ -647,8 +678,10 @@ ao_scheme_read(void)
                        --ao_scheme_read_list;
                        read_state = pop_read_stack();
 #ifdef AO_SCHEME_FEATURE_VECTOR
-                       if (read_state & READ_SAW_VECTOR)
+                       if (read_state & READ_SAW_VECTOR) {
                                v = ao_scheme_vector_poly(ao_scheme_list_to_vector(ao_scheme_poly_cons(v)));
+                               read_state &= ~READ_SAW_VECTOR;
+                       }
 #endif
                        break;
                case DOT: