From d8c9024f3829dc3f241b16869f165f3ee01764f3 Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Tue, 12 Dec 2017 15:25:51 -0800 Subject: altos/scheme: Support scheme subsetting via feature settings This provides for the creation of smaller versions of the interpreter, leaving out options like floating point numbers and vectors. Signed-off-by: Keith Packard --- src/scheme/ao_scheme_make_builtin | 116 +++++++++++++++++++++++++++++++++----- 1 file changed, 101 insertions(+), 15 deletions(-) (limited to 'src/scheme/ao_scheme_make_builtin') diff --git a/src/scheme/ao_scheme_make_builtin b/src/scheme/ao_scheme_make_builtin index 8e9c2c0b..78f97789 100644 --- a/src/scheme/ao_scheme_make_builtin +++ b/src/scheme/ao_scheme_make_builtin @@ -1,6 +1,7 @@ #!/usr/bin/nickle typedef struct { + string feature; string type; string c_name; string[*] lisp_names; @@ -12,6 +13,7 @@ string[string] type_map = { "macro" => "MACRO", "f_lambda" => "F_LAMBDA", "atom" => "atom", + "feature" => "feature", }; string[*] @@ -19,9 +21,9 @@ make_lisp(string[*] tokens) { string[...] lisp = {}; - if (dim(tokens) < 3) + if (dim(tokens) < 4) return (string[1]) { tokens[dim(tokens) - 1] }; - return (string[dim(tokens)-2]) { [i] = tokens[i+2] }; + return (string[dim(tokens)-3]) { [i] = tokens[i+3] }; } builtin_t @@ -30,8 +32,9 @@ read_builtin(file f) { string[*] tokens = String::wordsplit(line, " \t"); return (builtin_t) { - .type = dim(tokens) > 0 ? type_map[tokens[0]] : "#", - .c_name = dim(tokens) > 1 ? tokens[1] : "#", + .feature = dim(tokens) > 0 ? tokens[0] : "#", + .type = dim(tokens) > 1 ? type_map[tokens[1]] : "#", + .c_name = dim(tokens) > 2 ? tokens[2] : "#", .lisp_names = make_lisp(tokens), }; } @@ -49,16 +52,37 @@ read_builtins(file f) { return builtins; } +void +dump_ifdef(builtin_t builtin) +{ + if (builtin.feature != "all") + printf("#ifdef AO_SCHEME_FEATURE_%s\n", builtin.feature); +} + +void +dump_endif(builtin_t builtin) +{ + if (builtin.feature != "all") + printf("#endif /* AO_SCHEME_FEATURE_%s */\n", builtin.feature); +} + bool is_atom(builtin_t b) = b.type == "atom"; +bool is_func(builtin_t b) = b.type != "atom" && b.type != "feature"; + +bool is_feature(builtin_t b) = b.type == "feature"; + void dump_ids(builtin_t[*] builtins) { printf("#ifdef AO_SCHEME_BUILTIN_ID\n"); printf("#undef AO_SCHEME_BUILTIN_ID\n"); printf("enum ao_scheme_builtin_id {\n"); for (int i = 0; i < dim(builtins); i++) - if (!is_atom(builtins[i])) + if (is_func(builtins[i])) { + dump_ifdef(builtins[i]); printf("\tbuiltin_%s,\n", builtins[i].c_name); + dump_endif(builtins[i]); + } printf("\t_builtin_last\n"); printf("};\n"); printf("#endif /* AO_SCHEME_BUILTIN_ID */\n"); @@ -71,9 +95,12 @@ dump_casename(builtin_t[*] builtins) { printf("static char *ao_scheme_builtin_name(enum ao_scheme_builtin_id b) {\n"); printf("\tswitch(b) {\n"); for (int i = 0; i < dim(builtins); i++) - if (!is_atom(builtins[i])) + if (is_func(builtins[i])) { + dump_ifdef(builtins[i]); printf("\tcase builtin_%s: return ao_scheme_poly_atom(_atom(\"%s\"))->name;\n", builtins[i].c_name, builtins[i].lisp_names[0]); + dump_endif(builtins[i]); + } printf("\tdefault: return \"???\";\n"); printf("\t}\n"); printf("}\n"); @@ -97,11 +124,13 @@ dump_arrayname(builtin_t[*] builtins) { printf("#undef AO_SCHEME_BUILTIN_ARRAYNAME\n"); printf("static const ao_poly builtin_names[] = {\n"); for (int i = 0; i < dim(builtins); i++) { - if (!is_atom(builtins[i])) { + if (is_func(builtins[i])) { + dump_ifdef(builtins[i]); printf("\t[builtin_%s] = _ao_scheme_atom_", builtins[i].c_name); cify_lisp(builtins[i].lisp_names[0]); printf(",\n"); + dump_endif(builtins[i]); } } printf("};\n"); @@ -114,10 +143,13 @@ dump_funcs(builtin_t[*] builtins) { printf("#undef AO_SCHEME_BUILTIN_FUNCS\n"); printf("const ao_scheme_func_t ao_scheme_builtins[] = {\n"); for (int i = 0; i < dim(builtins); i++) { - if (!is_atom(builtins[i])) + if (is_func(builtins[i])) { + dump_ifdef(builtins[i]); printf("\t[builtin_%s] = ao_scheme_do_%s,\n", builtins[i].c_name, builtins[i].c_name); + dump_endif(builtins[i]); + } } printf("};\n"); printf("#endif /* AO_SCHEME_BUILTIN_FUNCS */\n"); @@ -128,10 +160,12 @@ dump_decls(builtin_t[*] builtins) { printf("#ifdef AO_SCHEME_BUILTIN_DECLS\n"); printf("#undef AO_SCHEME_BUILTIN_DECLS\n"); for (int i = 0; i < dim(builtins); i++) { - if (!is_atom(builtins[i])) { + if (is_func(builtins[i])) { + dump_ifdef(builtins[i]); printf("ao_poly\n"); printf("ao_scheme_do_%s(struct ao_scheme_cons *cons);\n", builtins[i].c_name); + dump_endif(builtins[i]); } } printf("#endif /* AO_SCHEME_BUILTIN_DECLS */\n"); @@ -143,13 +177,16 @@ dump_consts(builtin_t[*] builtins) { printf("#undef AO_SCHEME_BUILTIN_CONSTS\n"); printf("struct builtin_func funcs[] = {\n"); for (int i = 0; i < dim(builtins); i++) { - if (!is_atom(builtins[i])) { + if (is_func(builtins[i])) { + dump_ifdef(builtins[i]); for (int j = 0; j < dim(builtins[i].lisp_names); j++) { - printf ("\t{ .name = \"%s\", .args = AO_SCHEME_FUNC_%s, .func = builtin_%s },\n", + printf ("\t{ .feature = \"%s\", .name = \"%s\", .args = AO_SCHEME_FUNC_%s, .func = builtin_%s },\n", + builtins[i].feature, builtins[i].lisp_names[j], builtins[i].type, builtins[i].c_name); } + dump_endif(builtins[i]); } } printf("};\n"); @@ -161,15 +198,60 @@ dump_atoms(builtin_t[*] builtins) { printf("#ifdef AO_SCHEME_BUILTIN_ATOMS\n"); printf("#undef AO_SCHEME_BUILTIN_ATOMS\n"); for (int i = 0; i < dim(builtins); i++) { - for (int j = 0; j < dim(builtins[i].lisp_names); j++) { - printf("#define _ao_scheme_atom_"); - cify_lisp(builtins[i].lisp_names[j]); - printf(" _atom(\"%s\")\n", builtins[i].lisp_names[j]); + if (!is_feature(builtins[i])) { + for (int j = 0; j < dim(builtins[i].lisp_names); j++) { + printf("#define _ao_scheme_atom_"); + cify_lisp(builtins[i].lisp_names[j]); + printf(" _atom(\"%s\")\n", builtins[i].lisp_names[j]); + } } } printf("#endif /* AO_SCHEME_BUILTIN_ATOMS */\n"); } +void +dump_atom_names(builtin_t[*] builtins) { + printf("#ifdef AO_SCHEME_BUILTIN_ATOM_NAMES\n"); + printf("#undef AO_SCHEME_BUILTIN_ATOM_NAMES\n"); + printf("static struct builtin_atom atoms[] = {\n"); + for (int i = 0; i < dim(builtins); i++) { + if (is_atom(builtins[i])) { + for (int j = 0; j < dim(builtins[i].lisp_names); j++) { + printf("\t{ .feature = \"%s\", .name = \"%s\" },\n", + builtins[i].feature, + builtins[i].lisp_names[j]); + } + } + } + printf("};\n"); + printf("#endif /* AO_SCHEME_BUILTIN_ATOM_NAMES */\n"); +} + +bool +has_feature(string[*] features, string feature) +{ + for (int i = 0; i < dim(features); i++) + if (features[i] == feature) + return true; + return false; +} + +void +dump_features(builtin_t[*] builtins) { + string[...] features = {}; + printf("#ifdef AO_SCHEME_BUILTIN_FEATURES\n"); + for (int i = 0; i < dim(builtins); i++) { + if (builtins[i].feature != "all") { + string feature = builtins[i].feature; + if (!has_feature(features, feature)) { + features[dim(features)] = feature; + printf("#define AO_SCHEME_FEATURE_%s\n", feature); + } + } + } + printf("#endif /* AO_SCHEME_BUILTIN_FEATURES */\n"); +} + void main() { if (dim(argv) < 2) { File::fprintf(stderr, "usage: %s \n", argv[0]); @@ -177,6 +259,8 @@ void main() { } twixt(file f = File::open(argv[1], "r"); File::close(f)) { builtin_t[*] builtins = read_builtins(f); + + printf("/* %d builtins */\n", dim(builtins)); dump_ids(builtins); dump_casename(builtins); dump_arrayname(builtins); @@ -184,6 +268,8 @@ void main() { dump_decls(builtins); dump_consts(builtins); dump_atoms(builtins); + dump_atom_names(builtins); + dump_features(builtins); } } -- cgit v1.2.3 From 4bfce37e7567d9c2a09ea4da8113e7639516ed6e Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Tue, 12 Dec 2017 17:54:03 -0800 Subject: altos/scheme: apply const to places taking const strings. Mostly printf and friends. Signed-off-by: Keith Packard --- src/scheme/ao_scheme.h | 12 +++++----- src/scheme/ao_scheme_builtin.c | 6 ++--- src/scheme/ao_scheme_error.c | 10 ++++----- src/scheme/ao_scheme_make_builtin | 2 +- src/scheme/ao_scheme_make_const.c | 46 +++++++++++++++++++++------------------ 5 files changed, 40 insertions(+), 36 deletions(-) (limited to 'src/scheme/ao_scheme_make_builtin') diff --git a/src/scheme/ao_scheme.h b/src/scheme/ao_scheme.h index db4417e5..7e4b3697 100644 --- a/src/scheme/ao_scheme.h +++ b/src/scheme/ao_scheme.h @@ -63,7 +63,7 @@ extern uint8_t ao_scheme_const[AO_SCHEME_POOL_CONST] __attribute__((aligned(4))) #define ao_scheme_pool ao_scheme_const #define AO_SCHEME_POOL AO_SCHEME_POOL_CONST -#define _atom(n) ao_scheme_atom_poly(ao_scheme_atom_intern(n)) +#define _atom(n) ao_scheme_atom_poly(ao_scheme_atom_intern((char *) n)) #define _bool(v) ao_scheme_bool_poly(ao_scheme_bool_get(v)) #define _ao_scheme_bool_true _bool(1) @@ -940,19 +940,19 @@ ao_scheme_stack_eval(void); /* error */ void -ao_scheme_vprintf(char *format, va_list args); +ao_scheme_vprintf(const char *format, va_list args); void -ao_scheme_printf(char *format, ...); +ao_scheme_printf(const char *format, ...); void -ao_scheme_error_poly(char *name, ao_poly poly, ao_poly last); +ao_scheme_error_poly(const char *name, ao_poly poly, ao_poly last); void -ao_scheme_error_frame(int indent, char *name, struct ao_scheme_frame *frame); +ao_scheme_error_frame(int indent, const char *name, struct ao_scheme_frame *frame); ao_poly -ao_scheme_error(int error, char *format, ...); +ao_scheme_error(int error, const char *format, ...); /* builtins */ diff --git a/src/scheme/ao_scheme_builtin.c b/src/scheme/ao_scheme_builtin.c index c0f636fa..4def5704 100644 --- a/src/scheme/ao_scheme_builtin.c +++ b/src/scheme/ao_scheme_builtin.c @@ -52,7 +52,7 @@ char *ao_scheme_args_name(uint8_t args) { case AO_SCHEME_FUNC_LAMBDA: return ao_scheme_poly_atom(_ao_scheme_atom_lambda)->name; case AO_SCHEME_FUNC_NLAMBDA: return ao_scheme_poly_atom(_ao_scheme_atom_nlambda)->name; case AO_SCHEME_FUNC_MACRO: return ao_scheme_poly_atom(_ao_scheme_atom_macro)->name; - default: return "???"; + default: return (char *) "???"; } } #else @@ -64,7 +64,7 @@ static char * ao_scheme_builtin_name(enum ao_scheme_builtin_id b) { if (b < _builtin_last) return ao_scheme_poly_atom(builtin_names[b])->name; - return "???"; + return (char *) "???"; } static const ao_poly ao_scheme_args_atoms[] = { @@ -79,7 +79,7 @@ ao_scheme_args_name(uint8_t args) args &= AO_SCHEME_FUNC_MASK; if (args < sizeof ao_scheme_args_atoms / sizeof ao_scheme_args_atoms[0]) return ao_scheme_poly_atom(ao_scheme_args_atoms[args])->name; - return "(unknown)"; + return (char *) "(unknown)"; } #endif diff --git a/src/scheme/ao_scheme_error.c b/src/scheme/ao_scheme_error.c index d580a2c0..c015c76a 100644 --- a/src/scheme/ao_scheme_error.c +++ b/src/scheme/ao_scheme_error.c @@ -16,7 +16,7 @@ #include void -ao_scheme_error_poly(char *name, ao_poly poly, ao_poly last) +ao_scheme_error_poly(const char *name, ao_poly poly, ao_poly last) { int first = 1; printf("\t\t%s(", name); @@ -50,7 +50,7 @@ static void tabs(int indent) } void -ao_scheme_error_frame(int indent, char *name, struct ao_scheme_frame *frame) +ao_scheme_error_frame(int indent, const char *name, struct ao_scheme_frame *frame) { int f; @@ -83,7 +83,7 @@ ao_scheme_error_frame(int indent, char *name, struct ao_scheme_frame *frame) } void -ao_scheme_vprintf(char *format, va_list args) +ao_scheme_vprintf(const char *format, va_list args) { char c; @@ -112,7 +112,7 @@ ao_scheme_vprintf(char *format, va_list args) } void -ao_scheme_printf(char *format, ...) +ao_scheme_printf(const char *format, ...) { va_list args; va_start(args, format); @@ -121,7 +121,7 @@ ao_scheme_printf(char *format, ...) } ao_poly -ao_scheme_error(int error, char *format, ...) +ao_scheme_error(int error, const char *format, ...) { va_list args; diff --git a/src/scheme/ao_scheme_make_builtin b/src/scheme/ao_scheme_make_builtin index 78f97789..a4d8326f 100644 --- a/src/scheme/ao_scheme_make_builtin +++ b/src/scheme/ao_scheme_make_builtin @@ -101,7 +101,7 @@ dump_casename(builtin_t[*] builtins) { builtins[i].c_name, builtins[i].lisp_names[0]); dump_endif(builtins[i]); } - printf("\tdefault: return \"???\";\n"); + printf("\tdefault: return (char *) \"???\";\n"); printf("\t}\n"); printf("}\n"); printf("#endif /* AO_SCHEME_BUILTIN_CASENAME */\n"); diff --git a/src/scheme/ao_scheme_make_const.c b/src/scheme/ao_scheme_make_const.c index 6bd552f5..d0a51ec8 100644 --- a/src/scheme/ao_scheme_make_const.c +++ b/src/scheme/ao_scheme_make_const.c @@ -30,15 +30,15 @@ ao_scheme_make_builtin(enum ao_scheme_builtin_id func, int args) { } struct builtin_func { - char *feature; - char *name; - int args; + const char *feature; + const char *name; + int args; enum ao_scheme_builtin_id func; }; struct builtin_atom { - char *feature; - char *name; + const char *feature; + const char *name; }; #define AO_SCHEME_BUILTIN_CONSTS @@ -306,8 +306,8 @@ ao_scheme_add_feature(struct feature **list, char *name) *list = feature; } -bool -ao_scheme_has_feature(struct feature *list, char *name) +static bool +ao_scheme_has_feature(struct feature *list, const char *name) { while (list) { if (!strcmp(list->name, name)) @@ -317,17 +317,20 @@ ao_scheme_has_feature(struct feature *list, char *name) return false; } -void -ao_scheme_add_features(struct feature **list, char *names) +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(names, ",", &saveptr)) != NULL) { - names = NULL; + 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 @@ -407,7 +410,7 @@ main(int argc, char **argv) */ func_map[prev_func] = target_func++; } - a = ao_scheme_atom_intern(funcs[f].name); + a = ao_scheme_atom_intern((char *) funcs[f].name); ao_scheme_atom_def(ao_scheme_atom_poly(a), ao_scheme_builtin_poly(b)); } @@ -474,32 +477,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"); -- cgit v1.2.3