From 6d82221978884447cf3d7aeaff673b2a25a26df0 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 20 Sep 2026 17:36:10 +0700 Subject: [PATCH] A dyn trap that says where: the nine trapping operators take a site MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The dyn arithmetic and ordering entry points printed their sentence with no file, no line and no column, which in a dynamic-first language is the type error arriving from nowhere. flan_rt.c's bounds and arithmetic traps have taken an emitter-threaded (loc, loclen) pair since they were written, and [flan_dyn_cast_kind] is the fresh precedent on the dyn side; this is the same pair, threaded through [arith], [want_nums] and [order] to the five arithmetic and four ordering entry points. [eq] never traps and takes none. The three trap printers take the pair and print nothing for a NULL loc, so every other call site in the file — and test/dyn_ops.c, which calls the runtime directly and has no source position — keeps its sentence byte for byte. [trap_oom] is left alone: it is reached from [gc_alloc], which has no site to be given and would have had to grow one on every allocation path in the file for no reader's benefit. --- lib/check.ml | 14 +++- lib/emit.ml | 22 ++++--- runtime/flan_dyn.c | 140 +++++++++++++++++++++++++++------------- runtime/flan_dyn.h | 28 +++++--- runtime/flan_dyn_stub.c | 54 +++++++++++++--- test/dyn_ops.c | 78 +++++++++++++--------- test/test_flan.ml | 6 ++ 7 files changed, 234 insertions(+), 108 deletions(-) diff --git a/lib/check.ml b/lib/check.ml index 179bb35..6c2cea3 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -4358,7 +4358,11 @@ and dyn_fold ctx ~want loc name first rest = no_dyn_yet loc ~into:false Types.Dyn (Printf.sprintf " — %s has no dyn form" name) in - let apply acc b = rt loc Types.Dyn sym [ acc; box loc b ] in + (* The site travels with the operands. A dyn arithmetic trap is this + language's type error, and until now it printed with no file, no line and + no column — [here loc] is the same string literal [cast_dyn] hands the + runtime, and the runtime prints it as a GNU prefix. *) + let apply acc b = rt loc Types.Dyn sym [ acc; box loc b; here loc ] in let acc = match first with | [ a; b ] -> apply (box loc a) b @@ -4688,7 +4692,13 @@ and named_call ctx ~want loc name args = | "<" -> "flan_dyn_lt" | "<=" -> "flan_dyn_le" | ">" -> "flan_dyn_gt" | _ -> "flan_dyn_ge" in - let cmp = unbox loc Types.Bool (rt loc Types.Dyn sym [ box loc a; box loc b ]) in + (* [eq] never traps and takes no site; the four orderings do, and get + one, for the reason [dyn_fold] gives. *) + let site = if String.equal sym "flan_dyn_eq" then [] else [ here loc ] in + let cmp = + unbox loc Types.Bool + (rt loc Types.Dyn sym ([ box loc a; box loc b ] @ site)) + in (* [!=] has no entry point of its own: there is one structural equality and the negation is an [i1] flip the backend folds away. *) let r = diff --git a/lib/emit.ml b/lib/emit.ml index ca4d8a5..4cdc1fd 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -3625,15 +3625,19 @@ declare i64 @flan_dyn_kw(ptr, i64) declare i64 @flan_dyn_map_get(i64, i64) declare void @flan_dyn_map_set(i64, i64, i64) declare i64 @flan_dyn_map_contains(i64, i64) -declare i64 @flan_dyn_add(i64, i64) -declare i64 @flan_dyn_sub(i64, i64) -declare i64 @flan_dyn_mul(i64, i64) -declare i64 @flan_dyn_div(i64, i64) -declare i64 @flan_dyn_rem(i64, i64) -declare i64 @flan_dyn_lt(i64, i64) -declare i64 @flan_dyn_le(i64, i64) -declare i64 @flan_dyn_gt(i64, i64) -declare i64 @flan_dyn_ge(i64, i64) +; The nine that trap carry the site as ptr+len, the way the bounds and +; arithmetic traps in flan_rt.c do: a dyn type error IS the type error in a +; dynamic program, and it used to print with no file and no line. [eq] never +; traps, so it has nowhere to put one. +declare i64 @flan_dyn_add(i64, i64, ptr, i64) +declare i64 @flan_dyn_sub(i64, i64, ptr, i64) +declare i64 @flan_dyn_mul(i64, i64, ptr, i64) +declare i64 @flan_dyn_div(i64, i64, ptr, i64) +declare i64 @flan_dyn_rem(i64, i64, ptr, i64) +declare i64 @flan_dyn_lt(i64, i64, ptr, i64) +declare i64 @flan_dyn_le(i64, i64, ptr, i64) +declare i64 @flan_dyn_gt(i64, i64, ptr, i64) +declare i64 @flan_dyn_ge(i64, i64, ptr, i64) declare i64 @flan_dyn_eq(i64, i64) declare i64 @flan_dyn_len(i64) declare i64 @flan_dyn_at(i64, i64) diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 8169146..9268c5b 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -759,22 +759,42 @@ static void say(char *buf, int64_t cap, flan_dyn v) { * which without reading the sentence twice — and because the break loop lists * them by name. */ -static _Noreturn void trap2(const char *name, int64_t namelen, const char *op, +/* Where the operation was written, printed as flan_rt.c's traps print it: the + * GNU "file:line:col: " prefix, so `next-error` walks to the dyn failure the + * same way it walks to a bounds failure. The pair is what an emitted string + * literal already is — a pointer and a length, not a C string — and the + * emitter hands it over exactly as [flan_dyn_cast_kind]'s site does. + * + * A NULL [loc] prints nothing at all and the sentence after it is byte for + * byte the one this file printed before: the entry points that have not been + * given a site yet (every one but the five arithmetic and four ordering ones) + * pass NULL, and so does test/dyn_ops.c, which calls the runtime directly and + * has no source position to offer. */ +static void trap_where(const uint8_t *loc, int64_t loclen) { + if (loc != NULL && loclen > 0) + fprintf(stderr, "%.*s: ", (int)loclen, (const char *)loc); +} + +static _Noreturn void trap2(const uint8_t *loc, int64_t loclen, + const char *name, int64_t namelen, const char *op, const char *why, flan_dyn a, flan_dyn b) { char sa[SAY_MAX], sb[SAY_MAX]; say(sa, SAY_MAX, a); say(sb, SAY_MAX, b); fflush(stdout); + trap_where(loc, loclen); fprintf(stderr, "dyn %s: %s and %s, and %s — (%s %s %s)\n", op, tag_of(a), tag_of(b), why, op, sa, sb); flan_trap((const uint8_t *)name, namelen); } -static _Noreturn void trap1(const char *name, int64_t namelen, const char *op, +static _Noreturn void trap1(const uint8_t *loc, int64_t loclen, + const char *name, int64_t namelen, const char *op, const char *why, flan_dyn a) { char sa[SAY_MAX]; say(sa, SAY_MAX, a); fflush(stdout); + trap_where(loc, loclen); fprintf(stderr, "dyn %s: %s, and %s — (%s %s)\n", op, tag_of(a), why, op, sa); flan_trap((const uint8_t *)name, namelen); } @@ -782,11 +802,17 @@ static _Noreturn void trap1(const char *name, int64_t namelen, const char *op, #define TYPE_TRAP "DynType", 7 #define ARITH_TRAP "DynArith", 8 -static _Noreturn void trap_range(const char *op, flan_dyn v, int64_t i, +/* No site reaches these two yet: [at], [set-at], [push] and the allocator + * paths are not among the nine entry points this pass gave a location to. The + * parameter is here so that giving them one later is a call-site change and + * not another round of signature churn. */ +static _Noreturn void trap_range(const uint8_t *loc, int64_t loclen, + const char *op, flan_dyn v, int64_t i, int64_t len) { char sv[SAY_MAX]; say(sv, SAY_MAX, v); fflush(stdout); + trap_where(loc, loclen); fprintf(stderr, "dyn %s: index %lld is out of bounds for %s of length %lld — %s\n", op, (long long)i, tag_of(v), (long long)len, sv); @@ -1080,7 +1106,7 @@ flan_dyn flan_dyn_map_new(void) { flan_dyn flan_dyn_map_new_class(flan_dyn k) { flan_obj *o; if (flan_dyn_tag(k) != FLAN_DYN_TAG_KEYWORD) - trap1(TYPE_TRAP, "class instance", "a class tag is a keyword", k); + trap1(NULL, 0, TYPE_TRAP, "class instance", "a class tag is a keyword", k); o = gc_alloc(OBJ_MAP, 0); o->len = 0; o->u.v.items = NULL; @@ -1177,7 +1203,7 @@ static inline int is_vec(flan_dyn v) { int64_t flan_dyn_need_i64(flan_dyn v) { if (flan_dyn_tag(v) != FLAN_DYN_TAG_INT) - trap1(TYPE_TRAP, "i64", "an int was wanted", v); + trap1(NULL, 0, TYPE_TRAP, "i64", "an int was wanted", v); return dyn_int_value(v); } @@ -1204,13 +1230,13 @@ int64_t flan_dyn_need_i64(flan_dyn v) { * not tell (g 1) from (g (len xs)). */ double flan_dyn_need_f64(flan_dyn v) { if (flan_dyn_tag(v) != FLAN_DYN_TAG_FLOAT) - trap1(TYPE_TRAP, "f64", "a float was wanted", v); + trap1(NULL, 0, TYPE_TRAP, "f64", "a float was wanted", v); return dyn_num_value(v); } uint8_t flan_dyn_need_bool(flan_dyn v) { if (flan_dyn_tag(v) != FLAN_DYN_TAG_BOOL) - trap1(TYPE_TRAP, "bool", "a bool was wanted", v); + trap1(NULL, 0, TYPE_TRAP, "bool", "a bool was wanted", v); return (uint8_t)(dyn_payload(v) ? 1 : 0); } @@ -1304,7 +1330,7 @@ int32_t flan_dyn_cast_kind(flan_dyn v, const uint8_t *loc, int64_t loc_len, : sizeof name - 1; memcpy(name, target, n); name[n] = '\0'; - trap1(TYPE_TRAP, name, "a number was wanted", v); + trap1(NULL, 0, TYPE_TRAP, name, "a number was wanted", v); } int32_t is_float = tag == FLAN_DYN_TAG_FLOAT ? 1 : 0; if (is_float != (want_float ? 1 : 0) && site_first_time(loc, loc_len)) { @@ -1331,7 +1357,7 @@ int32_t flan_dyn_is_nil(flan_dyn v) { * operation that refused. */ flan_dyn flan_dyn_need_not_nil(flan_dyn v) { if (flan_dyn_tag(v) == FLAN_DYN_TAG_NIL) - trap1(TYPE_TRAP, "some", + trap1(NULL, 0, TYPE_TRAP, "some", "Some cannot hold nil -- nil and None would become the same case " "of an (Option dyn)", v); return v; @@ -1367,15 +1393,17 @@ uint8_t flan_dyn_truthy(flan_dyn v) { * its own sentence for the reason flan_rt.c's gives it one: somebody meeting * it has probably never had to think about it. */ -static void want_nums(const char *op, const char *why, flan_dyn a, flan_dyn b) { - if (!is_num(a) || !is_num(b)) trap2(TYPE_TRAP, op, why, a, b); +static void want_nums(const uint8_t *loc, int64_t loclen, const char *op, + const char *why, flan_dyn a, flan_dyn b) { + if (!is_num(a) || !is_num(b)) trap2(loc, loclen, TYPE_TRAP, op, why, a, b); } #define ARITH_NUM "it takes two numbers" -static flan_dyn arith(const char *op, flan_dyn a, flan_dyn b) { +static flan_dyn arith(const uint8_t *loc, int64_t loclen, const char *op, + flan_dyn a, flan_dyn b) { int64_t x, y; - want_nums(op, ARITH_NUM, a, b); + want_nums(loc, loclen, op, ARITH_NUM, a, b); if (flan_dyn_tag(a) == FLAN_DYN_TAG_INT && flan_dyn_tag(b) == FLAN_DYN_TAG_INT) { x = dyn_int_value(a); @@ -1385,14 +1413,14 @@ static flan_dyn arith(const char *op, flan_dyn a, flan_dyn b) { case '-': return flan_dyn_from_i64((int64_t)((uint64_t)x - (uint64_t)y)); case '*': return flan_dyn_from_i64((int64_t)((uint64_t)x * (uint64_t)y)); case '/': - if (y == 0) trap2(ARITH_TRAP, op, "it does not divide by zero", a, b); + if (y == 0) trap2(loc, loclen, ARITH_TRAP, op, "it does not divide by zero", a, b); if (x == INT64_MIN && y == -1) - trap2(ARITH_TRAP, op, + trap2(loc, loclen, ARITH_TRAP, op, "the quotient is one past the largest i64, which is true of " "this pair of operands and no other", a, b); return flan_dyn_from_i64(x / y); default: - if (y == 0) trap2(ARITH_TRAP, op, "it does not divide by zero", a, b); + if (y == 0) trap2(loc, loclen, ARITH_TRAP, op, "it does not divide by zero", a, b); if (x == INT64_MIN && y == -1) return flan_dyn_from_i64(0); return flan_dyn_from_i64(x % y); } @@ -1425,11 +1453,26 @@ static flan_dyn arith(const char *op, flan_dyn a, flan_dyn b) { } } -flan_dyn flan_dyn_add(flan_dyn a, flan_dyn b) { return arith("+", a, b); } -flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b) { return arith("-", a, b); } -flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b) { return arith("*", a, b); } -flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b) { return arith("/", a, b); } -flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b) { return arith("%", a, b); } +flan_dyn flan_dyn_add(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + return arith(loc, loclen, "+", a, b); +} +flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + return arith(loc, loclen, "-", a, b); +} +flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + return arith(loc, loclen, "*", a, b); +} +flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + return arith(loc, loclen, "/", a, b); +} +flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + return arith(loc, loclen, "%", a, b); +} /* ── Ordering ────────────────────────────────────────────────────────── * @@ -1444,7 +1487,8 @@ flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b) { return arith("%", a, b); } * numbering, and a program that sorted a mixed vec would get a stable answer * that means nothing. */ -static int order(const char *op, flan_dyn a, flan_dyn b) { +static int order(const uint8_t *loc, int64_t loclen, const char *op, + flan_dyn a, flan_dyn b) { if (is_num(a) && is_num(b)) { if (flan_dyn_tag(a) == FLAN_DYN_TAG_INT && flan_dyn_tag(b) == FLAN_DYN_TAG_INT) { @@ -1468,22 +1512,26 @@ static int order(const char *op, flan_dyn a, flan_dyn b) { if (c != 0) return c < 0 ? -1 : 1; return x->len < y->len ? -1 : (x->len > y->len ? 1 : 0); } - trap2(TYPE_TRAP, op, + trap2(loc, loclen, TYPE_TRAP, op, "it compares two numbers or two texts, and these are neither", a, b); } -flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b) { - return flan_dyn_from_bool(order("<", a, b) == -1); +flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + return flan_dyn_from_bool(order(loc, loclen, "<", a, b) == -1); } -flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b) { - int c = order("<=", a, b); +flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + int c = order(loc, loclen, "<=", a, b); return flan_dyn_from_bool(c == -1 || c == 0); } -flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b) { - return flan_dyn_from_bool(order(">", a, b) == 1); +flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + return flan_dyn_from_bool(order(loc, loclen, ">", a, b) == 1); } -flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b) { - int c = order(">=", a, b); +flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + int c = order(loc, loclen, ">=", a, b); return flan_dyn_from_bool(c == 1 || c == 0); } @@ -1699,7 +1747,7 @@ static void view_unbox(const char *op, flan_dyn v, int32_t elem, flan_dyn x, case FLAN_VIEW_I64: { int64_t n; if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT) - trap2(TYPE_TRAP, op, "this view's elements are int", v, x); + trap2(NULL, 0, TYPE_TRAP, op, "this view's elements are int", v, x); n = dyn_int_value(x); memcpy(p, &n, 8); return; @@ -1707,7 +1755,7 @@ static void view_unbox(const char *op, flan_dyn v, int32_t elem, flan_dyn x, case FLAN_VIEW_F64: { double d; if (flan_dyn_tag(x) != FLAN_DYN_TAG_FLOAT) - trap2(TYPE_TRAP, op, "this view's elements are float", v, x); + trap2(NULL, 0, TYPE_TRAP, op, "this view's elements are float", v, x); d = dyn_num_value(x); memcpy(p, &d, 8); return; @@ -1715,7 +1763,7 @@ static void view_unbox(const char *op, flan_dyn v, int32_t elem, flan_dyn x, default: { uint8_t b; if (flan_dyn_tag(x) != FLAN_DYN_TAG_BOOL) - trap2(TYPE_TRAP, op, "this view's elements are bool", v, x); + trap2(NULL, 0, TYPE_TRAP, op, "this view's elements are bool", v, x); b = dyn_payload(x) ? 1 : 0; *p = b; return; @@ -1748,7 +1796,7 @@ flan_dyn flan_dyn_len(flan_dyn v) { if (o->kind == OBJ_VIEW) return flan_dyn_from_i64(view_len("len", o)); return flan_dyn_from_i64(o->len); } - trap1(TYPE_TRAP, "len", "only a text, a vec or a map has one", v); + trap1(NULL, 0, TYPE_TRAP, "len", "only a text, a vec or a map has one", v); } /* The index has to be an int, and that is a separate sentence from the @@ -1756,7 +1804,7 @@ flan_dyn flan_dyn_len(flan_dyn v) { * and telling somebody "these are the wrong types" names neither. */ static int64_t need_index(const char *op, flan_dyn v, flan_dyn i) { if (flan_dyn_tag(i) != FLAN_DYN_TAG_INT) - trap2(TYPE_TRAP, op, "an index must be an int", v, i); + trap2(NULL, 0, TYPE_TRAP, op, "an index must be an int", v, i); return dyn_int_value(i); } @@ -1767,16 +1815,16 @@ flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i) { int64_t k; flan_obj *o; if (!is_text(v) && !is_vec(v)) - trap2(TYPE_TRAP, "at", "only a text or a vec is indexed", v, i); + trap2(NULL, 0, TYPE_TRAP, "at", "only a text or a vec is indexed", v, i); k = need_index("at", v, i); o = dyn_obj(v); if (o->kind == OBJ_VIEW) { int64_t len = view_len("at", o); - if (k < 0 || k >= len) trap_range("at", v, k, len); + if (k < 0 || k >= len) trap_range(NULL, 0, "at", v, k, len); return view_box(o->u.view.elem, (const uint8_t *)view_base(o) + k * view_elem_size(o->u.view.elem)); } - if (k < 0 || k >= o->len) trap_range("at", v, k, o->len); + if (k < 0 || k >= o->len) trap_range(NULL, 0, "at", v, k, o->len); if (o->kind == OBJ_TEXT) return flan_dyn_from_i64(obj_text_bytes(o)[k]); return o->u.v.items[k]; } @@ -1785,20 +1833,20 @@ void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x) { int64_t k; flan_obj *o; if (is_text(v)) - trap2(TYPE_TRAP, "set-at", "a text is immutable — build another one", v, i); + trap2(NULL, 0, TYPE_TRAP, "set-at", "a text is immutable — build another one", v, i); if (!is_vec(v)) - trap2(TYPE_TRAP, "set-at", "only a vec is assigned into", v, i); + trap2(NULL, 0, TYPE_TRAP, "set-at", "only a vec is assigned into", v, i); k = need_index("set-at", v, i); o = dyn_obj(v); if (o->kind == OBJ_VIEW) { int64_t len = view_len("set-at", o); uint8_t *p; - if (k < 0 || k >= len) trap_range("set-at", v, k, len); + if (k < 0 || k >= len) trap_range(NULL, 0, "set-at", v, k, len); p = (uint8_t *)view_base(o) + k * view_elem_size(o->u.view.elem); view_unbox("set-at", v, o->u.view.elem, x, p); return; } - if (k < 0 || k >= o->len) trap_range("set-at", v, k, o->len); + if (k < 0 || k >= o->len) trap_range(NULL, 0, "set-at", v, k, o->len); o->u.v.items[k] = x; } @@ -1807,7 +1855,7 @@ void flan_dyn_push(flan_dyn v, flan_dyn x) { if (!is_vec(v)) { /* The value is in the sentence rather than the vec, because the vec is the * thing that is wrong and the value is what says which push it was. */ - trap2(TYPE_TRAP, "push", "only a vec is pushed to", v, x); + trap2(NULL, 0, TYPE_TRAP, "push", "only a vec is pushed to", v, x); } o = dyn_obj(v); if (o->kind == OBJ_VIEW) { @@ -1815,7 +1863,7 @@ void flan_dyn_push(flan_dyn v, flan_dyn x) { static const uint8_t push_loc[] = "(dyn push)"; int64_t size; if (!o->u.view.is_vec) - trap2(TYPE_TRAP, "push", + trap2(NULL, 0, TYPE_TRAP, "push", "this view is a slice or an array and cannot grow", v, x); size = view_elem_size(o->u.view.elem); view_unbox("push", v, o->u.view.elem, x, buf); @@ -1869,7 +1917,7 @@ static int64_t map_find(flan_obj *o, flan_dyn k) { } static flan_obj *want_map(const char *op, flan_dyn m, flan_dyn k) { - if (!is_map(m)) trap2(TYPE_TRAP, op, "only a map answers it", m, k); + if (!is_map(m)) trap2(NULL, 0, TYPE_TRAP, op, "only a map answers it", m, k); return dyn_obj(m); } diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index 928e1e9..49643de 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -108,20 +108,28 @@ flan_dyn flan_dyn_kw(const uint8_t *p, int64_t n); * sentence naming the operation, the tags it was given and the values, and * then takes flan_rt.c's [flan_trap] — which parks the program for inspection * in a dev session and ends it in a standalone build. The three that cannot - * trap say so on their own line. */ + * trap say so on their own line. + * + * The nine below take the site as well: [loc]/[loclen] are the bytes of a + * "file:line:col" string the emitter already has, and the trap prints them as + * a GNU prefix so the failure is somewhere rather than nowhere. It is the same + * pair flan_rt.c's bounds and arithmetic traps take, and the same pair + * [flan_dyn_cast_kind] takes below. A caller with no site — the C tests, and + * anything outside a compiled Flan program — passes (NULL, 0) and gets the + * sentence with no prefix. */ -flan_dyn flan_dyn_add(flan_dyn a, flan_dyn b); -flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b); -flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b); -flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b); -flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b); +flan_dyn flan_dyn_add(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); +flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); +flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); +flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); +flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); /* Answer a bool dyn. Numbers compare as numbers and text compares bytewise; * a mixture of the two, or anything else, traps. */ -flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b); -flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b); -flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b); -flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b); +flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); +flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); +flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); +flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen); /* Structural, and the one operation in this file that never traps: two values * of unrelated tags are not an error, they are unequal. */ diff --git a/runtime/flan_dyn_stub.c b/runtime/flan_dyn_stub.c index ce64ee7..617c601 100644 --- a/runtime/flan_dyn_stub.c +++ b/runtime/flan_dyn_stub.c @@ -148,11 +148,31 @@ static flan_dyn arith(flan_dyn a, flan_dyn b, char op) { } } -flan_dyn flan_dyn_add(flan_dyn a, flan_dyn b) { return arith(a, b, '+'); } -flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b) { return arith(a, b, '-'); } -flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b) { return arith(a, b, '*'); } -flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b) { return arith(a, b, '/'); } -flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b) { return arith(a, b, '%'); } +flan_dyn flan_dyn_add(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + (void)loc; (void)loclen; + return arith(a, b, '+'); +} +flan_dyn flan_dyn_sub(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + (void)loc; (void)loclen; + return arith(a, b, '-'); +} +flan_dyn flan_dyn_mul(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + (void)loc; (void)loclen; + return arith(a, b, '*'); +} +flan_dyn flan_dyn_div(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + (void)loc; (void)loclen; + return arith(a, b, '/'); +} +flan_dyn flan_dyn_rem(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + (void)loc; (void)loclen; + return arith(a, b, '%'); +} /* ── Ordering and equality ─────────────────────────────────────────── */ @@ -173,10 +193,26 @@ static int cmp(flan_dyn a, flan_dyn b) { } } -flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b) { return flan_dyn_from_bool(cmp(a, b) < 0); } -flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b) { return flan_dyn_from_bool(cmp(a, b) <= 0); } -flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b) { return flan_dyn_from_bool(cmp(a, b) > 0); } -flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b) { return flan_dyn_from_bool(cmp(a, b) >= 0); } +flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + (void)loc; (void)loclen; + return flan_dyn_from_bool(cmp(a, b) < 0); +} +flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + (void)loc; (void)loclen; + return flan_dyn_from_bool(cmp(a, b) <= 0); +} +flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + (void)loc; (void)loclen; + return flan_dyn_from_bool(cmp(a, b) > 0); +} +flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b, const uint8_t *loc, + int64_t loclen) { + (void)loc; (void)loclen; + return flan_dyn_from_bool(cmp(a, b) >= 0); +} /* Structural, and never traps — the header's one exception. */ static int eq(cell *x, cell *y) { diff --git a/test/dyn_ops.c b/test/dyn_ops.c index 09e715d..50ac322 100644 --- a/test/dyn_ops.c +++ b/test/dyn_ops.c @@ -40,6 +40,20 @@ * rather than a hand-copied list. */ #include "flan_dyn.h" +/* The nine trapping operators took a site — (loc, len) — when flan_dyn.c's + * traps learned to print a file and a line. This file calls the runtime + * directly and has no source position to offer, so it passes (NULL, 0), which + * prints the sentence exactly as it printed before. */ +#define FDYN_add(a, b) flan_dyn_add((a), (b), NULL, 0) +#define FDYN_sub(a, b) flan_dyn_sub((a), (b), NULL, 0) +#define FDYN_mul(a, b) flan_dyn_mul((a), (b), NULL, 0) +#define FDYN_div(a, b) flan_dyn_div((a), (b), NULL, 0) +#define FDYN_rem(a, b) flan_dyn_rem((a), (b), NULL, 0) +#define FDYN_lt(a, b) flan_dyn_lt((a), (b), NULL, 0) +#define FDYN_le(a, b) flan_dyn_le((a), (b), NULL, 0) +#define FDYN_gt(a, b) flan_dyn_gt((a), (b), NULL, 0) +#define FDYN_ge(a, b) flan_dyn_ge((a), (b), NULL, 0) + void flan_rt_init(int32_t argc, char **argv); void flan_vec_free(void *v, int64_t size, int64_t align, const uint8_t *loc, int64_t loclen); @@ -161,41 +175,41 @@ static void ops(void) { "a boxed int is still an int"); /* Arithmetic. Two ints answer an int; a float anywhere answers a float. */ - check(num(flan_dyn_add(flan_dyn_from_i64(2), flan_dyn_from_i64(3))) == 5, "+"); - check(num(flan_dyn_sub(flan_dyn_from_i64(2), flan_dyn_from_i64(3))) == -1, "-"); - check(num(flan_dyn_mul(flan_dyn_from_i64(2), flan_dyn_from_i64(3))) == 6, "*"); - check(num(flan_dyn_div(flan_dyn_from_i64(7), flan_dyn_from_i64(2))) == 3, "/"); - check(num(flan_dyn_rem(flan_dyn_from_i64(7), flan_dyn_from_i64(2))) == 1, "%"); - check(num(flan_dyn_rem(flan_dyn_from_i64(-7), flan_dyn_from_i64(2))) == -1, + check(num(FDYN_add(flan_dyn_from_i64(2), flan_dyn_from_i64(3))) == 5, "+"); + check(num(FDYN_sub(flan_dyn_from_i64(2), flan_dyn_from_i64(3))) == -1, "-"); + check(num(FDYN_mul(flan_dyn_from_i64(2), flan_dyn_from_i64(3))) == 6, "*"); + check(num(FDYN_div(flan_dyn_from_i64(7), flan_dyn_from_i64(2))) == 3, "/"); + check(num(FDYN_rem(flan_dyn_from_i64(7), flan_dyn_from_i64(2))) == 1, "%"); + check(num(FDYN_rem(flan_dyn_from_i64(-7), flan_dyn_from_i64(2))) == -1, "% keeps the sign of the dividend"); check(flan_dyn_need_f64( - flan_dyn_add(flan_dyn_from_i64(1), flan_dyn_from_f64(0.5))) == 1.5, + FDYN_add(flan_dyn_from_i64(1), flan_dyn_from_f64(0.5))) == 1.5, "int and float promote"); check(flan_dyn_need_f64( - flan_dyn_div(flan_dyn_from_f64(1.0), flan_dyn_from_f64(4.0))) == 0.25, + FDYN_div(flan_dyn_from_f64(1.0), flan_dyn_from_f64(4.0))) == 0.25, "float /"); check(flan_dyn_need_f64( - flan_dyn_rem(flan_dyn_from_f64(7.5), flan_dyn_from_f64(2.0))) == 1.5, + FDYN_rem(flan_dyn_from_f64(7.5), flan_dyn_from_f64(2.0))) == 1.5, "float %"); /* The boxed end of the range arithmetically, not only as a round trip. */ - check(num(flan_dyn_add(flan_dyn_from_i64(140737488355327LL), + check(num(FDYN_add(flan_dyn_from_i64(140737488355327LL), flan_dyn_from_i64(1))) == 140737488355328LL, "+ crosses into the box"); /* Ordering. Numbers against numbers across the two tags, text bytewise, and a NaN that is none of less, equal or greater. */ - check(truth(flan_dyn_lt(flan_dyn_from_i64(1), flan_dyn_from_i64(2))), "<"); - check(!truth(flan_dyn_lt(flan_dyn_from_i64(2), flan_dyn_from_i64(2))), "< eq"); - check(truth(flan_dyn_le(flan_dyn_from_i64(2), flan_dyn_from_i64(2))), "<="); - check(truth(flan_dyn_gt(flan_dyn_from_f64(2.5), flan_dyn_from_i64(2))), ">"); - check(truth(flan_dyn_ge(flan_dyn_from_i64(2), flan_dyn_from_f64(2.0))), ">="); - check(truth(flan_dyn_lt(text("abc"), text("abd"))), "< text"); - check(truth(flan_dyn_lt(text("ab"), text("abc"))), "< text prefix"); - check(!truth(flan_dyn_lt(text("abc"), text("abc"))), "< text equal"); + check(truth(FDYN_lt(flan_dyn_from_i64(1), flan_dyn_from_i64(2))), "<"); + check(!truth(FDYN_lt(flan_dyn_from_i64(2), flan_dyn_from_i64(2))), "< eq"); + check(truth(FDYN_le(flan_dyn_from_i64(2), flan_dyn_from_i64(2))), "<="); + check(truth(FDYN_gt(flan_dyn_from_f64(2.5), flan_dyn_from_i64(2))), ">"); + check(truth(FDYN_ge(flan_dyn_from_i64(2), flan_dyn_from_f64(2.0))), ">="); + check(truth(FDYN_lt(text("abc"), text("abd"))), "< text"); + check(truth(FDYN_lt(text("ab"), text("abc"))), "< text prefix"); + check(!truth(FDYN_lt(text("abc"), text("abc"))), "< text equal"); { flan_dyn n = flan_dyn_from_f64(0.0 / 0.0), one = flan_dyn_from_i64(1); - check(!truth(flan_dyn_lt(n, one)) && !truth(flan_dyn_gt(n, one)) - && !truth(flan_dyn_le(n, one)) && !truth(flan_dyn_ge(n, one)), + check(!truth(FDYN_lt(n, one)) && !truth(FDYN_gt(n, one)) + && !truth(FDYN_le(n, one)) && !truth(FDYN_ge(n, one)), "nan is unordered in all four directions"); } @@ -952,27 +966,27 @@ static void desc(void) { static void refuse(const char *what) { flan_dyn v = flan_dyn_vec_new(); flan_dyn t = text("hi"); - if (strcmp(what, "add") == 0) (void)flan_dyn_add(flan_dyn_from_i64(3), t); + if (strcmp(what, "add") == 0) (void)FDYN_add(flan_dyn_from_i64(3), t); else if (strcmp(what, "sub") == 0) - (void)flan_dyn_sub(flan_dyn_nil(), flan_dyn_from_i64(1)); + (void)FDYN_sub(flan_dyn_nil(), flan_dyn_from_i64(1)); else if (strcmp(what, "mul") == 0) - (void)flan_dyn_mul(flan_dyn_from_bool(1), flan_dyn_from_i64(2)); + (void)FDYN_mul(flan_dyn_from_bool(1), flan_dyn_from_i64(2)); else if (strcmp(what, "div") == 0) - (void)flan_dyn_div(v, flan_dyn_from_i64(2)); + (void)FDYN_div(v, flan_dyn_from_i64(2)); else if (strcmp(what, "rem") == 0) - (void)flan_dyn_rem(flan_dyn_from_i64(2), flan_dyn_nil()); + (void)FDYN_rem(flan_dyn_from_i64(2), flan_dyn_nil()); else if (strcmp(what, "divzero") == 0) - (void)flan_dyn_div(flan_dyn_from_i64(1), flan_dyn_from_i64(0)); + (void)FDYN_div(flan_dyn_from_i64(1), flan_dyn_from_i64(0)); else if (strcmp(what, "remzero") == 0) - (void)flan_dyn_rem(flan_dyn_from_i64(1), flan_dyn_from_i64(0)); + (void)FDYN_rem(flan_dyn_from_i64(1), flan_dyn_from_i64(0)); else if (strcmp(what, "divover") == 0) - (void)flan_dyn_div(flan_dyn_from_i64(INT64_MIN), flan_dyn_from_i64(-1)); + (void)FDYN_div(flan_dyn_from_i64(INT64_MIN), flan_dyn_from_i64(-1)); else if (strcmp(what, "lt") == 0) - (void)flan_dyn_lt(flan_dyn_from_i64(1), t); - else if (strcmp(what, "le") == 0) (void)flan_dyn_le(t, flan_dyn_nil()); - else if (strcmp(what, "gt") == 0) (void)flan_dyn_gt(v, v); + (void)FDYN_lt(flan_dyn_from_i64(1), t); + else if (strcmp(what, "le") == 0) (void)FDYN_le(t, flan_dyn_nil()); + else if (strcmp(what, "gt") == 0) (void)FDYN_gt(v, v); else if (strcmp(what, "ge") == 0) - (void)flan_dyn_ge(flan_dyn_from_bool(0), flan_dyn_from_bool(1)); + (void)FDYN_ge(flan_dyn_from_bool(0), flan_dyn_from_bool(1)); else if (strcmp(what, "len") == 0) (void)flan_dyn_len(flan_dyn_from_i64(1)); else if (strcmp(what, "at") == 0) (void)flan_dyn_at(flan_dyn_from_i64(3), flan_dyn_from_i64(0)); diff --git a/test/test_flan.ml b/test/test_flan.ml index 753bc77..10ccff0 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -1555,6 +1555,12 @@ let () = check "the x86 backend roots its dyn values" (contains dyn_asm "flan_dyn_root_push" && contains dyn_asm "flan_dyn_root_pop"); + (* The site travels with the operands, on this backend as on the other. A + dyn arithmetic trap is the type error of a dynamic program and it used to + print with no file and no line; the string literal below is what the + runtime prints as a GNU prefix in front of the sentence. *) + check "the x86 backend hands the dyn operators their site" + (contains dyn_asm ":1:21"); (* And a program with no dyn in it emits not one byte of any of it, which is what lets the sweep's other MATCHes stand as a regression check on this lane rather than being re-measured by it. *)