From de8e00314b176f3f9ea425c9a9173728e881c242 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 11:32:57 +0700 Subject: [PATCH] A string literal handed to a declare-c reaches C uncopied, and both backends write a NUL after every literal --- TODO.org | 10 ++++------ lib/check.ml | 24 +++++++++++++++++++++++ lib/emit.ml | 12 +++++++++--- lib/shim.ml | 20 ++++++++++++++----- test/programs/shim-literal.flan | 34 +++++++++++++++++++++++++++++++++ test/test_acceptance.ml | 14 ++++++++++++-- test/test_session.ml | 4 ++-- 7 files changed, 100 insertions(+), 18 deletions(-) create mode 100644 test/programs/shim-literal.flan diff --git a/TODO.org b/TODO.org index 081c65c5..e46e02ac 100644 --- a/TODO.org +++ b/TODO.org @@ -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] diff --git a/lib/check.ml b/lib/check.ml index e5106991..569f9221 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -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 diff --git a/lib/emit.ml b/lib/emit.ml index 800e4a71..18f1a15f 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -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 = diff --git a/lib/shim.ml b/lib/shim.ml index 47d1fd4e..b99e00a3 100644 --- a/lib/shim.ml +++ b/lib/shim.ml @@ -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 diff --git a/test/programs/shim-literal.flan b/test/programs/shim-literal.flan new file mode 100644 index 00000000..8c9a3ac7 --- /dev/null +++ b/test/programs/shim-literal.flan @@ -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) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 6ced8956..9c4a4397 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -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 diff --git a/test/test_session.ml b/test/test_session.ml index 78a3936d..97207544 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -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);