blob: 5525a697076bc7463ed2a28ba793de8bc3e8240d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* Greta Yorsh, Jane Street Europe *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* Copyright 2019 Jane Street Group LLC *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* Marshal and unmarshal a compilation unit in linear format *)
type linear_item_info =
| Func of Linear.fundecl
| Data of Cmm.data_item list
type linear_unit_info =
{
mutable unit_name : string;
mutable items : linear_item_info list;
mutable for_pack : string option
}
type error =
| Wrong_format of string
| Wrong_version of string
| Corrupted of string
| Marshal_failed of string
exception Error of error
let save filename linear_unit_info =
let ch = open_out_bin filename in
Misc.try_finally (fun () ->
output_string ch Config.linear_magic_number;
output_value ch linear_unit_info;
(* Saved because Linearize and Emit depend on Cmm.label. *)
output_value ch (Cmm.cur_label ());
(* Compute digest of the contents and append it to the file. *)
flush ch;
let crc = Digest.file filename in
output_value ch crc
)
~always:(fun () -> close_out ch)
~exceptionally:(fun () -> raise (Error (Marshal_failed filename)))
let restore filename =
let ic = open_in_bin filename in
Misc.try_finally
(fun () ->
let magic = Config.linear_magic_number in
let buffer = really_input_string ic (String.length magic) in
if String.equal buffer magic then begin
try
let linear_unit_info = (input_value ic : linear_unit_info) in
let last_label = (input_value ic : Cmm.label) in
Cmm.reset ();
Cmm.set_label last_label;
let crc = (input_value ic : Digest.t) in
linear_unit_info, crc
with End_of_file | Failure _ -> raise (Error (Corrupted filename))
| Error e -> raise (Error e)
end
else if String.sub buffer 0 9 = String.sub magic 0 9 then
raise (Error (Wrong_version filename))
else
raise (Error (Wrong_format filename))
)
~always:(fun () -> close_in ic)
(* Error report *)
open Format
let report_error ppf = function
| Wrong_format filename ->
fprintf ppf "Expected Linear format. Incompatible file %a"
Location.print_filename filename
| Wrong_version filename ->
fprintf ppf
"%a@ is not compatible with this version of OCaml"
Location.print_filename filename
| Corrupted filename ->
fprintf ppf "Corrupted format@ %a"
Location.print_filename filename
| Marshal_failed filename ->
fprintf ppf "Failed to marshal Linear to file@ %a"
Location.print_filename filename
let () =
Location.register_error_of_exn
(function
| Error err -> Some (Location.error_of_printer_file report_error err)
| _ -> None
)
|
