JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A dev build refuses (free s) on a slice over a Vec's or a Map's storage, and says a formatted number's text is released by free-temp

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 17:04:52 +07:00
parent 7c1cbd3a9f
commit 7bcf9e5054
6 changed files with 80 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lib/check.ml
View File

@ -8482,7 +8482,7 @@ and dup_elems ctx loc elem (src : Tast.expr) (a : Tast.expr) =
(v, mk loc (Types.Vec elem) (Tast.Zero (Types.Vec elem)));
(out, mk loc (Types.Slice (Types.Mut, elem)) (Tast.Zero (Types.Slice (Types.Mut, elem)))) ],
[ with_note loc (alloc_guard ctx loc attempt)
(reg_note loc "flan_dev_reg_note_vec"
(reg_note loc "flan_dev_reg_note_slice"
(mk loc (Types.Vec elem) (Tast.Local v))
[ size_of loc elem ] elem);
fill;

1
lib/emit.ml
View File

@ -5037,6 +5037,7 @@ declare void @flan_dyn_root_globals_end()
declare void @flan_gc_init()
declare void @flan_dev_reg_enable()
declare void @flan_dev_reg_note_vec(ptr, i64, ptr, i64)
declare void @flan_dev_reg_note_slice(ptr, i64, ptr, i64)
declare void @flan_dev_reg_note_map(ptr, i64, i64, ptr, i64)
declare void @flan_dev_reg_note_res_acquire(i64, ptr, i64, ptr, i64)
declare void @flan_dev_reg_note_res_release(i64, ptr, i64, ptr, i64)

40
runtime/flan_dev.c
View File

@ -1267,6 +1267,10 @@ typedef struct {
* the temp arena's — and NULL where it did not. (free s) on a slice asks
* it, so a block is never handed to an allocator it did not come from. */
const void *owner;
/* Set for a block handed out as a slice — (bytes s), (clone xs), a
* formatted number — and clear for a Vec's or a Map's storage, which only
* their own free releases. */
int32_t sliced;
} flan_reg_entry;
/* ── Why this table has a seqlock and the watch table's is the model ───
@ -1560,6 +1564,7 @@ static void flan_reg_compact(void) {
e->base = old[i].base; e->bytes = old[i].bytes;
e->elem = old[i].elem; e->seq = old[i].seq; e->died = old[i].died;
e->owner = old[i].owner;
e->sliced = old[i].sliced;
flan_reg_end(e);
flan_reg_used++;
break;
@ -1573,18 +1578,31 @@ static void flan_reg_compact(void) {
/* One note per allocation. [base] replaces whatever was recorded there, live
* or dead: the allocator handing out an address is the event that makes any
* older answer about it wrong. */
void flan_dev_reg_note_owned(void *base, int64_t bytes, int64_t elem,
const char *type, int64_t typelen,
const void *owner);
static void flan_reg_note_full(void *base, int64_t bytes, int64_t elem,
const char *type, int64_t typelen,
const void *owner, int32_t sliced);
void flan_dev_reg_note(void *base, int64_t bytes, int64_t elem,
const char *type, int64_t typelen) {
flan_dev_reg_note_owned(base, bytes, elem, type, typelen, NULL);
flan_reg_note_full(base, bytes, elem, type, typelen, NULL, 0);
}
void flan_dev_reg_note_owned(void *base, int64_t bytes, int64_t elem,
const char *type, int64_t typelen,
const void *owner) {
flan_reg_note_full(base, bytes, elem, type, typelen, owner, 0);
}
/* A block handed out as a slice, which (free s) may release. */
void flan_dev_reg_note_sliced(void *base, int64_t bytes, int64_t elem,
const char *type, int64_t typelen,
const void *owner) {
flan_reg_note_full(base, bytes, elem, type, typelen, owner, 1);
}
static void flan_reg_note_full(void *base, int64_t bytes, int64_t elem,
const char *type, int64_t typelen,
const void *owner, int32_t sliced) {
uintptr_t a = (uintptr_t)base;
size_t s;
int64_t probe;
@ -1615,6 +1633,7 @@ void flan_dev_reg_note_owned(void *base, int64_t bytes, int64_t elem,
flan_reg[j].seq = ++flan_reg_seq;
flan_reg[j].died = 0;
flan_reg[j].owner = owner;
flan_reg[j].sliced = sliced;
flan_reg_end(&flan_reg[j]);
return;
}
@ -1645,17 +1664,24 @@ int flan_dev_reg_overflowed(void) { return flan_reg_full; }
* go to [owner] — or when the registry cannot say, because this is not a dev
* build, the table is full, or the note did not know the allocator — 1 when
* [p] is not the start of a block any allocator handed out, 2 when the block
* came from another allocator, 3 when it was already released. */
* came from another allocator (whose record goes to [*found]), 3 when it was
* already released, 4 when it is a Vec's or a Map's storage rather than a
* block handed out as a slice. */
static flan_reg_entry *flan_reg_find(uintptr_t a);
int32_t flan_dev_reg_owner_check(const void *p, const void *owner) {
int32_t flan_dev_reg_owner_check(const void *p, const void *owner,
const void **found) {
flan_reg_entry *e;
if (!flan_reg_on) return 0;
e = flan_reg_find((uintptr_t)p);
if (e == NULL) return flan_reg_full ? 0 : 1;
if (e->base != (uintptr_t)p) return 1;
if (e->died != 0) return 3;
if (e->owner != NULL && e->owner != owner) return 2;
if (!e->sliced) return 4;
if (e->owner != NULL && e->owner != owner) {
if (found) *found = e->owner;
return 2;
}
return 0;
}

36
runtime/flan_rt.c
View File

@ -1680,7 +1680,11 @@ void flan_dev_reg_note(void *base, int64_t bytes, int64_t elem,
void flan_dev_reg_note_owned(void *base, int64_t bytes, int64_t elem,
const char *type, int64_t typelen,
const void *owner);
int32_t flan_dev_reg_owner_check(const void *p, const void *owner);
int32_t flan_dev_reg_owner_check(const void *p, const void *owner,
const void **found);
void flan_dev_reg_note_sliced(void *base, int64_t bytes, int64_t elem,
const char *type, int64_t typelen,
const void *owner);
void flan_dev_reg_dead(void *base);
void flan_dev_reg_dead_range(void *base, int64_t bytes);
/* flan_dev.c: a dev build fills a block a resize moved away from, so that a
@ -2485,7 +2489,7 @@ static int8_t flan_temp_text(flan_render render, const void *x,
if (!q) return 0;
memcpy(q, buf, (size_t)len);
}
flan_dev_reg_note_owned(q, len, 1, "u8", 2, a);
flan_dev_reg_note_sliced(q, len, 1, "u8", 2, a);
out->ptr = q;
out->len = len;
return 1;
@ -2748,9 +2752,14 @@ _Noreturn static void flan_slice_free_fail(const uint8_t *loc, int64_t loclen,
int32_t why) {
rt_flush_out();
fprintf(stderr, "%.*s: %s\n", (int)loclen, (const char *)loc,
why == 2 ? "this slice's block came from another allocator — free it "
"through the allocator it was made with, (free s a)"
why == 5 ? "this slice is text in the temp allocator, which is "
"released all at once by (free-temp), not one slice at a "
"time"
: why == 2 ? "this slice's block came from another allocator — free "
"it through the allocator it was made with, (free s a)"
: why == 3 ? "this slice's block was already freed"
: why == 4 ? "this slice views a Vec's or a Map's storage, which "
"only freeing the Vec or the Map releases"
: "this slice is not a block an allocator handed out — "
"only a slice (bytes s) or (clone xs) made can be freed");
rt_trap((const uint8_t *)"BadFree", 7);
@ -2762,8 +2771,15 @@ void flan_slice_free(const void *p, int64_t n, int64_t size, int64_t align,
int64_t bytes;
if (p == NULL || n <= 0) return;
if (!a) flan_null_alloc_fail(loc, loclen);
why = flan_dev_reg_owner_check(p, a);
if (why != 0) flan_slice_free_fail(loc, loclen, why);
{
const void *found = NULL;
why = flan_dev_reg_owner_check(p, a, &found);
if (why == 2 && found != NULL
&& ((flan_allocator *)found)->proc == flan_arena_proc
&& ((flan_arena *)((flan_allocator *)found)->data)->grow)
why = 5;
if (why != 0) flan_slice_free_fail(loc, loclen, why);
}
if (!(a->caps & FLAN_CAN_FREE)) return;
if (!flan_mul_bytes(n, size, &bytes)) return;
a->proc(a, FLAN_ALLOC_FREE, (void *)p, bytes, 0, align);
@ -3696,6 +3712,14 @@ int8_t flan_map_clone(flan_map *dst, flan_map *src, flan_allocator *a,
* A container with no storage yet notes nothing: flan_dev_reg_note ignores a
* null base, so an empty Vec needs no branch on this side. */
/* The note for a (bytes s) or (clone xs) block: the hidden Vec that made it,
* marked as a block handed out as a slice. */
void flan_dev_reg_note_slice(flan_vec *v, int64_t size, const char *type,
int64_t typelen) {
if (v) flan_dev_reg_note_sliced(v->ptr, v->cap * size, size, type, typelen,
v->alloc);
}
void flan_dev_reg_note_vec(flan_vec *v, int64_t size, const char *type,
int64_t typelen) {
if (v) flan_dev_reg_note_owned(v->ptr, v->cap * size, size, type, typelen,

11
test/programs/free-slice.flan
View File

@ -3,7 +3,9 @@
;;;; the block against the allocation registry and traps rather than hand one
;;;; allocator another's block. Argument 0 frees correctly both ways; 1 frees
;;;; an arena's copy through the context allocator; 2 frees one copy twice;
;;;; 3 frees a view of an array, which no allocator handed out.
;;;; 3 frees a view of an array, which no allocator handed out; 4 frees a
;;;; Vec's storage through a let-bound view of it; 5 frees a formatted
;;;; number's text, which the temp allocator holds.
(defn main [args [string]] i32
(let [which (if (> (length args) 1) (bytes->i64 (bytes-view (at args 1))) 0)
a (arena-new 4096)]
@ -13,6 +15,13 @@
(= which 3) (let [arr [1 2 3]
s (slice arr)]
(free s))
(= which 4) (let [v (vec-new i32)]
(push v 1)
(push v 2)
(let [s (slice v)] (free s))
(println (at v 1))
(free v))
(= which 5) (let [t (i64->bytes 42)] (free t))
:else
(let [b (bytes "heap")
c (bytes "arena" a)

8
test/test_acceptance.ml
View File

@ -913,9 +913,11 @@ let () =
"FAIL a dev build refuses a bad free of a slice, argument \
%s%s\n got: %S (exit %d)\n" arg tag text code
end)
[ ("1", 11, "came from another allocator");
("2", 12, "was already freed");
("3", 15, "not a block an allocator handed out") ];
[ ("1", 13, "came from another allocator");
("2", 14, "was already freed");
("3", 17, "not a block an allocator handed out");
("4", 21, "views a Vec's or a Map's storage");
("5", 24, "released all at once by (free-temp)") ];
(try Sys.remove exe with Sys_error _ -> ()))
[ (false, ", dev"); (true, ", dev --x86") ];
(* The other half of the same ruling: a store through a bytes-view is