A str from dyn text is pinned once per temp stamp and is a poisoned temp copy in a dev build, a float past f32's range and a map key a struct lacks trap, and a struct's refusal names what the value is.

This commit is contained in:
Joseph Ferano 2026-09-26 12:09:25 +07:00
parent 66ea0b3abe
commit 78e25dfa48
3 changed files with 185 additions and 39 deletions

View File

@ -1540,56 +1540,97 @@ static void mark_desc(char *base, const flan_desc *d) {
* Rooting the text in the crossing's frame would be shorter than that and
* wrong for a str returned or stored, and a pin for good would keep every
* text a frame loop ever crossed. A copy into the temp arena would be sound
* too; this is the same lifetime without the copy. */
* too; this is the same lifetime without the copy, and a dev build takes the
* copy instead ([into_text]) so that a str kept past free-temp reads the
* arena's poison, as i64->bytes's text does, rather than whatever text the
* 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
* 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
* sit in runs, one per stamp, so an entry is a pointer and a run's stamp is
* kept once. */
const void *flan_temp_stamp(uint64_t *inc, uint64_t *epoch);
int32_t flan_temp_stamp_live(const void *a, uint64_t inc, uint64_t epoch);
typedef struct text_pin {
flan_obj *o;
typedef struct pin_run {
const void *a;
uint64_t inc, epoch;
} text_pin;
int64_t start; /* its first entry in [pins] */
} pin_run;
static text_pin *pins;
static int64_t pins_n, pins_cap;
static flan_obj **pins;
static int64_t pins_n, pins_cap;
static pin_run *runs;
static int64_t runs_n, runs_cap;
/* The number the newest run's texts carry in [gen]; never 0, which is what
a text is made with. A wrap would take four billion stamps, and costs one
duplicate entry when it lands on an old text's number. */
static uint32_t pin_gen;
static int64_t pins_count(void) { return pins_n; }
static void pins_prune(void) {
int64_t i, k = 0;
for (i = 0; i < pins_n; i++)
if (flan_temp_stamp_live(pins[i].a, pins[i].inc, pins[i].epoch))
pins[k++] = pins[i];
int64_t r, k = 0, rk = 0;
for (r = 0; r < runs_n; r++) {
int64_t lo = runs[r].start;
int64_t hi = r + 1 < runs_n ? runs[r + 1].start : pins_n;
if (!flan_temp_stamp_live(runs[r].a, runs[r].inc, runs[r].epoch)) continue;
memmove(pins + k, pins + lo, (size_t)(hi - lo) * sizeof *pins);
runs[rk] = runs[r];
runs[rk].start = k;
k += hi - lo;
rk++;
}
pins_n = k;
runs_n = rk;
}
static void *pins_grow(void *p, int64_t *cap, size_t each) {
int64_t c = *cap ? *cap * 2 : 64;
void *q = realloc(p, (size_t)c * each);
if (q == NULL) trap_oom(NULL, 0, c * (int64_t)each);
*cap = c;
return q;
}
static void pin_text(flan_obj *o) {
uint64_t inc, epoch;
const void *a = flan_temp_stamp(&inc, &epoch);
text_pin *last = pins_n > 0 ? &pins[pins_n - 1] : NULL;
if (last != NULL && last->o == o && last->a == a && last->inc == inc
&& last->epoch == epoch)
pin_run *last = runs_n > 0 ? &runs[runs_n - 1] : NULL;
if (last == NULL || last->a != a || last->inc != inc
|| last->epoch != epoch) {
if (runs_n == runs_cap) {
pins_prune();
if (runs_n == runs_cap) runs = pins_grow(runs, &runs_cap, sizeof *runs);
}
runs[runs_n].a = a;
runs[runs_n].inc = inc;
runs[runs_n].epoch = epoch;
runs[runs_n].start = pins_n;
runs_n++;
if (++pin_gen == 0) pin_gen = 1;
} else if (o->gen == pin_gen)
return;
if (pins_n == pins_cap) {
pins_prune();
if (pins_n == pins_cap) {
int64_t cap = pins_cap ? pins_cap * 2 : 64;
text_pin *p = (text_pin *)realloc(pins, (size_t)cap * sizeof *p);
if (p == NULL) trap_oom(NULL, 0, cap * (int64_t)sizeof *p);
pins = p;
pins_cap = cap;
}
if (pins_n == pins_cap) pins = pins_grow(pins, &pins_cap, sizeof *pins);
}
pins[pins_n].o = o;
pins[pins_n].a = a;
pins[pins_n].inc = inc;
pins[pins_n].epoch = epoch;
pins_n++;
o->gen = pin_gen;
pins[pins_n++] = o;
}
/* How many texts are pinned now, for a test that the list stays flat. */
int64_t flan_dyn_pin_count(void) { return pins_count(); }
static void gc_mark_all(void) {
int64_t i;
unsigned k;
pins_prune();
for (i = 0; i < pins_n; i++) mark_push(pins[i].o);
for (i = 0; i < pins_n; i++) mark_push(pins[i]);
for (i = 0; i < roots_n; i++) {
const flan_desc *d = roots[i].desc;
if (d == NULL) mark_value(*(flan_dyn *)roots[i].base);
@ -4219,10 +4260,23 @@ static void into_put(into_site *s, const uint8_t *d, flan_dyn x, uint8_t *p);
static void into_slice(into_site *s, const uint8_t *d, flan_dyn x,
uint8_t *p);
/* A text's bytes as a str's two words, pinned. */
/* A text's bytes as a str's two words, pinned — or, in a dev build, copied
* into the temp arena, whose registry note and poison catch a str kept past
* free-temp (see [pin_text]). */
static void into_text(flan_dyn x, uint8_t *p) {
flan_obj *o = dyn_obj(x);
const uint8_t *b = obj_text_bytes(o);
if (flan_dev_reg_enabled()) {
uint8_t *q = NULL;
if (o->len > 0) {
q = (uint8_t *)flan_temp_block(o->len, 1, 1, "u8", 2);
if (q == NULL) trap_oom(NULL, 0, o->len);
memcpy(q, b, (size_t)o->len);
}
memcpy(p, &q, 8);
memcpy(p + 8, &o->len, 8);
return;
}
pin_text(o);
memcpy(p, &b, 8);
memcpy(p + 8, &o->len, 8);
@ -4282,9 +4336,18 @@ static void into_put(into_site *s, const uint8_t *d, flan_dyn x, uint8_t *p) {
into_trap(s, "DynRange", "%s is %lld, which has no exact %s. Write "
"it as a float, as in %lld.0", into_who(s), (long long)n,
*d == 'f' ? "f32" : "f64", (long long)n);
} else if (flan_dyn_tag(x) == FLAN_DYN_TAG_FLOAT)
} else if (flan_dyn_tag(x) == FLAN_DYN_TAG_FLOAT) {
f = dyn_num_value(x);
else {
/* A finite float past f32's range would become inf, which is a change
of value and not a rounding: refused, as an int out of range is. */
if (*d == 'f' && f == f && f - f == 0 && (f > 3.4028234663852886e38
|| f < -3.4028234663852886e38)) {
char sx[SAY_MAX];
say(sx, SAY_MAX, x);
into_trap(s, "DynRange", "%s is %s, and an f32 holds -3.4028235e38 "
"to 3.4028235e38", into_who(s), sx);
}
} else {
into_wanted(why, sizeof why, d);
into_wrong(s, x, why);
}
@ -4348,16 +4411,60 @@ static void into_put(into_site *s, const uint8_t *d, flan_dyn x, uint8_t *p) {
return;
}
memcpy(saved, s->where, sizeof saved);
/* What the value is called in a sentence: its place inside the whole,
else what it is — a struct's view, a class's instance, a map. */
{
char what[160];
flan_obj *m = dyn_obj(x);
int64_t i, n;
if (s->where[0]) snprintf(what, sizeof what, "%s", s->where);
else if (o != NULL) {
const char *nm;
int64_t nl;
view_struct_name(o, &nm, &nl);
snprintf(what, sizeof what, "this %.*s", (int)nl, nm);
} else if (m->u.v.klass != NULL) {
kw_entry *k = m->u.v.klass;
snprintf(what, sizeof what, "this %.*s", (int)k->len,
(const char *)kw_bytes(k));
} else
snprintf(what, sizeof what, "this map");
at = desc_fields(d, &off);
while (desc_next(&at, &off, &name, &namelen, &foff, &fty))
if (!flan_dyn_truthy(flan_dyn_map_contains_at(
x, flan_dyn_kw(name, namelen), s->loc, s->loclen))) {
desc_spell(d, ty, sizeof ty);
into_trap(s, "DynType", "%s has no :%.*s, and %s %s needs every "
"field", what, (int)namelen, (const char *)name, an(ty),
ty);
}
/* A key the struct has no field for is refused, as a class refuses a
slot it does not declare: dropping it would lose what was written. */
if (o == NULL) class_sync(m);
n = o != NULL ? view_nfields(o) : m->len;
for (i = 0; i < n; i++) {
flan_dyn k = o != NULL ? view_field_key(o, i) : m->u.v.items[2 * i];
int64_t foff2;
if (desc_field(d, k, &foff2) == NULL) {
char sk[SAY_MAX];
int64_t off2;
const uint8_t *at2;
say(sk, SAY_MAX, k);
desc_spell(d, ty, sizeof ty);
said_len = 0;
said_add("dyn %s: %s has %s, and %s %s has no field %s. Its fields "
"are", s->op, what, sk, an(ty), ty, sk);
at2 = desc_fields(d, &off2);
while (desc_next(&at2, &off2, &name, &namelen, &foff, &fty))
said_add(" :%.*s", (int)namelen, (const char *)name);
flan_say(s->loc, s->loclen, "%s", said_buf);
dyn_trap((const uint8_t *)"DynType", 7);
}
}
}
at = desc_fields(d, &off);
while (desc_next(&at, &off, &name, &namelen, &foff, &fty)) {
flan_dyn k = flan_dyn_kw(name, namelen), v;
if (!flan_dyn_truthy(flan_dyn_map_contains_at(x, k, s->loc,
s->loclen))) {
desc_spell(d, ty, sizeof ty);
into_trap(s, "DynType", "%s has no :%.*s, and %s %s needs every "
"field", s->where[0] ? s->where : "this map",
(int)namelen, (const char *)name, an(ty), ty);
}
v = flan_dyn_get(x, k, s->loc, s->loclen);
into_enter(s, "field :%.*s", (int)namelen, (const char *)name);
into_put(s, fty, v, p + foff);

View File

@ -42,6 +42,15 @@
(defn f64s [xs [f64]] () (println (length xs)))
(defn raw [xs [u8]] () (println (length xs)))
(declare pin-count [] i64 "flan_dyn_pin_count")
(defn slen [s str] i64 (length s))
(defn f32s [xs [const f32]] () (println (length xs)))
(defclass pq [x])
;; A str kept in a global past free-temp: a dev build's copy is poisoned.
(defonce kept str "")
(defn stash-str [] () (set kept (keep-str (keep "kept text"))))
;; A view of a local, kept past the call that owns the local.
(defonce held dyn nil)
(defn leak-local [] ()
@ -72,6 +81,10 @@
(free-temp)
(gc-collect)
(println (< (- (gc-count) before) 100)))
;; The same texts crossing again and again are pinned once each.
(let [t1 (keep "one") t2 (keep "two") n (i64 0)]
(dotimes [i 100000] (set n (+ n (slen t1) (slen t2))))
(println n (< (pin-count) 10)))
;; A view of typed storage comes back as that storage.
(let [a [(i64 1) 2 3]]
(bump (keep a))
@ -112,4 +125,14 @@
(= n 9) (do (raw (keep "abc")) 0)
(= n 10) (let [a [(f32 1) 2]] (f64s (keep a)) 0)
(= n 11) (do (println (px (the dyn {:x 1.5 :y "no"}))) 0)
(= n 12) (do (f32s (the dyn [1.5 1e300])) 0)
(= n 13) (do (println (px (pq 1.5))) 0)
(= n 14) (do (println (px (the dyn {:x 1.5 :y 2 :z 3}))) 0)
(= n 15)
(do (stash-str)
(free-temp)
(gc-collect)
(dotimes [i 1000] (text-of (keep "XXXXXXXXXX")))
(println (at kept 0))
0)
:else 1)))

View File

@ -6106,10 +6106,10 @@ level "1"
each naming the element and what it holds. Mode 8, a view of a
returned call's local, traps under --dev only. *)
let into_out =
"hello\n4\npinne\ntrue\n[101 102 103]\n306\n105 106\n10\n3.5\n258\n\
"hello\n4\npinne\ntrue\n600000 true\n[101 102 103]\n306\n105 106\n10\n3.5\n258\n\
131\nada\nbo\n3\n15\n40\n10\n3\n3.5\n5.5\n4.25\ncy 9\n"
and into_traps =
[ ("1", "dyn-into-typed.flan:104:33: dyn into [const i64]: element 1 \
[ ("1", "dyn-into-typed.flan:117:33: dyn into [const i64]: element 1 \
is a text, \"a\", and an i64 is wanted there");
("2", "dyn into [i64]: this vec is a dyn vec, so a [i64] of it would \
be a copy, and a write through the copy would never reach the \
@ -6123,7 +6123,13 @@ level "1"
("9", "a text is read-only, so it becomes a str or a [const u8] and \
never a [u8]");
("10", "this vec is a view of f32 elements");
("11", "field :y is a text, \"no\", and an i32 is wanted there") ]
("11", "field :y is a text, \"no\", and an i32 is wanted there");
("12", "element 1 is 1e+300, and an f32 holds -3.4028235e38 to \
3.4028235e38");
("13", "dyn into Point: this pq has no :y, and a Point needs every \
field");
("14", "dyn into Point: this map has :z, and a Point has no field \
:z. Its fields are :x :y") ]
and into_stale =
[ ("8", "dyn into [i64]: this view points into a local of leak-local, \
and that call has returned") ]
@ -6151,6 +6157,16 @@ level "1"
saying %S\n" (name (", mode " ^ mode)) text code needle
end)
(into_traps @ if dev then into_stale else []);
(* A str from a text kept in a global past free-temp: a dev build's
copy reads the arena's poison (0xEF), never another text's bytes. *)
if dev then begin
let code, text = run exe (Some "15") in
if code <> 0 || text <> "239\n" then begin
incr failures;
Printf.printf "FAIL %s\n got: %S (exit %d)\n wanted: %S\n"
(name ", a str kept past free-temp") text code "239\n"
end
end;
(try Sys.remove exe with Sys_error _ -> ())
in
dyn_into ();