Skip to content

Commit 1200de9

Browse files
gretay-jsgretay-js
committed
Address review comments
1 parent e5a4b21 commit 1200de9

8 files changed

Lines changed: 46 additions & 35 deletions

File tree

‎asmcomp/asmgen.ml‎

Lines changed: 16 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -42,10 +42,10 @@ let pass_dump_linear_if ppf flag message phrase =
4242
let should_save_before_emit () =
4343
should_save_ir_after Compiler_pass.Scheduling
4444

45-
let linear_unit_info = { Linear_format.
46-
unit_name = "";
47-
items = [];
48-
}
45+
let linear_unit_info =
46+
{ Linear_format.unit_name = "";
47+
items = [];
48+
}
4949

5050
let reset () =
5151
if should_save_before_emit () then begin
@@ -54,20 +54,23 @@ let reset () =
5454
end
5555

5656
let save_data dl =
57-
if should_save_before_emit () then
58-
linear_unit_info.items <- Linear_format.(Data dl) :: linear_unit_info.items;
57+
if should_save_before_emit () then begin
58+
linear_unit_info.items <- Linear_format.(Data dl) :: linear_unit_info.items
59+
end;
5960
dl
6061

6162
let save_linear f =
62-
if should_save_before_emit () then
63-
linear_unit_info.items <- Linear_format.(Func f) :: linear_unit_info.items;
63+
if should_save_before_emit () then begin
64+
linear_unit_info.items <- Linear_format.(Func f) :: linear_unit_info.items
65+
end;
6466
f
6567

6668
let write_linear output_prefix =
67-
if should_save_before_emit () then
69+
if should_save_before_emit () then begin
6870
let filename = output_prefix ^ Clflags.Compiler_ir.(extension Linear) in
6971
linear_unit_info.items <- List.rev linear_unit_info.items;
7072
Linear_format.save filename linear_unit_info
73+
end
7174

7275
let should_emit () =
7376
not (should_stop_after Compiler_pass.Scheduling)
@@ -158,8 +161,7 @@ let compile_genfuns ~ppf_dump f =
158161
| _ -> ())
159162
(Cmm_helpers.generic_functions true [Compilenv.current_unit_infos ()])
160163

161-
let compile_unit output_prefix asm_filename keep_asm
162-
obj_filename gen =
164+
let compile_unit ~output_prefix ~asm_filename ~keep_asm ~obj_filename gen =
163165
reset ();
164166
let create_asm = should_emit () &&
165167
(keep_asm || not !Emitaux.binary_backend_available) in
@@ -218,12 +220,13 @@ type middle_end =
218220

