2 * Copyright © 2016 Keith Packard <keithp@keithp.com>
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation, either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful, but
10 * WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 * General Public License for more details.
15 #include "ao_scheme.h"
22 static struct ao_scheme_builtin *
23 ao_scheme_make_builtin(enum ao_scheme_builtin_id func, int args) {
24 struct ao_scheme_builtin *b = ao_scheme_alloc(sizeof (struct ao_scheme_builtin));
26 b->type = AO_SCHEME_BUILTIN;
36 enum ao_scheme_builtin_id func;
44 #define AO_SCHEME_BUILTIN_CONSTS
45 #define AO_SCHEME_BUILTIN_ATOM_NAMES
47 #include "ao_scheme_builtin.h"
49 #define N_FUNC (sizeof funcs / sizeof funcs[0])
51 #define N_ATOM (sizeof atoms / sizeof atoms[0])
53 struct ao_scheme_frame *globals;
58 struct ao_scheme_atom *a;
60 for (a = ao_scheme_atoms; a; a = ao_scheme_poly_atom(a->next))
61 if (((uint8_t *) a->name - ao_scheme_const) == offset)
62 return strlen(a->name);
66 #define AO_FEC_CRC_INIT 0xffff
68 static inline uint16_t
69 ao_fec_crc_byte(uint8_t byte, uint16_t crc)
73 for (bit = 0; bit < 8; bit++) {
74 if (((crc & 0x8000) >> 8) ^ (byte & 0x80))
75 crc = (crc << 1) ^ 0x8005;
84 ao_fec_crc(const uint8_t *bytes, uint8_t len)
86 uint16_t crc = AO_FEC_CRC_INIT;
89 crc = ao_fec_crc_byte(*bytes++, crc);
93 struct ao_scheme_macro_stack {
94 struct ao_scheme_macro_stack *next;
98 struct ao_scheme_macro_stack *macro_stack;
101 ao_scheme_macro_push(ao_poly p)
103 struct ao_scheme_macro_stack *m = macro_stack;
110 m = malloc (sizeof (struct ao_scheme_macro_stack));
112 m->next = macro_stack;
118 ao_scheme_macro_pop(void)
120 struct ao_scheme_macro_stack *m = macro_stack;
122 macro_stack = m->next;
128 static int macro_scan_depth;
130 static void indent(void)
133 for (i = 0; i < macro_scan_depth; i++)
136 #define MACRO_DEBUG(a) a
138 #define MACRO_DEBUG(a)
142 ao_has_macro(ao_poly p);
145 ao_macro_test_get(ao_poly atom)
147 ao_poly *ref = ao_scheme_atom_ref(atom, NULL);
150 return AO_SCHEME_NIL;
154 ao_is_macro(ao_poly p)
156 struct ao_scheme_builtin *builtin;
157 struct ao_scheme_lambda *lambda;
160 MACRO_DEBUG(indent(); ao_scheme_printf ("is macro %v\n", p); ++macro_scan_depth);
161 switch (ao_scheme_poly_type(p)) {
163 if (ao_scheme_macro_push(p))
166 if (ao_is_macro(ao_macro_test_get(p)))
170 ao_scheme_macro_pop();
174 ret = ao_has_macro(p);
176 case AO_SCHEME_BUILTIN:
177 builtin = ao_scheme_poly_builtin(p);
178 if ((builtin->args & AO_SCHEME_FUNC_MASK) == AO_SCHEME_FUNC_MACRO)
184 case AO_SCHEME_LAMBDA:
185 lambda = ao_scheme_poly_lambda(p);
186 if (lambda->args == AO_SCHEME_FUNC_MACRO)
189 ret = ao_has_macro(lambda->code);
195 MACRO_DEBUG(--macro_scan_depth; indent(); ao_scheme_printf ("... %v\n", ret););
200 ao_has_macro(ao_poly p)
202 struct ao_scheme_cons *cons;
203 struct ao_scheme_lambda *lambda;
207 if (p == AO_SCHEME_NIL)
208 return AO_SCHEME_NIL;
210 MACRO_DEBUG(indent(); ao_scheme_printf("has macro %v\n", p); ++macro_scan_depth);
211 switch (ao_scheme_poly_type(p)) {
212 case AO_SCHEME_LAMBDA:
213 lambda = ao_scheme_poly_lambda(p);
214 p = ao_has_macro(ao_scheme_poly_cons(lambda->code)->cdr);
217 cons = ao_scheme_poly_cons(p);
218 if ((p = ao_is_macro(cons->car)))
223 while (ao_scheme_is_pair(list)) {
224 cons = ao_scheme_poly_cons(list);
225 m = ao_has_macro(cons->car);
238 MACRO_DEBUG(--macro_scan_depth; indent(); ao_scheme_printf("... %v\n", p));
242 static struct ao_scheme_builtin *
243 ao_scheme_get_builtin(ao_poly p)
245 if (ao_scheme_poly_type(p) == AO_SCHEME_BUILTIN)
246 return ao_scheme_poly_builtin(p);
250 struct seen_builtin {
251 struct seen_builtin *next;
252 struct ao_scheme_builtin *builtin;
255 static struct seen_builtin *seen_builtins;
258 ao_scheme_seen_builtin(struct ao_scheme_builtin *b)
260 struct seen_builtin *s;
262 for (s = seen_builtins; s; s = s->next)
265 s = malloc (sizeof (struct seen_builtin));
267 s->next = seen_builtins;
273 ao_scheme_read_eval_abort(FILE *read_file)
278 in = ao_scheme_read(read_file);
279 if (in == _ao_scheme_atom_eof)
281 (void) ao_scheme_eval(in);
282 if (ao_scheme_exception) {
283 ao_scheme_fprintf(stderr, "make_const failed on %v\n", in);
294 struct feature *next;
298 static struct feature *enable;
299 static struct feature *disable;
302 ao_scheme_add_feature(struct feature **list, char *name)
304 struct feature *feature = malloc (sizeof (struct feature) + strlen(name) + 1);
305 strcpy(feature->name, name);
306 feature->next = *list;
311 _ao_scheme_has_feature(struct feature *list, const char *name, bool skip_undef)
313 if (skip_undef && !strcmp(name, "UNDEF"))
317 if (!strcmp(list->name, name))
325 ao_scheme_has_undef(struct feature *list)
327 return _ao_scheme_has_feature(list, "UNDEF", false);
331 ao_scheme_has_feature(struct feature *list, const char *name)
333 return _ao_scheme_has_feature(list, name, true);
337 ao_scheme_add_features(struct feature **list, const char *names)
339 char *saveptr = NULL;
341 char *copy = strdup(names);
344 while ((name = strtok_r(copy, ",", &saveptr)) != NULL) {
346 if (!ao_scheme_has_feature(*list, name))
347 ao_scheme_add_feature(list, name);
358 static const struct option options[] = {
359 { .name = "out", .has_arg = 1, .val = 'o' },
360 { .name = "disable", .has_arg = 1, .val = 'd' },
361 { .name = "enable", .has_arg = 1, .val = 'e' },
365 static void usage(char *program)
367 fprintf(stderr, "usage: %s [--out=<output>] [--disable={feature,...}] [--enable={feature,...} [input]\n", program);
372 main(int argc, char **argv)
376 struct ao_scheme_atom *a;
377 struct ao_scheme_builtin *b;
380 char *out_name = NULL;
382 enum ao_scheme_builtin_id prev_func;
383 enum ao_scheme_builtin_id target_func;
384 enum ao_scheme_builtin_id func_map[_builtin_last];
389 while ((c = getopt_long(argc, argv, "o:d:e:", options, NULL)) != -1) {
395 ao_scheme_add_features(&disable, optarg);
398 ao_scheme_add_features(&enable, optarg);
406 ao_scheme_frame_init();
408 /* Boolean values #f and #t */
409 ao_scheme_bool_get(0);
410 ao_scheme_bool_get(1);
412 prev_func = _builtin_last;
415 for (f = 0; f < (int) N_FUNC; f++) {
416 if (ao_scheme_has_feature(enable, funcs[f].feature) || !ao_scheme_has_feature(disable, funcs[f].feature)) {
417 if (funcs[f].func != prev_func) {
418 prev_func = funcs[f].func;
419 b = ao_scheme_make_builtin(prev_func, funcs[f].args);
421 /* Target may have only a subset of
422 * the enum values; record what those
423 * values will be here. This obviously
424 * depends on the functions in the
425 * array being in the same order as
426 * the enumeration; which
427 * ao_scheme_make_builtin ensures.
429 func_map[prev_func] = target_func++;
431 a = ao_scheme_atom_intern((char *) funcs[f].name);
432 ao_scheme_atom_def(ao_scheme_atom_poly(a),
433 ao_scheme_builtin_poly(b));
438 for (an = 0; an < (int) N_ATOM; an++) {
439 if (ao_scheme_has_feature(enable, atoms[an].feature) || !ao_scheme_has_feature(disable, atoms[an].feature))
440 a = ao_scheme_atom_intern((char *) atoms[an].name);
443 while (argv[optind]) {
444 in = fopen(argv[optind], "r");
446 perror(argv[optind]);
449 if (!ao_scheme_read_eval_abort(in)) {
450 fprintf(stderr, "eval failed\n");
457 if (!ao_scheme_has_undef(enable) && ao_scheme_has_undef(disable)) {
458 struct ao_scheme_cons cons;
460 cons.car = _ao_scheme_atom_undef;
461 cons.cdr = AO_SCHEME_NIL;
462 ao_scheme_do_undef(&cons);
465 /* Reduce to referenced values */
466 ao_scheme_collect(AO_SCHEME_COLLECT_FULL);
468 for (f = 0; f < ao_scheme_frame_global->num; f++) {
469 struct ao_scheme_frame_vals *vals = ao_scheme_poly_frame_vals(ao_scheme_frame_global->vals);
471 val = ao_has_macro(vals->vals[f].val);
472 if (val != AO_SCHEME_NIL) {
473 fprintf(stderr, "error: function %s contains unresolved macro: ",
474 ao_scheme_poly_atom(vals->vals[f].atom)->name);
475 ao_scheme_poly_write(stderr, val, true);
476 fprintf(stderr, "\n");
480 /* Remap builtin enum values to match target set */
481 b = ao_scheme_get_builtin(vals->vals[f].val);
483 if (!ao_scheme_seen_builtin(b))
484 b->func = func_map[b->func];
489 out = fopen(out_name, "w");
496 fprintf(out, "/* Generated file, do not edit */\n\n");
498 for (d = disable; d; d = d->next)
499 fprintf(out, "#undef AO_SCHEME_FEATURE_%s\n", d->name);
501 fprintf(out, "#define AO_SCHEME_POOL_CONST %d\n", ao_scheme_top);
502 fprintf(out, "extern const uint8_t ao_scheme_const[AO_SCHEME_POOL_CONST] __attribute__((aligned(4)));\n");
503 fprintf(out, "#define ao_builtin_atoms 0x%04x\n", ao_scheme_atom_poly(ao_scheme_atoms));
504 fprintf(out, "#define ao_builtin_frame 0x%04x\n", ao_scheme_frame_poly(ao_scheme_frame_global));
505 fprintf(out, "#define ao_scheme_const_checksum ((uint16_t) 0x%04x)\n", ao_fec_crc(ao_scheme_const, ao_scheme_top));
507 fprintf(out, "#define _ao_scheme_bool_false 0x%04x\n", ao_scheme_bool_poly(ao_scheme_false));
508 fprintf(out, "#define _ao_scheme_bool_true 0x%04x\n", ao_scheme_bool_poly(ao_scheme_true));
510 for (a = ao_scheme_atoms; a; a = ao_scheme_poly_atom(a->next)) {
511 const char *n = a->name;
513 fprintf(out, "#define _ao_scheme_atom_");
514 while ((ch = *n++)) {
516 fprintf(out, "%c", ch);
518 fprintf(out, "%02x", ch);
520 fprintf(out, " 0x%04x\n", ao_scheme_atom_poly(a));
522 fprintf(out, "#ifdef AO_SCHEME_CONST_BITS\n");
523 fprintf(out, "const uint8_t ao_scheme_const[AO_SCHEME_POOL_CONST] __attribute((aligned(4))) = {");
524 for (o = 0; o < ao_scheme_top; o++) {
527 fprintf(out, "\n\t");
530 ch = ao_scheme_const[o];
532 in_atom = is_atom(o);
534 fprintf(out, " '%c',", ch);
537 fprintf(out, "0x%02x,", ch);
540 fprintf(out, "\n};\n");
541 fprintf(out, "#endif /* AO_SCHEME_CONST_BITS */\n");