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

A string literal handed to a declare-c reaches C uncopied, and both backends write a NUL after every literal

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 11:32:57 +07:00
parent 8b4c6f81df
commit de8e00314b
7 changed files with 100 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
TODO.org
View File

@ -1166,12 +1166,10 @@ The module links and runs. What is not proved is a collection running while a li
instance of a dyn-holding struct sits in a frame of a body that module delivered.
For the next sweep rather than for a lane.
** NEXT A sliced string loses the trailing NUL
Decided 2026-09-25: both backends emit a NUL after every string literal, and a declare-c wrapper passes a literal argument to C without the copy it makes for any other string. A string is still pointer and length; no slice is promised a NUL. Rules out a NUL guarantee on every string.
The x86 backend emits a NUL after every string constant and the LLVM one does not,
so a =declare-c= wrapper leaning on the courtesy is already backend-dependent as
well as slice-dependent. The contract is pointer and length, and nothing promised
otherwise.
** DONE A string literal crosses to C uncopied
CLOSED: [2026-09-25]
Both backends write a NUL after every literal and a declare-c passes a literal argument
uncopied. Rules out a NUL guarantee on any other string: a slice is pointer and length.
** DONE Frame descriptions are gated on --debug
CLOSED: [2026-09-25]

24
lib/check.ml
View File

@ -2237,6 +2237,29 @@ let to_bytes ctx loc pr (x : Tast.expr) =
[ mk loc bslice
(Tast.Prim (pr, [ x; addr_of loc (mk loc bty (Tast.Local s)) ])) ]))
(* A string literal handed to a [declare-c] function goes to C without the copy
the wrapper makes of any other string. Both backends write a NUL after a
literal's bytes, so the literal is passed with its length counting that NUL,
and the wrapper hands a string whose last byte is NUL to C as it is
([Shim.cstr_helpers]). The one reader of the argument is C, which stops at
the NUL, so the longer length changes nothing it sees.
The callee is a declare-c when it binds the shim's symbol for its own name —
directly, or through the flattened [-c] declaration the shim puts under a
Flan wrapper when the signature has a struct in it. The literal passes
through that wrapper untouched, because its body only forwards it. *)
let c_literals env name (params : Types.t list) (args : Tast.expr list) =
let sym = Shim.shim_symbol name in
let bound n = Hashtbl.find_opt env.externs n = Some sym in
if not (bound name || bound (Shim.raw_name name)) then args
else
List.map2
(fun (p : Types.t) (a : Tast.expr) ->
match p, a.Tast.e with
| Types.String, Tast.Str s -> { a with Tast.e = Tast.Str (s ^ "\000") }
| _ -> a)
params args
(* ── The region requirement, emitted ───────────────────────────────────
spec-memory.md's arena rule, and the whole of what replaced the three
refusals a container of owning elements used to meet at its *type*. The
@ -9136,6 +9159,7 @@ and ordinary_call ctx ~want loc name args =
let args =
map2_lr (fun p a -> incr i; check_arg ctx name !i p a) params args
in
let args = c_literals ctx.env name params args in
expect ctx loc ~want (mk loc ret (Tast.Call (name, args)))
| None ->
if Hashtbl.mem ctx.env.datas name then

12
lib/emit.ml
View File

@ -1566,13 +1566,19 @@ let escape s =
Buffer.contents b
(* The constant itself, as the pointer and length a caller needs separately —
a bounds message crosses to C as ptr+len like any other slice. *)
a bounds message crosses to C as ptr+len like any other slice.
One byte more than the length, a NUL, which nothing reads through the
length. The x86 backend has always written it; this one writes it too, so
that a declare-c wrapper handed a literal can give C the constant itself
rather than a copy (see [Shim.cstr_helpers]) on either backend. A string
is still a pointer and a length, and no slice of one is promised a NUL. *)
let string_bytes m s =
let id = Printf.sprintf "@\".str.%d\"" m.nstr in
m.nstr <- m.nstr + 1;
Buffer.add_string m.strs
(Printf.sprintf "%s = private unnamed_addr constant [%d x i8] c\"%s\"\n"
id (String.length s) (escape s));
(Printf.sprintf "%s = private unnamed_addr constant [%d x i8] c\"%s\\00\"\n"
id (String.length s + 1) (escape s));
id, String.length s
let string_const m s =

20
lib/shim.ml
View File

@ -308,14 +308,24 @@ let header =
query needs for the same reason: C reads to the first NUL, so what crosses
would be a prefix of the string the program passed and the function would
act on a value nobody wrote. The refusal is the runtime's — the shim has no
condition channel — and it names the declare-c it came from. *)
condition channel — and it names the declare-c it came from.
The one NUL that is not refused is a last byte: a string ending in one goes
to C as it is, uncopied, and C reads exactly the bytes before it. That is
how a literal crosses without a copy — both backends write a NUL after a
literal's bytes, and the checker passes a literal argument of a declare-c
with its length counting that NUL ([Check.c_literals]). *)
let cstr_helpers =
"_Noreturn void flan_shim_nul_fail(const char *site);\n\n\
static char *flan_shim_cstr(const char *p, int64_t n, char *buf, size_t cap,\n\
\ const char *site) {\n\
\ size_t len = n <= 0 ? 0 : (size_t)n;\n\
\ char *d = buf;\n\
\ if (len != 0 && memchr(p, '\\0', len) != NULL) flan_shim_nul_fail(site);\n\
\ const char *z = len != 0 ? (const char *)memchr(p, '\\0', len) : NULL;\n\
\ if (z != NULL) {\n\
\ if (z == p + len - 1) return (char *)p; /* already a C string */\n\
\ flan_shim_nul_fail(site);\n\
\ }\n\
\ if (len + 1 > cap) {\n\
\ d = (char *)malloc(len + 1);\n\
\ if (d == NULL) { d = buf; len = cap - 1; } /* out of memory: truncate */\n\
@ -324,8 +334,8 @@ let cstr_helpers =
\ d[len] = '\\0';\n\
\ return d;\n\
}\n\n\
static void flan_shim_cstr_free(char *d, char *buf) {\n\
\ if (d != buf) free(d);\n\
static void flan_shim_cstr_free(char *d, char *buf, const char *p) {\n\
\ if (d != buf && d != p) free(d);\n\
}\n\n"
let cstr_cap = 256
@ -421,7 +431,7 @@ let c_for (s : shim) =
match k with
| Pstr ->
let a = arg_name i in
Printf.bprintf b " flan_shim_cstr_free(%s, %s_b);\n" a a
Printf.bprintf b " flan_shim_cstr_free(%s, %s_b, %s_p);\n" a a a
| _ -> ())
s.sargs;
match s.sret with

