A --sanitize flag, and the attribute without which it measures nothing

ASan is an LLVM pass but instruments only functions carrying
sanitize_address, which clang's C frontend adds and nothing adds to IR
written by hand. Passing -fsanitize=address to the clang run over the
.ll therefore instruments flan_rt.c and not one instruction of Flan: an
out-of-bounds read of a defvar array, built --no-bounds-checks, printed
its garbage and exited 0. With Emit naming an attribute group on every
define, the same program reports global-buffer-overflow in flan.main.

UBSan has no such lever. Its checks are branches the C frontend emits to
__ubsan_handle_*, not a pass, so -fsanitize=undefined covers the runtime
and nothing else; (<< 1 32) still goes unremarked. Recorded where it
will be read rather than discovered again.

The flag does not force -O0 the way --debug does -- the UB worth finding
is what the optimiser does with it -- and it does pull in -g, since a
report with no line costs more than the build. compile_c's cache key now
digests the same cflags list the command line uses, because an
unsanitized flan_rt.o served out of the cache links fine and reports
nothing.

bin/main.ml

@@ -72,7 +72,14 @@ let dev_flag = "--dev"
    stop it and read it". See [Build.opts]. *)
 let debug_flag = "--debug"
 
-let flags = [ no_checks_flag; dev_flag; debug_flag ]
+(* ASan and UBSan over the whole program, the runtime's C and the Flan alike.
+   Its own flag for the same reason --debug is: it answers "is this program
+   touching memory it does not own", which is neither of the other two
+   questions. It does not imply -O0 — see [Build.opts], which also records
+   what each of the two sanitizers actually reaches. *)
+let sanitize_flag = "--sanitize"
+
+let flags = [ no_checks_flag; dev_flag; debug_flag; sanitize_flag ]
 
 (* [--target=wasm32-wasi], the one cross target. Unlike the flags above it
    carries a value, so it is matched by prefix and stripped from the residual
@@ -153,6 +160,10 @@ let () =
     let checks = not (List.mem no_checks_flag args) in
     let dev = List.mem dev_flag args in
     let debug = List.mem debug_flag args in
+    (* --sanitize changes the IR — every [define] names the attribute group
+       ASan's pass selects on — so [emit] has to honour it or what this prints
+       is not what a sanitized build compiles. *)
+    let sanitize = List.mem sanitize_flag args in
     let files = List.filter (fun a -> not (is_flag a)) args in
     List.iter
       (fun path ->
@@ -160,13 +171,14 @@ let () =
            let l = load path in
            let pnames = if debug then param_names l else [] in
            Flan.Check.program l.decls
-           |> Flan.Emit.program ~checks ~dev ~debug ~pnames
+           |> Flan.Emit.program ~checks ~dev ~debug ~pnames ~sanitize
            |> print_string))
       files
   | _ :: "build" :: path :: rest ->
     let checks = not (List.mem no_checks_flag rest) in
     let dev = List.mem dev_flag rest in
     let debug = List.mem debug_flag rest in
+    let sanitize = List.mem sanitize_flag rest in
     let target = target_of rest in
     let out =
       match List.filter (fun a -> not (is_flag a)) rest with
