directly mmap files instead of read loop
This commit is contained in:
parent
4c2d4be9fb
commit
09a5947a27
|
@ -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))
|
|
||||||
|
|
|
@ -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 = {
|
||||||
|
|
|
@ -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")
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue