Merge branch 'branch-1.8' into debian

1 files changed, 0 insertions, 423 deletions

diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c
deleted file mode 100644
index 49f989e6..00000000
--- a/src/lisp/ao_lisp_make_const.c
+++ /dev/null
@@ -1,423 +0,0 @@
-/*
- * Copyright © 2016 Keith Packard <keithp@keithp.com>
- *
- * 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_lisp.h"
-#include <stdlib.h>
-#include <ctype.h>
-#include <unistd.h>
-#include <getopt.h>
-
-static struct ao_lisp_builtin *
-ao_lisp_make_builtin(enum ao_lisp_builtin_id func, int args) {
-	struct ao_lisp_builtin *b = ao_lisp_alloc(sizeof (struct ao_lisp_builtin));
-
-	b->type = AO_LISP_BUILTIN;
-	b->func = func;
-	b->args = args;
-	return b;
-}
-
-struct builtin_func {
-	char	*name;
-	int	args;
-	int	func;
-};
-
-struct builtin_func funcs[] = {
-	{ .name = "eval",	.args = AO_LISP_FUNC_F_LAMBDA,	.func = builtin_eval },
-	{ .name = "read",	.args = AO_LISP_FUNC_F_LAMBDA,	.func = builtin_read },
-	{ .name = "lambda",	.args = AO_LISP_FUNC_NLAMBDA,	.func = builtin_lambda },
-	{ .name = "lexpr",	.args = AO_LISP_FUNC_NLAMBDA,	.func = builtin_lexpr },
-	{ .name = "nlambda",	.args = AO_LISP_FUNC_NLAMBDA,	.func = builtin_nlambda },
-	{ .name = "macro",	.args = AO_LISP_FUNC_NLAMBDA,	.func = builtin_macro },
-	{ .name = "car",	.args = AO_LISP_FUNC_F_LAMBDA,	.func = builtin_car },
-	{ .name = "cdr",	.args = AO_LISP_FUNC_F_LAMBDA,	.func = builtin_cdr },
-	{ .name = "cons",	.args = AO_LISP_FUNC_F_LAMBDA,	.func = builtin_cons },
-	{ .name = "last",	.args = AO_LISP_FUNC_F_LAMBDA,	.func = builtin_last },
-	{ .name = "length",	.args = AO_LISP_FUNC_F_LAMBDA,	.func = builtin_length },
-	{ .name = "quote",	.args = AO_LISP_FUNC_NLAMBDA,	.func = builtin_quote },
-	{ .name = "set",	.args = AO_LISP_FUNC_F_LAMBDA,	.func = builtin_set },
-	{ .name = "setq",	.args = AO_LISP_FUNC_MACRO,	.func = builtin_setq },
-	{ .name = "cond",	.args = AO_LISP_FUNC_NLAMBDA,	.func = builtin_cond },
-	{ .name = "progn",	.args = AO_LISP_FUNC_NLAMBDA,	.func = builtin_progn },
-	{ .name = "while",	.args = AO_LISP_FUNC_NLAMBDA,	.func = builtin_while },
-	{ .name = "print",	.args = AO_LISP_FUNC_F_LEXPR,	.func = builtin_print },
-	{ .name = "patom",	.args = AO_LISP_FUNC_F_LEXPR,	.func = builtin_patom },
-	{ .name = "+",		.args = AO_LISP_FUNC_F_LEXPR,	.func = builtin_plus },
-	{ .name = "-",		.args = AO_LISP_FUNC_F_LEXPR,	.func = builtin_minus },
-	{ .name = "*",		.args = AO_LISP_FUNC_F_LEXPR,	.func = builtin_times },
-	{ .name = "/",		.args = AO_LISP_FUNC_F_LEXPR,	.func = builtin_divide },
-	{ .name = "%",		.args = AO_LISP_FUNC_F_LEXPR,	.func = builtin_mod },
-	{ .name = "=",		.args = AO_LISP_FUNC_F_LEXPR,	.func = builtin_equal },
-	{ .name = "<",		.args = AO_LISP_FUNC_F_LEXPR,	.func = builtin_less },
-	{ .name = ">",		.args = AO_LISP_FUNC_F_LEXPR,	.func = builtin_greater },
-	{ .name = "<=",		.args = AO_LISP_FUNC_F_LEXPR,	.func = builtin_less_equal },
-	{ .name = ">=",		.args = AO_LISP_FUNC_F_LEXPR,	.func = builtin_greater_equal },
-	{ .name = "pack",	.args = AO_LISP_FUNC_F_LAMBDA,	.func = builtin_pack },
-	{ .name = "unpack",	.args = AO_LISP_FUNC_F_LAMBDA,	.func = builtin_unpack },
-	{ .name = "flush",	.args = AO_LISP_FUNC_F_LAMBDA,	.func = builtin_flush },
-	{ .name = "delay",	.args = AO_LISP_FUNC_F_LAMBDA,	.func = builtin_delay },
-	{ .name = "led",	.args = AO_LISP_FUNC_F_LEXPR,	.func = builtin_led },
-	{ .name = "save",	.args = AO_LISP_FUNC_F_LAMBDA,	.func = builtin_save },
-	{ .name = "restore",	.args = AO_LISP_FUNC_F_LAMBDA,	.func = builtin_restore },
-	{ .name = "call/cc",	.args = AO_LISP_FUNC_F_LAMBDA,	.func = builtin_call_cc },
-	{ .name = "collect",	.args = AO_LISP_FUNC_F_LAMBDA,	.func = builtin_collect },
-};
-
-#define N_FUNC (sizeof funcs / sizeof funcs[0])
-
-struct ao_lisp_frame	*globals;
-
-static int
-is_atom(int offset)
-{
-	struct ao_lisp_atom *a;
-
-	for (a = ao_lisp_atoms; a; a = ao_lisp_poly_atom(a->next))
-		if (((uint8_t *) a->name - ao_lisp_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;
-}
-
-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_lisp_macro_stack {
-	struct ao_lisp_macro_stack *next;
-	ao_poly	p;
-};
-
-struct ao_lisp_macro_stack *macro_stack;
-
-int
-ao_lisp_macro_push(ao_poly p)
-{
-	struct ao_lisp_macro_stack *m = macro_stack;
-
-	while (m) {
-		if (m->p == p)
-			return 1;
-		m = m->next;
-	}
-	m = malloc (sizeof (struct ao_lisp_macro_stack));
-	m->p = p;
-	m->next = macro_stack;
-	macro_stack = m;
-	return 0;
-}
-
-void
-ao_lisp_macro_pop(void)
-{
-	struct ao_lisp_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);
-
-ao_poly
-ao_macro_test_get(ao_poly atom)
-{
-	ao_poly	*ref = ao_lisp_atom_ref(ao_lisp_frame_global, atom);
-	if (ref)
-		return *ref;
-	return AO_LISP_NIL;
-}
-
-ao_poly
-ao_is_macro(ao_poly p)
-{
-	struct ao_lisp_builtin	*builtin;
-	struct ao_lisp_lambda	*lambda;
-	ao_poly ret;
-
-	MACRO_DEBUG(indent(); printf ("is macro "); ao_lisp_poly_print(p); printf("\n"); ++macro_scan_depth);
-	switch (ao_lisp_poly_type(p)) {
-	case AO_LISP_ATOM:
-		if (ao_lisp_macro_push(p))
-			ret = AO_LISP_NIL;
-		else {
-			if (ao_is_macro(ao_macro_test_get(p)))
-				ret = p;
-			else
-				ret = AO_LISP_NIL;
-			ao_lisp_macro_pop();
-		}
-		break;
-	case AO_LISP_CONS:
-		ret = ao_has_macro(p);
-		break;
-	case AO_LISP_BUILTIN:
-		builtin = ao_lisp_poly_builtin(p);
-		if ((builtin->args & AO_LISP_FUNC_MASK) == AO_LISP_FUNC_MACRO)
-			ret = p;
-		else
-			ret = 0;
-		break;
-
-	case AO_LISP_LAMBDA:
-		lambda = ao_lisp_poly_lambda(p);
-		if (lambda->args == AO_LISP_FUNC_MACRO)
-			ret = p;
-		else
-			ret = ao_has_macro(lambda->code);
-		break;
-	default:
-		ret = AO_LISP_NIL;
-		break;
-	}
-	MACRO_DEBUG(--macro_scan_depth;	indent(); printf ("... "); ao_lisp_poly_print(ret); printf("\n"));
-	return ret;
-}
-
-ao_poly
-ao_has_macro(ao_poly p)
-{
-	struct ao_lisp_cons	*cons;
-	struct ao_lisp_lambda	*lambda;
-	ao_poly			m;
-
-	if (p == AO_LISP_NIL)
-		return AO_LISP_NIL;
-
-	MACRO_DEBUG(indent(); printf("has macro "); ao_lisp_poly_print(p); printf("\n"); ++macro_scan_depth);
-	switch (ao_lisp_poly_type(p)) {
-	case AO_LISP_LAMBDA:
-		lambda = ao_lisp_poly_lambda(p);
-		p = ao_has_macro(lambda->code);
-		break;
-	case AO_LISP_CONS:
-		cons = ao_lisp_poly_cons(p);
-		if ((p = ao_is_macro(cons->car)))
-			break;
-
-		cons = ao_lisp_poly_cons(cons->cdr);
-		p = AO_LISP_NIL;
-		while (cons) {
-			m = ao_has_macro(cons->car);
-			if (m) {
-				p = m;
-				break;
-			}
-			cons = ao_lisp_poly_cons(cons->cdr);
-		}
-		break;
-
-	default:
-		p = AO_LISP_NIL;
-		break;
-	}
-	MACRO_DEBUG(--macro_scan_depth;	indent(); printf("... "); ao_lisp_poly_print(p); printf("\n"));
-	return p;
-}
-
-int
-ao_lisp_read_eval_abort(void)
-{
-	ao_poly	in, out = AO_LISP_NIL;
-	for(;;) {
-		in = ao_lisp_read();
-		if (in == _ao_lisp_atom_eof)
-			break;
-		out = ao_lisp_eval(in);
-		if (ao_lisp_exception)
-			return 0;
-		ao_lisp_poly_print(out);
-		putchar ('\n');
-	}
-	return 1;
-}
-
-static FILE	*in;
-static FILE	*out;
-
-int
-ao_lisp_getc(void)
-{
-	return getc(in);
-}
-
-static const struct option options[] = {
-	{ .name = "out", .has_arg = 1, .val = 'o' },
-	{ 0, 0, 0, 0 }
-};
-
-static void usage(char *program)
-{
-	fprintf(stderr, "usage: %s [--out=<output>] [input]\n", program);
-	exit(1);
-}
-
-int
-main(int argc, char **argv)
-{
-	int	f, o;
-	ao_poly	val;
-	struct ao_lisp_atom	*a;
-	struct ao_lisp_builtin	*b;
-	int	in_atom = 0;
-	char	*out_name = NULL;
-	int	c;
-
-	in = stdin;
-	out = stdout;
-
-	while ((c = getopt_long(argc, argv, "o:", options, NULL)) != -1) {
-		switch (c) {
-		case 'o':
-			out_name = optarg;
-			break;
-		default:
-			usage(argv[0]);
-			break;
-		}
-	}
-
-	for (f = 0; f < (int) N_FUNC; f++) {
-		b = ao_lisp_make_builtin(funcs[f].func, funcs[f].args);
-		a = ao_lisp_atom_intern(funcs[f].name);
-		ao_lisp_atom_set(ao_lisp_atom_poly(a),
-				 ao_lisp_builtin_poly(b));
-	}
-
-	/* boolean constants */
-	ao_lisp_atom_set(ao_lisp_atom_poly(ao_lisp_atom_intern("nil")),
-			 AO_LISP_NIL);
-	a = ao_lisp_atom_intern("t");
-	ao_lisp_atom_set(ao_lisp_atom_poly(a),
-			 ao_lisp_atom_poly(a));
-
-	/* end of file value */
-	a = ao_lisp_atom_intern("eof");
-	ao_lisp_atom_set(ao_lisp_atom_poly(a),
-			 ao_lisp_atom_poly(a));
-
-	if (argv[optind]){
-		in = fopen(argv[optind], "r");
-		if (!in) {
-			perror(argv[optind]);
-			exit(1);
-		}
-	}
-	if (!ao_lisp_read_eval_abort()) {
-		fprintf(stderr, "eval failed\n");
-		exit(1);
-	}
-
-	/* Reduce to referenced values */
-	ao_lisp_collect(AO_LISP_COLLECT_FULL);
-
-	for (f = 0; f < ao_lisp_frame_global->num; f++) {
-		val = ao_has_macro(ao_lisp_frame_global->vals[f].val);
-		if (val != AO_LISP_NIL) {
-			printf("error: function %s contains unresolved macro: ",
-			       ao_lisp_poly_atom(ao_lisp_frame_global->vals[f].atom)->name);
-			ao_lisp_poly_print(val);
-			printf("\n");
-			exit(1);
-		}
-	}
-
-	if (out_name) {
-		out = fopen(out_name, "w");
-		if (!out) {
-			perror(out_name);
-			exit(1);
-		}
-	}
-
-	fprintf(out, "/* Generated file, do not edit */\n\n");
-
-	fprintf(out, "#define AO_LISP_POOL_CONST %d\n", ao_lisp_top);
-	fprintf(out, "extern const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4)));\n");
-	fprintf(out, "#define ao_builtin_atoms 0x%04x\n", ao_lisp_atom_poly(ao_lisp_atoms));
-	fprintf(out, "#define ao_builtin_frame 0x%04x\n", ao_lisp_frame_poly(ao_lisp_frame_global));
-	fprintf(out, "#define ao_lisp_const_checksum ((uint16_t) 0x%04x)\n", ao_fec_crc(ao_lisp_const, ao_lisp_top));
-
-
-	for (a = ao_lisp_atoms; a; a = ao_lisp_poly_atom(a->next)) {
-		char	*n = a->name, c;
-		fprintf(out, "#define _ao_lisp_atom_");
-		while ((c = *n++)) {
-			if (isalnum(c))
-				fprintf(out, "%c", c);
-			else
-				fprintf(out, "%02x", c);
-		}
-		fprintf(out, "  0x%04x\n", ao_lisp_atom_poly(a));
-	}
-	fprintf(out, "#ifdef AO_LISP_CONST_BITS\n");
-	fprintf(out, "const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute((aligned(4))) = {");
-	for (o = 0; o < ao_lisp_top; o++) {
-		uint8_t	c;
-		if ((o & 0xf) == 0)
-			fprintf(out, "\n\t");
-		else
-			fprintf(out, " ");
-		c = ao_lisp_const[o];
-		if (!in_atom)
-			in_atom = is_atom(o);
-		if (in_atom) {
-			fprintf(out, " '%c',", c);
-			in_atom--;
-		} else {
-			fprintf(out, "0x%02x,", c);
-		}
-	}
-	fprintf(out, "\n};\n");
-	fprintf(out, "#endif /* AO_LISP_CONST_BITS */\n");
-	exit(0);
-}