altos/lisp: Separate out values from atoms

This enables changing values of atoms declared as constants, should
enable lets, and with some work, even lexical scoping.

this required changing the constant computation to run
ao_lisp_collect() before dumping the block of constant data, and that
uncovered some minor memory manager bugs.

Signed-off-by: Keith Packard <keithp@keithp.com>

1 files changed, 80 insertions, 25 deletions

diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index d4108662..98e99acb 100644
--- a/src/lisp/ao_lisp.h
+++ b/src/lisp/ao_lisp.h
@@ -15,9 +15,12 @@
 #ifndef _AO_LISP_H_
 #define _AO_LISP_H_
 
+#include <stdlib.h>
+
 #if !defined(AO_LISP_TEST) && !defined(AO_LISP_MAKE_CONST)
 #include <ao.h>
 #define AO_LISP_ALTOS	1
+#define abort() ao_panic(1)
 #endif
 
 #include <stdint.h>
@@ -27,9 +30,14 @@
 #ifdef AO_LISP_MAKE_CONST
 #define AO_LISP_POOL_CONST	16384
 extern uint8_t ao_lisp_const[AO_LISP_POOL_CONST];
+#define ao_lisp_pool ao_lisp_const
+#define AO_LISP_POOL AO_LISP_POOL_CONST
 #define _ao_lisp_atom_quote ao_lisp_atom_poly(ao_lisp_atom_intern("quote"))
+#define _ao_lisp_atom_set ao_lisp_atom_poly(ao_lisp_atom_intern("set"))
 #else
 #include "ao_lisp_const.h"
+#define AO_LISP_POOL	1024
+extern uint8_t		ao_lisp_pool[AO_LISP_POOL];
 #endif
 
 /* Primitive types */
@@ -46,13 +54,11 @@ extern uint8_t ao_lisp_const[AO_LISP_POOL_CONST];
 /* These have a type value at the start of the struct */
 #define AO_LISP_ATOM		4
 #define AO_LISP_BUILTIN		5
-#define AO_LISP_NUM_TYPE	6
+#define AO_LISP_FRAME		6
+#define AO_LISP_NUM_TYPE	7
 
 #define AO_LISP_NIL	0
 
-#define AO_LISP_POOL	1024
-
-extern uint8_t		ao_lisp_pool[AO_LISP_POOL];
 extern uint16_t		ao_lisp_top;
 
 #define AO_LISP_OOM		0x01
@@ -68,37 +74,31 @@ ao_lisp_is_const(ao_poly poly) {
 	return poly & AO_LISP_CONST;
 }
 
+#define AO_LISP_POOL_BASE	(ao_lisp_pool - 4)
+#define AO_LISP_CONST_BASE	(ao_lisp_const - 4)
+
+#define AO_LISP_IS_CONST(a)	(ao_lisp_const <= ((uint8_t *) (a)) && ((uint8_t *) (a)) < ao_lisp_const + AO_LISP_POOL_CONST)
+#define AO_LISP_IS_POOL(a)	(ao_lisp_pool <= ((uint8_t *) (a)) && ((uint8_t *) (a)) < ao_lisp_pool + AO_LISP_POOL)
+
 static inline void *
 ao_lisp_ref(ao_poly poly) {
 	if (poly == AO_LISP_NIL)
 		return NULL;
 	if (poly & AO_LISP_CONST)
-		return (void *) ((ao_lisp_const - 4) + (poly & AO_LISP_REF_MASK));
-	else
-		return (void *) ((ao_lisp_pool - 4) + (poly & AO_LISP_REF_MASK));
+		return (void *) (AO_LISP_CONST_BASE + (poly & AO_LISP_REF_MASK));
+	return (void *) (AO_LISP_POOL_BASE + (poly & AO_LISP_REF_MASK));
 }
 
 static inline ao_poly
 ao_lisp_poly(const void *addr, ao_poly type) {
 	const uint8_t	*a = addr;
-	if (addr == NULL)
+	if (a == NULL)
 		return AO_LISP_NIL;
-	if (ao_lisp_pool <= a && a < ao_lisp_pool + AO_LISP_POOL)
-		return (a - (ao_lisp_pool - 4)) | type;
-	else if (ao_lisp_const <= a && a <= ao_lisp_const + AO_LISP_POOL_CONST)
-		return AO_LISP_CONST | (a - (ao_lisp_const - 4)) | type;
-	else {
-		ao_lisp_exception |= AO_LISP_INVALID;
-		return AO_LISP_NIL;
-	}
+	if (AO_LISP_IS_CONST(a))
+		return AO_LISP_CONST | (a - AO_LISP_CONST_BASE) | type;
+	return (a - AO_LISP_POOL_BASE) | type;
 }
 
