altos/lisp: Add 'big' ints -- 24 bits wide

With the default ints being only 14 bits, having a larger type with
more precision seems useful. This is not exposed to the application.

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

9 files changed, 157 insertions, 19 deletions

diff --git a/src/cortexelf-v1/ao_lisp_os.h b/src/cortexelf-v1/ao_lisp_os.h
index 50c9d40f..27ea7806 100644
--- a/src/cortexelf-v1/ao_lisp_os.h
+++ b/src/cortexelf-v1/ao_lisp_os.h
@@ -23,6 +23,12 @@
 #define AO_LISP_POOL_TOTAL		16384
 #define AO_LISP_SAVE			1
 
+#ifndef __BYTE_ORDER
+#define	__LITTLE_ENDIAN	1234
+#define	__BIG_ENDIAN	4321
+#define __BYTE_ORDER	__LITTLE_ENDIAN
+#endif
+
 static inline int
 ao_lisp_getc() {
 	static uint8_t	at_eol;
diff --git a/src/lisp/ao_lisp.h b/src/lisp/ao_lisp.h
index a10ccc43..08278fe7 100644
--- a/src/lisp/ao_lisp.h
+++ b/src/lisp/ao_lisp.h
@@ -21,6 +21,9 @@
 #include <stdint.h>
 #include <string.h>
 #include <ao_lisp_os.h>
+#ifndef __BYTE_ORDER
+#include <endian.h>
+#endif
 
 typedef uint16_t	ao_poly;
 typedef int16_t		ao_signed_poly;
@@ -92,7 +95,8 @@ extern uint8_t		ao_lisp_pool[AO_LISP_POOL + AO_LISP_POOL_EXTRA] __attribute__((a
 #define AO_LISP_LAMBDA		7
 #define AO_LISP_STACK		8
 #define AO_LISP_BOOL		9
-#define AO_LISP_NUM_TYPE	10
+#define AO_LISP_BIGINT		10
+#define AO_LISP_NUM_TYPE	11
 
 /* Leave two bits for types to use as they please */
 #define AO_LISP_OTHER_TYPE_MASK	0x3f
@@ -162,6 +166,35 @@ struct ao_lisp_bool {
 	uint16_t		pad;
 };
 
+struct ao_lisp_bigint {
+	uint32_t		value;
+};
+
+#if __BYTE_ORDER == __LITTLE_ENDIAN
+static inline uint32_t
+ao_lisp_int_bigint(int32_t i) {
+	return AO_LISP_BIGINT | (i << 8);
+}
+static inline int32_t
+ao_lisp_bigint_int(uint32_t bi) {
+	return (int32_t) bi >> 8;
+}
+#else
+static inline uint32_t
+ao_lisp_int_bigint(int32_t i) {
+	return (uint32_t) (i & 0xffffff) | (AO_LISP_BIGINT << 24);
+}
+static inlint int32_t
+ao_lisp_bigint_int(uint32_t bi) {
+	return (int32_t) (bi << 8) >> 8;
+}
+#endif
+
+#define AO_LISP_MIN_INT		(-(1 << (15 - AO_LISP_TYPE_SHIFT)))
+#define AO_LISP_MAX_INT		((1 << (15 - AO_LISP_TYPE_SHIFT)) - 1)
+
+#define AO_LISP_NOT_INTEGER	0x7fffffff
+
 /* Set on type when the frame escapes the lambda */
 #define AO_LISP_FRAME_MARK	0x80
 #define AO_LISP_FRAME_PRINT	0x40
@@ -338,18 +371,30 @@ ao_lisp_cons_poly(struct ao_lisp_cons *cons)
 	return ao_lisp_poly(cons, AO_LISP_CONS);
 }
 
-static inline int
+static inline int32_t
 ao_lisp_poly_int(ao_poly poly)
 {
-	return (int) ((ao_signed_poly) poly >> AO_LISP_TYPE_SHIFT);
+	return (int32_t) ((ao_signed_poly) poly >> AO_LISP_TYPE_SHIFT);
 }
 
 static inline ao_poly
-ao_lisp_int_poly(int i)
+ao_lisp_int_poly(int32_t i)
 {
 	return ((ao_poly) i << 2) | AO_LISP_INT;
 }
 
+static inline struct ao_lisp_bigint *
+ao_lisp_poly_bigint(ao_poly poly)
+{
+	return ao_lisp_ref(poly);
+}
+
+static inline ao_poly
+ao_lisp_bigint_poly(struct ao_lisp_bigint *bi)
+{
+	return ao_lisp_poly(bi, AO_LISP_OTHER);
+}
+
 static inline char *
 ao_lisp_poly_string(ao_poly poly)
 {
@@ -543,6 +588,22 @@ ao_lisp_atom_set(ao_poly atom, ao_poly val);
 void
 ao_lisp_int_write(ao_poly i);
 
+int32_t
+ao_lisp_poly_integer(ao_poly p);
+
+ao_poly
+ao_lisp_integer_poly(int32_t i);
+
+static inline int
+ao_lisp_integer_typep(uint8_t t)
+{
+	return (t == AO_LISP_INT) || (t == AO_LISP_BIGINT);
+}
+
+void
+ao_lisp_bigint_write(ao_poly i);
+
+extern const struct ao_lisp_type	ao_lisp_bigint_type;
 /* prim */
 void
 ao_lisp_poly_write(ao_poly p);
diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c
index 6dd4d5e6..ccd13d07 100644
--- a/src/lisp/ao_lisp_builtin.c
+++ b/src/lisp/ao_lisp_builtin.c
@@ -290,10 +290,10 @@ ao_lisp_math(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op)
 			if (cons->cdr == AO_LISP_NIL && ct == AO_LISP_INT) {
 				switch (op) {
 				case builtin_minus:
-					ret = ao_lisp_int_poly(-ao_lisp_poly_int(ret));
+					ret = ao_lisp_integer_poly(-ao_lisp_poly_integer(ret));
 					break;
 				case builtin_divide:
-					switch (ao_lisp_poly_int(ret)) {
+					switch (ao_lisp_poly_integer(ret)) {
 					case 0:
 						return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "divide by zero");
 					case 1:
@@ -307,9 +307,9 @@ ao_lisp_math(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op)
 					break;
 				}
 			}
-		} else if (rt == AO_LISP_INT && ct == AO_LISP_INT) {
-			int	r = ao_lisp_poly_int(ret);
-			int	c = ao_lisp_poly_int(car);
+		} else if (ao_lisp_integer_typep(rt) && ao_lisp_integer_typep(ct)) {
+			int32_t	r = ao_lisp_poly_integer(ret);
+			int32_t	c = ao_lisp_poly_integer(car);
 
 			switch(op) {
 			case builtin_plus:
@@ -349,7 +349,7 @@ ao_lisp_math(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op)
 			default:
 				break;
 			}
-			ret = ao_lisp_int_poly(r);
+			ret = ao_lisp_integer_poly(r);
 		}
 
 		else if (rt == AO_LISP_STRING && ct == AO_LISP_STRING && op == builtin_plus)
@@ -427,9 +427,9 @@ ao_lisp_compare(struct ao_lisp_cons *cons, enum ao_lisp_builtin_id op)
 		} else {
 			uint8_t	lt = ao_lisp_poly_type(left);
 			uint8_t	rt = ao_lisp_poly_type(right);
-			if (lt == AO_LISP_INT && rt == AO_LISP_INT) {
-				int l = ao_lisp_poly_int(left);
-				int r = ao_lisp_poly_int(right);
+			if (ao_lisp_integer_typep(lt) && ao_lisp_integer_typep(rt)) {
+				int32_t l = ao_lisp_poly_integer(left);
+				int32_t r = ao_lisp_poly_integer(right);
 
 				switch (op) {
 				case builtin_less:
@@ -643,7 +643,15 @@ ao_lisp_do_pairp(struct ao_lisp_cons *cons)
 ao_poly
 ao_lisp_do_numberp(struct ao_lisp_cons *cons)
 {
-	return ao_lisp_do_typep(AO_LISP_INT, cons);
+	if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1))
+		return AO_LISP_NIL;
+	switch (ao_lisp_poly_type(ao_lisp_arg(cons, 0))) {
+	case AO_LISP_INT:
+	case AO_LISP_BIGINT:
+		return _ao_lisp_bool_true;
+	default:
+		return _ao_lisp_bool_false;
+	}
 }
 
 ao_poly
@@ -755,7 +763,7 @@ ao_lisp_do_write_char(struct ao_lisp_cons *cons)
 		return AO_LISP_NIL;
 	if (!ao_lisp_check_argt(_ao_lisp_atom_led, cons, 0, AO_LISP_INT, 0))
 		return AO_LISP_NIL;
-	putchar(ao_lisp_poly_int(ao_lisp_arg(cons, 0)));
+	putchar(ao_lisp_poly_integer(ao_lisp_arg(cons, 0)));
 	return _ao_lisp_bool_true;
 }
 
diff --git a/src/lisp/ao_lisp_eval.c b/src/lisp/ao_lisp_eval.c
index 758a9232..8fa488e2 100644
--- a/src/lisp/ao_lisp_eval.c
+++ b/src/lisp/ao_lisp_eval.c
@@ -110,6 +110,7 @@ ao_lisp_eval_sexpr(void)
 		/* fall through */
 	case AO_LISP_BOOL:
 	case AO_LISP_INT:
+	case AO_LISP_BIGINT:
 	case AO_LISP_STRING:
 	case AO_LISP_BUILTIN:
 	case AO_LISP_LAMBDA:
diff --git a/src/lisp/ao_lisp_int.c b/src/lisp/ao_lisp_int.c
index 3b5341bd..8e467755 100644
--- a/src/lisp/ao_lisp_int.c
+++ b/src/lisp/ao_lisp_int.c
@@ -20,3 +20,60 @@ ao_lisp_int_write(ao_poly p)
 	int i = ao_lisp_poly_int(p);
 	printf("%d", i);
 }
+
+int32_t
+ao_lisp_poly_integer(ao_poly p)
+{
+	switch (ao_lisp_poly_base_type(p)) {
+	case AO_LISP_INT:
+		return ao_lisp_poly_int(p);
+	case AO_LISP_OTHER:
+		if (ao_lisp_other_type(ao_lisp_poly_other(p)) == AO_LISP_BIGINT)
+			return ao_lisp_bigint_int(ao_lisp_poly_bigint(p)->value);
+	}
+	return AO_LISP_NOT_INTEGER;
+}
+
+ao_poly
+ao_lisp_integer_poly(int32_t p)
+{
+	struct ao_lisp_bigint	*bi;
+
+	if (AO_LISP_MIN_INT <= p && p <= AO_LISP_MAX_INT)
+		return ao_lisp_int_poly(p);
+	bi = ao_lisp_alloc(sizeof (struct ao_lisp_bigint));
+	bi->value = ao_lisp_int_bigint(p);
+	return ao_lisp_bigint_poly(bi);
+}
+
+static void bigint_mark(void *addr)
+{
+	(void) addr;
+}
+
+static int bigint_size(void *addr)
+{
+	if (!addr)
+		return 0;
+	return sizeof (struct ao_lisp_bigint);
+}
+
+static void bigint_move(void *addr)
+{
+	(void) addr;
+}
+
+const struct ao_lisp_type ao_lisp_bigint_type = {
+	.mark = bigint_mark,
+	.size = bigint_size,
+	.move = bigint_move,
+	.name = "bigint",
+};
+
+void
+ao_lisp_bigint_write(ao_poly p)
+{
+	struct ao_lisp_bigint	*bi = ao_lisp_poly_bigint(p);
+
+	printf("%d", ao_lisp_bigint_int(bi->value));
+}
diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c
index 156221e8..f333073a 100644
--- a/src/lisp/ao_lisp_mem.c
+++ b/src/lisp/ao_lisp_mem.c
@@ -458,6 +458,7 @@ static const struct ao_lisp_type *ao_lisp_types[AO_LISP_NUM_TYPE] = {
 	[AO_LISP_LAMBDA] = &ao_lisp_lambda_type,
 	[AO_LISP_STACK] = &ao_lisp_stack_type,
 	[AO_LISP_BOOL] = &ao_lisp_bool_type,
+	[AO_LISP_BIGINT] = &ao_lisp_bigint_type,
 };
 
 static int
diff --git a/src/lisp/ao_lisp_poly.c b/src/lisp/ao_lisp_poly.c
index 7e4c98d2..94ecd042 100644
--- a/src/lisp/ao_lisp_poly.c
+++ b/src/lisp/ao_lisp_poly.c
@@ -56,6 +56,10 @@ static const struct ao_lisp_funcs ao_lisp_funcs[AO_LISP_NUM_TYPE] = {
 		.write = ao_lisp_bool_write,
 		.display = ao_lisp_bool_write,
 	},
+	[AO_LISP_BIGINT] = {
+		.write = ao_lisp_bigint_write,
+		.display = ao_lisp_bigint_write,
+	},
 };
 
 static const struct ao_lisp_funcs *
diff --git a/src/lisp/ao_lisp_read.c b/src/lisp/ao_lisp_read.c
index 8c06e198..5115f46e 100644
--- a/src/lisp/ao_lisp_read.c
+++ b/src/lisp/ao_lisp_read.c
@@ -245,7 +245,7 @@ lex_quoted(void)
 #define AO_LISP_TOKEN_MAX	32
 
 static char	token_string[AO_LISP_TOKEN_MAX];
-static int	token_int;
+static int32_t	token_int;
 static int	token_len;
 
 static inline void add_token(int c) {
@@ -497,7 +497,7 @@ ao_lisp_read(void)
 				v = AO_LISP_NIL;
 			break;
 		case NUM:
-			v = ao_lisp_int_poly(token_int);
+			v = ao_lisp_integer_poly(token_int);
 			break;
 		case BOOL:
 			if (token_string[0] == 't')
diff --git a/src/lisp/ao_lisp_string.c b/src/lisp/ao_lisp_string.c
index 87f9289c..fff218df 100644
--- a/src/lisp/ao_lisp_string.c
+++ b/src/lisp/ao_lisp_string.c
@@ -83,9 +83,9 @@ ao_lisp_string_pack(struct ao_lisp_cons *cons)
 	char	*s = r;
 
 	while (cons) {
-		if (ao_lisp_poly_type(cons->car) != AO_LISP_INT)
+		if (!ao_lisp_integer_typep(ao_lisp_poly_type(cons->car)))
 			return ao_lisp_error(AO_LISP_INVALID, "non-int passed to pack");
-		*s++ = ao_lisp_poly_int(cons->car);
+		*s++ = ao_lisp_poly_integer(cons->car);
 		cons = ao_lisp_poly_cons(cons->cdr);
 	}
 	*s++ = 0;