perf(ml): P2-3 scene batch cache — memoized GPU frame resources

platform/native/lui_d3d11/lui_d3d11.ml

@@ -174,36 +174,12 @@ let effect_source eglsl =
 
 (* {1 Instance packing} *)
 
-type pack = { data : f32_ba; spans : (int * int) array }
-
 let attribute_count = Lui_gpu.instance_floats / 4
 let instance_bytes = Lui_gpu.instance_floats * 4
 
 let attribute_offset start attr =
   start * instance_bytes + attr * 16
 
-let pack_batches batches =
-  let total =
-    List.fold_left (fun n b -> n + List.length b.Lui_gpu.instances) 0 batches
-  in
-  let data =
-    A1.create Bigarray.float32 Bigarray.c_layout
-      (total * Lui_gpu.instance_floats)
-  in
-  let spans = Array.make (List.length batches) (0, 0) in
-  let ofs = ref 0 in
-  List.iteri
-    (fun bi b ->
-      let start = !ofs / Lui_gpu.instance_floats in
-      List.iter
-        (fun inst ->
-          Lui_gpu.pack_instance inst data ~ofs:!ofs;
-          ofs := !ofs + Lui_gpu.instance_floats)
-        b.Lui_gpu.instances;
-      spans.(bi) <- (start, List.length b.Lui_gpu.instances))
-    batches;
-  { data; spans }
-
 (* {1 Textures} *)
 
 (* What a texture tracking an atlas must do to catch up. *)