-#define AO_LISP_POLY(addr, type) (((ao_lisp_pool <= ((uint8_t *) (a)) && \
-				    ((uint8_t *) (a)) < ao_lisp_pool + AO_LISP_POOL) ? \
-				   ((uint8_t *) (a) - (ao_lisp_pool - 4)) : \
-				   (((uint8_t *) (a) - (ao_lisp_const - 4)) | AO_LISP_POOL_CONST)) | \
-				  (type))
-
 struct ao_lisp_type {
 	void	(*mark)(void *addr);
 	int	(*size)(void *addr);
@@ -113,11 +113,32 @@ struct ao_lisp_cons {
 struct ao_lisp_atom {
 	uint8_t		type;
 	uint8_t		pad[1];
-	ao_poly		val;
 	ao_poly		next;
 	char		name[];
 };
 
+struct ao_lisp_val {
+	ao_poly		atom;
+	ao_poly		val;
+};
+
+struct ao_lisp_frame {
+	uint8_t			num;
+	uint8_t			readonly;
+	ao_poly			next;
+	struct ao_lisp_val	vals[];
+};
+
+static inline struct ao_lisp_frame *
+ao_lisp_poly_frame(ao_poly poly) {
+	return ao_lisp_ref(poly);
+}
+
+static inline ao_poly
+ao_lisp_frame_poly(struct ao_lisp_frame *frame) {
+	return ao_lisp_poly(frame, AO_LISP_OTHER);
+}
+
 #define AO_LISP_LAMBDA	0
 #define AO_LISP_NLAMBDA	1
 #define AO_LISP_MACRO	2
@@ -160,6 +181,11 @@ ao_lisp_poly_other(ao_poly poly) {
 	return ao_lisp_ref(poly);
 }
 
+static inline uint8_t
+ao_lisp_other_type(void *other) {
+	return *((uint8_t *) other);
+}
+
 static inline ao_poly
 ao_lisp_other_poly(const void *other)
 {
@@ -175,9 +201,9 @@ ao_lisp_mem_round(int size)
 #define AO_LISP_OTHER_POLY(other) ((ao_poly)(other) + AO_LISP_OTHER)
 
 static inline int ao_lisp_poly_type(ao_poly poly) {
-	int	type = poly & 3;
+	int	type = poly & AO_LISP_TYPE_MASK;
 	if (type == AO_LISP_OTHER)
-		return *((uint8_t *) ao_lisp_poly_other(poly));
+		return ao_lisp_other_type(ao_lisp_poly_other(poly));
 	return type;
 }
 
@@ -250,6 +276,9 @@ int
 ao_lisp_mark_memory(void *addr, int size);
 
 void *
+ao_lisp_move_map(void *addr);
+
+void *
 ao_lisp_move(const struct ao_lisp_type *type, void *addr);
 
 /* returns NULL if the object was already moved */
@@ -259,6 +288,9 @@ ao_lisp_move_memory(void *addr, int size);
 void *
 ao_lisp_alloc(int size);
 
+void
+ao_lisp_collect(void);
+
 int
 ao_lisp_root_add(const struct ao_lisp_type *type, void *addr);
 
@@ -303,6 +335,12 @@ ao_lisp_atom_print(ao_poly a);
 struct ao_lisp_atom *
 ao_lisp_atom_intern(char *name);
 
+ao_poly
+ao_lisp_atom_get(ao_poly atom);
+
+ao_poly
+ao_lisp_atom_set(ao_poly atom, ao_poly val);
+
 /* int */
 void
 ao_lisp_int_print(ao_poly i);
@@ -325,6 +363,8 @@ ao_lisp_eval(ao_poly p);
 void
 ao_lisp_builtin_print(ao_poly b);
 
+extern const struct ao_lisp_type ao_lisp_builtin_type;
+
 /* read */
 ao_poly
 ao_lisp_read(void);
@@ -333,4 +373,19 @@ ao_lisp_read(void);
 ao_poly
 ao_lisp_read_eval_print(void);
 
+/* frame */
+extern const struct ao_lisp_type ao_lisp_frame_type;
+
+int
+ao_lisp_frame_set(struct ao_lisp_frame *frame, ao_poly atom, ao_poly val);
+
+ao_poly
+ao_lisp_frame_get(struct ao_lisp_frame *frame, ao_poly atom);
+
+struct ao_lisp_frame *
+ao_lisp_frame_new(int num, int readonly);
+
+struct ao_lisp_frame *
+ao_lisp_frame_add(struct ao_lisp_frame *frame, ao_poly atom, ao_poly val);
+
 #endif /* _AO_LISP_H_ */