34
test/programs/shim-literal.flan Normal file
View File

@ -0,0 +1,34 @@
;;;; A string literal handed to a declare-c goes to C uncopied; any other string
;;;; is copied and terminated.
;;;;
;;;; basename is bound for the pointer it returns, which for a name with no
;;;; slash in it is the pointer it was given: the literal's own address in the
;;;; program image for the first call, and the wrapper's stack buffer for the
;;;; second, whose string is a local and gets the copy. The two are far apart
;;;; only when the literal was not copied.
;;;;
;;;; puts then shows the bytes C read: the literal, the empty literal, and a
;;;; sub-view that has no NUL after it and so must still be copied.
;;;;
;;;; c-where2 is the same question through a signature with a struct in it,
;;;; which the shim answers with a Flan wrapper over a flattened declaration:
;;;; the literal has to pass through that wrapper. It binds glibc's POSIX
;;;; basename, which answers the same pointer and ignores the extra argument.
(defstruct Ch [c i32])
(declare-c c-where [s string] i64 "basename")
(declare-c c-where2 [s string c Ch] i64 "__xpg_basename")
(declare-c c-puts [s string] i32 "puts")
(defn far? [a i64 b i64] bool
(let [d (- a b)]
(> (if (< d 0) (- 0 d) d) 1048576)))
(defn main [] i32
(let [s "hello"]
(println (far? (c-where "hello") (c-where s)))
(println (far? (c-where2 "hello" (Ch {.c 104})) (c-where2 s (Ch {.c 104}))))
(c-puts "hello")
(c-puts "")
(c-puts (string (slice (bytes-view "hello world") 0 3))))
0)

14
test/test_acceptance.ml
View File

@ -878,6 +878,16 @@ let () =
outputs "string of bytes" "programs/string-of-bytes.flan" string_of_bytes_out;
outputs ~opt:"-O0" "string of bytes, -O0" "programs/string-of-bytes.flan"
string_of_bytes_out;
(* A literal crosses a declare-c uncopied, directly and through the Flan
wrapper a struct parameter makes; a sub-view with no NUL after it is
still copied. Every backend, because each writes the literal's NUL. *)
let shim_literal_out = "true\ntrue\nhello\n\nhel\n" in
outputs "a literal crosses to C uncopied" "programs/shim-literal.flan"
shim_literal_out;
outputs ~opt:"-O0" "a literal crosses to C uncopied, -O0"
"programs/shim-literal.flan" shim_literal_out;
outputs ~x86:true "a literal crosses to C uncopied, --x86"
"programs/shim-literal.flan" shim_literal_out;
(* Two rendered numbers held at once, which is what one shared buffer in
the runtime made impossible: this printed "22 22" and could not have
@ -3849,12 +3859,12 @@ level "1"
"(declare-c open-it [path string] bool \"OpenIt\")"
[ "char a0_b[256];";
"flan_shim_cstr(a0_p, a0_n, a0_b, sizeof a0_b, \"open-it\")";
"bool r = OpenIt(a0);"; "flan_shim_cstr_free(a0, a0_b);";
"bool r = OpenIt(a0);"; "flan_shim_cstr_free(a0, a0_b, a0_p);";
" return r;\n" ];
shim_case "declare-c: two strings get two buffers"
"(declare-c both [a string b string] \"Both\")"
[ "char a0_b[256];"; "char a1_b[256];";
"flan_shim_cstr_free(a0, a0_b);"; "flan_shim_cstr_free(a1, a1_b);" ];
"flan_shim_cstr_free(a0, a0_b, a0_p);"; "flan_shim_cstr_free(a1, a1_b, a1_p);" ];
(* [declare] is untouched by any of this: its signature still IS the C
signature, which is what vendor/agent's flan_agent_start and the

4
test/test_session.ml
View File

@ -1309,7 +1309,7 @@ let () =
(* And the slot names, in the packed form the runtime splits — which is
what says the call carries *this* class's new list and not some
other module's leftovers. *)
if not (has c.Session.ir "c\"x\\0Ay\\0Az\"") then
if not (has c.Session.ir "c\"x\\0Ay\\0Az\\00\"") then
fail "the registration did not carry the new slot list"
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "adding a slot to a class was refused: %s" m);
@ -1342,7 +1342,7 @@ let () =
| c ->
if not (has c.Session.ir "call void @flan_dyn_class_def") then
fail "an unchanged class definition registered nothing";
if not (has c.Session.ir "c\"x\\0Ay\"") then
if not (has c.Session.ir "c\"x\\0Ay\\00\"") then
fail "an unchanged class registered some other slot list"
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "re-evaluating an unchanged class was refused: %s" m);