Skip to content

Commit fec04c7

Browse files
gretay-jsdbuenzli
authored and
mshinwell
committed
Simplify processing and remove dead code (error paths) in asmlink (port upstream PR#9943) (#557)
* Asmlink.object_file_name removal: add object_file_name_of_file An analysis of the code should convince yourself that the [object_file_name] function is not needed and that its erroring paths are dead code. The reasoning is the following: all the uses of [object_file_name] in asmlink.ml are performed on [obj_name]s which went through [read_file] before. The latter does exactly the same file name lookup and erroring treatement, except not in a stringly manner like [object_file_name] does. This new function derives the same information as [object_file_name] except it does it on the [file] datatype returned by [read_file]. Note that all the erroring code paths of [object_file_name] have been handled by the [read_file] which derived the [file] value. We integrate the logic added by PR #9011 for empty cmxa here. * Asmlink.object_file_name removal: remove. This commit does the following four things (it's difficult to them in separate commits that compile). 1) It removes the [read_file] from [scan_file]. Reading the files is done seperately before returning an [obj_infos] list of [file] values. This turns [scan_file] into a function that operates on values of type [file]. 2) In [scan_file] it removes the separate list of [obj_files] introduced by #9011. We can derive the same list using the function [object_file_name_of_file] introduced in the previous commit on the list of [obj_infos]. Effectively we bring back [scan_file] to the state before #9011 modulo the [read_file] removal. 3) We derive the list of [obj_files] directly from the [obj_infos] list via [object_file_name_of_file]. Note that the logic introduced by #9011 is preserved by virtue of [object_file_name_of_file]'s optional result. 4) Deletes [object_file_name] which is no longer used. Co-authored-by: Daniel Bünzli <[email protected]>
1 parent ad6678b commit fec04c7

File tree

2 files changed

+68
-100
lines changed

2 files changed

+68
-100
lines changed

‎backend/asmlink.ml

Lines changed: 34 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -127,19 +127,6 @@ let runtime_lib () =
127127
with Not_found ->
128128
raise(Error(File_not_found libname))
129129

130-
let object_file_name name =
131-
let file_name =
132-
try
133-
Load_path.find name
134-
with Not_found ->
135-
fatal_errorf "Asmlink.object_file_name: %s not found" name in
136-
if Filename.check_suffix file_name ".cmx" then
137-
Filename.chop_suffix file_name ".cmx" ^ ext_obj
138-
else if Filename.check_suffix file_name ".cmxa" then
139-
Filename.chop_suffix file_name ".cmxa" ^ ext_lib
140-
else
141-
fatal_error "Asmlink.object_file_name: bad ext"
142-
143130
(* First pass: determine which units are needed *)
144131

145132
let missing_globals = (Hashtbl.create 17 : (string, string list ref) Hashtbl.t)
@@ -167,6 +154,17 @@ type file =
167154
| Unit of string * unit_infos * Digest.t
168155
| Library of string * library_infos
169156

157+
let object_file_name_of_file = function
158+
| Unit (fname, _, _) -> Some (Filename.chop_suffix fname ".cmx" ^ ext_obj)
159+
| Library (fname, infos) ->
160+
let obj_file = Filename.chop_suffix fname ".cmxa" ^ ext_lib in
161+
(* MSVC doesn't support empty .lib files, and macOS struggles to make
162+
them (#6550), so there shouldn't be one if the .cmxa contains no
163+
units. The file_exists check is added to be ultra-defensive for the
164+
case where a user has manually added things to the .a/.lib file *)
165+
if infos.lib_units = [] && not (Sys.file_exists obj_file) then None else
166+
Some obj_file
167+
170168
let read_file obj_name =
171169
let file_name =
172170
try
@@ -189,42 +187,30 @@ let read_file obj_name =
189187
end
190188
else raise(Error(Not_an_object_file file_name))
191189

192-
let scan_file obj_name (tolink, objfiles) = match read_file obj_name with
190+
let scan_file file tolink = match file with
193191
| Unit (file_name,info,crc) ->
194192
(* This is a .cmx file. It must be linked in any case. *)
195193
remove_required info.ui_name;
196194
List.iter (add_required file_name) info.ui_imports_cmx;
197-
((info, file_name, crc) :: tolink, obj_name :: objfiles)
195+
(info, file_name, crc) :: tolink
198196
| Library (file_name,infos) ->
199197
(* This is an archive file. Each unit contained in it will be linked
200198
in only if needed. *)
201199
add_ccobjs (Filename.dirname file_name) infos;
202-
let tolink =
203-
List.fold_right
204-
(fun (info, crc) reqd ->
205-
if info.ui_force_link
206-
|| !Clflags.link_everything
207-
|| is_required info.ui_name
208-
then begin
209-
remove_required info.ui_name;
210-
List.iter (add_required (Printf.sprintf "%s(%s)"
211-
file_name info.ui_name))
212-
info.ui_imports_cmx;
213-
(info, file_name, crc) :: reqd
214-
end else
215-
reqd)
216-
infos.lib_units tolink
217-
and objfiles =
218-
if infos.lib_units = []
219-
&& not (Sys.file_exists (object_file_name obj_name)) then
220-
(* MSVC doesn't support empty .lib files, and macOS struggles to make
221-
them (#6550), so there shouldn't be one if the .cmxa contains no
222-
units. The file_exists check is added to be ultra-defensive for the
223-
case where a user has manually added things to the .a/.lib file *)
224-
objfiles
225-
else
226-
obj_name :: objfiles
227-
in (tolink, objfiles)
200+
List.fold_right
201+
(fun (info, crc) reqd ->
202+
if info.ui_force_link
203+
|| !Clflags.link_everything
204+
|| is_required info.ui_name
205+
then begin
206+
remove_required info.ui_name;
207+
List.iter (add_required (Printf.sprintf "%s(%s)"
208+
file_name info.ui_name))
209+
info.ui_imports_cmx;
210+
(info, file_name, crc) :: reqd
211+
end else
212+
reqd)
213+
infos.lib_units tolink
228214

229215
(* Second pass: generate the startup file and link it with everything else *)
230216

@@ -303,17 +289,16 @@ let call_linker_shared file_list output_name =
303289

304290
let link_shared ~ppf_dump objfiles output_name =
305291
Profile.record_call output_name (fun () ->
306-
let units_tolink, objfiles =
307-
List.fold_right scan_file objfiles ([], [])
308-
in
292+
let obj_infos = List.map read_file objfiles in
293+
let units_tolink = List.fold_right scan_file obj_infos [] in
309294
List.iter
310295
(fun (info, file_name, crc) -> check_consistency file_name info crc)
311296
units_tolink;
312297
Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs;
313298
Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts;
314-
let objfiles = List.rev_map object_file_name objfiles @
299+
let objfiles =
300+
List.rev (List.filter_map object_file_name_of_file obj_infos) @
315301
(List.rev !Clflags.ccobjs) in
316-
317302
let startup =
318303
if !Clflags.keep_startup_file || !Emitaux.binary_backend_available
319304
then output_name ^ ".startup" ^ ext_asm
@@ -374,9 +359,8 @@ let link ~ppf_dump objfiles output_name =
374359
if !Clflags.nopervasives then objfiles
375360
else if !Clflags.output_c_object then stdlib :: objfiles
376361
else stdlib :: (objfiles @ [stdexit]) in
377-
let units_tolink, objfiles =
378-
List.fold_right scan_file objfiles ([], [])
379-
in
362+
let obj_infos = List.map read_file objfiles in
363+
let units_tolink = List.fold_right scan_file obj_infos [] in
380364
Array.iter remove_required Runtimedef.builtin_exceptions;
381365
begin match extract_missing_globals() with
382366
[] -> ()
@@ -401,7 +385,7 @@ let link ~ppf_dump objfiles output_name =
401385
Emitaux.reduce_heap_size ~reset:(fun () -> reset ());
402386
Misc.try_finally
403387
(fun () ->
404-
call_linker (List.map object_file_name objfiles)
388+
call_linker (List.filter_map object_file_name_of_file obj_infos)
405389
startup_obj output_name)
406390
~always:(fun () -> remove_file startup_obj)
407391
)

‎ocaml/asmcomp/asmlink.ml

Lines changed: 34 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -124,19 +124,6 @@ let runtime_lib () =
124124
with Not_found ->
125125
raise(Error(File_not_found libname))
126126

127-
let object_file_name name =
128-
let file_name =
129-
try
130-
Load_path.find name
131-
with Not_found ->
132-
fatal_errorf "Asmlink.object_file_name: %s not found" name in
133-
if Filename.check_suffix file_name ".cmx" then
134-
Filename.chop_suffix file_name ".cmx" ^ ext_obj
135-
else if Filename.check_suffix file_name ".cmxa" then
136-
Filename.chop_suffix file_name ".cmxa" ^ ext_lib
137-
else
138-
fatal_error "Asmlink.object_file_name: bad ext"
139-
140127
(* First pass: determine which units are needed *)
141128

142129
let missing_globals = (Hashtbl.create 17 : (string, string list ref) Hashtbl.t)
@@ -164,6 +151,17 @@ type file =
164151
| Unit of string * unit_infos * Digest.t
165152
| Library of string * library_infos
166153

154+
let object_file_name_of_file = function
155+
| Unit (fname, _, _) -> Some (Filename.chop_suffix fname ".cmx" ^ ext_obj)
156+
| Library (fname, infos) ->
157+
let obj_file = Filename.chop_suffix fname ".cmxa" ^ ext_lib in
158+
(* MSVC doesn't support empty .lib files, and macOS struggles to make
159+
them (#6550), so there shouldn't be one if the .cmxa contains no
160+
units. The file_exists check is added to be ultra-defensive for the
161+
case where a user has manually added things to the .a/.lib file *)
162+
if infos.lib_units = [] && not (Sys.file_exists obj_file) then None else
163+
Some obj_file
164+
167165
let read_file obj_name =
168166
let file_name =
169167
try
@@ -186,42 +184,30 @@ let read_file obj_name =
186184
end
187185
else raise(Error(Not_an_object_file file_name))
188186

189-
let scan_file obj_name (tolink, objfiles) = match read_file obj_name with
187+
let scan_file file tolink = match file with
190188
| Unit (file_name,info,crc) ->
191189
(* This is a .cmx file. It must be linked in any case. *)
192190
remove_required info.ui_name;
193191
List.iter (add_required file_name) info.ui_imports_cmx;
194-
((info, file_name, crc) :: tolink, obj_name :: objfiles)
192+
(info, file_name, crc) :: tolink
195193
| Library (file_name,infos) ->
196194
(* This is an archive file. Each unit contained in it will be linked
197195
in only if needed. *)
198196
add_ccobjs (Filename.dirname file_name) infos;
199-
let tolink =
200-
List.fold_right
201-
(fun (info, crc) reqd ->
202-
if info.ui_force_link
203-
|| !Clflags.link_everything
204-
|| is_required info.ui_name
205-
then begin
206-
remove_required info.ui_name;
207-
List.iter (add_required (Printf.sprintf "%s(%s)"
208-
file_name info.ui_name))
209-
info.ui_imports_cmx;
210-
(info, file_name, crc) :: reqd
211-
end else
212-
reqd)
213-
infos.lib_units tolink
214-
and objfiles =
215-
if infos.lib_units = []
216-
&& not (Sys.file_exists (object_file_name obj_name)) then
217-
(* MSVC doesn't support empty .lib files, and macOS struggles to make
218-
them (#6550), so there shouldn't be one if the .cmxa contains no
219-
units. The file_exists check is added to be ultra-defensive for the
220-
case where a user has manually added things to the .a/.lib file *)
221-
objfiles
222-
else
223-
obj_name :: objfiles
224-
in (tolink, objfiles)
197+
List.fold_right
198+
(fun (info, crc) reqd ->
199+
if info.ui_force_link
200+
|| !Clflags.link_everything
201+
|| is_required info.ui_name
202+
then begin
203+
remove_required info.ui_name;
204+
List.iter (add_required (Printf.sprintf "%s(%s)"
205+
file_name info.ui_name))
206+
info.ui_imports_cmx;
207+
(info, file_name, crc) :: reqd
208+
end else
209+
reqd)
210+
infos.lib_units tolink
225211

226212
(* Second pass: generate the startup file and link it with everything else *)
227213

@@ -295,17 +281,16 @@ let call_linker_shared file_list output_name =
295281

296282
let link_shared ~ppf_dump objfiles output_name =
297283
Profile.record_call output_name (fun () ->
298-
let units_tolink, objfiles =
299-
List.fold_right scan_file objfiles ([], [])
300-
in
284+
let obj_infos = List.map read_file objfiles in
285+
let units_tolink = List.fold_right scan_file obj_infos [] in
301286
List.iter
302287
(fun (info, file_name, crc) -> check_consistency file_name info crc)
303288
units_tolink;
304289
Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs;
305290
Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts;
306-
let objfiles = List.rev_map object_file_name objfiles @
291+
let objfiles =
292+
List.rev (List.filter_map object_file_name_of_file obj_infos) @
307293
(List.rev !Clflags.ccobjs) in
308-
309294
let startup =
310295
if !Clflags.keep_startup_file || !Emitaux.binary_backend_available
311296
then output_name ^ ".startup" ^ ext_asm
@@ -355,9 +340,8 @@ let link ~ppf_dump objfiles output_name =
355340
if !Clflags.nopervasives then objfiles
356341
else if !Clflags.output_c_object then stdlib :: objfiles
357342
else stdlib :: (objfiles @ [stdexit]) in
358-
let units_tolink, objfiles =
359-
List.fold_right scan_file objfiles ([], [])
360-
in
343+
let obj_infos = List.map read_file objfiles in
344+
let units_tolink = List.fold_right scan_file obj_infos [] in
361345
Array.iter remove_required Runtimedef.builtin_exceptions;
362346
begin match extract_missing_globals() with
363347
[] -> ()
@@ -381,7 +365,7 @@ let link ~ppf_dump objfiles output_name =
381365
(fun () -> make_startup_file ~ppf_dump units_tolink ~crc_interfaces);
382366
Misc.try_finally
383367
(fun () ->
384-
call_linker (List.map object_file_name objfiles)
368+
call_linker (List.filter_map object_file_name_of_file obj_infos)
385369
startup_obj output_name)
386370
~always:(fun () -> remove_file startup_obj)
387371
)

0 commit comments

Comments
 (0)