#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;
#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;
#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
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
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)
{
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);
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:
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:
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)
} 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:
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
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;
}
/* 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:
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));
+}
[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
.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 *
#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) {
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')
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;