directly mmap files instead of read loop

This commit is contained in:
tali 2024-01-20 13:36:29 -05:00
parent 4c2d4be9fb
commit 09a5947a27
5 changed files with 28 additions and 22 deletions

View File

@ -8,23 +8,26 @@ let absolute_path path =
with Unix.Unix_error (ENOENT, _, _) -> with Unix.Unix_error (ENOENT, _, _) ->
raise (Error (path, "not found")) raise (Error (path, "not found"))
let load_file path = let load_file path of_bigstring =
trace (fun m -> m "open text file %S" path); trace (fun m -> m "reading file %S" path);
let fd = Unix.openfile (absolute_path path) [O_RDONLY] 0 in let fd = Unix.openfile (absolute_path path) [O_RDONLY] 0 in
let len = (Unix.fstat fd).st_size in try
let buf = Bytes.create len in let mmap = Unix.map_file fd Char C_layout false [|-1|] in
trace (fun m -> m "length=%d" len); let res = of_bigstring (array1_of_genarray mmap) in
let rec read i = Unix.close fd; res
match Unix.read fd buf i (len - i) with with exn ->
| 0 -> Unix.close fd; i Unix.close fd; raise exn
| n -> read (i + n)
in let string_of_bigarray ba =
Bytes.sub_string buf 0 (read 0) 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 = let load_sexp_conv path of_sexp =
try try of_sexp (load_file path Sexp.of_bigstring)
load_file path with Failure msg | Sexp_conv.Of_sexp_error (Failure msg, _) ->
|> Sexplib.Sexp.of_string raise (Error (path, msg))
|> of_sexp
with Sexplib.Conv.Of_sexp_error (Failure msg, _) ->
raise (Error (path, "parse error: " ^ msg))

View File

@ -1,6 +1,4 @@
open! Import open! Import
module Sexp = Sexplib.Sexp
module Sexp_conv = Sexplib.Conv
include (val Ohlog.sublogs logger "Font") include (val Ohlog.sublogs logger "Font")
type glyph = { type glyph = {

View File

@ -1,4 +1,6 @@
include Adam include Adam
include Bigarray include Bigarray
module Sexp = Sexplib.Sexp
module Sexp_conv = Sexplib.Conv
include (val Ohlog.logs "S2") include (val Ohlog.logs "S2")

View File

@ -110,8 +110,8 @@ let compile_shader ~vert ~frag =
let load_shader ~name = let load_shader ~name =
let shd = let shd =
compile_shader compile_shader
~vert:(Printf.ksprintf Asset.load_file "shaders/%s.vert" name) ~vert:(Printf.ksprintf Asset.load_string "shaders/%s.vert" name)
~frag:(Printf.ksprintf Asset.load_file "shaders/%s.frag" name) ~frag:(Printf.ksprintf Asset.load_string "shaders/%s.frag" name)
in in
debug (fun m -> m "loaded shader %S" name); shd debug (fun m -> m "loaded shader %S" name); shd

View File

@ -41,10 +41,13 @@ end
module Asset : sig module Asset : sig
open Sexplib open Sexplib
open Bigarray
type bigstring := (char, int8_unsigned_elt, c_layout) Array1.t
exception Error of string * string 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_sexp_conv : string -> (Sexp.t -> 'a) -> 'a
val load_sprite_map : ?dpi:int -> string -> Sprite.map val load_sprite_map : ?dpi:int -> string -> Sprite.map
val load_font : string -> Font.t val load_font : string -> Font.t