altos/scheme: Stash cons across value allocation in compare

Large ints, strings and floats can cause allocation, requiring that
the 'cons' pointer be stashed and retrieved in case it moved.

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

diff --git a/src/scheme/ao_scheme_builtin.c b/src/scheme/ao_scheme_builtin.c
index 6f9e1390c9eb6e090bb74d40872aba5439f91709..7a5907357b0938647d4f3abd2aeb55c7308adb93 100644 (file)
--- a/src/scheme/ao_scheme_builtin.c
+++ b/src/scheme/ao_scheme_builtin.c
@@ -319,6 +319,7 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op)
 
                if (cons == orig_cons) {
                        ret = car;
+                       ao_scheme_cons_stash(0, cons);
                        if (cons->cdr == AO_SCHEME_NIL) {
                                switch (op) {
                                case builtin_minus:
@@ -339,6 +340,7 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op)
                                        break;
                                }
                        }
+                       cons = ao_scheme_cons_fetch(0);
                } else if (ao_scheme_integer_typep(rt) && ao_scheme_integer_typep(ct)) {
                        int32_t r = ao_scheme_poly_integer(ret);
                        int32_t c = ao_scheme_poly_integer(car);
@@ -390,7 +392,9 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op)
                        default:
                                break;
                        }
+                       ao_scheme_cons_stash(0, cons);
                        ret = ao_scheme_integer_poly(r);
+                       cons = ao_scheme_cons_fetch(0);
                } else if (ao_scheme_number_typep(rt) && ao_scheme_number_typep(ct)) {
                        float r, c;
                inexact:
@@ -416,12 +420,18 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op)
                        default:
                                break;
                        }
+                       ao_scheme_cons_stash(0, cons);
                        ret = ao_scheme_float_get(r);
+                       cons = ao_scheme_cons_fetch(0);
                }
-
-               else if (rt == AO_SCHEME_STRING && ct == AO_SCHEME_STRING && op == builtin_plus)
+               else if (rt == AO_SCHEME_STRING && ct == AO_SCHEME_STRING && op == builtin_plus) {
+                       ao_scheme_cons_stash(0, cons);
                        ret = ao_scheme_string_poly(ao_scheme_string_cat(ao_scheme_poly_string(ret),
-                                                                    ao_scheme_poly_string(car)));
+                                                                        ao_scheme_poly_string(car)));
+                       cons = ao_scheme_cons_fetch(0);
+                       if (!ret)
+                               return ret;
+               }
                else
                        return ao_scheme_error(AO_SCHEME_INVALID, "invalid args");
        }