A slice that bytes or clone copied is released with free, and a dev build traps a free through the wrong allocator
This commit is contained in:
commit
dbdaf66e29
@ -3003,7 +3003,7 @@ fires. The value is two words: the struct's address and the incarnation of it th
|
||||
| `(slice v)` / `(slice v lo)` / `(slice v lo hi)` | a non-owning `[T]` view — the array names again, extended |
|
||||
| `(clone v)` / `(clone v a)` | the only copy; assignment moves |
|
||||
| `(free v)` | consumes its argument |
|
||||
| `(bytes s)` / `(bytes s a)` | a writable copy of a string's bytes, against the context or a named allocator — an allocating operation like `vec-new`: StorageExhausted with retry, a registry note in dev builds. The answer is a `[u8]` view of the block, so nothing can `free` it through the slice; it lives until its allocator's `free-all` or destroy |
|
||||
| `(bytes s)` / `(bytes s a)` | a writable copy of a string's bytes, against the context or a named allocator — an allocating operation like `vec-new`: StorageExhausted with retry, a registry note in dev builds. The answer is a `[u8]` view of the block; `(free b)` hands it back to the context allocator, or `(free b a)` to the one named, and a dev build's registry traps on a mismatch |
|
||||
| `(bytes-view s)` | the string's own storage as a `[const u8]`, costing nothing — the old `(bytes s)` reinterpret, renamed. A store through it is a compile error, because a literal's view points into `.rodata` |
|
||||
|
||||
### A view of a `Vec` goes stale at the `push`, and nothing checks it
|
||||
|
||||
89
lib/check.ml
89
lib/check.ml
@ -8448,8 +8448,9 @@ and alloc_value ctx loc e = use_alloc ctx loc (check ctx ~want:Types.Alloc e)
|
||||
holds the block so the allocation registry can read its extent, the attempt
|
||||
sits under [alloc_guard] so a failure signals StorageExhausted with retry,
|
||||
and the answer is the [slice] of the whole of it. The slice carries no
|
||||
allocator, so nothing can [free] the block through it — it lives until its
|
||||
allocator's free-all or destroy.
|
||||
allocator: (free s) hands the block back to the context allocator or the
|
||||
one named, and a dev build's registry — which the note gives the Vec's
|
||||
allocator — refuses the wrong one.
|
||||
|
||||
The source is bound before the guard's loop, so a retry re-attempts the
|
||||
same copy rather than re-evaluating the expression that produced it. Same
|
||||
@ -8481,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;
|
||||
@ -9394,9 +9395,18 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
traps a read through a released region. That is the Odin contract: free
|
||||
is a thing you write, and writing it twice is yours to not do. *)
|
||||
| "free" ->
|
||||
arity ctx loc name 1 args;
|
||||
(match args with
|
||||
| [ _ ] | [ _; _ ] -> ()
|
||||
| _ -> fail loc "free is (free v), or (free s allocator) for a slice");
|
||||
let target = check_target ctx (List.hd args) in
|
||||
refuse_const_change ctx loc target;
|
||||
(match target.Tast.ty, args with
|
||||
| (Types.Vec _ | Types.Map _), [ _; _ ] ->
|
||||
fail loc
|
||||
"a %s knows the allocator it came from, so free takes only the \
|
||||
container. Write (free %s)"
|
||||
(Types.to_string target.Tast.ty) (spell_arg "v" (List.hd args))
|
||||
| _ -> ());
|
||||
(* A container of owning elements is refused here, and a reader will
|
||||
assume the opposite — that [free] recurses — so this says why it does
|
||||
not and what does.
|
||||
@ -9436,11 +9446,41 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
expect ctx loc ~want
|
||||
(rt loc Types.Unit "flan_map_free"
|
||||
[ target; size_of loc k; size_of loc v; here loc ])
|
||||
(* A slice (bytes s) or (clone xs) answered: its block goes back to the
|
||||
allocator it came from, which a slice does not carry — so it is the
|
||||
context allocator, as Odin's delete defaults to, or the one named. A
|
||||
dev build checks the block against the allocation registry and traps
|
||||
on a slice that is not the start of a block, or on the wrong
|
||||
allocator, instead of handing one allocator another's block. *)
|
||||
| Types.Slice (Types.Const, _) ->
|
||||
fail loc
|
||||
"%s can only be read, so it cannot be freed. Free the [%s] it was \
|
||||
copied into"
|
||||
(Types.to_string target.Tast.ty)
|
||||
(match target.Tast.ty with
|
||||
| Types.Slice (_, e) -> Types.to_string e
|
||||
| t -> Types.to_string t)
|
||||
(* A view written right here — (slice ...) or (slice-from-ptr ...) —
|
||||
is storage something else owns, known without running anything. *)
|
||||
| Types.Slice (Types.Mut, _)
|
||||
when (match (List.hd args).Ast.e with
|
||||
| Ast.Call ({ Ast.e = Ast.Var ("slice" | "slice-from-ptr"); _ }, _) ->
|
||||
true
|
||||
| _ -> false) ->
|
||||
fail loc
|
||||
"this is a view of storage something else owns, so it cannot be \
|
||||
freed. Only a slice (bytes s) or (clone xs) made can be"
|
||||
| Types.Slice (Types.Mut, elem) ->
|
||||
let a = allocator_arg ctx loc (List.tl args) in
|
||||
expect ctx loc ~want
|
||||
(rt loc Types.Unit "flan_slice_free"
|
||||
[ target; size_of loc elem; align_of loc elem; a; here loc ])
|
||||
| other ->
|
||||
(* A field is never freed on its own: it would leave its owner partly
|
||||
dead with no way to say so. *)
|
||||
fail loc
|
||||
"free takes an owning container — a Vec or a Map — found %s"
|
||||
"free takes a Vec, a Map, or a slice (bytes s) or (clone xs) made — \
|
||||
found %s"
|
||||
(Types.to_string other))
|
||||
(* (clone v) uses the current allocator, (clone v a) names one. A deep,
|
||||
independent copy: spec-memory.md's "copying is always explicit". *)
|
||||
@ -10232,12 +10272,20 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
let int k = mk loc index_ty (Tast.Int (k, Types.I32)) in
|
||||
(* [hi] is wanted twice only when it is the implicit length of
|
||||
something whose length is not static. *)
|
||||
(* An array literal is also given a slot, so that what the slice views
|
||||
lives for the whole function in both backends: the x86 backend
|
||||
otherwise holds it in an expression temporary, reclaimed as soon as
|
||||
the slice has been made, and a later temporary — (clone ...)'s own,
|
||||
say — was written over it. *)
|
||||
let needs_slot =
|
||||
List.length bounds < 2
|
||||
&& (match ty with Types.Array _ -> false | _ -> true)
|
||||
&& (match target.Tast.e with
|
||||
| Tast.Local _ | Tast.Global _ -> false
|
||||
| _ -> true)
|
||||
(match ty, target.Tast.e with
|
||||
| Types.Array _, Tast.Arr _ -> true
|
||||
| _ -> false)
|
||||
|| List.length bounds < 2
|
||||
&& (match ty with Types.Array _ -> false | _ -> true)
|
||||
&& (match target.Tast.e with
|
||||
| Tast.Local _ | Tast.Global _ -> false
|
||||
| _ -> true)
|
||||
in
|
||||
let slot = if needs_slot then Some (fresh_slot ctx ty) else None in
|
||||
let src () = match slot with
|
||||
@ -10308,10 +10356,9 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
and a reader who sees it has already been told where the promise comes
|
||||
from.
|
||||
|
||||
**It owns nothing.** The result is a [Types.Slice], which carries no
|
||||
allocator and is the same non-owning view (slice v) answers — so
|
||||
[free] refuses it by the rule it already had ("free takes an owning
|
||||
container"). *)
|
||||
**It owns nothing.** The result is a [Types.Slice], the same non-owning
|
||||
view (slice v) answers; (free s) on it is the program's error, which a
|
||||
dev build's registry traps as a slice no allocator handed out. *)
|
||||
| "slice-from-ptr" ->
|
||||
arity ctx loc name 2 args;
|
||||
(match args with
|
||||
@ -12041,14 +12088,16 @@ let builtins : (string * string * string) list =
|
||||
"Makes room for n more. For a map the number is entries rather than \
|
||||
slots — the block is sized so that n still sits under the load \
|
||||
factor.");
|
||||
("free", "free [(Vec T)|(Map K V)] ()",
|
||||
("free", "free [(Vec T)|(Map K V)|[T] Allocator?] ()",
|
||||
"Releases the container's block. It does not recurse into elements that \
|
||||
own storage — such a container is refused here, and releasing its \
|
||||
region with free-all is the answer.");
|
||||
region with free-all is the answer. A slice (bytes s) or (clone xs) \
|
||||
made goes back to the current allocator, or the one named; a dev build \
|
||||
traps on a slice from another allocator or not from one at all.");
|
||||
("clone", "clone [(Vec T)|(Map K V)|[T] Allocator?] (Vec T)|(Map K V)|[T]",
|
||||
"A deep, independent copy, from the current allocator or one named. \
|
||||
A slice's copy is a slice over a new block, which lives until its \
|
||||
allocator's free-all or destroy. Refused for elements that own \
|
||||
A slice's copy is a slice over a new block, released by (free s) or by \
|
||||
its allocator's free-all. Refused for elements that own \
|
||||
storage: a bytewise copy would alias the original's blocks under a \
|
||||
name promising otherwise.");
|
||||
|
||||
@ -12156,8 +12205,8 @@ let builtins : (string * string * string) list =
|
||||
("bytes", "bytes [string Allocator?] [u8]",
|
||||
"A writable copy of the string's bytes, from the current allocator or \
|
||||
one named. It allocates like vec-new does — a failure signals \
|
||||
StorageExhausted with retry — and the block lives until its \
|
||||
allocator's free-all or destroy. For reading without a copy, \
|
||||
StorageExhausted with retry — and (free b) releases it, through the \
|
||||
current allocator or (free b a) through the one it came from. For reading without a copy, \
|
||||
bytes-view.");
|
||||
("bytes-view", "bytes-view [string] [const u8]",
|
||||
"The string's own storage seen as a read-only byte slice. It costs \
|
||||
|
||||
@ -4929,6 +4929,7 @@ declare ptr @flan_context_allocator()
|
||||
declare ptr @flan_context_use(ptr, i64)
|
||||
declare void @flan_context_value(ptr)
|
||||
declare void @flan_free_temp()
|
||||
declare void @flan_slice_free(ptr, i64, i64, i64, ptr, ptr, i64)
|
||||
declare i8 @flan_i64_temp(i64, ptr)
|
||||
declare i8 @flan_f64_temp(double, ptr)
|
||||
declare void @flan_alloc_seal(ptr, ptr)
|
||||
@ -5036,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)
|
||||
|
||||
@ -1263,6 +1263,14 @@ typedef struct {
|
||||
int64_t seq; /* when it was made */
|
||||
int64_t died; /* when it was released, or 0 while it is live */
|
||||
uint64_t gen; /* this slot's own seqlock; odd while it is written */
|
||||
/* The allocator the block came from, where the note knew it — a Vec's, or
|
||||
* 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 ───
|
||||
@ -1555,6 +1563,8 @@ static void flan_reg_compact(void) {
|
||||
e->type = old[i].type; e->typelen = old[i].typelen;
|
||||
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;
|
||||
@ -1568,8 +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. */
|
||||
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_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;
|
||||
@ -1599,6 +1632,8 @@ void flan_dev_reg_note(void *base, int64_t bytes, int64_t elem,
|
||||
flan_reg[j].elem = 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;
|
||||
}
|
||||
@ -1625,6 +1660,31 @@ void flan_dev_reg_note(void *base, int64_t bytes, int64_t elem,
|
||||
|
||||
int flan_dev_reg_overflowed(void) { return flan_reg_full; }
|
||||
|
||||
/* (free s) on a slice, asked before the block is handed back: 0 when it may
|
||||
* 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 (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,
|
||||
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->sliced) return 4;
|
||||
if (e->owner != NULL && e->owner != owner) {
|
||||
if (found) *found = e->owner;
|
||||
return 2;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* The block containing [a], live or dead, or NULL. A linear scan, because the
|
||||
* reader is a person pressing a key and the writer is a game loop: the cost
|
||||
* belongs on this side of the table. */
|
||||
|
||||
@ -1677,6 +1677,14 @@ static int flan_over_budget(flan_allocator *a, int64_t size) {
|
||||
*/
|
||||
void flan_dev_reg_note(void *base, int64_t bytes, int64_t elem,
|
||||
const char *type, int64_t typelen);
|
||||
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,
|
||||
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
|
||||
@ -2481,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(q, len, 1, "u8", 2);
|
||||
flan_dev_reg_note_sliced(q, len, 1, "u8", 2, a);
|
||||
out->ptr = q;
|
||||
out->len = len;
|
||||
return 1;
|
||||
@ -2733,6 +2741,50 @@ int8_t flan_bytes_dup(flan_vec *v, flan_allocator *a, const uint8_t *p,
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* (free s) on a slice (bytes s) or (clone xs) made: the block goes back to
|
||||
* [a], the allocator the compiler passes — the context's, or the one named.
|
||||
* The slice carries no allocator, so a dev build checks the registry first and
|
||||
* traps on a slice that is not the start of a live block, or on a block from
|
||||
* another allocator; a release build trusts the program, as Odin's delete
|
||||
* does. An allocator that cannot free one block keeps it, as flan_vec_free
|
||||
* does: free-all is how its region is released. */
|
||||
_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 == 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);
|
||||
}
|
||||
|
||||
void flan_slice_free(const void *p, int64_t n, int64_t size, int64_t align,
|
||||
flan_allocator *a, const uint8_t *loc, int64_t loclen) {
|
||||
int32_t why;
|
||||
int64_t bytes;
|
||||
if (p == NULL || n <= 0) return;
|
||||
if (!a) flan_null_alloc_fail(loc, loclen);
|
||||
{
|
||||
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);
|
||||
}
|
||||
|
||||
int8_t flan_vec_clone(flan_vec *dst, flan_vec *src, flan_allocator *a,
|
||||
int64_t size, int64_t align, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
@ -3660,9 +3712,18 @@ 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(v->ptr, v->cap * size, size, type, typelen);
|
||||
if (v) flan_dev_reg_note_owned(v->ptr, v->cap * size, size, type, typelen,
|
||||
v->alloc);
|
||||
}
|
||||
|
||||
void flan_dev_reg_note_map(flan_map *m, int64_t ksize, int64_t vsize,
|
||||
|
||||
@ -14,13 +14,17 @@
|
||||
b (bytes s)]
|
||||
(set (at b 0) \Z)
|
||||
(println (string b)) ; ZNSERTIONSORT
|
||||
(println s)) ; INSERTIONSORT
|
||||
(println s) ; INSERTIONSORT
|
||||
;; The copy's block came from the context allocator, and free hands it
|
||||
;; back there — which is what keeps this program leak-free.
|
||||
(free b))
|
||||
|
||||
;; 2. A literal's copy is writable — the exact form that used to segfault
|
||||
;; at -O0 and silently do nothing at -O2.
|
||||
(let [b (bytes "hi")]
|
||||
(set (at b 0) \H)
|
||||
(println (string b))) ; Hi
|
||||
(println (string b)) ; Hi
|
||||
(free b))
|
||||
|
||||
;; 3. The view still costs nothing and reads the string's own storage.
|
||||
(let [v (bytes-view "abc")]
|
||||
@ -35,4 +39,10 @@
|
||||
(println (string b))) ; arenA
|
||||
(free-all frame)
|
||||
(arena-destroy frame)
|
||||
|
||||
;; 5. (clone xs) with no allocator is the context's too, and free releases
|
||||
;; it the same way.
|
||||
(let [c (clone (slice [1 2 3]))]
|
||||
(println (at c 2)) ; 3
|
||||
(free c))
|
||||
0)
|
||||
|
||||
35
test/programs/free-slice.flan
Normal file
35
test/programs/free-slice.flan
Normal file
@ -0,0 +1,35 @@
|
||||
;;;; (free s) on a slice hands its block back to the context allocator, or to
|
||||
;;;; the one named. A slice does not carry its allocator, so a dev build checks
|
||||
;;;; 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; 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)]
|
||||
(cond
|
||||
(= which 1) (let [b (bytes "arena" a)] (free b))
|
||||
(= which 2) (let [b (bytes "twice")] (free b) (free b))
|
||||
(= 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)
|
||||
d (clone (slice [1.5 2.5]) (heap-allocator))]
|
||||
(println (string b) (string c) (at d 1))
|
||||
(free b)
|
||||
(free c a)
|
||||
(free d (heap-allocator))))
|
||||
(println "done")
|
||||
(arena-destroy a))
|
||||
0)
|
||||
@ -881,7 +881,7 @@ let () =
|
||||
*by* build shape (trap at -O0, silent no-op at -O2) and the copy must
|
||||
not. *)
|
||||
let bytes_copy_out =
|
||||
"ZNSERTIONSORT\nINSERTIONSORT\nHi\n3\n99\narenA\n"
|
||||
"ZNSERTIONSORT\nINSERTIONSORT\nHi\n3\n99\narenA\n3\n"
|
||||
in
|
||||
outputs "bytes copies, bytes-view aliases" "programs/bytes-copy.flan"
|
||||
bytes_copy_out;
|
||||
@ -889,6 +889,37 @@ let () =
|
||||
"programs/bytes-copy.flan" bytes_copy_out;
|
||||
outputs ~x86:true "bytes copies, bytes-view aliases, --x86"
|
||||
"programs/bytes-copy.flan" bytes_copy_out;
|
||||
(* (free s) on a slice: through the context allocator and through a named
|
||||
one, every backend; and in a dev build, the registry's three refusals —
|
||||
another allocator's block, a block freed twice, a view no allocator
|
||||
handed out. *)
|
||||
let fs = "programs/free-slice.flan" in
|
||||
outputs "free on a slice" fs "heap arena 2.5\ndone\n";
|
||||
outputs ~opt:"-O0" "free on a slice, -O0" fs "heap arena 2.5\ndone\n";
|
||||
outputs ~x86:true "free on a slice, --x86" fs "heap arena 2.5\ndone\n";
|
||||
List.iter
|
||||
(fun (x86, tag) ->
|
||||
let exe = compile ~x86 ~dev:true fs in
|
||||
List.iter
|
||||
(fun (arg, line, want) ->
|
||||
let code, text = run exe (Some arg) in
|
||||
if code <> 134
|
||||
|| not (contains text
|
||||
(Printf.sprintf "programs/free-slice.flan:%d:" line))
|
||||
|| not (contains text want) || contains text "done"
|
||||
then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
"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", 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
|
||||
refused before anything is built, because bytes-view answers a
|
||||
[const u8]. It used to compile and trap at -O0 on both backends, and be
|
||||
|
||||
@ -2508,12 +2508,14 @@ let () =
|
||||
rejects_check "slice-from-ptr with a negative literal length"
|
||||
"(defn f [p (Ptr i32)] i32 (length (slice-from-ptr p -1)))"
|
||||
~needle:"is negative";
|
||||
(* The storage stays C's. A slice carries no allocator, so free refuses one
|
||||
by the rule it already had — this pins that the new form did not become
|
||||
a thing anybody could hand to free. *)
|
||||
(* The storage stays C's, and a view made in place is refused at free
|
||||
without running anything. *)
|
||||
rejects_check "free of a slice made from a pointer"
|
||||
"(defn f [p (Ptr i32)] () (free (slice-from-ptr p 3)))"
|
||||
~needle:"free takes an owning container";
|
||||
~needle:"is a view of storage something else owns";
|
||||
rejects_check "free of a slice written in place"
|
||||
"(defn f [v (Vec i32)] () (free (slice v)))"
|
||||
~needle:"is a view of storage something else owns";
|
||||
|
||||
(* ── Structs, fields and auto-deref ────────────────────────────── *)
|
||||
let cursor = "(defstruct Cursor [src [u8] pos i32]) " in
|
||||
|
||||
@ -842,8 +842,10 @@ is allocated. <code>(bytes-view s)</code> is the string's own storage seen as a
|
||||
<code>[const u8]</code> and costs nothing; it aliases the string, and a store through
|
||||
it is a compile error. <code>(bytes s)</code> and
|
||||
<code>(bytes s allocator)</code> make a writable copy through the allocator — never a
|
||||
hidden <code>malloc</code>, which is the rule every allocating operation follows. The
|
||||
example above wants a view and takes one.</p>
|
||||
hidden <code>malloc</code>, which is the rule every allocating operation follows.
|
||||
<code>(free b)</code> hands the copy back to the current allocator and
|
||||
<code>(free b allocator)</code> to the one named. The example above wants a view and
|
||||
takes one.</p>
|
||||
|
||||
<p>An enum is an <code>i32</code> at run time and its own type in the checker. A
|
||||
keyword at a call site resolves against the parameter's enum type at compile time, so a
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user