diff options
| author | Keith Packard <keithp@keithp.com> | 2016-11-05 17:53:15 -0700 | 
|---|---|---|
| committer | Keith Packard <keithp@keithp.com> | 2017-02-20 11:16:50 -0800 | 
| commit | d8cf97fe22acefab40d7bb321138e46d4483fef7 (patch) | |
| tree | 8dbab3f6977c62aa16208913013b3bd0d0728817 | |
| parent | 286d07d83bd7ff361e5a904c151a75e5a9c8b071 (diff) | |
altos/lisp: more GC issues. add patom
Use global ao_lisp_stack instead of local stack so that gc
moves of that item work.
Signed-off-by: Keith Packard <keithp@keithp.com>
| -rw-r--r-- | src/lambdakey-v1.0/ao_lambdakey.c | 28 | ||||
| -rw-r--r-- | src/lambdakey-v1.0/ao_pins.h | 3 | ||||
| -rw-r--r-- | src/lisp/ao_lisp.h | 12 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_builtin.c | 13 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_cons.c | 11 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_eval.c | 197 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_make_const.c | 1 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_mem.c | 11 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_prim.c | 61 | ||||
| -rw-r--r-- | src/lisp/ao_lisp_string.c | 10 | ||||
| -rw-r--r-- | src/nucleao-32/ao_pins.h | 3 | 
11 files changed, 237 insertions, 113 deletions
| diff --git a/src/lambdakey-v1.0/ao_lambdakey.c b/src/lambdakey-v1.0/ao_lambdakey.c index 6ac78717..8353d811 100644 --- a/src/lambdakey-v1.0/ao_lambdakey.c +++ b/src/lambdakey-v1.0/ao_lambdakey.c @@ -15,39 +15,11 @@  #include <ao.h>  #include <ao_lisp.h> -static uint16_t	blink_delay, blink_running; - -static void blink(void) { -	blink_running = 1; -	while (blink_delay) { -		ao_led_on(AO_LED_RED); -		ao_delay(blink_delay); -		ao_led_off(AO_LED_RED); -		ao_delay(blink_delay); -	} -	blink_running = 0; -	ao_wakeup(&blink_running); -	ao_exit(); -} - -struct ao_task blink_task; - -static void blink_cmd() { -	ao_cmd_decimal(); -	blink_delay = ao_cmd_lex_i; -	if (blink_delay && !blink_running) -		ao_add_task(&blink_task, blink, "blink"); -	if (!blink_delay) -		while (blink_running) -			ao_sleep(&blink_running); -} -  static void lisp_cmd() {  	ao_lisp_read_eval_print();  }  static const struct ao_cmds blink_cmds[] = { -	{ blink_cmd,	"b <delay, 0 off>\0Blink the green LED" },  	{ lisp_cmd,	"l\0Run lisp interpreter" },  	{ 0, 0 }  }; diff --git a/src/lambdakey-v1.0/ao_pins.h b/src/lambdakey-v1.0/ao_pins.h index e379ed12..4da638b9 100644 --- a/src/lambdakey-v1.0/ao_pins.h +++ b/src/lambdakey-v1.0/ao_pins.h @@ -25,7 +25,8 @@  #define AO_LED_RED	(1 << LED_PIN_RED)  #define AO_LED_PANIC	AO_LED_RED  #define AO_CMD_LEN	128 -#define AO_LISP_POOL	2048 +#define AO_LISP_POOL	1536 +#define AO_STACK_SIZE	2048  #define LEDS_AVAILABLE	(AO_LED_RED) diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h index 27174e13..0d179942 100644 --- a/src/lisp/ao_lisp.h +++ b/src/lisp/ao_lisp.h @@ -173,6 +173,7 @@ enum ao_lisp_builtin_id {  	builtin_setq,  	builtin_cond,  	builtin_print, +	builtin_patom,  	builtin_plus,  	builtin_minus,  	builtin_times, @@ -331,6 +332,9 @@ ao_lisp_cons_cons(ao_poly car, struct ao_lisp_cons *cdr);  void  ao_lisp_cons_print(ao_poly); +void +ao_lisp_cons_patom(ao_poly); +  /* string */  extern const struct ao_lisp_type ao_lisp_string_type; @@ -346,6 +350,9 @@ ao_lisp_string_cat(char *a, char *b);  void  ao_lisp_string_print(ao_poly s); +void +ao_lisp_string_patom(ao_poly s); +  /* atom */  extern const struct ao_lisp_type ao_lisp_atom_type; @@ -370,9 +377,12 @@ void  ao_lisp_int_print(ao_poly i);  /* prim */ -ao_poly +void  ao_lisp_poly_print(ao_poly p); +void +ao_lisp_poly_patom(ao_poly p); +  int  ao_lisp_poly_mark(ao_poly p); diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c index 0ad1f464..49b6c37d 100644 --- a/src/lisp/ao_lisp_builtin.c +++ b/src/lisp/ao_lisp_builtin.c @@ -180,6 +180,18 @@ ao_lisp_print(struct ao_lisp_cons *cons)  }  ao_poly +ao_lisp_patom(struct ao_lisp_cons *cons) +{ +	ao_poly	val = AO_LISP_NIL; +	while (cons) { +		val = cons->car; +		ao_lisp_poly_patom(val); +		cons = ao_lisp_poly_cons(cons->cdr); +	} +	return val; +} + +ao_poly  ao_lisp_math(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op)  {  	ao_poly	ret = AO_LISP_NIL; @@ -376,6 +388,7 @@ ao_lisp_func_t ao_lisp_builtins[] = {  	[builtin_setq] = ao_lisp_setq,  	[builtin_cond] = ao_lisp_cond,  	[builtin_print] = ao_lisp_print, +	[builtin_patom] = ao_lisp_patom,  	[builtin_plus] = ao_lisp_plus,  	[builtin_minus] = ao_lisp_minus,  	[builtin_times] = ao_lisp_times, diff --git a/src/lisp/ao_lisp_cons.c b/src/lisp/ao_lisp_cons.c index 4929b91c..7d3ca68d 100644 --- a/src/lisp/ao_lisp_cons.c +++ b/src/lisp/ao_lisp_cons.c @@ -83,3 +83,14 @@ ao_lisp_cons_print(ao_poly c)  	}  	printf(")");  } + +void +ao_lisp_cons_patom(ao_poly c) +{ +	struct ao_lisp_cons *cons = ao_lisp_poly_cons(c); + +	while (cons) { +		ao_lisp_poly_patom(cons->car); +		cons = ao_lisp_poly_cons(cons->cdr); +	} +} diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c index 0de3f190..e3d653b9 100644 --- a/src/lisp/ao_lisp_eval.c +++ b/src/lisp/ao_lisp_eval.c @@ -15,12 +15,13 @@  #include "ao_lisp.h"  #if 0 +#define DBG_CODE	1  static int stack_depth;  #define DBG_INDENT()	do { int _s; for(_s = 0; _s < stack_depth; _s++) printf("  "); } while(0)  #define DBG_IN()	(++stack_depth)  #define DBG_OUT()	(--stack_depth)  #define DBG(...) 	printf(__VA_ARGS__) -#define DBGI(...)	do { DBG_INDENT(); DBG(__VA_ARGS__); } while (0) +#define DBGI(...)	do { DBG_INDENT(); DBG("%4d: ", __LINE__); DBG(__VA_ARGS__); } while (0)  #define DBG_CONS(a)	ao_lisp_cons_print(ao_lisp_cons_poly(a))  #define DBG_POLY(a)	ao_lisp_poly_print(a)  #define OFFSET(a)	((a) ? (int) ((uint8_t *) a - ao_lisp_pool) : -1) @@ -90,6 +91,29 @@ stack_mark(void *addr)  static const struct ao_lisp_type ao_lisp_stack_type; +#if DBG_CODE +static void +stack_validate_tail(struct ao_lisp_stack *stack) +{ +	struct ao_lisp_cons *head = ao_lisp_poly_cons(stack->formals); +	struct ao_lisp_cons *tail = ao_lisp_poly_cons(stack->formals_tail); +	struct ao_lisp_cons *cons; +	for (cons = head; cons && cons->cdr && cons != tail; cons = ao_lisp_poly_cons(cons->cdr)) +		; +	if (cons != tail || (tail && tail->cdr)) { +		if (!tail) { +			printf("tail null\n"); +		} else { +			printf("tail validate fail head %d actual %d recorded %d\n", +			       OFFSET(head), OFFSET(cons), OFFSET(tail)); +			abort(); +		} +	} +} +#else +#define stack_validate_tail(s) +#endif +  static void  stack_move(void *addr)  { @@ -106,7 +130,8 @@ stack_move(void *addr)  		ret = ao_lisp_move(&ao_lisp_stack_type, &prev);  		if (prev != ao_lisp_poly_stack(stack->prev))  			stack->prev = ao_lisp_stack_poly(prev); -		if (ret); +		stack_validate_tail(stack); +		if (ret)  			break;  		stack = ao_lisp_poly_stack(stack->prev);  	} @@ -122,6 +147,19 @@ static struct ao_lisp_stack	*ao_lisp_stack;  static ao_poly			ao_lisp_v;  static uint8_t been_here; +#if DBG_CODE +static void +stack_validate_tails(void) +{ +	struct ao_lisp_stack	*stack; + +	for (stack = ao_lisp_stack; stack; stack = ao_lisp_poly_stack(stack->prev)) +		stack_validate_tail(stack); +} +#else +#define stack_validate_tails(s) +#endif +  ao_poly  ao_lisp_set_cond(struct ao_lisp_cons *c)  { @@ -139,27 +177,35 @@ ao_lisp_stack_reset(struct ao_lisp_stack *stack)  	stack->formals = AO_LISP_NIL;  	stack->formals_tail = AO_LISP_NIL;  	stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current); +	stack_validate_tails();  } -struct ao_lisp_stack * +int  ao_lisp_stack_push(void)  { +	stack_validate_tails(); +	if (ao_lisp_stack) { +		DBGI("formals "); DBG_POLY(ao_lisp_stack->formals); DBG("\n"); +		DBGI("actuals "); DBG_POLY(ao_lisp_stack->actuals); DBG("\n"); +	} +	DBGI("stack push\n"); +	DBG_IN();  	struct ao_lisp_stack	*stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack));  	if (!stack) -		return NULL; +		return 0;  	stack->prev = ao_lisp_stack_poly(ao_lisp_stack);  	ao_lisp_stack = stack;  	ao_lisp_stack_reset(stack); -	DBGI("stack push\n"); -	DBG_IN(); -	return stack; +	stack_validate_tails(); +	return 1;  } -struct ao_lisp_stack * +void  ao_lisp_stack_pop(void)  {  	if (!ao_lisp_stack) -		return NULL; +		return; +	stack_validate_tails();  	DBG_OUT();  	DBGI("stack pop\n");  	ao_lisp_stack = ao_lisp_poly_stack(ao_lisp_stack->prev); @@ -167,12 +213,16 @@ ao_lisp_stack_pop(void)  		ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->frame);  	else  		ao_lisp_frame_current = NULL; -	return ao_lisp_stack; +	if (ao_lisp_stack) { +		DBGI("formals "); DBG_POLY(ao_lisp_stack->formals); DBG("\n"); +		DBGI("actuals "); DBG_POLY(ao_lisp_stack->actuals); DBG("\n"); +	}  }  static void  ao_lisp_stack_clear(void)  { +	stack_validate_tails();  	ao_lisp_stack = NULL;  	ao_lisp_frame_current = NULL;  } @@ -285,7 +335,6 @@ ao_lisp_lambda(struct ao_lisp_cons *cons)  ao_poly  ao_lisp_eval(ao_poly _v)  { -	struct ao_lisp_stack	*stack;  	ao_poly			formal;  	ao_lisp_v = _v; @@ -295,45 +344,50 @@ ao_lisp_eval(ao_poly _v)  		ao_lisp_root_poly_add(&ao_lisp_v);  	} -	stack = ao_lisp_stack_push(); +	if (!ao_lisp_stack_push()) +		goto bail;  	for (;;) {  		if (ao_lisp_exception) -			return AO_LISP_NIL; -		switch (stack->state) { +			goto bail; +		switch (ao_lisp_stack->state) {  		case eval_sexpr:  			DBGI("sexpr: "); DBG_POLY(ao_lisp_v); DBG("\n");  			switch (ao_lisp_poly_type(ao_lisp_v)) {  			case AO_LISP_CONS:  				if (ao_lisp_v == AO_LISP_NIL) { -					stack->state = eval_exec; +					ao_lisp_stack->state = eval_exec;  					break;  				} -				stack->actuals = ao_lisp_v; -				stack->state = eval_formal; -				stack = ao_lisp_stack_push(); +				ao_lisp_stack->actuals = ao_lisp_v; +				DBGI("actuals now "); DBG_POLY(ao_lisp_v); DBG("\n"); +				ao_lisp_stack->state = eval_formal; +				if (!ao_lisp_stack_push()) +					goto bail;  				ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car; +				stack_validate_tails();  				break;  			case AO_LISP_ATOM:  				ao_lisp_v = ao_lisp_atom_get(ao_lisp_v);  				/* fall through */  			case AO_LISP_INT:  			case AO_LISP_STRING: -				stack->state = eval_val; +			case AO_LISP_BUILTIN: +				ao_lisp_stack->state = eval_val;  				break;  			}  			break;  		case eval_val:  			DBGI("val: "); DBG_POLY(ao_lisp_v); DBG("\n"); -			stack = ao_lisp_stack_pop(); -			if (!stack) +			ao_lisp_stack_pop(); +			if (!ao_lisp_stack)  				return ao_lisp_v; -			DBGI("..state %d\n", stack->state); +			DBGI("..state %d\n", ao_lisp_stack->state);  			break;  		case eval_formal:  			/* Check what kind of function we've got */ -			if (!stack->formals) { +			if (!ao_lisp_stack->formals) {  				switch (func_type(ao_lisp_v)) {  				case AO_LISP_LAMBDA:  				case _ao_lisp_atom_lambda: @@ -343,99 +397,108 @@ ao_lisp_eval(ao_poly _v)  					break;  				case AO_LISP_MACRO:  				case _ao_lisp_atom_macro: -					stack->macro = 1; +					ao_lisp_stack->macro = 1;  				case AO_LISP_NLAMBDA:  				case _ao_lisp_atom_nlambda:  					DBGI(".. nlambda or macro\n"); -					stack->formals = stack->actuals; -					stack->state = eval_exec_direct; +					ao_lisp_stack->formals = ao_lisp_stack->actuals; +					ao_lisp_stack->formals_tail = AO_LISP_NIL; +					ao_lisp_stack->state = eval_exec_direct; +					stack_validate_tails();  					break;  				} -				if (stack->state == eval_exec_direct) +				if (ao_lisp_stack->state == eval_exec_direct)  					break;  			} +			DBGI("add formal "); DBG_POLY(ao_lisp_v); DBG("\n"); +			stack_validate_tails();  			formal = ao_lisp_cons_poly(ao_lisp_cons_cons(ao_lisp_v, NULL)); -			if (!formal) { -				ao_lisp_stack_clear(); -				return AO_LISP_NIL; -			} +			stack_validate_tails(); +			if (!formal) +				goto bail; -			if (stack->formals_tail) -				ao_lisp_poly_cons(stack->formals_tail)->cdr = formal; +			if (ao_lisp_stack->formals_tail) +				ao_lisp_poly_cons(ao_lisp_stack->formals_tail)->cdr = formal;  			else -				stack->formals = formal; -			stack->formals_tail = formal; +				ao_lisp_stack->formals = formal; +			ao_lisp_stack->formals_tail = formal; -			DBGI("formals now "); DBG_POLY(stack->formals); DBG("\n"); +			DBGI("formals now "); DBG_POLY(ao_lisp_stack->formals); DBG("\n"); -			ao_lisp_v = ao_lisp_poly_cons(stack->actuals)->cdr; +			ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->actuals)->cdr; -			stack->state = eval_sexpr; +			stack_validate_tails(); +			ao_lisp_stack->state = eval_sexpr;  			break;  		case eval_exec: -			if (!stack->formals) { +			if (!ao_lisp_stack->formals) {  				ao_lisp_v = AO_LISP_NIL; -				stack->state = eval_val; +				ao_lisp_stack->state = eval_val;  				break;  			} -			ao_lisp_v = ao_lisp_poly_cons(stack->formals)->car; +			ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->formals)->car;  		case eval_exec_direct: -			DBGI("exec: macro %d ", stack->macro); DBG_POLY(ao_lisp_v); DBG(" formals "); DBG_POLY(stack->formals); DBG ("\n"); +			DBGI("exec: macro %d ", ao_lisp_stack->macro); DBG_POLY(ao_lisp_v); DBG(" formals "); DBG_POLY(ao_lisp_stack->formals); DBG ("\n");  			if (ao_lisp_poly_type(ao_lisp_v) == AO_LISP_BUILTIN) { -				struct ao_lisp_builtin *b = ao_lisp_poly_builtin(ao_lisp_v); -				struct ao_lisp_cons	*f = ao_lisp_poly_cons(ao_lisp_poly_cons(stack->formals)->cdr); +				stack_validate_tails(); +				struct ao_lisp_builtin	*b = ao_lisp_poly_builtin(ao_lisp_v); +				stack_validate_tails(); +				struct ao_lisp_cons	*f = ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->formals)->cdr);  				DBGI(".. builtin formals "); DBG_CONS(f); DBG("\n"); -				if (stack->macro) -					stack->state = eval_sexpr; +				stack_validate_tails(); +				if (ao_lisp_stack->macro) +					ao_lisp_stack->state = eval_sexpr;  				else -					stack->state = eval_val; -				stack->macro = 0; +					ao_lisp_stack->state = eval_val; +				ao_lisp_stack->macro = 0; +				ao_lisp_stack->actuals = ao_lisp_stack->formals = ao_lisp_stack->formals_tail = AO_LISP_NIL;  				ao_lisp_v = ao_lisp_func(b) (f);  				DBGI("builtin result:"); DBG_POLY(ao_lisp_v); DBG ("\n"); -				if (ao_lisp_exception) { -					ao_lisp_stack_clear(); -					return AO_LISP_NIL; -				} +				if (ao_lisp_exception) +					goto bail;  				break;  			} else { -				ao_lisp_v = ao_lisp_lambda(ao_lisp_poly_cons(stack->formals)); -				ao_lisp_stack_reset(stack); +				ao_lisp_v = ao_lisp_lambda(ao_lisp_poly_cons(ao_lisp_stack->formals)); +				ao_lisp_stack_reset(ao_lisp_stack);  			}  			break;  		case eval_cond: -			DBGI("cond: "); DBG_POLY(stack->actuals); DBG("\n"); -			if (!stack->actuals) { +			DBGI("cond: "); DBG_POLY(ao_lisp_stack->actuals); DBG("\n"); +			if (!ao_lisp_stack->actuals) {  				ao_lisp_v = AO_LISP_NIL; -				stack->state = eval_val; +				ao_lisp_stack->state = eval_val;  			} else { -				ao_lisp_v = ao_lisp_poly_cons(stack->actuals)->car; +				ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->actuals)->car;  				if (!ao_lisp_v || ao_lisp_poly_type(ao_lisp_v) != AO_LISP_CONS) {  					ao_lisp_error(AO_LISP_INVALID, "invalid cond clause");  					goto bail;  				}  				ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car; -				stack->state = eval_cond_test; -				stack = ao_lisp_stack_push(); -				stack->state = eval_sexpr; +				ao_lisp_stack->state = eval_cond_test; +				stack_validate_tails(); +				ao_lisp_stack_push(); +				stack_validate_tails(); +				ao_lisp_stack->state = eval_sexpr;  			}  			break;  		case eval_cond_test: -			DBGI("cond_test "); DBG_POLY(ao_lisp_v); DBG("\n"); +			DBGI("cond_test: "); DBG_POLY(ao_lisp_v); DBG(" actuals "); DBG_POLY(ao_lisp_stack->actuals); DBG("\n");  			if (ao_lisp_v) { -				struct ao_lisp_cons *car = ao_lisp_poly_cons(ao_lisp_poly_cons(stack->actuals)->car); +				struct ao_lisp_cons *car = ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->actuals)->car);  				struct ao_lisp_cons *c = ao_lisp_poly_cons(car->cdr);  				if (c) {  					ao_lisp_v = c->car; -					stack->state = eval_sexpr; +					ao_lisp_stack->state = eval_sexpr;  				} else { -					stack->state = eval_val; +					ao_lisp_stack->state = eval_val;  				}  			} else { -				stack->actuals = ao_lisp_poly_cons(stack->actuals)->cdr; -				stack->state = eval_cond; +				ao_lisp_stack->actuals = ao_lisp_poly_cons(ao_lisp_stack->actuals)->cdr; +				DBGI("actuals now "); DBG_POLY(ao_lisp_stack->actuals); DBG("\n"); +				ao_lisp_stack->state = eval_cond;  			}  			break;  		} diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c index 9768dc22..f2e3cea1 100644 --- a/src/lisp/ao_lisp_make_const.c +++ b/src/lisp/ao_lisp_make_const.c @@ -41,6 +41,7 @@ struct builtin_func funcs[] = {  	"setq",		AO_LISP_MACRO,	builtin_setq,  	"cond",		AO_LISP_NLAMBDA,builtin_cond,  	"print",	AO_LISP_LEXPR,	builtin_print, +	"patom",	AO_LISP_LEXPR,	builtin_patom,  	"+",		AO_LISP_LEXPR,	builtin_plus,  	"-",		AO_LISP_LEXPR,	builtin_minus,  	"*",		AO_LISP_LEXPR,	builtin_times, diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c index 9e716da9..6e656454 100644 --- a/src/lisp/ao_lisp_mem.c +++ b/src/lisp/ao_lisp_mem.c @@ -36,6 +36,7 @@ uint8_t	ao_lisp_pool[AO_LISP_POOL] __attribute__((aligned(4)));  #endif  #if 0 +#define DBG_INCLUDE  #define DBG_DUMP	0  #define DBG_OFFSET(a)	((int) ((uint8_t *) (a) - ao_lisp_pool))  #define DBG(...) printf(__VA_ARGS__) @@ -179,15 +180,17 @@ move_object(void)  			DBG_DO(void *addr = *ao_lisp_root[i].addr);  			DBG_MOVE("root %d\n", DBG_OFFSET(addr));  			if (!ao_lisp_move(ao_lisp_root[i].type, -					  ao_lisp_root[i].addr)) +					  ao_lisp_root[i].addr)) {  				DBG_MOVE("root moves from %p to %p\n",  					 addr,  					 *ao_lisp_root[i].addr); +			}  		} else {  			DBG_DO(ao_poly p = *(ao_poly *) ao_lisp_root[i].addr); -			if (!ao_lisp_poly_move((ao_poly *) ao_lisp_root[i].addr)) +			if (!ao_lisp_poly_move((ao_poly *) ao_lisp_root[i].addr)) {  				DBG_MOVE("root poly move from %04x to %04x\n",  					 p, *(ao_poly *) ao_lisp_root[i].addr); +			}  		}  	}  	DBG_MOVE_OUT(); @@ -338,7 +341,7 @@ ao_lisp_move(const struct ao_lisp_type *type, void **ref)  	int		size = type->size(addr);  	if (!addr) -		return NULL; +		return 1;  #ifndef AO_LISP_MAKE_CONST  	if (AO_LISP_IS_CONST(addr)) @@ -370,7 +373,7 @@ ao_lisp_move_memory(void **ref, int size)  {  	void *addr = *ref;  	if (!addr) -		return NULL; +		return 1;  	DBG_MOVE("memory %d\n", DBG_OFFSET(addr));  	DBG_MOVE_IN(); diff --git a/src/lisp/ao_lisp_prim.c b/src/lisp/ao_lisp_prim.c index 7f02505d..82386a83 100644 --- a/src/lisp/ao_lisp_prim.c +++ b/src/lisp/ao_lisp_prim.c @@ -20,21 +20,60 @@  #define DBG(...)  #endif -static void (*const ao_lisp_print_funcs[AO_LISP_NUM_TYPE])(ao_poly) = { -	[AO_LISP_CONS] = ao_lisp_cons_print, -	[AO_LISP_STRING] = ao_lisp_string_print, -	[AO_LISP_INT] = ao_lisp_int_print, -	[AO_LISP_ATOM] = ao_lisp_atom_print, -	[AO_LISP_BUILTIN] = ao_lisp_builtin_print +struct ao_lisp_funcs { +	void (*print)(ao_poly); +	void (*patom)(ao_poly);  }; -ao_poly +static const struct ao_lisp_funcs ao_lisp_funcs[AO_LISP_NUM_TYPE] = { +	[AO_LISP_CONS] = { +		.print = ao_lisp_cons_print, +		.patom = ao_lisp_cons_patom, +	}, +	[AO_LISP_STRING] = { +		.print = ao_lisp_string_print, +		.patom = ao_lisp_string_patom, +	}, +	[AO_LISP_INT] = { +		.print = ao_lisp_int_print, +		.patom = ao_lisp_int_print, +	}, +	[AO_LISP_ATOM] = { +		.print = ao_lisp_atom_print, +		.patom = ao_lisp_atom_print, +	}, +	[AO_LISP_BUILTIN] = { +		.print = ao_lisp_builtin_print, +		.patom = ao_lisp_builtin_print, +	} +}; + +static const struct ao_lisp_funcs * +funcs(ao_poly p) +{ +	uint8_t	type = ao_lisp_poly_type(p); + +	if (type < AO_LISP_NUM_TYPE) +		return &ao_lisp_funcs[type]; +	return NULL; +} + +void  ao_lisp_poly_print(ao_poly p)  { -	void (*print)(ao_poly) = ao_lisp_print_funcs[ao_lisp_poly_type(p)]; -	if (print) -		print(p); -	return p; +	const struct ao_lisp_funcs *f = funcs(p); + +	if (f && f->print) +		f->print(p); +} + +void +ao_lisp_poly_patom(ao_poly p) +{ +	const struct ao_lisp_funcs *f = funcs(p); + +	if (f && f->patom) +		f->patom(p);  }  static const struct ao_lisp_type const *ao_lisp_types[AO_LISP_NUM_TYPE] = { diff --git a/src/lisp/ao_lisp_string.c b/src/lisp/ao_lisp_string.c index 39c3dc81..0064064c 100644 --- a/src/lisp/ao_lisp_string.c +++ b/src/lisp/ao_lisp_string.c @@ -99,3 +99,13 @@ ao_lisp_string_print(ao_poly p)  	}  	putchar('"');  } + +void +ao_lisp_string_patom(ao_poly p) +{ +	char	*s = ao_lisp_poly_string(p); +	char	c; + +	while ((c = *s++)) +		putchar(c); +} diff --git a/src/nucleao-32/ao_pins.h b/src/nucleao-32/ao_pins.h index 65de89ed..092d347c 100644 --- a/src/nucleao-32/ao_pins.h +++ b/src/nucleao-32/ao_pins.h @@ -25,7 +25,8 @@  #define AO_LED_GREEN	(1 << LED_PIN_GREEN)  #define AO_LED_PANIC	AO_LED_GREEN  #define AO_CMD_LEN	128 -#define AO_LISP_POOL	2048 +#define AO_LISP_POOL	1024 +#define AO_STACK_SIZE	1536  #define LEDS_AVAILABLE	(AO_LED_GREEN) | 