@@ -181,7 +193,7 @@ let () =
       | _ ->
         prerr_endline
           "usage: flan build <file.flan> [-o out] [--no-bounds-checks] \
-           [--dev] [--debug] [--target=wasm32-wasi]";
+           [--dev] [--debug] [--sanitize] [--target=wasm32-wasi]";
         exit 2
     in
     with_errors path (fun () ->
@@ -193,7 +205,8 @@ let () =
          raylib and still be buildable for wasm32. *)
       let p, csrcs, lflags = Flan.Reach.link ~dev l p in
       ignore (Flan.Build.executable
-                ~opts:{ Flan.Build.default with checks; dev; debug; target }
+                ~opts:{ Flan.Build.default with checks; dev; debug; sanitize;
+                                                target }
                 ~csrcs ~lflags ~pnames:(if debug then param_names l else [])
                 p ~out))
   (* The daemon an editor talks to: one session, the program it belongs to
@@ -272,7 +285,7 @@ let () =
     prerr_endline
       "usage: flan (read|parse|check|emit|shim) <file.flan>...\n\
       \       flan build <file.flan> [-o out] [--no-bounds-checks] [--dev] \
-       [--debug] [--target=wasm32-wasi]\n\
+       [--debug] [--sanitize] [--target=wasm32-wasi]\n\
       \       flan run <file.flan> [args...]\n\
       \       flan reload <program.flan> <forms.flan> [-o out.so]\n\
       \       flan dev <program.flan> [-s socket]";

lib/build.ml

@@ -72,6 +72,28 @@ type opts = {
      mechanism is a [llvm.dbg.declare] on an alloca and mem2reg deletes the
      alloca. *)
   debug : bool;
+  (* AddressSanitizer and UndefinedBehaviorSanitizer over the whole program:
+     the runtime's C, the generated shim, and — via [Emit]'s
+     [sanitize_address] attribute — the Flan code itself.
+
+     Its own axis and not a mode of [debug]. It deliberately does *not* force
+     -O0: the UB worth finding (a shift past the width folding to nothing, a
+     float cast that only traps once it is a real cvttss2si) is what the
+     optimiser does with it, so the sweep is worth running at -O2 and at -O0
+     and any divergence between the two is itself the finding. It does pull in
+     -g, because a report without a line number costs more to read than the
+     build costs to make.
+
+     What reaches what, measured rather than assumed:
+       - ASan instruments Flan functions only because [Emit] attributes them;
+         globals get their redzone from the module pass either way.
+       - UBSan instruments the C only. Its checks come out of clang's C
+         frontend, and there is no attribute that asks a pass for them, so
+         hand-written IR gets none. See [Emit]'s [sanitize] comment.
+       - signed-integer-overflow is excluded because wrapping is what this
+         language's arithmetic means; without the exclusion every program
+         trips on its first [+]. Nothing else is excluded. *)
+  sanitize : bool;
 }
 
 (* Checks are deliberately independent of [opt]: the acceptance table runs the
@@ -80,7 +102,24 @@ type opts = {
    checks. Dropping them is a release decision, not an optimisation one. *)
 let default =
   { target = None; opt = "-O2"; keep = false; checks = true; dev = false;
-    debug = false }
+    debug = false; sanitize = false }
+
+(* The flags that are neither [opt] nor the target, spelled once so that the
+   compile command and the object-cache key cannot disagree. They did before:
+   -g was written out at the command and again at the key, and a flag that
+   appears in one and not the other is the silent failure — an unsanitized
+   [flan_rt.o] served out of the cache to a sanitized build links fine and
+   reports nothing. *)
+let cflags opts =
+  (if opts.debug then [ "-g" ] else [])
+  @ (if opts.sanitize then
+       (* -g here and not via [debug]: a sanitizer report with no file and no
+          line is most of the work still to do. *)
+       [ "-fsanitize=address,undefined";
+         "-fno-sanitize=signed-integer-overflow";
+         "-fno-omit-frame-pointer" ]
+       @ (if opts.debug then [] else [ "-g" ])
+     else [])
 
 (* ── wasm32, which needs more than a triple ──────────────────────────
    The native target is whatever clang was built for, so [--target=] alone is
@@ -278,7 +317,7 @@ let compile_c ~opts ?tflags ~src ~name () =
       (Digest.string
          (String.concat "\000"
             [ name; src; Lazy.force clang_stamp; opts.opt;
-              (if opts.debug then "-g" else "");
+              String.concat " " (cflags opts);
               String.concat " " tflags ]))
   in
   let obj = Filename.concat (cachedir ()) (key ^ ".o") in
@@ -292,7 +331,7 @@ let compile_c ~opts ?tflags ~src ~name () =
     let cmd =
       String.concat " "
         ([ Filename.quote clang; opts.opt ]
-         @ (if opts.debug then [ "-g" ] else [])
+         @ cflags opts
          @ [ "-c" ] @ tflags
          @ [ Filename.quote c; "-o"; Filename.quote tmp ])
     in
@@ -327,14 +366,23 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = [])
       "wasm32: --debug is native only — the DWARF member offsets are computed \
        for the host's layout, and wasm32's 32-bit pointer moves every one of \
        them";
+  (* There is no wasm32 sanitizer runtime to link against: clang accepts
+     -fsanitize=address for the triple and the link fails on
+     __asan_report_load4. Refused by name rather than met at the linker. *)
+  if wasm_target opts && opts.sanitize then
+    failwith
+      "wasm32: --sanitize is native only — there is no libclang_rt.asan for \
+       wasm32-wasi to link against";
   (* -O0 is not a choice a debug build offers: [llvm.dbg.declare] describes an
-     alloca, and at -O2 mem2reg deletes the alloca. *)
+     alloca, and at -O2 mem2reg deletes the alloca. [sanitize] deliberately
+     does not do this: see [opts]. *)
   let opts = if opts.debug then { opts with opt = "-O0" } else opts in
   let tflags = target_flags opts in
   let dir = workdir () in
   let ll = Filename.concat dir (Filename.basename out ^ ".ll") in
   write ll
-    (Emit.program ~checks:opts.checks ~dev:opts.dev ~debug:opts.debug ~pnames p);
+    (Emit.program ~checks:opts.checks ~dev:opts.dev ~debug:opts.debug ~pnames
+       ~sanitize:opts.sanitize p);
   (* [flan_dev.c] is compiled into every build, not only a dev one. Nothing in
      a release build calls into it — the compiler only emits a registry lookup
      for a name the host was not built with, which cannot arise without cells —
@@ -368,8 +416,12 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = [])
     String.concat " "
       ([ Filename.quote clang; opts.opt; "-Wno-override-module" ]
        (* -g at the link so clang does not strip, and keeps the object files'
-          debug sections; the .ll carries its own. *)
+          debug sections; the .ll carries its own. The sanitizer flags have to
-       @ (if opts.debug then [ "-g" ] else [])
+          be here too — they are what pulls in libclang_rt.asan and the UBSan
+          runtime, and they are also what makes clang run the ASan pass over
+          the .ll, which is the only place the Flan half of the program gets
+          instrumented at all. *)
+       @ cflags opts
        @ (if opts.dev then [ "-rdynamic" ] else [])
        @ tflags
        @ [ Filename.quote ll ]

