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, _, _) ->
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))

View File

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

View File

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

View File

@ -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

View File

@ -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