SHARE
TWEET

Untitled

a guest Feb 16th, 2019 80 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. From 61b1018760dd54b9a7f5c80ac7afb7fc6cf26258 Mon Sep 17 00:00:00 2001
  2. From: Jeremie Dimino <jdimino@janestreet.com>
  3. Date: Mon, 15 Jul 2013 11:55:07 +0100
  4. Subject: [PATCH 2/2] lazy initialization of dynlinked plugins
  5.  
  6. ---
  7.  otherlibs/dynlink/dynlink.ml    |   60 ++++++++++++++++++++++----------------
  8.  otherlibs/dynlink/dynlink.mli   |    6 ++++
  9.  otherlibs/dynlink/natdynlink.ml |   32 +++++++++++++--------
  10.  3 files changed, 61 insertions(+), 37 deletions(-)
  11.  
  12. diff --git a/otherlibs/dynlink/dynlink.ml b/otherlibs/dynlink/dynlink.ml
  13. index 89e21aa..45e1b26 100644
  14. --- a/otherlibs/dynlink/dynlink.ml
  15. +++ b/otherlibs/dynlink/dynlink.ml
  16. @@ -224,13 +224,14 @@ let load_compunit ic file_name file_digest compunit =
  17.    let digest = Digest.string (file_digest ^ compunit.cu_name) in
  18.    register_code_fragment code code_size digest;
  19.    begin try
  20. -    ignore((Meta.reify_bytecode code code_size) ())
  21. +    let f = Meta.reify_bytecode code code_size in
  22. +    fun () -> ignore (f ())
  23.    with exn ->
  24.      Symtable.restore_state initial_symtable;
  25.      raise exn
  26.    end
  27.  
  28. -let loadfile file_name =
  29. +let loadfile_lazy file_name =
  30.    init();
  31.    if not (Sys.file_exists file_name) then raise(Error (File_not_found file_name));
  32.    let ic = open_in_bin file_name in
  33. @@ -241,42 +242,51 @@ let loadfile file_name =
  34.        try Misc.input_bytes ic (String.length Config.cmo_magic_number)
  35.        with End_of_file -> raise (Error (Not_a_bytecode_file file_name))
  36.      in
  37. -    if buffer = Config.cmo_magic_number then begin
  38. -      let compunit_pos = input_binary_int ic in  (* Go to descriptor *)
  39. -      seek_in ic compunit_pos;
  40. -      let cu = (input_value ic : compilation_unit) in
  41. -      load_compunit ic file_name file_digest cu
  42. -    end else
  43. -    if buffer = Config.cma_magic_number then begin
  44. -      let toc_pos = input_binary_int ic in  (* Go to table of contents *)
  45. -      seek_in ic toc_pos;
  46. -      let lib = (input_value ic : library) in
  47. -      begin try
  48. -        Dll.open_dlls Dll.For_execution
  49. -                      (List.map Dll.extract_dll_name lib.lib_dllibs)
  50. -      with Failure reason ->
  51. -        raise(Error(Cannot_open_dll reason))
  52. -      end;
  53. -      List.iter (load_compunit ic file_name file_digest) lib.lib_units
  54. -    end else
  55. -      raise(Error(Not_a_bytecode_file file_name));
  56. -    close_in ic
  57. +    let run =
  58. +      if buffer = Config.cmo_magic_number then begin
  59. +        let compunit_pos = input_binary_int ic in  (* Go to descriptor *)
  60. +        seek_in ic compunit_pos;
  61. +        let cu = (input_value ic : compilation_unit) in
  62. +        let f = load_compunit ic file_name file_digest cu in
  63. +        Lazy.lazy_from_fun f
  64. +      end else
  65. +      if buffer = Config.cma_magic_number then begin
  66. +        let toc_pos = input_binary_int ic in  (* Go to table of contents *)
  67. +        seek_in ic toc_pos;
  68. +        let lib = (input_value ic : library) in
  69. +        begin try
  70. +          Dll.open_dlls Dll.For_execution
  71. +                        (List.map Dll.extract_dll_name lib.lib_dllibs)
  72. +        with Failure reason ->
  73. +          raise(Error(Cannot_open_dll reason))
  74. +        end;
  75. +        let l = List.map (load_compunit ic file_name file_digest) lib.lib_units in
  76. +        lazy (List.iter (fun f -> f ()) l)
  77. +      end else
  78. +        raise(Error(Not_a_bytecode_file file_name));
  79. +    in
  80. +    close_in ic;
  81. +    run
  82.    with exc ->
  83.      close_in ic; raise exc
  84.  
  85. -let loadfile_private file_name =
  86. +let loadfile_private_lazy file_name =
  87.    init();
  88.    let initial_symtable = Symtable.current_state()
  89.    and initial_crc = !crc_interfaces in
  90.    try
  91. -    loadfile file_name;
  92. +    let run = loadfile_lazy file_name in
  93.      Symtable.hide_additions initial_symtable;
  94. -    crc_interfaces := initial_crc
  95. +    crc_interfaces := initial_crc;
  96. +    run
  97.    with exn ->
  98.      Symtable.hide_additions initial_symtable;
  99.      crc_interfaces := initial_crc;
  100.      raise exn
  101.  
  102. +let loadfile filename = Lazy.force (loadfile_lazy filename)
  103. +let loadfile_private filename = Lazy.force (loadfile_private_lazy filename)
  104. +
  105.  (* Error report *)
  106.  
  107.  let error_message = function
  108. diff --git a/otherlibs/dynlink/dynlink.mli b/otherlibs/dynlink/dynlink.mli
  109. index 4ced876..1a26b51 100644
  110. --- a/otherlibs/dynlink/dynlink.mli
  111. +++ b/otherlibs/dynlink/dynlink.mli
  112. @@ -36,6 +36,12 @@ val loadfile_private : string -> unit
  113.      are hidden (cannot be referenced) from other modules dynamically
  114.      loaded afterwards. *)
  115.  
  116. +val loadfile_lazy : string -> unit Lazy.t
  117. +(** Same as [loadfile], except that the initialization of the module is deferred. It will
  118. +    be performed when the returned lazy value is forced. *)
  119. +
  120. +val loadfile_private_lazy : string -> unit Lazy.t
  121. +
  122.  val adapt_filename : string -> string
  123.  (** In bytecode, the identity function. In native code, replace the last
  124.      extension with [.cmxs]. *)
  125. diff --git a/otherlibs/dynlink/natdynlink.ml b/otherlibs/dynlink/natdynlink.ml
  126. index fd06d7c..886e5e7 100644
  127. --- a/otherlibs/dynlink/natdynlink.ml
  128. +++ b/otherlibs/dynlink/natdynlink.ml
  129. @@ -71,7 +71,7 @@ let read_file filename priv =
  130.  module StrMap = Map.Make(String)
  131.  
  132.  type implem_state =
  133. -  | Loaded
  134. +  | Loaded of unit Lazy.t
  135.    | Check_inited of int
  136.  
  137.  type state = {
  138. @@ -153,12 +153,20 @@ let check_implems filename ui implems =
  139.             | Check_inited i ->
  140.                 if ndl_globals_inited() < i
  141.                 then raise(Error(Unavailable_unit name))
  142. -           | Loaded -> ()
  143. +           | Loaded init ->
  144. +               if not (Lazy.is_val init)
  145. +               then raise(Error(Unavailable_unit name))
  146.         with Not_found ->
  147.           raise (Error(Unavailable_unit name))
  148.      ) ui.dynu_imports_cmx
  149.  
  150.  let loadunits filename handle units state =
  151. +  let defines = List.flatten (List.map (fun ui -> ui.dynu_defines) units) in
  152. +  let run = lazy (
  153. +    ndl_run handle "_shared_startup";
  154. +    List.iter (ndl_run handle) defines;
  155. +  ) in
  156. +
  157.    let new_ifaces =
  158.      List.fold_left
  159.        (fun accu ui -> add_check_ifaces !allow_extension filename ui accu)
  160. @@ -167,23 +175,23 @@ let loadunits filename handle units state =
  161.      List.fold_left
  162.        (fun accu ui ->
  163.           check_implems filename ui accu;
  164. -         StrMap.add ui.dynu_name (ui.dynu_crc,filename,Loaded) accu)
  165. +         StrMap.add ui.dynu_name (ui.dynu_crc,filename,Loaded run) accu)
  166.        state.implems units in
  167.  
  168. -  let defines = List.flatten (List.map (fun ui -> ui.dynu_defines) units) in
  169. -
  170. -  ndl_run handle "_shared_startup";
  171. -  List.iter (ndl_run handle) defines;
  172. -  { implems = new_implems; ifaces = new_ifaces }
  173. +  (run, { implems = new_implems; ifaces = new_ifaces })
  174.  
  175.  let load priv filename =
  176.    init();
  177.    let (filename,handle,units) = read_file filename priv in
  178. -  let nstate = loadunits filename handle units !global_state in
  179. -  if not priv then global_state := nstate
  180. +  let run, nstate = loadunits filename handle units !global_state in
  181. +  if not priv then global_state := nstate;
  182. +  run
  183. +
  184. +let loadfile_lazy filename = load false filename
  185. +let loadfile_private_lazy filename = load true filename
  186.  
  187. -let loadfile filename = load false filename
  188. -let loadfile_private filename = load true filename
  189. +let loadfile filename = Lazy.force (loadfile_lazy filename)
  190. +let loadfile_private filename = Lazy.force (loadfile_private_lazy filename)
  191.  
  192.  let allow_only names =
  193.    init();
  194. --
  195. 1.7.1
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top