Skip to content

Commit

Permalink
Merge flambda-backend changes
Browse files Browse the repository at this point in the history
  • Loading branch information
mshinwell committed Dec 13, 2022
2 parents 0ac7fdd + 06c189a commit a6a9031
Show file tree
Hide file tree
Showing 160 changed files with 5,346 additions and 5,691 deletions.
137 changes: 89 additions & 48 deletions .depend

Large diffs are not rendered by default.

3 changes: 3 additions & 0 deletions Makefile.common-jst
Original file line number Diff line number Diff line change
Expand Up @@ -178,6 +178,9 @@ install_for_test: _install
# replace backend-specific testsuite/tools with their new versions
rm _runtest/testsuite/tools/*
cp -a testsuite/tools/* _runtest/testsuite/tools/
# replace backend-specific testsuite/tests/asmcomp with their new versions
rm _runtest/testsuite/tests/asmcomp/*
cp -a testsuite/tests/asmcomp/* _runtest/testsuite/tests/asmcomp/
# replace backend-specific testsuite/tests/asmgen with their new versions
rm _runtest/testsuite/tests/asmgen/*
cp -a testsuite/tests/asmgen/* _runtest/testsuite/tests/asmgen/
Expand Down
1 change: 1 addition & 0 deletions Makefile.config.in
Original file line number Diff line number Diff line change
Expand Up @@ -252,6 +252,7 @@ STDLIB_MANPAGES=@stdlib_manpages@
NAKED_POINTERS=@naked_pointers@
INTEL_JCC_BUG_CFLAGS=@intel_jcc_bug_cflags@
STACK_ALLOCATION=@stack_allocation@
POLL_INSERTION=@poll_insertion@
DUNE=@dune@

### Native command to build ocamlrun.exe
Expand Down
5 changes: 3 additions & 2 deletions asmcomp/asmgen.ml
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,7 @@ let linear_unit_info =
let reset () =
start_from_emit := false;
if should_save_before_emit () then begin
linear_unit_info.unit <- Compilation_unit.get_current_exn ();
linear_unit_info.unit <- Compilation_unit.get_current_or_dummy ();
linear_unit_info.items <- [];
end

Expand Down Expand Up @@ -272,7 +272,8 @@ let compile_implementation ?toplevel ~backend ~prefixname ~middle_end
~asm_filename:(asm_filename prefixname) ~keep_asm:!keep_asm_file
~obj_filename:(prefixname ^ ext_obj)
(fun () ->
Ident.Set.iter Compilenv.require_global program.required_globals;
Compilation_unit.Set.iter Compilenv.require_global
program.required_globals;
let clambda_with_constants =
middle_end ~backend ~prefixname ~ppf_dump program
in
Expand Down
102 changes: 42 additions & 60 deletions asmcomp/asmlink.ml
Original file line number Diff line number Diff line change
Expand Up @@ -25,40 +25,40 @@ module CU = Compilation_unit
type error =
| File_not_found of filepath
| Not_an_object_file of filepath
| Missing_implementations of (Linkage_name.t * string list) list
| Missing_implementations of (CU.t * string list) list
| Inconsistent_interface of CU.Name.t * filepath * filepath
| Inconsistent_implementation of CU.Name.t * filepath * filepath
| Inconsistent_implementation of CU.t * filepath * filepath
| Assembler_error of filepath
| Linking_error of int
| Multiple_definition of CU.Name.t * filepath * filepath
| Missing_cmx of filepath * CU.Name.t
| Missing_cmx of filepath * CU.t

exception Error of error

(* Consistency check between interfaces and implementations *)

module Cmi_consistbl = Consistbl.Make (CU.Name)
module Cmi_consistbl = Consistbl.Make (CU.Name) (CU)
let crc_interfaces = Cmi_consistbl.create ()
let interfaces = ref ([] : CU.Name.t list)

module Cmx_consistbl = Consistbl.Make (CU.Name)
module Cmx_consistbl = Consistbl.Make (CU) (Unit)
let crc_implementations = Cmx_consistbl.create ()
let implementations = ref ([] : CU.Name.t list)
let implementations_defined = ref ([] : (CU.Name.t * string) list)
let cmx_required = ref ([] : CU.Name.t list)
let implementations = ref ([] : CU.t list)
let implementations_defined = ref ([] : (CU.t * string) list)
let cmx_required = ref ([] : CU.t list)

let check_consistency file_name unit crc =
begin try
List.iter
(fun (name, crco) ->
let name = CU.Name.of_string name in
interfaces := name :: !interfaces;
match crco with
None -> ()
| Some crc ->
| Some (full_name, crc) ->
if CU.Name.equal name (CU.name unit.ui_unit)
then Cmi_consistbl.set crc_interfaces name crc file_name
else Cmi_consistbl.check crc_interfaces name crc file_name)
then Cmi_consistbl.set crc_interfaces name full_name crc file_name
else
Cmi_consistbl.check crc_interfaces name full_name crc file_name)
unit.ui_imports_cmi
with Cmi_consistbl.Inconsistency {
unit_name = name;
Expand All @@ -70,14 +70,13 @@ let check_consistency file_name unit crc =
begin try
List.iter
(fun (name, crco) ->
let name = name |> CU.Name.of_string in
implementations := name :: !implementations;
match crco with
None ->
if List.mem name !cmx_required then
raise(Error(Missing_cmx(file_name, name)))
| Some crc ->
Cmx_consistbl.check crc_implementations name crc file_name)
Cmx_consistbl.check crc_implementations name () crc file_name)
unit.ui_imports_cmx
with Cmx_consistbl.Inconsistency {
unit_name = name;
Expand All @@ -88,25 +87,22 @@ let check_consistency file_name unit crc =
end;
let ui_name = CU.name unit.ui_unit in
begin try
let source = List.assoc ui_name !implementations_defined in
raise (Error(Multiple_definition(CU.name unit.ui_unit, file_name, source)))
let source = List.assoc unit.ui_unit !implementations_defined in
raise (Error(Multiple_definition(ui_name, file_name, source)))
with Not_found -> ()
end;
implementations := ui_name :: !implementations;
Cmx_consistbl.set crc_implementations ui_name crc file_name;
implementations := unit.ui_unit :: !implementations;
Cmx_consistbl.set crc_implementations unit.ui_unit () crc file_name;
implementations_defined :=
(ui_name, file_name) :: !implementations_defined;
(unit.ui_unit, file_name) :: !implementations_defined;
if CU.is_packed unit.ui_unit then
cmx_required := ui_name :: !cmx_required
cmx_required := unit.ui_unit :: !cmx_required

let extract_crc_interfaces0 () =
Cmi_consistbl.extract !interfaces crc_interfaces
let extract_crc_interfaces () =
extract_crc_interfaces0 ()
|> List.map (fun (name, crc) -> (name |> CU.Name.to_string, crc))
Cmi_consistbl.extract !interfaces crc_interfaces
let extract_crc_implementations () =
Cmx_consistbl.extract !implementations crc_implementations
|> List.map (fun (name, crc) -> (name |> CU.Name.to_string, crc))
|> List.map (fun (name, crco) -> name, Option.map snd crco)

(* Add C objects and options and "custom" info from a library descriptor.
See bytecomp/bytelink.ml for comments on the order of C objects. *)
Expand Down Expand Up @@ -135,7 +131,7 @@ let runtime_lib () =

let missing_globals =
(Hashtbl.create 17 :
(Linkage_name.t, string list ref) Hashtbl.t)
(CU.t, string list ref) Hashtbl.t)

let is_required name =
try ignore (Hashtbl.find missing_globals name); true
Expand Down Expand Up @@ -193,26 +189,17 @@ let read_file obj_name =
end
else raise(Error(Not_an_object_file file_name))

let linkage_name_of_modname modname =
let assume_no_prefix modname =
(* We're the linker, so we assume that everything's already been packed, so
no module needs its prefix considered. *)
modname |> Linkage_name.of_string
CU.create CU.Prefix.empty modname

let scan_file file tolink =
match file with
| Unit (file_name,info,crc) ->
(* This is a .cmx file. It must be linked in any case. *)
let linkage_name =
info.ui_unit
|> Compilation_unit.name
|> Compilation_unit.Name.to_string
|> linkage_name_of_modname
in
remove_required linkage_name;
List.iter (fun (name, crc) ->
let name = name |> linkage_name_of_modname in
add_required file_name (name, crc))
info.ui_imports_cmx;
remove_required info.ui_unit;
List.iter (add_required file_name) info.ui_imports_cmx;
(info, file_name, crc) :: tolink
| Library (file_name,infos) ->
(* This is an archive file. Each unit contained in it will be linked
Expand All @@ -221,20 +208,15 @@ let scan_file file tolink =
List.fold_right
(fun (info, crc) reqd ->
let ui_name = CU.name info.ui_unit in
let linkage_name =
ui_name |> CU.Name.to_string |> linkage_name_of_modname
in
if info.ui_force_link
|| !Clflags.link_everything
|| is_required linkage_name
|| is_required info.ui_unit
then begin
remove_required linkage_name;
remove_required info.ui_unit;
let req_by =
Printf.sprintf "%s(%s)" file_name (ui_name |> CU.Name.to_string)
in
info.ui_imports_cmx |> List.iter (fun (modname, digest) ->
let linkage_name = modname |> Linkage_name.of_string in
add_required req_by (linkage_name, digest));
List.iter (add_required req_by) info.ui_imports_cmx;
(info, file_name, crc) :: reqd
end else
reqd)
Expand All @@ -254,22 +236,24 @@ let make_globals_map units_list ~crc_interfaces =
let defined =
List.map (fun (unit, _, impl_crc) ->
let name = CU.name unit.ui_unit in
let intf_crc = CU.Name.Tbl.find crc_interfaces name in
let intf_crc =
CU.Name.Tbl.find crc_interfaces name
|> Option.map (fun (_unit, crc) -> crc)
in
CU.Name.Tbl.remove crc_interfaces name;
let syms = List.map Symbol.for_compilation_unit unit.ui_defines in
(name, intf_crc, Some impl_crc, syms))
(unit.ui_unit, intf_crc, Some impl_crc, syms))
units_list
in
CU.Name.Tbl.fold (fun name intf acc ->
(name, intf, None, []) :: acc)
let intf = Option.map (fun (_unit, crc) -> crc) intf in
(assume_no_prefix name, intf, None, []) :: acc)
crc_interfaces defined

let make_startup_file ~ppf_dump units_list ~crc_interfaces =
let compile_phrase p = Asmgen.compile_phrase ~ppf_dump p in
Location.input_name := "caml_startup"; (* set name of "current" input *)
let startup_comp_unit =
CU.create CU.Prefix.empty (CU.Name.of_string "_startup")
in
let startup_comp_unit = CU.of_string "_startup" in
Compilenv.reset startup_comp_unit;
Emit.begin_assembly ();
let name_list =
Expand Down Expand Up @@ -390,16 +374,14 @@ let link ~ppf_dump objfiles output_name =
else stdlib :: (objfiles @ [stdexit]) in
let obj_infos = List.map read_file objfiles in
let units_tolink = List.fold_right scan_file obj_infos [] in
Array.iter (fun name -> remove_required (name |> Linkage_name.of_string))
Runtimedef.builtin_exceptions;
begin match extract_missing_globals() with
[] -> ()
| mg -> raise(Error(Missing_implementations mg))
end;
List.iter
(fun (info, file_name, crc) -> check_consistency file_name info crc)
units_tolink;
let crc_interfaces = extract_crc_interfaces0 () in
let crc_interfaces = extract_crc_interfaces () in
Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs;
Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts;
(* put user's opts first *)
Expand Down Expand Up @@ -439,7 +421,7 @@ let report_error ppf = function
List.iter
(fun (md, rq) ->
fprintf ppf "@ @[<hov 2>%a referenced from %a@]"
Linkage_name.print md
Compilation_unit.print md
print_references rq) in
fprintf ppf
"@[<v 2>No implementations provided for the following modules:%a@]"
Expand All @@ -457,7 +439,7 @@ let report_error ppf = function
over implementation %a@]"
Location.print_filename file1
Location.print_filename file2
CU.Name.print intf
CU.print intf
| Assembler_error file ->
fprintf ppf "Error while assembling %a" Location.print_filename file
| Linking_error exitcode ->
Expand All @@ -476,9 +458,9 @@ let report_error ppf = function
Please recompile %a@ with the correct `-I' option@ \
so that %a.cmx@ is found.@]"
Location.print_filename filename
CU.Name.print name
CU.print name
Location.print_filename filename
CU.Name.print name
CU.Name.print (CU.name name)

let () =
Location.register_error_of_exn
Expand Down
10 changes: 5 additions & 5 deletions asmcomp/asmlink.mli
Original file line number Diff line number Diff line change
Expand Up @@ -26,19 +26,19 @@ val call_linker_shared: string list -> string -> unit

val reset : unit -> unit
val check_consistency: filepath -> Cmx_format.unit_infos -> Digest.t -> unit
val extract_crc_interfaces: unit -> crcs
val extract_crc_implementations: unit -> crcs
val extract_crc_interfaces: unit -> Cmx_format.import_info_cmi list
val extract_crc_implementations: unit -> Cmx_format.import_info_cmx list

type error =
| File_not_found of filepath
| Not_an_object_file of filepath
| Missing_implementations of (Linkage_name.t * string list) list
| Missing_implementations of (Compilation_unit.t * string list) list
| Inconsistent_interface of Compilation_unit.Name.t * filepath * filepath
| Inconsistent_implementation of Compilation_unit.Name.t * filepath * filepath
| Inconsistent_implementation of Compilation_unit.t * filepath * filepath
| Assembler_error of filepath
| Linking_error of int
| Multiple_definition of Compilation_unit.Name.t * filepath * filepath
| Missing_cmx of filepath * Compilation_unit.Name.t
| Missing_cmx of filepath * Compilation_unit.t

exception Error of error

Expand Down
Loading

0 comments on commit a6a9031

Please sign in to comment.