diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 1044f30e..1756ed75 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -767,23 +767,20 @@ static void char_spell(uint32_t cp, char buf[16]) { } /* A text is immutable, so its char count is taken once, when it is made, and - * kept in the header's [u.i], which a text does not otherwise use; [gen] - * says whether every byte is ASCII, which makes an index a byte offset. */ -#define TEXT_ASCII 1u - + * kept in the header's [u.i], which a text does not otherwise use. A count + * equal to the byte length means every byte is ASCII, and an index is then a + * byte offset. [gen] is not touched: on a text it is [pin_text]'s stamp. */ static void text_measure(flan_obj *o) { const uint8_t *p = obj_text_bytes(o); int64_t i = 0, n = 0; - int w, ascii = 1; + int w; while (i < o->len) { if (p[i] < 0x80) { i++; n++; continue; } - ascii = 0; utf8_decode(p + i, o->len - i, &w); i += w; n++; } o->u.i = n; - o->gen = ascii ? TEXT_ASCII : 0; } /* The byte offset of char [k], 0 <= k <= the char count. */ @@ -791,7 +788,7 @@ static int64_t text_offset(flan_obj *o, int64_t k) { const uint8_t *p = obj_text_bytes(o); int64_t i = 0; int w; - if (o->gen & TEXT_ASCII) return k; + if (o->u.i == o->len) return k; while (k > 0 && i < o->len) { utf8_decode(p + i, o->len - i, &w); i += w; @@ -1681,8 +1678,9 @@ static void mark_desc(char *base, const flan_desc *d) { * allocator put there next. * * A text is pinned once per stamp, however often it crosses: the stamp's - * number is written into the text's [gen], which nothing else reads for a - * text, so a program that never calls free-temp and passes the same texts + * number is written into the text's [gen], which nothing else reads or + * writes for a text — its char count is in [u.i], and whether it is ASCII is + * that count against its length ([text_measure]) — so a program that never calls free-temp and passes the same texts * in a loop keeps a flat list. Distinct texts cost one pointer each here, * and each keeps its own object alive until the stamp ends — heavier than * i64->bytes's few bytes of arena, since the object has a header. The pins @@ -4067,6 +4065,27 @@ static void view_write(const uint8_t *loc, int64_t loclen, const char *op, desc_spell(d, ty, sizeof ty); if (int_range(*d, &lo, &hi)) { int64_t n; + /* A char is written as its code point where it fits, [into_put]'s rule: + into a byte only when ASCII, since a byte past ASCII is not that char + in UTF-8. */ + if (flan_dyn_tag(x) == FLAN_DYN_TAG_CHAR) { + char cs[16]; + int byte = *d == 'b' || *d == 'B'; + n = (int64_t)dyn_payload(x); + if (n <= (byte ? 127 : hi)) goto store; + char_spell((uint32_t)n, cs); + if (byte) + snprintf(why, sizeof why, ", and the char %s is more than one byte in " + "UTF-8. Take its code point as an i32", cs); + else + snprintf(why, sizeof why, ", which holds %lld to %lld, and the char " + "%s, code point %lld, does not fit", (long long)lo, + (long long)hi, cs, (long long)n); + if (field) field_refuse(loc, loclen, op, v, key, d, x, "DynRange", why); + flan_say(loc, loclen, "dyn %s: this element is %s %s%s", op, an(ty), ty, + why); + dyn_trap((const uint8_t *)"DynRange", 8); + } if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT) { if (field) { value_is(why, sizeof why, x); @@ -4098,6 +4117,7 @@ static void view_write(const uint8_t *loc, int64_t loclen, const char *op, (long long)hi); dyn_trap((const uint8_t *)"DynRange", 8); } + store: switch (*d) { case 'b': case 'B': { uint8_t b = (uint8_t)n; memcpy(p, &b, 1); return; } case 'h': case 'H': { uint16_t h = (uint16_t)n; memcpy(p, &h, 2); return; } diff --git a/test/programs/dyn-char-pinned.flan b/test/programs/dyn-char-pinned.flan new file mode 100644 index 00000000..3801c28a --- /dev/null +++ b/test/programs/dyn-char-pinned.flan @@ -0,0 +1,25 @@ +;;;; A non-ASCII text that has crossed into a str still counts characters, +;;;; however many times it crosses; and a char is written through a dyn view of +;;;; typed storage as its code point where it fits. With an argument, \é +;;;; written into a view of bytes traps. + +(defn byte-len [s str] i32 (length s)) + +(defn main [args [str]] i32 + (let [t (the dyn "é日😀")] + (dotimes [i 3] (println (byte-len t))) + (println (length t)) + (println (at t 1)) + (println (slice t 0 2))) + (let [a (the [3 i32] [1 2 3]) + v (the dyn a)] + (set (at v 0) \z) + (set (at v 1) \日) + (println (at a 0) (at a 1) (at a 2))) + (let [b (the [2 u8] [1 2]) + w (the dyn b)] + (set (at w 0) \a) + (println (at b 0) (at b 1)) + (when (> (length args) 1) + (set (at w 1) \é))) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 11b717c8..ce12cc2c 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5447,6 +5447,29 @@ level "1" outputs "dyn: chars" "programs/dyn-char.flan" dyn_char_out; outputs ~opt:"-O0" "dyn: chars, -O0" "programs/dyn-char.flan" dyn_char_out; outputs ~x86:true "dyn: chars, --x86" "programs/dyn-char.flan" dyn_char_out; + (* A text pinned by crossing into a str keeps counting characters (the + pin's stamp and the text's measure live in different header fields), + and a char writes through a view of typed storage. *) + let pinned_out = "9\n9\n9\n3\n\\日\né日\n122 26085 3\n97 2\n" in + outputs "dyn: a pinned text counts chars" "programs/dyn-char-pinned.flan" + pinned_out; + outputs ~opt:"-O0" "dyn: a pinned text counts chars, -O0" + "programs/dyn-char-pinned.flan" pinned_out; + outputs ~x86:true "dyn: a pinned text counts chars, --x86" + "programs/dyn-char-pinned.flan" pinned_out; + List.iter + (fun x86 -> + let exe = compile ~x86 "programs/dyn-char-pinned.flan" in + let code, text = run exe (Some "x") in + let want = "programs/dyn-char-pinned.flan:24:7: dyn set-at: this \ + element is a u8, and the char \\é is more than one byte" in + if code <> 134 || not (contains text want) then begin + incr failures; + Printf.printf "FAIL dyn: \\é into a byte view traps%s\n \ + got: %S (exit %d)\n" + (if x86 then ", --x86" else "") text code + end) + [ false; true ]; (* A dyn into every integer width: both edges pass, a char passes where it fits, a cast takes a char and wraps as the typed cast beside it does; then one trap per width past its range, a char too wide, and a