@@ -234,6 +210,10 @@ type t = {
   mutable grab : int * int;
   mutable backdrop_tex : int * int;
   mutable effects : (fx * int) list;
+  (* The scene's compiled batches and packed staging; a frame whose
+     display list did not move reuses them and skips the instance
+     upload — the vertex buffer still holds what was drawn. *)
+  fc : Lui_gpu.batch_cache;
 }
 and texture =
   { mutable gen : int; mutable ver : int; mutable w : int;
@@ -376,7 +356,7 @@ let read_backdrop r (bk : backdrop) =
 (* {1 Drawing} *)
 
 let draw_batch r s pack bi (b : Lui_gpu.batch) bound program hole =
-  let start, count = pack.spans.(bi) in
+  let start, count = pack.Lui_gpu.spans.(bi) in
   let sc = clamp_scissor b.Lui_gpu.scissor ~w:s.width ~h:s.height in
   if count > 0 && not (Lui_gpu.scissor_empty sc) then (
     let want =
@@ -418,13 +398,15 @@ let render r s =
     r.frame <- r.frame + 1;
     sync_atlas r 0 r.mask s.mask_atlas;
     sync_atlas r 1 r.color s.color_atlas;
-    let batches = Lui_gpu.build s in
+    let batches, pack, rebuilt = Lui_gpu.frame r.fc s in
     fit_backdrop r batches;
     let cr, cg, cb, ca = premul s.clear 1. in
     c_begin r.ctx w h cr cg cb ca;
-    let pack = pack_batches batches in
-    if A1.dim pack.data > 0 then (
-      c_instances r.ctx pack.data;
+    if pack.Lui_gpu.floats > 0 then (
+      (* A scene the cache already compiled reuses the vertex
+         buffer's contents as uploaded — no second upload. *)
+      if rebuilt then
+        c_instances r.ctx (A1.sub pack.data 0 pack.floats);
       let bound = ref (-1) and program = ref 0 and hole = ref false in
       List.iteri (fun i b -> draw_batch r s pack i b bound program hole)
         batches);
@@ -450,7 +432,8 @@ let init hwnd ~w ~h =
         images = Hashtbl.create 16;
         grab = (0, 0);
         backdrop_tex = (0, 0);
-        effects = [] }
+        effects = [];
+        fc = Lui_gpu.batch_cache () }
 
 let init_offscreen ~w ~h = init 0n ~w ~h
 

platform/native/lui_d3d11/lui_d3d11.mli

@@ -67,15 +67,6 @@ val attribute_offset : int -> int -> int
 (** [attribute_offset index attribute] is the byte offset of [attribute]
     of instance [index]. *)
 
-type pack = {
-  data : (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t;
-  spans : (int * int) array;  (** instance (start, count) per batch *)
-}
-
-val pack_batches : Lui_gpu.batch list -> pack
-(** The instance data of [batches], packed as the vertex shader reads
-    them, plus each batch's span. *)
-
 val clamp_scissor : Lui_gpu.scissor -> w:int -> h:int -> Lui_gpu.scissor
 
 type atlas_plan = Recreate | Upload of Lui_scene.irect list | Nothing

platform/native/lui_gl/lui_gl.ml

@@ -1,6 +1,6 @@
 (* OpenGL renderer for Lui_scene display lists, through tgls: every op
    of a scene is an instanced quad drawn by the one shader
-   (Lui_gpu.shader_source) from the instances Lui_gpu.build produces;
+   (Lui_gpu.shader_source) from the instances Lui_gpu.frame compiles;
    clips are scissor rectangles, with the innermost rounded clip
    computed in the shader.
 
@@ -26,8 +26,6 @@ module A1 = Bigarray.Array1
 
 type char_ba =
   (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
-type f32_ba =
-  (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t
 
 external blit_bytes_to_ba :
   Bytes.t -> int -> char_ba -> int -> int -> unit = "lui_gl_blit_bytes_to_ba"
@@ -284,10 +282,12 @@ type t = {
   backdrop_fb : int array;
   header : string;
   mutable effects : (fx * effect_program) list;
+  (* The scene's compiled batches and packed staging; a frame whose
+     display list did not move reuses them and skips the instance
+     upload — [buf] still holds what was drawn. *)
+  fc : Lui_gpu.batch_cache;
 }
 
-type pack = { data : f32_ba; spans : (int * int) array }
-
 (* {1 Instance packing} *)
 
 let attribute_count = Lui_gpu.instance_floats / 4
@@ -296,28 +296,6 @@ let instance_bytes = Lui_gpu.instance_floats * 4
 let attribute_offset start attr =
   start * instance_bytes + attr * 16
 
-let pack_batches batches =
-  let total =
-    List.fold_left (fun n b -> n + List.length b.Lui_gpu.instances) 0 batches
-  in
-  let data =
-    A1.create Bigarray.float32 Bigarray.c_layout
-      (total * Lui_gpu.instance_floats)
-  in
-  let spans = Array.make (List.length batches) (0, 0) in
-  let ofs = ref 0 in
-  List.iteri
-    (fun bi b ->
-      let start = !ofs / Lui_gpu.instance_floats in
-      List.iter
-        (fun inst ->
-          Lui_gpu.pack_instance inst data ~ofs:!ofs;
-          ofs := !ofs + Lui_gpu.instance_floats)
-        b.Lui_gpu.instances;
-      spans.(bi) <- (start, List.length b.Lui_gpu.instances))
-    batches;
-  { data; spans }
-
 (* {1 Textures} *)
 
 let scratch = ref (A1.create Bigarray.char Bigarray.c_layout 0)
@@ -577,7 +555,8 @@ let init () =
                   backdrop_tex = [| texture (); texture () |];
                   backdrop_fb = [| 0; 0 |];
                   header;
-                  effects = [] }))))
+                  effects = [];
+                  fc = Lui_gpu.batch_cache () }))))
 
 (* {1 Backdrop passes} *)
 
@@ -710,7 +689,7 @@ let bind_state r s =
   Gl.enable Gl.scissor_test
 
 let draw_batch r s fb pack bi (b : Lui_gpu.batch) bound program hole =
