From 09a5947a27b290a8d9d1fca4a47a1365ef1b5658 Mon Sep 17 00:00:00 2001
From: tali <iitalics@gmail.com>
Date: Sat, 20 Jan 2024 13:36:29 -0500
Subject: [PATCH] directly mmap files instead of read loop

---
 src/s2/asset.ml    | 37 ++++++++++++++++++++-----------------
 src/s2/font.ml     |  2 --
 src/s2/import.ml   |  2 ++
 src/s2/renderer.ml |  4 ++--
 src/s2/s2.mli      |  5 ++++-
 5 files changed, 28 insertions(+), 22 deletions(-)

diff --git a/src/s2/asset.ml b/src/s2/asset.ml
index 4519d76..f0e3797 100644
--- a/src/s2/asset.ml
+++ b/src/s2/asset.ml
@@ -8,23 +8,26 @@ let absolute_path path =
   with Unix.Unix_error (ENOENT, _, _) ->
     raise (Error (path, "not found"))
 
-let load_file path =
-  trace (fun m -> m "open text file %S" path);
+let load_file path of_bigstring =
+  trace (fun m -> m "reading file %S" path);
   let fd = Unix.openfile (absolute_path path) [O_RDONLY] 0 in
-  let len = (Unix.fstat fd).st_size in
-  let buf = Bytes.create len in
-  trace (fun m -> m "length=%d" len);
-  let rec read i =
-    match Unix.read fd buf i (len - i) with
-    | 0 -> Unix.close fd; i
-    | n -> read (i + n)
-  in
-  Bytes.sub_string buf 0 (read 0)
+  try
+    let mmap = Unix.map_file fd Char C_layout false [|-1|] in
+    let res = of_bigstring (array1_of_genarray mmap) in
+    Unix.close fd; res
+  with exn ->
+    Unix.close fd; raise exn
+
+let string_of_bigarray ba =
+  let len = Array1.dim ba in
+  let str = Bytes.create len in
+  for i = 0 to len - 1 do Bytes.unsafe_set str i ba.{i} done;
+  Bytes.unsafe_to_string str
+
+let load_string path =
+  load_file path string_of_bigarray
 
 let load_sexp_conv path of_sexp =
-  try
-    load_file path
-    |> Sexplib.Sexp.of_string
-    |> of_sexp
-  with Sexplib.Conv.Of_sexp_error (Failure msg, _) ->
-    raise (Error (path, "parse error: " ^ msg))
+  try of_sexp (load_file path Sexp.of_bigstring)
+  with Failure msg | Sexp_conv.Of_sexp_error (Failure msg, _) ->
+    raise (Error (path, msg))
diff --git a/src/s2/font.ml b/src/s2/font.ml
index 4dd15ea..5997cb3 100644
--- a/src/s2/font.ml
+++ b/src/s2/font.ml
@@ -1,6 +1,4 @@
 open! Import
-module Sexp = Sexplib.Sexp
-module Sexp_conv = Sexplib.Conv
 include (val Ohlog.sublogs logger "Font")
 
 type glyph = {
diff --git a/src/s2/import.ml b/src/s2/import.ml
index 1c22a32..aed6d5b 100644
--- a/src/s2/import.ml
+++ b/src/s2/import.ml
@@ -1,4 +1,6 @@
 include Adam
 include Bigarray
+module Sexp = Sexplib.Sexp
+module Sexp_conv = Sexplib.Conv
 
 include (val Ohlog.logs "S2")
diff --git a/src/s2/renderer.ml b/src/s2/renderer.ml
index 13e9e67..c088830 100644
--- a/src/s2/renderer.ml
+++ b/src/s2/renderer.ml
@@ -110,8 +110,8 @@ let compile_shader ~vert ~frag =
 let load_shader ~name =
   let shd =
     compile_shader
-      ~vert:(Printf.ksprintf Asset.load_file "shaders/%s.vert" name)
-      ~frag:(Printf.ksprintf Asset.load_file "shaders/%s.frag" name)
+      ~vert:(Printf.ksprintf Asset.load_string "shaders/%s.vert" name)
+      ~frag:(Printf.ksprintf Asset.load_string "shaders/%s.frag" name)
   in
   debug (fun m -> m "loaded shader %S" name); shd
 
diff --git a/src/s2/s2.mli b/src/s2/s2.mli
index 5f84887..c00e632 100644
--- a/src/s2/s2.mli
+++ b/src/s2/s2.mli
@@ -41,10 +41,13 @@ end
 
 module Asset : sig
   open Sexplib
+  open Bigarray
+  type bigstring := (char, int8_unsigned_elt, c_layout) Array1.t
 
   exception Error of string * string
 
-  val load_file : string -> string
+  val load_string : string -> string
+  val load_file : string -> (bigstring -> 'a) -> 'a
   val load_sexp_conv : string -> (Sexp.t -> 'a) -> 'a
   val load_sprite_map : ?dpi:int -> string -> Sprite.map
   val load_font : string -> Font.t