lib/emit.ml

@@ -193,9 +193,26 @@ type m = {
      down because every emitter that can produce an instruction has to be able
      to hang a location on it. *)
   dbg     : dbg option;
+  (* True in a sanitized build, and the whole of what ASan needs from us.
+     AddressSanitizer is an LLVM *pass*, but it instruments only functions
+     carrying the [sanitize_address] attribute — which clang's C frontend adds
+     and nothing adds to IR written by hand. Passing -fsanitize=address to the
+     clang run over this .ll therefore instruments the runtime's C and not one
+     instruction of Flan; measured, not assumed (see NEXT.md). So every
+     [define] here names attribute group #0 and [finish] writes it out.
+
+     There is no equivalent for UndefinedBehaviorSanitizer: its checks are
+     emitted by the C frontend as branches to __ubsan_handle_*, and no
+     attribute asks a pass to produce them. UBSan over this .ll covers the C
+     and nothing else. *)
+  sanitize : bool;
   mutable nstr : int;
 }
 
+(* The attribute group every emitted function names, empty unless sanitizing.
+   Spelled once so the [define] sites and [finish] cannot disagree. *)
+let attrs m = if m.sanitize then " #0" else ""
+
 let field_ty m sn i =
   let s = Hashtbl.find m.structs sn in
   (List.nth s.Tast.fields i).Tast.fty
@@ -1472,8 +1489,8 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) =
     end
   end;
   Buffer.add_string m.out
-    (Printf.sprintf "\ndefine %s%s%s {\nentry:\n%s%s}\n"
+    (Printf.sprintf "\ndefine %s%s%s%s {\nentry:\n%s%s}\n"
-       (if hidden then "hidden " else "") (signature ~named:true fn)
+       (if hidden then "hidden " else "") (signature ~named:true fn) (attrs m)
        (match dsub with None -> "" | Some n -> Printf.sprintf " !dbg !%d" n)
        (Buffer.contents f.allocas) (Buffer.contents f.b))
 
@@ -1557,7 +1574,9 @@ declare void @flan_slice_fail(ptr, i64, i64, i64, i64) noreturn cold
    the i32 status are each optional (plan.org, Milestone-2 primitives). *)
 let emit_main m (fn : Tast.fn) =
   let b = Buffer.create 256 in
-  Buffer.add_string b "\ndefine i32 @main(i32 %argc, ptr %argv) {\nentry:\n";
+  Buffer.add_string b
+    (Printf.sprintf "\ndefine i32 @main(i32 %%argc, ptr %%argv)%s {\nentry:\n"
+       (attrs m));
   Buffer.add_string b "  call void @flan_rt_init(i32 %argc, ptr %argv)\n";
   (* The program's own end of the transfer channel. Nothing can be transferring
      when [main] returns: a restart is found by name on the restart stack, and
@@ -1616,12 +1635,13 @@ let new_dbg (p : Tast.program) =
        file);
   d
 
-let new_module ~checks ~dev ~known ?(debug = false) (p : Tast.program) =
+let new_module ~checks ~dev ~known ?(debug = false) ?(sanitize = false)
+      (p : Tast.program) =
   let m = {
     out = Buffer.create 8192; strs = Buffer.create 512;
     structs = Hashtbl.create 16; globals = Hashtbl.create 16;
     externs = Hashtbl.create 32;
-    checks; dev; known; nstr = 0;
+    checks; dev; known; nstr = 0; sanitize;
     dbg = (if debug then Some (new_dbg p) else None);
   } in
   List.iter (fun (s : Tast.structure) -> Hashtbl.replace m.structs s.Tast.sname s)
@@ -1676,13 +1696,14 @@ let dmodule d =
 
 let finish m =
   header ^ Buffer.contents m.strs ^ "\n" ^ Buffer.contents m.out
+  ^ (if m.sanitize then "\nattributes #0 = { sanitize_address }\n" else "")
   ^ (match m.dbg with None -> "" | Some d -> dmodule d)
 
 (* [checks] is on by default: a dev build traps on an out-of-bounds [at] or
    [slice], a release build is told to drop them. *)
 let program ?(checks = true) ?(dev = false) ?(debug = false) ?(pnames = [])
-      (p : Tast.program) : string =
+      ?(sanitize = false) (p : Tast.program) : string =
-  let m = new_module ~checks ~dev ~known:(fun _ -> true) ~debug p in
+  let m = new_module ~checks ~dev ~known:(fun _ -> true) ~debug ~sanitize p in
   (* One cell per function, initialised to the function this build compiled.
      Nothing has been redefined yet, so a dev build starts out behaving exactly
      like a release one — the indirection is the only difference. *)