altos/scheme: Add ports. Split scheme code up.
[fw/altos] / src / scheme / ao_scheme_make_const.c
index cf42ec521490c3e51dd7ca47fcb75324bd5603d2..8561bf0b47d39302846f452ea3a7a4427a3ae6d4 100644 (file)
@@ -17,6 +17,7 @@
 #include <ctype.h>
 #include <unistd.h>
 #include <getopt.h>
+#include <stdbool.h>
 
 static struct ao_scheme_builtin *
 ao_scheme_make_builtin(enum ao_scheme_builtin_id func, int args) {
@@ -29,15 +30,25 @@ ao_scheme_make_builtin(enum ao_scheme_builtin_id func, int args) {
 }
 
 struct builtin_func {
-       char    *name;
-       int     args;
+       const char      *feature;
+       const char      *name;
+       int             args;
        enum ao_scheme_builtin_id       func;
 };
 
+struct builtin_atom {
+       const char      *feature;
+       const char      *name;
+};
+
 #define AO_SCHEME_BUILTIN_CONSTS
+#define AO_SCHEME_BUILTIN_ATOM_NAMES
+
 #include "ao_scheme_builtin.h"
 
-#define N_FUNC (sizeof funcs / sizeof funcs[0])
+#define N_FUNC         (sizeof funcs / sizeof funcs[0])
+
+#define N_ATOM         (sizeof atoms / sizeof atoms[0])
 
 struct ao_scheme_frame *globals;
 
@@ -69,7 +80,7 @@ ao_fec_crc_byte(uint8_t byte, uint16_t crc)
        return crc;
 }
 
