X-Git-Url: https://git.gag.com/?p=fw%2Faltos;a=blobdiff_plain;f=src%2Fscheme%2Fao_scheme_make_const.c;fp=src%2Fscheme%2Fao_scheme_make_const.c;h=0000000000000000000000000000000000000000;hp=e34792c400c82ef15db87c52382b71167701bc62;hb=ee79a205e118ea8730a02cc327d8fb79cc5f74ff;hpb=365eee3ebfe73204033089b363687228f97e5d98 diff --git a/src/scheme/ao_scheme_make_const.c b/src/scheme/ao_scheme_make_const.c deleted file mode 100644 index e34792c4..00000000 --- a/src/scheme/ao_scheme_make_const.c +++ /dev/null @@ -1,517 +0,0 @@ -/* - * 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_scheme.h" -#include -#include -#include -#include -#include - -static struct ao_scheme_builtin * -ao_scheme_make_builtin(enum ao_scheme_builtin_id func, int args) { - struct ao_scheme_builtin *b = ao_scheme_alloc(sizeof (struct ao_scheme_builtin)); - - b->type = AO_SCHEME_BUILTIN; - b->func = func; - b->args = args; - return b; -} - -struct builtin_func { - 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_ATOM (sizeof atoms / sizeof atoms[0]) - -struct ao_scheme_frame *globals; - -static int -is_atom(int offset) -{ - struct ao_scheme_atom *a; - - for (a = ao_scheme_atoms; a; a = ao_scheme_poly_atom(a->next)) - if (((uint8_t *) a->name - ao_scheme_const) == offset) - return strlen(a->name); - return 0; -} - -#define AO_FEC_CRC_INIT 0xffff - -static inline uint16_t -ao_fec_crc_byte(uint8_t byte, uint16_t crc) -{ - uint8_t bit; - - for (bit = 0; bit < 8; bit++) { - if (((crc & 0x8000) >> 8) ^ (byte & 0x80)) - crc = (crc << 1) ^ 0x8005; - else - crc = (crc << 1); - byte <<= 1; - } - return crc; -} - -static uint16_t -ao_fec_crc(const uint8_t *bytes, uint8_t len) -{ - uint16_t crc = AO_FEC_CRC_INIT; - - while (len--) - crc = ao_fec_crc_byte(*bytes++, crc); - return crc; -} - -struct ao_scheme_macro_stack { - struct ao_scheme_macro_stack *next; - ao_poly p; -}; - -struct ao_scheme_macro_stack *macro_stack; - -static int -ao_scheme_macro_push(ao_poly p) -{ - struct ao_scheme_macro_stack *m = macro_stack; - - while (m) { - if (m->p == p) - return 1; - m = m->next; - } - m = malloc (sizeof (struct ao_scheme_macro_stack)); - m->p = p; - m->next = macro_stack; - macro_stack = m; - return 0; -} - -static void -ao_scheme_macro_pop(void) -{ - struct ao_scheme_macro_stack *m = macro_stack; - - macro_stack = m->next; - free(m); -} - -#define DBG_MACRO 0 -#if DBG_MACRO -int macro_scan_depth; - -void indent(void) -{ - int i; - for (i = 0; i < macro_scan_depth; i++) - printf(" "); -} -#define MACRO_DEBUG(a) a -#else -#define MACRO_DEBUG(a) -#endif - -ao_poly -ao_has_macro(ao_poly p); - -static ao_poly -ao_macro_test_get(ao_poly atom) -{ - ao_poly *ref = ao_scheme_atom_ref(atom, NULL); - if (ref) - return *ref; - return AO_SCHEME_NIL; -} - -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); - switch (ao_scheme_poly_type(p)) { - case AO_SCHEME_ATOM: - if (ao_scheme_macro_push(p)) - ret = AO_SCHEME_NIL; - else { - if (ao_is_macro(ao_macro_test_get(p))) - ret = p; - else - ret = AO_SCHEME_NIL; - ao_scheme_macro_pop(); - } - break; - case AO_SCHEME_CONS: - ret = ao_has_macro(p); - break; - case AO_SCHEME_BUILTIN: - builtin = ao_scheme_poly_builtin(p); - if ((builtin->args & AO_SCHEME_FUNC_MASK) == AO_SCHEME_FUNC_MACRO) - ret = p; - else - ret = 0; - break; - - case AO_SCHEME_LAMBDA: - lambda = ao_scheme_poly_lambda(p); - if (lambda->args == AO_SCHEME_FUNC_MACRO) - ret = p; - else - ret = ao_has_macro(lambda->code); - break; - default: - ret = AO_SCHEME_NIL; - break; - } - MACRO_DEBUG(--macro_scan_depth; indent(); printf ("... "); ao_scheme_poly_write(ret); printf("\n")); - return ret; -} - -ao_poly -ao_has_macro(ao_poly p) -{ - struct ao_scheme_cons *cons; - struct ao_scheme_lambda *lambda; - ao_poly m; - ao_poly list; - - 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); - switch (ao_scheme_poly_type(p)) { - case AO_SCHEME_LAMBDA: - lambda = ao_scheme_poly_lambda(p); - p = ao_has_macro(lambda->code); - break; - case AO_SCHEME_CONS: - cons = ao_scheme_poly_cons(p); - if ((p = ao_is_macro(cons->car))) - break; - - list = cons->cdr; - p = AO_SCHEME_NIL; - while (ao_scheme_is_pair(list)) { - cons = ao_scheme_poly_cons(list); - m = ao_has_macro(cons->car); - if (m) { - p = m; - break; - } - list = cons->cdr; - } - break; - - default: - p = AO_SCHEME_NIL; - break; - } - MACRO_DEBUG(--macro_scan_depth; indent(); printf("... "); ao_scheme_poly_write(p); printf("\n")); - return p; -} - -static struct ao_scheme_builtin * -ao_scheme_get_builtin(ao_poly p) -{ - 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(void) -{ - ao_poly in, out = AO_SCHEME_NIL; - for(;;) { - in = ao_scheme_read(); - if (in == _ao_scheme_atom_eof) - break; - out = ao_scheme_eval(in); - if (ao_scheme_exception) - return 0; - ao_scheme_poly_write(out, true); - putchar ('\n'); - } - return 1; -} - -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) -{ - while (list) { - if (!strcmp(list->name, name)) - return true; - list = list->next; - } - return false; -} - -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) -{ - return getc(in); -} - -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=] [--disable={feature,...}] [--enable={feature,...} [input]\n", program); - exit(1); -} - -int -main(int argc, char **argv) -{ - 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: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; - } - } - - ao_scheme_frame_init(); - - /* Boolean values #f and #t */ - ao_scheme_bool_get(0); - ao_scheme_bool_get(1); - - prev_func = _builtin_last; - target_func = 0; - b = NULL; - for (f = 0; f < (int) N_FUNC; f++) { - 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)); - } - } - - /* 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]){ - in = fopen(argv[optind], "r"); - if (!in) { - perror(argv[optind]); - exit(1); - } - } - if (!ao_scheme_read_eval_abort()) { - fprintf(stderr, "eval failed\n"); - exit(1); - } - - /* Reduce to referenced values */ - ao_scheme_collect(AO_SCHEME_COLLECT_FULL); - - 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, true); - printf("\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) { - out = fopen(out_name, "w"); - if (!out) { - perror(out_name); - exit(1); - } - } - - 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)); - fprintf(out, "#define ao_builtin_frame 0x%04x\n", ao_scheme_frame_poly(ao_scheme_frame_global)); - fprintf(out, "#define ao_scheme_const_checksum ((uint16_t) 0x%04x)\n", ao_fec_crc(ao_scheme_const, ao_scheme_top)); - - fprintf(out, "#define _ao_scheme_bool_false 0x%04x\n", ao_scheme_bool_poly(ao_scheme_false)); - 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)) { - const char *n = a->name; - char ch; - fprintf(out, "#define _ao_scheme_atom_"); - while ((ch = *n++)) { - if (isalnum(ch)) - fprintf(out, "%c", ch); - else - 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 ch; - if ((o & 0xf) == 0) - fprintf(out, "\n\t"); - else - fprintf(out, " "); - ch = ao_scheme_const[o]; - if (!in_atom) - in_atom = is_atom(o); - if (in_atom) { - fprintf(out, " '%c',", ch); - in_atom--; - } else { - fprintf(out, "0x%02x,", ch); - } - } - fprintf(out, "\n};\n"); - fprintf(out, "#endif /* AO_SCHEME_CONST_BITS */\n"); - exit(0); -}