219221
let compile_implementation ?toplevel ~backend ~filename ~prefixname ~middle_end
220222
~ppf_dump (program : Lambda.program) =
221-
let asmfile =
223+
let asm_filename =
222224
if !keep_asm_file || !Emitaux.binary_backend_available
223225
then prefixname ^ ext_asm
224226
else Filename.temp_file "camlasm" ext_asm
225227
in
226-
compile_unit prefixname asmfile !keep_asm_file (prefixname ^ ext_obj)
228+
compile_unit ~output_prefix:prefixname ~asm_filename ~keep_asm:!keep_asm_file
229+
~obj_filename:(prefixname ^ ext_obj)
227230
(fun () ->
228231
Ident.Set.iter Compilenv.require_global program.required_globals;
229232
let clambda_with_constants =

‎asmcomp/asmgen.mli‎

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -42,8 +42,10 @@ type error = Assembler_error of string
4242
exception Error of error
4343
val report_error: Format.formatter -> error -> unit
4444

45-
46-
val compile_unit:
47-
string(*output prefix*) ->
48-
string(*asm file*) -> bool(*keep asm*) ->
49-
string(*obj file*) -> (unit -> unit) -> unit
45+
val compile_unit
46+
: output_prefix:string
47+
-> asm_filename:string
48+
-> keep_asm:bool
49+
-> obj_filename:string
50+
-> (unit -> unit)
51+
-> unit

‎asmcomp/asmlink.ml‎

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -291,8 +291,9 @@ let link_shared ~ppf_dump objfiles output_name =
291291
then output_name ^ ".startup" ^ ext_asm
292292
else Filename.temp_file "camlstartup" ext_asm in
293293
let startup_obj = output_name ^ ".startup" ^ ext_obj in
294-
Asmgen.compile_unit
295-
startup output_name !Clflags.keep_startup_file startup_obj
294+
Asmgen.compile_unit ~output_prefix:output_name
295+
~asm_filename:startup ~keep_asm:!Clflags.keep_startup_file
296+
~obj_filename:startup_obj
296297
(fun () ->
297298
make_shared_startup_file ~ppf_dump
298299
(List.map (fun (ui,_,crc) -> (ui,crc)) units_tolink)
@@ -356,8 +357,9 @@ let link ~ppf_dump objfiles output_name =
356357
then output_name ^ ".startup" ^ ext_asm
357358
else Filename.temp_file "camlstartup" ext_asm in
358359
let startup_obj = Filename.temp_file "camlstartup" ext_obj in
359-
Asmgen.compile_unit output_name
360-
startup !Clflags.keep_startup_file startup_obj
360+
Asmgen.compile_unit ~output_prefix:output_name
361+
~asm_filename:startup ~keep_asm:!Clflags.keep_startup_file
362+
~obj_filename:startup_obj
361363
(fun () -> make_startup_file ~ppf_dump units_tolink ~crc_interfaces);
362364
Misc.try_finally
363365
(fun () ->

‎asmcomp/cmm.ml‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -99,7 +99,10 @@ let init_label = 99
9999
let label_counter = ref init_label
100100

101101
let set_label l =
102-
assert (l >= !label_counter);
102+
if (l < !label_counter) then begin
103+
Misc.fatal_errorf "Cannot set label counter to %d, it must be >= %d"
104+
l !label_counter ()
105+
end;
103106
label_counter := l
104107

105108
let cur_label () = !label_counter

‎asmcomp/cmm.mli‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -82,7 +82,7 @@ val swap_float_comparison: float_comparison -> float_comparison
8282

8383
type label = int
8484
val new_label: unit -> label
85-
val set_label: int -> unit
85+
val set_label: label -> unit
8686
val cur_label: unit -> label
8787

8888
type rec_flag = Nonrecursive | Recursive

‎file_formats/linear_format.ml‎

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@
1515
(* *)
1616
(**************************************************************************)
1717

18-
(* marshal and unmashal a compilation unit in linear format *)
18+
(* Marshal and unmarshal a compilation unit in linear format *)
1919
type linear_item_info =
2020
| Func of Linear.fundecl
2121
| Data of Cmm.data_item list
@@ -39,37 +39,37 @@ let save filename linear_unit_info =
3939
Misc.try_finally (fun () ->
4040
output_string ch Config.linear_magic_number;
4141
output_value ch linear_unit_info;
42-
(* Saved because linear and emit depend on cmm.label. *)
42+
(* Saved because Linearize and Emit depend on Cmm.label. *)
4343
output_value ch (Cmm.cur_label ());
4444
(* Compute digest of the contents and append it to the file. *)
4545
flush ch;
4646
let crc = Digest.file filename in
4747
output_value ch crc
4848
)
4949
~always:(fun () -> close_out ch)
50-
~exceptionally:(fun () -> raise(Error(Marshal_failed(filename))))
50+
~exceptionally:(fun () -> raise (Error (Marshal_failed filename)))
5151

5252
let restore filename =
5353
let ic = open_in_bin filename in
5454
Misc.try_finally
5555
(fun () ->
5656
let magic = Config.linear_magic_number in
5757
let buffer = really_input_string ic (String.length magic) in
58-
if buffer = magic then begin
58+
if String.equal buffer magic then begin
5959
try
6060
let linear_unit_info = (input_value ic : linear_unit_info) in
6161
let last_label = (input_value ic : Cmm.label) in
6262
Cmm.reset ();
6363
Cmm.set_label last_label;
6464
let crc = (input_value ic : Digest.t) in
65-
(linear_unit_info, crc)
66-
with End_of_file | Failure _ -> raise(Error(Corrupted(filename)))
65+
linear_unit_info, crc
66+
with End_of_file | Failure _ -> raise (Error (Corrupted filename))
6767
| Error e -> raise (Error e)
6868
end
6969
else if String.sub buffer 0 9 = String.sub magic 0 9 then
70-
raise(Error(Wrong_version(filename)))
70+
raise (Error (Wrong_version filename))
7171
else
72-
raise(Error(Wrong_format(filename)))
72+
raise (Error (Wrong_format filename))
7373
)
7474
~always:(fun () -> close_in ic)
7575

‎file_formats/linear_format.mli‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,9 @@ type linear_unit_info =
2929
mutable items : linear_item_info list;
3030
}
3131

32-
(* Marshal and unmashal a compilation unit in Linear format.
33-
Save and restores global state required for Emit. *)
32+
(* Marshal and unmarshal a compilation unit in Linear format.
33+
It includes saving and restoring global state required for Emit,
34+
that currently consists of Cmm.label_counter.
35+
*)
3436
val save : string -> linear_unit_info -> unit
3537
val restore : string -> linear_unit_info * Digest.t

‎testsuite/tests/tool-ocamlopt-save-ir/save_ir_after_scheduling.ml‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,6 @@
33
** setup-ocamlopt.byte-build-env
44
*** ocamlopt.byte
55
flags = "-save-ir-after scheduling -S"
6-
ocamlopt_byte_exit_status = "0"
76
**** check-ocamlopt.byte-output
87
***** script
98
script = "sh ${test_source_directory}/save_ir_after_scheduling.sh"

0 commit comments

Comments
 (0)