altos/lisp: Split out read debug, add memory validation

[fw/altos] / src / lisp / ao_lisp_builtin.c

diff --git a/src/lisp/ao_lisp_builtin.c b/src/lisp/ao_lisp_builtin.c
index d4dc8a8663f71876ce5cc0a6e7aca6bb22701ab1..fdca020849177c9d2684bc22cfd91ef2c7c20b0a 100644 (file)
--- a/src/lisp/ao_lisp_builtin.c
+++ b/src/lisp/ao_lisp_builtin.c
@@ -125,7 +125,7 @@ ao_lisp_check_argt(ao_poly name, struct ao_lisp_cons *cons, int argc, int type,
        ao_poly car = ao_lisp_arg(cons, argc);
 
        if ((!car && !nil_ok) || ao_lisp_poly_type(car) != type)
-               return ao_lisp_error(AO_LISP_INVALID, "%s: invalid type for arg %d", ao_lisp_poly_atom(name)->name, argc);
+               return ao_lisp_error(AO_LISP_INVALID, "%s: arg %d invalid type %v", ao_lisp_poly_atom(name)->name, argc, car);
        return _ao_lisp_bool_true;
 }
 
@@ -207,6 +207,17 @@ ao_lisp_do_set(struct ao_lisp_cons *cons)
        return ao_lisp_atom_set(ao_lisp_arg(cons, 0), ao_lisp_arg(cons, 1));
 }
 
+ao_poly
+ao_lisp_do_def(struct ao_lisp_cons *cons)
+{
+       if (!ao_lisp_check_argc(_ao_lisp_atom_def, cons, 2, 2))
+               return AO_LISP_NIL;
+       if (!ao_lisp_check_argt(_ao_lisp_atom_def, cons, 0, AO_LISP_ATOM, 0))
+               return AO_LISP_NIL;
+
+       return ao_lisp_atom_def(ao_lisp_arg(cons, 0), ao_lisp_arg(cons, 1));
+}
+
 ao_poly
 ao_lisp_do_setq(struct ao_lisp_cons *cons)
 {
@@ -215,9 +226,9 @@ ao_lisp_do_setq(struct ao_lisp_cons *cons)
                return AO_LISP_NIL;
        name = cons->car;
        if (ao_lisp_poly_type(name) != AO_LISP_ATOM)
-               return ao_lisp_error(AO_LISP_INVALID, "set! of non-atom");
-       if (!ao_lisp_atom_ref(ao_lisp_frame_current, name))
-               return ao_lisp_error(AO_LISP_INVALID, "atom not defined");
+               return ao_lisp_error(AO_LISP_INVALID, "set! of non-atom %v", name);
+       if (!ao_lisp_atom_ref(name))
+               return ao_lisp_error(AO_LISP_INVALID, "atom %v not defined", name);
        return ao_lisp__cons(_ao_lisp_atom_set,
                             ao_lisp__cons(ao_lisp__cons(_ao_lisp_atom_quote,
                                                         ao_lisp__cons(name, AO_LISP_NIL)),
@@ -232,9 +243,9 @@ ao_lisp_do_cond(struct ao_lisp_cons *cons)
 }
 
 ao_poly
-ao_lisp_do_progn(struct ao_lisp_cons *cons)
+ao_lisp_do_begin(struct ao_lisp_cons *cons)
 {
-       ao_lisp_stack->state = eval_progn;
+       ao_lisp_stack->state = eval_begin;
        ao_lisp_stack->sexprs = ao_lisp_cons_poly(cons);
        return AO_LISP_NIL;
 }
@@ -310,24 +321,30 @@ ao_lisp_math(struct ao_lisp_cons *orig_cons, enum ao_lisp_builtin_id op)
                } 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);
+                       int64_t t;
 
                        switch(op) {
                        case builtin_plus:
                                r += c;
+                       check_overflow:
+                               if (r < AO_LISP_MIN_BIGINT || AO_LISP_MAX_BIGINT < r)
+                                       goto inexact;
                                break;
                        case builtin_minus:
                                r -= c;
+                               goto check_overflow;
                                break;
                        case builtin_times:
-                               r *= c;
+                               t = (int64_t) r * (int64_t) c;
+                               if (t < AO_LISP_MIN_BIGINT || AO_LISP_MAX_BIGINT < t)
+                                       goto inexact;
+                               r = (int32_t) t;
                                break;
                        case builtin_divide:
                                if (c != 0 && (r % c) == 0)
                                        r /= c;
-                               else {
-                                       ret = ao_lisp_float_get((float) r / (float) c);
-                                       continue;
-                               }
+                               else
+                                       goto inexact;
                                break;
                        case builtin_quotient:
                                if (c == 0)
@@ -354,8 +371,10 @@ ao_lisp_math(struct ao_lisp_cons *orig_cons, enum ao_lisp_builtin_id op)
                        }
                        ret = ao_lisp_integer_poly(r);
                } else if (ao_lisp_number_typep(rt) && ao_lisp_number_typep(ct)) {
-                       float r = ao_lisp_poly_number(ret);
-                       float c = ao_lisp_poly_number(car);
+                       float r, c;
+               inexact:
+                       r = ao_lisp_poly_number(ret);
+                       c = ao_lisp_poly_number(car);
                        switch(op) {
                        case builtin_plus:
                                r += c;
@@ -369,28 +388,10 @@ ao_lisp_math(struct ao_lisp_cons *orig_cons, enum ao_lisp_builtin_id op)
                        case builtin_divide:
                                r /= c;
                                break;
-#if 0
                        case builtin_quotient:
-                               if (c == 0)
-                                       return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "quotient by zero");
-                               if (r % c != 0 && (c < 0) != (r < 0))
-                                       r = r / c - 1;
-                               else
-                                       r = r / c;
-                               break;
                        case builtin_remainder:
-                               if (c == 0)
-                                       return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "remainder by zero");
-                               r %= c;
-                               break;
                        case builtin_modulo:
-                               if (c == 0)
-                                       return ao_lisp_error(AO_LISP_DIVIDE_BY_ZERO, "modulo by zero");
-                               r %= c;
-                               if ((r < 0) != (c < 0))
-                                       r += c;
-                               break;
-#endif
+                               return ao_lisp_error(AO_LISP_INVALID, "non-integer value in integer divide");
                        default:
                                break;
                        }
@@ -675,7 +676,13 @@ ao_lisp_do_typep(int type, struct ao_lisp_cons *cons)
 ao_poly
 ao_lisp_do_pairp(struct ao_lisp_cons *cons)
 {
-       return ao_lisp_do_typep(AO_LISP_CONS, cons);
+       ao_poly v;
+       if (!ao_lisp_check_argc(_ao_lisp_atom_led, cons, 1, 1))
+               return AO_LISP_NIL;
+       v = ao_lisp_arg(cons, 0);
+       if (v != AO_LISP_NIL && ao_lisp_poly_type(v) == AO_LISP_CONS)
+               return _ao_lisp_bool_true;
+       return _ao_lisp_bool_false;
 }
 
 ao_poly