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/tiny-test/.gitignore | 1 + src/scheme/tiny-test/Makefile | 28 ++ src/scheme/tiny-test/ao_scheme_os.h | 72 +++++ src/scheme/tiny-test/ao_scheme_test.c | 141 ++++++++ src/scheme/tiny-test/ao_scheme_tiny_const.scheme | 389 +++++++++++++++++++++++ 5 files changed, 631 insertions(+) create mode 100644 src/scheme/tiny-test/.gitignore create mode 100644 src/scheme/tiny-test/Makefile create mode 100644 src/scheme/tiny-test/ao_scheme_os.h create mode 100644 src/scheme/tiny-test/ao_scheme_test.c create mode 100644 src/scheme/tiny-test/ao_scheme_tiny_const.scheme (limited to 'src/scheme/tiny-test') diff --git a/src/scheme/tiny-test/.gitignore b/src/scheme/tiny-test/.gitignore new file mode 100644 index 00000000..7c4c3956 --- /dev/null +++ b/src/scheme/tiny-test/.gitignore @@ -0,0 +1 @@ +ao-scheme-tiny diff --git a/src/scheme/tiny-test/Makefile b/src/scheme/tiny-test/Makefile new file mode 100644 index 00000000..5082df44 --- /dev/null +++ b/src/scheme/tiny-test/Makefile @@ -0,0 +1,28 @@ +include ../Makefile-inc + +vpath %.o . +vpath %.c .. +vpath %.h .. + +DEFS= + +SRCS=$(SCHEME_SRCS) ao_scheme_test.c +HDRS=$(SCHEME_HDRS) ao_scheme_const.h + +OBJS=$(SRCS:.c=.o) + +CFLAGS=-O0 -g -Wall -Wextra -I. -I.. + +ao-scheme-tiny: $(OBJS) + cc $(CFLAGS) -o $@ $(OBJS) -lm + +$(OBJS): $(HDRS) + +ao_scheme_const.h: ../make-const/ao_scheme_make_const ao_scheme_tiny_const.scheme + ../make-const/ao_scheme_make_const -o $@ -d FLOAT,VECTOR,QUASI,BIGINT ao_scheme_tiny_const.scheme + +clean:: + rm -f $(OBJS) ao-scheme-tiny ao_scheme_const.h + +install: ao-scheme-tiny + cp $^ $$HOME/bin diff --git a/src/scheme/tiny-test/ao_scheme_os.h b/src/scheme/tiny-test/ao_scheme_os.h new file mode 100644 index 00000000..7cfe3981 --- /dev/null +++ b/src/scheme/tiny-test/ao_scheme_os.h @@ -0,0 +1,72 @@ +/* + * 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; version 2 of the License. + * + * 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. + * + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA. + */ + +#ifndef _AO_SCHEME_OS_H_ +#define _AO_SCHEME_OS_H_ + +#include +#include +#include + +#undef AO_SCHEME_FEATURE_FLOAT +#undef AO_SCHEME_FEATURE_VECTOR +#undef AO_SCHEME_FEATURE_QUASI +#undef AO_SCHEME_FEATURE_BIGINT + +#define AO_SCHEME_POOL_TOTAL 4096 +#define AO_SCHEME_SAVE 1 + +extern int ao_scheme_getc(void); + +static inline void +ao_scheme_os_flush() { + fflush(stdout); +} + +static inline void +ao_scheme_abort(void) +{ + abort(); +} + +static inline void +ao_scheme_os_led(int led) +{ + printf("leds set to 0x%x\n", led); +} + +#define AO_SCHEME_JIFFIES_PER_SECOND 100 + +static inline void +ao_scheme_os_delay(int jiffies) +{ + struct timespec ts = { + .tv_sec = jiffies / AO_SCHEME_JIFFIES_PER_SECOND, + .tv_nsec = (jiffies % AO_SCHEME_JIFFIES_PER_SECOND) * (1000000000L / AO_SCHEME_JIFFIES_PER_SECOND) + }; + nanosleep(&ts, NULL); +} + +static inline int +ao_scheme_os_jiffy(void) +{ + struct timespec tp; + clock_gettime(CLOCK_MONOTONIC, &tp); + return tp.tv_sec * AO_SCHEME_JIFFIES_PER_SECOND + (tp.tv_nsec / (1000000000L / AO_SCHEME_JIFFIES_PER_SECOND)); +} + +#endif diff --git a/src/scheme/tiny-test/ao_scheme_test.c b/src/scheme/tiny-test/ao_scheme_test.c new file mode 100644 index 00000000..45068369 --- /dev/null +++ b/src/scheme/tiny-test/ao_scheme_test.c @@ -0,0 +1,141 @@ +/* + * 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 + +static FILE *ao_scheme_file; +static int newline = 1; + +static char save_file[] = "scheme.image"; + +int +ao_scheme_os_save(void) +{ + FILE *save = fopen(save_file, "w"); + + if (!save) { + perror(save_file); + return 0; + } + fwrite(ao_scheme_pool, 1, AO_SCHEME_POOL_TOTAL, save); + fclose(save); + return 1; +} + +int +ao_scheme_os_restore_save(struct ao_scheme_os_save *save, int offset) +{ + FILE *restore = fopen(save_file, "r"); + size_t ret; + + if (!restore) { + perror(save_file); + return 0; + } + fseek(restore, offset, SEEK_SET); + ret = fread(save, sizeof (struct ao_scheme_os_save), 1, restore); + fclose(restore); + if (ret != 1) + return 0; + return 1; +} + +int +ao_scheme_os_restore(void) +{ + FILE *restore = fopen(save_file, "r"); + size_t ret; + + if (!restore) { + perror(save_file); + return 0; + } + ret = fread(ao_scheme_pool, 1, AO_SCHEME_POOL_TOTAL, restore); + fclose(restore); + if (ret != AO_SCHEME_POOL_TOTAL) + return 0; + return 1; +} + +int +ao_scheme_getc(void) +{ + int c; + + if (ao_scheme_file) + return getc(ao_scheme_file); + + if (newline) { + if (ao_scheme_read_list) + printf("+ "); + else + printf("> "); + newline = 0; + } + c = getchar(); + if (c == '\n') + newline = 1; + return c; +} + +int +main (int argc, char **argv) +{ + (void) argc; + + while (*++argv) { + ao_scheme_file = fopen(*argv, "r"); + if (!ao_scheme_file) { + perror(*argv); + exit(1); + } + ao_scheme_read_eval_print(); + fclose(ao_scheme_file); + ao_scheme_file = NULL; + } + ao_scheme_read_eval_print(); + +#ifdef DBG_MEM_STATS + printf ("collects: full: %lu incremental %lu\n", + ao_scheme_collects[AO_SCHEME_COLLECT_FULL], + ao_scheme_collects[AO_SCHEME_COLLECT_INCREMENTAL]); + + printf ("freed: full %lu incremental %lu\n", + ao_scheme_freed[AO_SCHEME_COLLECT_FULL], + ao_scheme_freed[AO_SCHEME_COLLECT_INCREMENTAL]); + + printf("loops: full %lu incremental %lu\n", + ao_scheme_loops[AO_SCHEME_COLLECT_FULL], + ao_scheme_loops[AO_SCHEME_COLLECT_INCREMENTAL]); + + printf("loops per collect: full %f incremental %f\n", + (double) ao_scheme_loops[AO_SCHEME_COLLECT_FULL] / + (double) ao_scheme_collects[AO_SCHEME_COLLECT_FULL], + (double) ao_scheme_loops[AO_SCHEME_COLLECT_INCREMENTAL] / + (double) ao_scheme_collects[AO_SCHEME_COLLECT_INCREMENTAL]); + + printf("freed per collect: full %f incremental %f\n", + (double) ao_scheme_freed[AO_SCHEME_COLLECT_FULL] / + (double) ao_scheme_collects[AO_SCHEME_COLLECT_FULL], + (double) ao_scheme_freed[AO_SCHEME_COLLECT_INCREMENTAL] / + (double) ao_scheme_collects[AO_SCHEME_COLLECT_INCREMENTAL]); + + printf("freed per loop: full %f incremental %f\n", + (double) ao_scheme_freed[AO_SCHEME_COLLECT_FULL] / + (double) ao_scheme_loops[AO_SCHEME_COLLECT_FULL], + (double) ao_scheme_freed[AO_SCHEME_COLLECT_INCREMENTAL] / + (double) ao_scheme_loops[AO_SCHEME_COLLECT_INCREMENTAL]); +#endif +} diff --git a/src/scheme/tiny-test/ao_scheme_tiny_const.scheme b/src/scheme/tiny-test/ao_scheme_tiny_const.scheme new file mode 100644 index 00000000..d0c0e578 --- /dev/null +++ b/src/scheme/tiny-test/ao_scheme_tiny_const.scheme @@ -0,0 +1,389 @@ +; +; 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. +; +; Lisp code placed in ROM + + ; return a list containing all of the arguments +(def (quote list) (lambda l l)) + +(def (quote def!) + (macro (a b) + (list + def + (list quote a) + b) + ) + ) + +(begin + (def! append + (lambda args + (def! a-l + (lambda (a b) + (cond ((null? a) b) + (else (cons (car a) (a-l (cdr a) b))) + ) + ) + ) + + (def! a-ls + (lambda (l) + (cond ((null? l) l) + ((null? (cdr l)) (car l)) + (else (a-l (car l) (a-ls (cdr l)))) + ) + ) + ) + (a-ls args) + ) + ) + 'append) + +(append '(a b c) '(d e f) '(g h i)) + + ; + ; Define a variable without returning the value + ; Useful when defining functions to avoid + ; having lots of output generated. + ; + ; Also accepts the alternate + ; form for defining lambdas of + ; (define (name a y z) sexprs ...) + ; + +(begin + (def (quote define) + (macro (a . b) + ; check for alternate lambda definition form + + (cond ((list? a) + (set! b + (cons lambda (cons (cdr a) b))) + (set! a (car a)) + ) + (else + (set! b (car b)) + ) + ) + (cons begin + (cons + (cons def + (cons (cons quote (cons a '())) + (cons b '()) + ) + ) + (cons + (cons quote (cons a '())) + '()) + ) + ) + ) + ) + 'define + ) + + ; basic list accessors + +(define (caar l) (car (car l))) + +(define (cadr l) (car (cdr l))) + +(define (cdar l) (cdr (car l))) + +(define (caddr l) (car (cdr (cdr l)))) + + ; (if ) + ; (if 3 2) 'yes) +(if (> 3 2) 'yes 'no) +(if (> 2 3) 'no 'yes) +(if (> 2 3) 'no) + + ; simple math operators + +(define zero? (macro (value) (list eqv? value 0))) + +(zero? 1) +(zero? 0) +(zero? "hello") + +(define positive? (macro (value) (list > value 0))) + +(positive? 12) +(positive? -12) + +(define negative? (macro (value) (list < value 0))) + +(negative? 12) +(negative? -12) + +(define (abs a) (if (>= a 0) a (- a))) + +(abs 12) +(abs -12) + +(define max (lambda (a . b) + (while (not (null? b)) + (cond ((< a (car b)) + (set! a (car b))) + ) + (set! b (cdr b)) + ) + a) + ) + +(max 1 2 3) +(max 3 2 1) + +(define min (lambda (a . b) + (while (not (null? b)) + (cond ((> a (car b)) + (set! a (car b))) + ) + (set! b (cdr b)) + ) + a) + ) + +(min 1 2 3) +(min 3 2 1) + +(define (even? a) (zero? (% a 2))) + +(even? 2) +(even? -2) +(even? 3) +(even? -1) + +(define (odd? a) (not (even? a))) + +(odd? 2) +(odd? -2) +(odd? 3) +(odd? -1) + + +(define (list-tail a b) + (if (zero? b) + a + (list-tail (cdr a (- b 1))) + ) + ) + +(define (list-ref a b) + (car (list-tail a b)) + ) + +(define (list-tail a b) + (if (zero? b) + a + (list-tail (cdr a) (- b 1)))) + +(list-tail '(1 2 3) 2) + +(define (list-ref a b) (car (list-tail a b))) + +(list-ref '(1 2 3) 2) + + + ; define a set of local + ; variables one at a time and + ; then evaluate a list of + ; sexprs + ; + ; (let* (var-defines) sexprs) + ; + ; where var-defines are either + ; + ; (name value) + ; + ; or + ; + ; (name) + ; + ; e.g. + ; + ; (let* ((x 1) (y)) (set! y (+ x 1)) y) + +(define let* + (macro (a . b) + + ; + ; make the list of names in the let + ; + + (define (_n a) + (cond ((not (null? a)) + (cons (car (car a)) + (_n (cdr a)))) + (else ()) + ) + ) + + ; the set of expressions is + ; the list of set expressions + ; pre-pended to the + ; expressions to evaluate + + (define (_v a b) + (cond ((null? a) b) (else + (cons + (list set + (list quote + (car (car a)) + ) + (cond ((null? (cdr (car a))) ()) + (else (cadr (car a)))) + ) + (_v (cdr a) b) + ) + ) + ) + ) + + ; the parameters to the lambda is a list + ; of nils of the right length + + (define (_z a) + (cond ((null? a) ()) + (else (cons () (_z (cdr a)))) + ) + ) + ; build the lambda. + + (cons (cons lambda (cons (_n a) (_v a b))) (_z a)) + ) + ) + +(let* ((a 1) (y a)) (+ a y)) + +(define let let*) + ; recursive equality + +(define (equal? a b) + (cond ((eq? a b) #t) + ((pair? a) + (cond ((pair? b) + (cond ((equal? (car a) (car b)) + (equal? (cdr a) (cdr b))) + ) + ) + ) + ) + ) + ) + +(equal? '(a b c) '(a b c)) +(equal? '(a b c) '(a b b)) + +(define member (lambda (obj a . test?) + (cond ((null? a) + #f + ) + (else + (if (null? test?) (set! test? equal?) (set! test? (car test?))) + (if (test? obj (car a)) + a + (member obj (cdr a) test?)) + ) + ) + ) + ) + +(member '(2) '((1) (2) (3))) + +(member '(4) '((1) (2) (3))) + +(define (memq obj a) (member obj a eq?)) + +(memq 2 '(1 2 3)) + +(memq 4 '(1 2 3)) + +(memq '(2) '((1) (2) (3))) + +(define (_assoc a b t?) + (if (null? b) + #f + (if (t? a (caar b)) + (car b) + (_assoc a (cdr b) t?) + ) + ) + ) + +(define (assq a b) (_assoc a b eq?)) +(define (assoc a b) (_assoc a b equal?)) + +(assq 'a '((a 1) (b 2) (c 3))) +(assoc '(c) '((a 1) (b 2) ((c) 3))) + +(define string (lambda a (list->string a))) + +(display "apply\n") +(apply cons '(a b)) + +(define map + (lambda (a . b) + (define (args b) + (cond ((null? b) ()) + (else + (cons (caar b) (args (cdr b))) + ) + ) + ) + (define (next b) + (cond ((null? b) ()) + (else + (cons (cdr (car b)) (next (cdr b))) + ) + ) + ) + (define (domap b) + (cond ((null? (car b)) ()) + (else + (cons (apply a (args b)) (domap (next b))) + ) + ) + ) + (domap b) + ) + ) + +(map cadr '((a b) (d e) (g h))) + +(define for-each (lambda (a . b) + (apply map a b) + #t)) + +(for-each display '("hello" " " "world" "\n")) + +(define (newline) (write-char #\newline)) + +(newline) -- cgit v1.2.3 From ca27d467198c556be483961a6ca3b8f97bbe96a6 Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Tue, 12 Dec 2017 17:59:26 -0800 Subject: altos/scheme: More compiler warning cleanups Make local funcs static. Don't mix decls and code.x Signed-off-by: Keith Packard --- src/scheme/ao_scheme.h | 23 ++++++----------------- src/scheme/ao_scheme_builtin.c | 10 ++++++---- src/scheme/ao_scheme_lambda.c | 8 ++++---- src/scheme/ao_scheme_make_const.c | 19 ++++++++++++------- src/scheme/ao_scheme_save.c | 13 ++++++++++--- src/scheme/ao_scheme_stack.c | 3 ++- src/scheme/ao_scheme_string.c | 19 +++++++++++++------ src/scheme/make-const/Makefile | 2 +- src/scheme/test/Makefile | 2 +- src/scheme/test/ao_scheme_os.h | 2 +- src/scheme/tiny-test/Makefile | 2 +- src/scheme/tiny-test/ao_scheme_os.h | 7 +------ 12 files changed, 58 insertions(+), 52 deletions(-) (limited to 'src/scheme/tiny-test') diff --git a/src/scheme/ao_scheme.h b/src/scheme/ao_scheme.h index 7e4b3697..ad80db2f 100644 --- a/src/scheme/ao_scheme.h +++ b/src/scheme/ao_scheme.h @@ -43,6 +43,10 @@ struct ao_scheme_os_save { uint16_t const_checksum_inv; }; +#ifndef AO_SCHEME_POOL_TOTAL +#error Must define AO_SCHEME_POOL_TOTAL for AO_SCHEME_SAVE +#endif + #define AO_SCHEME_POOL_EXTRA (sizeof(struct ao_scheme_os_save)) #define AO_SCHEME_POOL ((int) (AO_SCHEME_POOL_TOTAL - AO_SCHEME_POOL_EXTRA)) @@ -78,7 +82,7 @@ extern uint8_t ao_scheme_const[AO_SCHEME_POOL_CONST] __attribute__((aligned(4))) #else #include "ao_scheme_const.h" #ifndef AO_SCHEME_POOL -#define AO_SCHEME_POOL 3072 +#error Must define AO_SCHEME_POOL #endif #ifndef AO_SCHEME_POOL_EXTRA #define AO_SCHEME_POOL_EXTRA 0 @@ -560,21 +564,10 @@ extern uint64_t ao_scheme_collects[2]; extern uint64_t ao_scheme_freed[2]; extern uint64_t ao_scheme_loops[2]; -/* returns 1 if the object was already marked */ -int -ao_scheme_mark(const struct ao_scheme_type *type, void *addr); - /* returns 1 if the object was already marked */ int ao_scheme_mark_memory(const struct ao_scheme_type *type, void *addr); -void * -ao_scheme_move_map(void *addr); - -/* returns 1 if the object was already moved */ -int -ao_scheme_move(const struct ao_scheme_type *type, void **ref); - /* returns 1 if the object was already moved */ int ao_scheme_move_memory(const struct ao_scheme_type *type, void **ref); @@ -635,7 +628,7 @@ void ao_scheme_bool_write(ao_poly v); #ifdef AO_SCHEME_MAKE_CONST -struct ao_scheme_bool *ao_scheme_true, *ao_scheme_false; +extern struct ao_scheme_bool *ao_scheme_true, *ao_scheme_false; struct ao_scheme_bool * ao_scheme_bool_get(uint8_t value); @@ -825,12 +818,8 @@ ao_scheme_number_typep(uint8_t t) { return ao_scheme_integer_typep(t) || (t == AO_SCHEME_FLOAT); } - -float -ao_scheme_poly_number(ao_poly p); #else #define ao_scheme_number_typep ao_scheme_integer_typep -#define ao_scheme_poly_number ao_scheme_poly_integer #endif /* builtin */ diff --git a/src/scheme/ao_scheme_builtin.c b/src/scheme/ao_scheme_builtin.c index 4def5704..b6788993 100644 --- a/src/scheme/ao_scheme_builtin.c +++ b/src/scheme/ao_scheme_builtin.c @@ -127,7 +127,7 @@ ao_scheme_check_argt(ao_poly name, struct ao_scheme_cons *cons, int argc, int ty return _ao_scheme_bool_true; } -int32_t +static int32_t ao_scheme_arg_int(ao_poly name, struct ao_scheme_cons *cons, int argc) { ao_poly p = ao_scheme_arg(cons, argc); @@ -306,10 +306,10 @@ ao_scheme_do_display(struct ao_scheme_cons *cons) return _ao_scheme_bool_true; } -ao_poly +static ao_poly ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op) { - struct ao_scheme_cons *cons = cons; + struct ao_scheme_cons *cons; ao_poly ret = AO_SCHEME_NIL; for (cons = orig_cons; cons; cons = ao_scheme_cons_cdr(cons)) { @@ -501,7 +501,7 @@ ao_scheme_do_remainder(struct ao_scheme_cons *cons) return ao_scheme_math(cons, builtin_remainder); } -ao_poly +static ao_poly ao_scheme_compare(struct ao_scheme_cons *cons, enum ao_scheme_builtin_id op) { ao_poly left; @@ -545,6 +545,7 @@ ao_scheme_compare(struct ao_scheme_cons *cons, enum ao_scheme_builtin_id op) default: break; } +#ifdef AO_SCHEME_FEATURE_FLOAT } else if (ao_scheme_number_typep(lt) && ao_scheme_number_typep(rt)) { float l, r; @@ -574,6 +575,7 @@ ao_scheme_compare(struct ao_scheme_cons *cons, enum ao_scheme_builtin_id op) default: break; } +#endif /* AO_SCHEME_FEATURE_FLOAT */ } else if (lt == AO_SCHEME_STRING && rt == AO_SCHEME_STRING) { int c = strcmp(ao_scheme_poly_string(left), ao_scheme_poly_string(right)); diff --git a/src/scheme/ao_scheme_lambda.c b/src/scheme/ao_scheme_lambda.c index ec6f858c..be87f4d1 100644 --- a/src/scheme/ao_scheme_lambda.c +++ b/src/scheme/ao_scheme_lambda.c @@ -17,14 +17,14 @@ #include "ao_scheme.h" -int +static int lambda_size(void *addr) { (void) addr; return sizeof (struct ao_scheme_lambda); } -void +static void lambda_mark(void *addr) { struct ao_scheme_lambda *lambda = addr; @@ -33,7 +33,7 @@ lambda_mark(void *addr) ao_scheme_poly_mark(lambda->frame, 0); } -void +static void lambda_move(void *addr) { struct ao_scheme_lambda *lambda = addr; @@ -65,7 +65,7 @@ ao_scheme_lambda_write(ao_poly poly) printf(")"); } -ao_poly +static ao_poly ao_scheme_lambda_alloc(struct ao_scheme_cons *code, int args) { struct ao_scheme_lambda *lambda; diff --git a/src/scheme/ao_scheme_make_const.c b/src/scheme/ao_scheme_make_const.c index d0a51ec8..51bb1269 100644 --- a/src/scheme/ao_scheme_make_const.c +++ b/src/scheme/ao_scheme_make_const.c @@ -80,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; @@ -97,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; @@ -114,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; @@ -141,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); @@ -150,7 +150,7 @@ 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; @@ -269,7 +269,7 @@ ao_scheme_seen_builtin(struct ao_scheme_builtin *b) return 0; } -int +static int ao_scheme_read_eval_abort(void) { ao_poly in, out = AO_SCHEME_NIL; @@ -297,7 +297,7 @@ struct feature { static struct feature *enable; static struct feature *disable; -void +static void ao_scheme_add_feature(struct feature **list, char *name) { struct feature *feature = malloc (sizeof (struct feature) + strlen(name) + 1); @@ -359,6 +359,7 @@ main(int argc, char **argv) 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; @@ -394,6 +395,7 @@ main(int argc, char **argv) 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) { @@ -467,6 +469,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)); diff --git a/src/scheme/ao_scheme_save.c b/src/scheme/ao_scheme_save.c index af9345b8..3a595d71 100644 --- a/src/scheme/ao_scheme_save.c +++ b/src/scheme/ao_scheme_save.c @@ -17,11 +17,15 @@ ao_poly ao_scheme_do_save(struct ao_scheme_cons *cons) { +#ifdef AO_SCHEME_SAVE + struct ao_scheme_os_save *os; +#endif + if (!ao_scheme_check_argc(_ao_scheme_atom_save, cons, 0, 0)) return AO_SCHEME_NIL; #ifdef AO_SCHEME_SAVE - struct ao_scheme_os_save *os = (struct ao_scheme_os_save *) (void *) &ao_scheme_pool[AO_SCHEME_POOL]; + os = (struct ao_scheme_os_save *) (void *) &ao_scheme_pool[AO_SCHEME_POOL]; ao_scheme_collect(AO_SCHEME_COLLECT_FULL); os->atoms = ao_scheme_atom_poly(ao_scheme_atoms); @@ -38,12 +42,15 @@ ao_scheme_do_save(struct ao_scheme_cons *cons) ao_poly ao_scheme_do_restore(struct ao_scheme_cons *cons) { +#ifdef AO_SCHEME_SAVE + struct ao_scheme_os_save save; + struct ao_scheme_os_save *os = (struct ao_scheme_os_save *) (void *) &ao_scheme_pool[AO_SCHEME_POOL]; +#endif if (!ao_scheme_check_argc(_ao_scheme_atom_save, cons, 0, 0)) return AO_SCHEME_NIL; #ifdef AO_SCHEME_SAVE - struct ao_scheme_os_save save; - struct ao_scheme_os_save *os = (struct ao_scheme_os_save *) (void *) &ao_scheme_pool[AO_SCHEME_POOL]; + os = (struct ao_scheme_os_save *) (void *) &ao_scheme_pool[AO_SCHEME_POOL]; if (!ao_scheme_os_restore_save(&save, AO_SCHEME_POOL)) return ao_scheme_error(AO_SCHEME_INVALID, "header restore failed"); diff --git a/src/scheme/ao_scheme_stack.c b/src/scheme/ao_scheme_stack.c index d19dd6d6..e062a093 100644 --- a/src/scheme/ao_scheme_stack.c +++ b/src/scheme/ao_scheme_stack.c @@ -221,11 +221,12 @@ ao_scheme_stack_copy(struct ao_scheme_stack *old) ao_poly ao_scheme_stack_eval(void) { + struct ao_scheme_cons *cons; struct ao_scheme_stack *new = ao_scheme_stack_copy(ao_scheme_poly_stack(ao_scheme_v)); if (!new) return AO_SCHEME_NIL; - struct ao_scheme_cons *cons = ao_scheme_poly_cons(ao_scheme_stack->values); + cons = ao_scheme_poly_cons(ao_scheme_stack->values); if (!cons || !cons->cdr) return ao_scheme_error(AO_SCHEME_INVALID, "continuation requires a value"); diff --git a/src/scheme/ao_scheme_string.c b/src/scheme/ao_scheme_string.c index e25306cb..ada626c3 100644 --- a/src/scheme/ao_scheme_string.c +++ b/src/scheme/ao_scheme_string.c @@ -45,9 +45,10 @@ char * ao_scheme_string_copy(char *a) { int alen = strlen(a); + char *r; ao_scheme_string_stash(0, a); - char *r = ao_scheme_alloc(alen + 1); + r = ao_scheme_alloc(alen + 1); a = ao_scheme_string_fetch(0); if (!r) return NULL; @@ -60,10 +61,11 @@ ao_scheme_string_cat(char *a, char *b) { int alen = strlen(a); int blen = strlen(b); + char *r; ao_scheme_string_stash(0, a); ao_scheme_string_stash(1, b); - char *r = ao_scheme_alloc(alen + blen + 1); + r = ao_scheme_alloc(alen + blen + 1); a = ao_scheme_string_fetch(0); b = ao_scheme_string_fetch(1); if (!r) @@ -76,11 +78,15 @@ ao_scheme_string_cat(char *a, char *b) ao_poly ao_scheme_string_pack(struct ao_scheme_cons *cons) { - int len = ao_scheme_cons_length(cons); + char *r; + char *s; + int len; + + len = ao_scheme_cons_length(cons); ao_scheme_cons_stash(0, cons); - char *r = ao_scheme_alloc(len + 1); + r = ao_scheme_alloc(len + 1); cons = ao_scheme_cons_fetch(0); - char *s = r; + s = r; while (cons) { if (!ao_scheme_integer_typep(ao_scheme_poly_type(cons->car))) @@ -100,10 +106,11 @@ ao_scheme_string_unpack(char *a) int i; for (i = 0; (c = a[i]); i++) { + struct ao_scheme_cons *n; ao_scheme_cons_stash(0, cons); ao_scheme_cons_stash(1, tail); ao_scheme_string_stash(0, a); - struct ao_scheme_cons *n = ao_scheme_cons_cons(ao_scheme_int_poly(c), AO_SCHEME_NIL); + n = ao_scheme_cons_cons(ao_scheme_int_poly(c), AO_SCHEME_NIL); a = ao_scheme_string_fetch(0); cons = ao_scheme_cons_fetch(0); tail = ao_scheme_cons_fetch(1); diff --git a/src/scheme/make-const/Makefile b/src/scheme/make-const/Makefile index caf7acbe..438b6a79 100644 --- a/src/scheme/make-const/Makefile +++ b/src/scheme/make-const/Makefile @@ -10,7 +10,7 @@ HDRS=$(SCHEME_HDRS) ao_scheme_os.h OBJS=$(SRCS:.c=.o) CC=cc -CFLAGS=-DAO_SCHEME_MAKE_CONST -O0 -g -I. -Wall -Wextra +CFLAGS=-DAO_SCHEME_MAKE_CONST -O2 -g -I. -Wall -Wextra -Wpointer-arith -Wmissing-declarations -Wformat=2 -Wstrict-prototypes -Wmissing-prototypes -Wnested-externs -Wbad-function-cast -Wold-style-definition -Wdeclaration-after-statement -Wunused -Wuninitialized -Wshadow -Wmissing-noreturn -Wmissing-format-attribute -Wredundant-decls -Wlogical-op -Werror=implicit -Werror=nonnull -Werror=init-self -Werror=main -Werror=missing-braces -Werror=sequence-point -Werror=return-type -Werror=trigraphs -Werror=array-bounds -Werror=write-strings -Werror=address -Werror=int-to-pointer-cast -Werror=pointer-to-int-cast .c.o: $(CC) -c $(CFLAGS) $< -o $@ diff --git a/src/scheme/test/Makefile b/src/scheme/test/Makefile index d1bc4239..d51fa7ba 100644 --- a/src/scheme/test/Makefile +++ b/src/scheme/test/Makefile @@ -9,7 +9,7 @@ HDRS=$(SCHEME_HDRS) ao_scheme_const.h OBJS=$(SRCS:.c=.o) -CFLAGS=-O2 -g -Wall -Wextra -I. -I.. +CFLAGS=-O2 -g -Wall -Wextra -I. -I.. -Wpointer-arith -Wmissing-declarations -Wformat=2 -Wstrict-prototypes -Wmissing-prototypes -Wnested-externs -Wbad-function-cast -Wold-style-definition -Wdeclaration-after-statement -Wunused -Wuninitialized -Wshadow -Wmissing-noreturn -Wmissing-format-attribute -Wredundant-decls -Wlogical-op -Werror=implicit -Werror=nonnull -Werror=init-self -Werror=main -Werror=missing-braces -Werror=sequence-point -Werror=return-type -Werror=trigraphs -Werror=array-bounds -Werror=write-strings -Werror=address -Werror=int-to-pointer-cast -Werror=pointer-to-int-cast ao-scheme: $(OBJS) cc $(CFLAGS) -o $@ $(OBJS) -lm diff --git a/src/scheme/test/ao_scheme_os.h b/src/scheme/test/ao_scheme_os.h index 958f68be..b225b2e8 100644 --- a/src/scheme/test/ao_scheme_os.h +++ b/src/scheme/test/ao_scheme_os.h @@ -28,7 +28,7 @@ extern int ao_scheme_getc(void); static inline void -ao_scheme_os_flush() { +ao_scheme_os_flush(void) { fflush(stdout); } diff --git a/src/scheme/tiny-test/Makefile b/src/scheme/tiny-test/Makefile index 5082df44..6b1fe003 100644 --- a/src/scheme/tiny-test/Makefile +++ b/src/scheme/tiny-test/Makefile @@ -11,7 +11,7 @@ HDRS=$(SCHEME_HDRS) ao_scheme_const.h OBJS=$(SRCS:.c=.o) -CFLAGS=-O0 -g -Wall -Wextra -I. -I.. +CFLAGS=-O0 -g -Wall -Wextra -I. -I.. -Wpointer-arith -Wmissing-declarations -Wformat=2 -Wstrict-prototypes -Wmissing-prototypes -Wnested-externs -Wbad-function-cast -Wold-style-definition -Wdeclaration-after-statement -Wunused -Wuninitialized -Wshadow -Wmissing-noreturn -Wmissing-format-attribute -Wredundant-decls -Wlogical-op -Werror=implicit -Werror=nonnull -Werror=init-self -Werror=main -Werror=missing-braces -Werror=sequence-point -Werror=return-type -Werror=trigraphs -Werror=array-bounds -Werror=write-strings -Werror=address -Werror=int-to-pointer-cast -Werror=pointer-to-int-cast ao-scheme-tiny: $(OBJS) cc $(CFLAGS) -o $@ $(OBJS) -lm diff --git a/src/scheme/tiny-test/ao_scheme_os.h b/src/scheme/tiny-test/ao_scheme_os.h index 7cfe3981..b9f3e31f 100644 --- a/src/scheme/tiny-test/ao_scheme_os.h +++ b/src/scheme/tiny-test/ao_scheme_os.h @@ -22,18 +22,13 @@ #include #include -#undef AO_SCHEME_FEATURE_FLOAT -#undef AO_SCHEME_FEATURE_VECTOR -#undef AO_SCHEME_FEATURE_QUASI -#undef AO_SCHEME_FEATURE_BIGINT - #define AO_SCHEME_POOL_TOTAL 4096 #define AO_SCHEME_SAVE 1 extern int ao_scheme_getc(void); static inline void -ao_scheme_os_flush() { +ao_scheme_os_flush(void) { fflush(stdout); } -- cgit v1.2.3