-  let start, count = pack.spans.(bi) in
+  let start, count = pack.Lui_gpu.spans.(bi) in
   let sc = clamp_scissor b.Lui_gpu.scissor ~w:s.width ~h:s.height in
   if count > 0 && not (Lui_gpu.scissor_empty sc) then (
     let want =
@@ -796,7 +775,7 @@ let render r s =
     Gl.active_texture Gl.texture0;
     sync_atlas r r.mask s.mask_atlas ~internal:Gl.r8 ~format:Gl.red;
     sync_atlas r r.color s.color_atlas ~internal:Gl.rgba8 ~format:Gl.rgba;
-    let batches = Lui_gpu.build s in
+    let batches, pack, rebuilt = Lui_gpu.frame r.fc s in
     fit_backdrop r batches;
     (* The framebuffer drawn into, which the backdrop passes leave for
        their own. *)
@@ -806,17 +785,20 @@ let render r s =
     let cr, cg, cb, ca = premul s.clear 1. in
     Gl.clear_color cr cg cb ca;
     Gl.clear Gl.color_buffer_bit;
-    let pack = pack_batches batches in
-    if A1.dim pack.data > 0 then (
-      Gl.bind_buffer Gl.array_buffer r.buf;
-      Gl.buffer_data Gl.array_buffer
-        (Gl.bigarray_byte_size pack.data)
-        (Some pack.data) Gl.stream_draw;
+    if pack.Lui_gpu.floats > 0 then (
+      (* A scene the cache already compiled reuses the instance
+         buffer's contents as uploaded — no second upload. *)
+      if rebuilt then (
+        let live = A1.sub pack.data 0 pack.floats in
+        Gl.bind_buffer Gl.array_buffer r.buf;
+        Gl.buffer_data Gl.array_buffer
+          (Gl.bigarray_byte_size live) (Some live) Gl.stream_draw);
       bind_state r s;
       let bound = ref r.empty
       and program = ref r.program
       and hole = ref false in
-      List.iteri (fun bi b -> draw_batch r s fb pack bi b bound program hole)
+      List.iteri
+        (fun bi b -> draw_batch r s fb pack bi b bound program hole)
         batches;
       teardown ();
       gc_images r);

platform/native/lui_gl/lui_gl.mli

@@ -59,18 +59,6 @@ val attribute_offset : int -> int -> int
     [attr]'s first component in the instance buffer, for a batch whose
     instances start at index [start]. *)
 
-type pack = {
-  data : (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t;
-  spans : (int * int) array;
-}
-(** A frame's instances packed for one buffer upload: [data] is the
-    float32 buffer and [spans.(i)] is the (first index, count) of
-    batch [i]'s instances in it. *)
-
-val pack_batches : Lui_gpu.batch list -> pack
-(** [pack_batches batches] packs every batch's instances into one
-    float32 bigarray. *)
-
 val clamp_scissor : Lui_gpu.scissor -> w:int -> h:int -> Lui_gpu.scissor
 (** [clamp_scissor sc ~w ~h] is [sc] clamped to the frame's pixels. *)
 

platform/native/lui_gl/test/lui_gl_test.ml

@@ -48,7 +48,7 @@ let test_pack_batches () =
   let s = make_scene ~w:64 ~h:64 in
   s.ops <- [ fill_op () ];
   let batches = Lui_gpu.build s in
-  let pack = Lui_gl.pack_batches batches in
+  let pack = Lui_gpu.pack_batches batches in
   Alcotest.(check int) "one batch" 1 (List.length batches);
   Alcotest.(check int) "one instance" 60
     (Bigarray.Array1.dim pack.data);
@@ -76,7 +76,7 @@ let test_pack_spans () =
       Lui_scene.Pop_clip;
       fill_op ~x:40. ~y:40. ~w:8. ~h:8. () ];
   let batches = Lui_gpu.build s in
-  let pack = Lui_gl.pack_batches batches in
+  let pack = Lui_gpu.pack_batches batches in
   Alcotest.(check int) "batches" 3 (List.length batches);
   Alcotest.(check int) "spans" 3 (Array.length pack.spans);
   Alcotest.(check (pair int int)) "span 0" (0, 1) pack.spans.(0);

platform/native/lui_gpu/lui_gpu.ml

@@ -559,4 +559,113 @@ let to_float32_array (i : instance) : float array =
   pack_instance i b ~ofs:0;
   Array.init instance_floats (fun j -> Bigarray.Array1.get b j)
 
+(* {1 Scene batch cache}
+
+   A renderer compiles a scene to a batch list and a packed instance
+   buffer every frame, even when the display list did not move — the
+   retained paint pass already reports that: an unchanged scene keeps
+   its revision. The cache memoizes both artifacts under a key of what
+   [build] folds into instances, so a clean frame reuses the batch
+   structure, the CPU staging buffer and the GPU-side contents it was
+   uploaded to — renderers skip the re-upload on a hit. *)
+
+type f32_ba =
+  (float, Bigarray.float32_elt, Bigarray.c_layout) Bigarray.Array1.t
+
+(* The buffer a renderer uploads: [data] is the grow-only staging,
+   [floats] the live prefix, [spans] each batch's (first, count) in
+   instances. *)
+type pack = { data : f32_ba; floats : int; spans : (int * int) array }
+
+(* The inputs [build] folds into instances besides the display list:
+   the revision identifying it, [wide] selecting the gamut, the frame
+   size (the root scissor), the text coverage params, and the atlas
+   dimensions glyph UVs divide by. A change to any recompiles. *)
+type key =
+  int * bool * int * int * text_params * (int * int) * (int * int)
+
+type batch_cache = {
+  mutable c_scene : t option;
+  mutable c_key : key option;
+  mutable c_batches : batch list;
+  mutable c_pack : pack;
+  mutable c_rebuilds : int;
+  mutable c_reuses : int;
+}
+
+let batch_cache () =
+  { c_scene = None; c_key = None; c_batches = [];
+    c_pack =
+      { data = Bigarray.(Array1.create float32 c_layout 0);
+        floats = 0; spans = [||] };
+    c_rebuilds = 0; c_reuses = 0 }
+
+let stat_rebuilds c = c.c_rebuilds
+let stat_reuses c = c.c_reuses
+
+(* Snapshot the key; the text params are copied so a later in-place
+   edit cannot mutate the stored key along with them. *)
+let key_of ~wide (s : t) : key =
+  ( s.rev, wide, s.width, s.height,
+    { gamma_ratios = s.text.gamma_ratios;
+      contrast = s.text.contrast;
+      subpixel_contrast = s.text.subpixel_contrast },
+    (s.mask_atlas.w, s.mask_atlas.h),
+    (s.color_atlas.w, s.color_atlas.h) )
+
+let pack_into (batches : batch list) (data : f32_ba) =
+  let spans = Array.make (List.length batches) (0, 0) in
+  let ofs = ref 0 in
+  List.iteri
+    (fun bi b ->
+      let start = !ofs / instance_floats in
+      List.iter
+        (fun inst ->
+          pack_instance inst data ~ofs:!ofs;
+          ofs := !ofs + instance_floats)
+        b.instances;
+      spans.(bi) <- (start, List.length b.instances))
+    batches;
+  spans
+
+(* The one-shot packer: an exact-size buffer, for callers without a
+   cache to grow into (tests). *)
+let pack_batches (batches : batch list) : pack =
+  let total =
+    List.fold_left (fun n b -> n + List.length b.instances) 0 batches
+  in
+  let floats = total * instance_floats in
+  let data = Bigarray.(Array1.create float32 c_layout floats) in
+  { data; floats; spans = pack_into batches data }
+
+let rebuild c ~wide s =
+  let batches = build ~wide s in
+  let total =
+    List.fold_left (fun n b -> n + List.length b.instances) 0 batches
+  in
+  let floats = total * instance_floats in
+  let data =
+    if Bigarray.Array1.dim c.c_pack.data >= floats then c.c_pack.data
+    else
+      Bigarray.(Array1.create float32 c_layout (floats + floats / 2))
+  in
+  let spans = pack_into batches data in
+  c.c_scene <- Some s;
+  c.c_key <- Some (key_of ~wide s);
+  c.c_batches <- batches;
+  c.c_pack <- { data; floats; spans };
+  c.c_rebuilds <- c.c_rebuilds + 1
+
+(* The scene's compiled batches and packed buffer, rebuilt only when
+   the key moved; [rebuilt] tells the renderer whether the GPU-side
+   buffer contents are stale. *)
+let frame ?(wide = false) c (s : t) : batch list * pack * bool =
+  match (c.c_scene, c.c_key) with
+  | Some sc, Some k when sc == s && k = key_of ~wide s ->
+    c.c_reuses <- c.c_reuses + 1;
+    (c.c_batches, c.c_pack, false)
+  | _ ->
+    rebuild c ~wide s;
+    (c.c_batches, c.c_pack, true)
+
 let shader_source = Shader_source.source