-uint16_t
+static uint16_t
 ao_fec_crc(const uint8_t *bytes, uint8_t len)
 {
        uint16_t        crc = AO_FEC_CRC_INIT;
@@ -86,7 +97,7 @@ struct ao_scheme_macro_stack {
 
 struct ao_scheme_macro_stack *macro_stack;
 
-int
+static int
 ao_scheme_macro_push(ao_poly p)
 {
        struct ao_scheme_macro_stack *m = macro_stack;
@@ -103,7 +114,7 @@ ao_scheme_macro_push(ao_poly p)
        return 0;
 }
 
-void
+static void
 ao_scheme_macro_pop(void)
 {
        struct ao_scheme_macro_stack *m = macro_stack;
@@ -114,9 +125,9 @@ ao_scheme_macro_pop(void)
 
 #define DBG_MACRO 0
 #if DBG_MACRO
-int macro_scan_depth;
+static int macro_scan_depth;
 
-void indent(void)
+static void indent(void)
 {
        int i;
        for (i = 0; i < macro_scan_depth; i++)
@@ -130,7 +141,7 @@ void indent(void)
 ao_poly
 ao_has_macro(ao_poly p);
 
-ao_poly
+static ao_poly
 ao_macro_test_get(ao_poly atom)
 {
        ao_poly *ref = ao_scheme_atom_ref(atom, NULL);
@@ -139,14 +150,14 @@ ao_macro_test_get(ao_poly atom)
        return AO_SCHEME_NIL;
 }
 
-ao_poly
+static ao_poly
 ao_is_macro(ao_poly p)
 {
        struct ao_scheme_builtin        *builtin;
        struct ao_scheme_lambda *lambda;
        ao_poly ret;
 
-       MACRO_DEBUG(indent(); printf ("is macro "); ao_scheme_poly_write(p); printf("\n"); ++macro_scan_depth);
+       MACRO_DEBUG(indent(); ao_scheme_printf ("is macro %v\n", p); ++macro_scan_depth);
        switch (ao_scheme_poly_type(p)) {
        case AO_SCHEME_ATOM:
                if (ao_scheme_macro_push(p))
@@ -181,7 +192,7 @@ ao_is_macro(ao_poly p)
                ret = AO_SCHEME_NIL;
                break;
        }
-       MACRO_DEBUG(--macro_scan_depth; indent(); printf ("... "); ao_scheme_poly_write(ret); printf("\n"));
+       MACRO_DEBUG(--macro_scan_depth; indent(); ao_scheme_printf ("... %v\n", ret););
        return ret;
 }
 
@@ -196,11 +207,11 @@ ao_has_macro(ao_poly p)
        if (p == AO_SCHEME_NIL)
                return AO_SCHEME_NIL;
 
-       MACRO_DEBUG(indent(); printf("has macro "); ao_scheme_poly_write(p); printf("\n"); ++macro_scan_depth);
+       MACRO_DEBUG(indent(); ao_scheme_printf("has macro %v\n", p); ++macro_scan_depth);
        switch (ao_scheme_poly_type(p)) {
        case AO_SCHEME_LAMBDA:
                lambda = ao_scheme_poly_lambda(p);
-               p = ao_has_macro(lambda->code);
+               p = ao_has_macro(ao_scheme_poly_cons(lambda->code)->cdr);
                break;
        case AO_SCHEME_CONS:
                cons = ao_scheme_poly_cons(p);
@@ -209,7 +220,7 @@ ao_has_macro(ao_poly p)
 
                list = cons->cdr;
                p = AO_SCHEME_NIL;
-               while (list != AO_SCHEME_NIL && ao_scheme_poly_type(list) == AO_SCHEME_CONS) {
+               while (ao_scheme_is_pair(list)) {
                        cons = ao_scheme_poly_cons(list);
                        m = ao_has_macro(cons->car);
                        if (m) {
@@ -224,23 +235,54 @@ ao_has_macro(ao_poly p)
                p = AO_SCHEME_NIL;
                break;
        }
-       MACRO_DEBUG(--macro_scan_depth; indent(); printf("... "); ao_scheme_poly_write(p); printf("\n"));
+       MACRO_DEBUG(--macro_scan_depth; indent(); ao_scheme_printf("... %v\n", p));
        return p;
 }
 
-int
-ao_scheme_read_eval_abort(void)
+static struct ao_scheme_builtin *
+ao_scheme_get_builtin(ao_poly p)
 {
-       ao_poly in, out = AO_SCHEME_NIL;
+       if (ao_scheme_poly_type(p) == AO_SCHEME_BUILTIN)
+               return ao_scheme_poly_builtin(p);
+       return NULL;
+}
+
+struct seen_builtin {
+       struct seen_builtin             *next;
+       struct ao_scheme_builtin        *builtin;
+};
+
+static struct seen_builtin *seen_builtins;
+
+static int
+ao_scheme_seen_builtin(struct ao_scheme_builtin *b)
+{
+       struct seen_builtin     *s;
+
+       for (s = seen_builtins; s; s = s->next)
+               if (s->builtin == b)
+                       return 1;
+       s = malloc (sizeof (struct seen_builtin));
+       s->builtin = b;
+       s->next = seen_builtins;
+       seen_builtins = s;
+       return 0;
+}
+
+static int
+ao_scheme_read_eval_abort(FILE *read_file)
+{
+       ao_poly in;
+
        for(;;) {
-               in = ao_scheme_read();
+               in = ao_scheme_read(read_file);
                if (in == _ao_scheme_atom_eof)
                        break;
-               out = ao_scheme_eval(in);
-               if (ao_scheme_exception)
+               (void) ao_scheme_eval(in);
+               if (ao_scheme_exception) {
+                       ao_scheme_fprintf(stderr, "make_const failed on %v\n", in);
                        return 0;
-               ao_scheme_poly_write(out);
-               putchar ('\n');
+               }
        }
        return 1;
 }
@@ -248,6 +290,65 @@ ao_scheme_read_eval_abort(void)
 static FILE    *in;
 static FILE    *out;
 
+struct feature {
+       struct feature  *next;
+       char            name[];
+};
+
+static struct feature *enable;
+static struct feature *disable;
+
+static void
+ao_scheme_add_feature(struct feature **list, char *name)
+{
+       struct feature *feature = malloc (sizeof (struct feature) + strlen(name) + 1);
+       strcpy(feature->name, name);
+       feature->next = *list;
+       *list = feature;
+}
+
+static bool
+_ao_scheme_has_feature(struct feature *list, const char *name, bool skip_undef)
+{
+       if (skip_undef && !strcmp(name, "UNDEF"))
+               return false;
+
+       while (list) {
+               if (!strcmp(list->name, name))
+                       return true;
+               list = list->next;
+       }
+       return false;
+}
+
+static bool
+ao_scheme_has_undef(struct feature *list)
+{
+       return _ao_scheme_has_feature(list, "UNDEF", false);
+}
+
+static bool
+ao_scheme_has_feature(struct feature *list, const char *name)
+{
+       return _ao_scheme_has_feature(list, name, true);
+}
+
+static void
+ao_scheme_add_features(struct feature **list, const char *names)
+{
+       char    *saveptr = NULL;
+       char    *name;
+       char    *copy = strdup(names);
+       char    *save = copy;
+
+       while ((name = strtok_r(copy, ",", &saveptr)) != NULL) {
+               copy = NULL;
+               if (!ao_scheme_has_feature(*list, name))
+                       ao_scheme_add_feature(list, name);
+       }
+       free(save);
+}
+
 int
 ao_scheme_getc(void)
 {
@@ -256,35 +357,46 @@ ao_scheme_getc(void)
 
 static const struct option options[] = {
        { .name = "out", .has_arg = 1, .val = 'o' },
+       { .name = "disable", .has_arg = 1, .val = 'd' },
+       { .name = "enable", .has_arg = 1, .val = 'e' },
        { 0, 0, 0, 0 }
 };
 
 static void usage(char *program)
 {
-       fprintf(stderr, "usage: %s [--out=<output>] [input]\n", program);
+       fprintf(stderr, "usage: %s [--out=<output>] [--disable={feature,...}] [--enable={feature,...} [input]\n", program);
        exit(1);
 }
 
 int
 main(int argc, char **argv)
 {
-       int     f, o;
+       int     f, o, an;
        ao_poly val;
        struct ao_scheme_atom   *a;
        struct ao_scheme_builtin        *b;
+       struct feature                  *d;
        int     in_atom = 0;
        char    *out_name = NULL;
        int     c;
        enum ao_scheme_builtin_id       prev_func;
+       enum ao_scheme_builtin_id       target_func;
+       enum ao_scheme_builtin_id       func_map[_builtin_last];
 
        in = stdin;
        out = stdout;
 
-       while ((c = getopt_long(argc, argv, "o:", options, NULL)) != -1) {
+       while ((c = getopt_long(argc, argv, "o:d:e:", options, NULL)) != -1) {
                switch (c) {
                case 'o':
                        out_name = optarg;
                        break;
+               case 'd':
+                       ao_scheme_add_features(&disable, optarg);
+                       break;
+               case 'e':
+                       ao_scheme_add_features(&enable, optarg);
+                       break;
                default:
                        usage(argv[0]);
                        break;
@@ -298,32 +410,56 @@ main(int argc, char **argv)
        ao_scheme_bool_get(1);
 
        prev_func = _builtin_last;
+       target_func = 0;
+       b = NULL;
        for (f = 0; f < (int) N_FUNC; f++) {
-               if (funcs[f].func != prev_func)
-                       b = ao_scheme_make_builtin(funcs[f].func, funcs[f].args);
-               a = ao_scheme_atom_intern(funcs[f].name);
-               ao_scheme_atom_def(ao_scheme_atom_poly(a),
-                                ao_scheme_builtin_poly(b));
+               if (ao_scheme_has_feature(enable, funcs[f].feature) || !ao_scheme_has_feature(disable, funcs[f].feature)) {
+                       if (funcs[f].func != prev_func) {
+                               prev_func = funcs[f].func;
+                               b = ao_scheme_make_builtin(prev_func, funcs[f].args);
+
+                               /* Target may have only a subset of
+                                * the enum values; record what those
+                                * values will be here. This obviously
+                                * depends on the functions in the
+                                * array being in the same order as
+                                * the enumeration; which
+                                * ao_scheme_make_builtin ensures.
+                                */
+                               func_map[prev_func] = target_func++;
+                       }
+                       a = ao_scheme_atom_intern((char *) funcs[f].name);
+                       ao_scheme_atom_def(ao_scheme_atom_poly(a),
+                                          ao_scheme_builtin_poly(b));
+               }
        }
 
-       /* end of file value */
-       a = ao_scheme_atom_intern("eof");
-       ao_scheme_atom_def(ao_scheme_atom_poly(a),
-                        ao_scheme_atom_poly(a));
-
-       /* 'else' */
-       a = ao_scheme_atom_intern("else");
+       /* atoms */
+       for (an = 0; an < (int) N_ATOM; an++) {
+               if (ao_scheme_has_feature(enable, atoms[an].feature) || !ao_scheme_has_feature(disable, atoms[an].feature))
+                       a = ao_scheme_atom_intern((char *) atoms[an].name);
+       }
 
-       if (argv[optind]){
+       while (argv[optind]) {
                in = fopen(argv[optind], "r");
                if (!in) {
                        perror(argv[optind]);
                        exit(1);
                }
+               if (!ao_scheme_read_eval_abort(in)) {
+                       fprintf(stderr, "eval failed\n");
+                       exit(1);
+               }
+               fclose(in);
+               optind++;
        }
-       if (!ao_scheme_read_eval_abort()) {
-               fprintf(stderr, "eval failed\n");
-               exit(1);
+
+       if (!ao_scheme_has_undef(enable) && ao_scheme_has_undef(disable)) {
+               struct ao_scheme_cons cons;
+
+               cons.car = _ao_scheme_atom_undef;
+               cons.cdr = AO_SCHEME_NIL;
+               ao_scheme_do_undef(&cons);
        }
 
        /* Reduce to referenced values */
@@ -331,14 +467,22 @@ main(int argc, char **argv)
 
        for (f = 0; f < ao_scheme_frame_global->num; f++) {
                struct ao_scheme_frame_vals     *vals = ao_scheme_poly_frame_vals(ao_scheme_frame_global->vals);
+
                val = ao_has_macro(vals->vals[f].val);
                if (val != AO_SCHEME_NIL) {
-                       printf("error: function %s contains unresolved macro: ",
-                              ao_scheme_poly_atom(vals->vals[f].atom)->name);
-                       ao_scheme_poly_write(val);
-                       printf("\n");
+                       fprintf(stderr, "error: function %s contains unresolved macro: ",
+                               ao_scheme_poly_atom(vals->vals[f].atom)->name);
+                       ao_scheme_poly_write(stderr, val, true);
+                       fprintf(stderr, "\n");
                        exit(1);
                }
+
+               /* Remap builtin enum values to match target set */
+               b = ao_scheme_get_builtin(vals->vals[f].val);
+               if (b != NULL) {
+                       if (!ao_scheme_seen_builtin(b))
+                               b->func = func_map[b->func];
+               }
        }
 
        if (out_name) {
@@ -351,6 +495,9 @@ main(int argc, char **argv)
 
        fprintf(out, "/* Generated file, do not edit */\n\n");
 
+       for (d = disable; d; d = d->next)
+               fprintf(out, "#undef AO_SCHEME_FEATURE_%s\n", d->name);
+
        fprintf(out, "#define AO_SCHEME_POOL_CONST %d\n", ao_scheme_top);
        fprintf(out, "extern const uint8_t ao_scheme_const[AO_SCHEME_POOL_CONST] __attribute__((aligned(4)));\n");
        fprintf(out, "#define ao_builtin_atoms 0x%04x\n", ao_scheme_atom_poly(ao_scheme_atoms));
@@ -361,32 +508,33 @@ main(int argc, char **argv)
        fprintf(out, "#define _ao_scheme_bool_true 0x%04x\n", ao_scheme_bool_poly(ao_scheme_true));
 
        for (a = ao_scheme_atoms; a; a = ao_scheme_poly_atom(a->next)) {
-               char    *n = a->name, c;
+               const char      *n = a->name;
+               char            ch;
                fprintf(out, "#define _ao_scheme_atom_");
-               while ((c = *n++)) {
-                       if (isalnum(c))
-                               fprintf(out, "%c", c);
+               while ((ch = *n++)) {
+                       if (isalnum(ch))
+                               fprintf(out, "%c", ch);
                        else
-                               fprintf(out, "%02x", c);
+                               fprintf(out, "%02x", ch);
                }
                fprintf(out, "  0x%04x\n", ao_scheme_atom_poly(a));
        }
        fprintf(out, "#ifdef AO_SCHEME_CONST_BITS\n");
        fprintf(out, "const uint8_t ao_scheme_const[AO_SCHEME_POOL_CONST] __attribute((aligned(4))) = {");
        for (o = 0; o < ao_scheme_top; o++) {
-               uint8_t c;
+               uint8_t ch;
                if ((o & 0xf) == 0)
                        fprintf(out, "\n\t");
                else
                        fprintf(out, " ");
-               c = ao_scheme_const[o];
+               ch = ao_scheme_const[o];
                if (!in_atom)
                        in_atom = is_atom(o);
                if (in_atom) {
-                       fprintf(out, " '%c',", c);
+                       fprintf(out, " '%c',", ch);
                        in_atom--;
                } else {
-                       fprintf(out, "0x%02x,", c);
+                       fprintf(out, "0x%02x,", ch);
                }
        }
        fprintf(out, "\n};\n");