Fix crc_interfaces stuff
parent
4dfa4d6e7a
commit
c237f42521
|
@ -20,6 +20,8 @@ open Config
|
|||
open Cmx_format
|
||||
open Compilenv
|
||||
|
||||
module String = Misc.Stdlib.String
|
||||
|
||||
type error =
|
||||
File_not_found of string
|
||||
| Not_an_object_file of string
|
||||
|
@ -207,29 +209,20 @@ let force_linking_of_startup ~ppf_dump =
|
|||
Asmgen.compile_phrase ~ppf_dump
|
||||
(Cmm.Cdata ([Cmm.Csymbol_address "caml_startup"]))
|
||||
|
||||
let make_globals_map units_list =
|
||||
let units = Hashtbl.create 17 in
|
||||
List.iter (fun (unit, _, _) ->
|
||||
List.iter (fun (name, intf_crc) ->
|
||||
match Hashtbl.find units name, intf_crc with
|
||||
| exception Not_found -> Hashtbl.add units name intf_crc
|
||||
| None, (Some _ as intf_crc) -> Hashtbl.replace units name intf_crc
|
||||
| Some _, _ -> ()
|
||||
| _, None -> ())
|
||||
unit.ui_imports_cmi)
|
||||
units_list;
|
||||
let make_globals_map units_list ~crc_interfaces =
|
||||
let crc_interfaces = String.Tbl.of_seq (List.to_seq crc_interfaces) in
|
||||
let defined =
|
||||
List.map (fun (unit, _, impl_crc) ->
|
||||
let intf_crc = Hashtbl.find units unit.ui_name in
|
||||
Hashtbl.remove units unit.ui_name;
|
||||
let intf_crc = String.Tbl.find crc_interfaces unit.ui_name in
|
||||
String.Tbl.remove crc_interfaces unit.ui_name;
|
||||
(unit.ui_name, intf_crc, Some impl_crc, unit.ui_defines))
|
||||
units_list
|
||||
in
|
||||
Hashtbl.fold (fun name intf acc ->
|
||||
String.Tbl.fold (fun name intf acc ->
|
||||
(name, intf, None, []) :: acc)
|
||||
units defined
|
||||
crc_interfaces defined
|
||||
|
||||
let make_startup_file ~ppf_dump units_list =
|
||||
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 *)
|
||||
Compilenv.reset "_startup";
|
||||
|
@ -244,7 +237,8 @@ let make_startup_file ~ppf_dump units_list =
|
|||
(fun i name -> compile_phrase (Cmmgen.predef_exception i name))
|
||||
Runtimedef.builtin_exceptions;
|
||||
compile_phrase (Cmmgen.global_table name_list);
|
||||
compile_phrase (Cmmgen.globals_map (make_globals_map units_list));
|
||||
let globals_map = make_globals_map units_list ~crc_interfaces in
|
||||
compile_phrase (Cmmgen.globals_map globals_map);
|
||||
compile_phrase(Cmmgen.data_segment_table ("_startup" :: name_list));
|
||||
compile_phrase(Cmmgen.code_segment_table ("_startup" :: name_list));
|
||||
let all_names = "_startup" :: "_system" :: name_list in
|
||||
|
@ -351,6 +345,7 @@ let link ~ppf_dump objfiles output_name =
|
|||
List.iter
|
||||
(fun (info, file_name, crc) -> check_consistency file_name info crc)
|
||||
units_tolink;
|
||||
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 *)
|
||||
|
@ -361,7 +356,7 @@ let link ~ppf_dump objfiles output_name =
|
|||
let startup_obj = Filename.temp_file "camlstartup" ext_obj in
|
||||
Asmgen.compile_unit output_name
|
||||
startup !Clflags.keep_startup_file startup_obj
|
||||
(fun () -> make_startup_file ~ppf_dump units_tolink);
|
||||
(fun () -> make_startup_file ~ppf_dump units_tolink ~crc_interfaces);
|
||||
Misc.try_finally
|
||||
(fun () ->
|
||||
call_linker (List.map object_file_name objfiles)
|
||||
|
|
|
@ -214,6 +214,10 @@ module Stdlib = struct
|
|||
include String
|
||||
module Set = Set.Make(String)
|
||||
module Map = Map.Make(String)
|
||||
module Tbl = Hashtbl.Make(struct
|
||||
include String
|
||||
let hash = Hashtbl.hash
|
||||
end)
|
||||
end
|
||||
|
||||
external compare : 'a -> 'a -> int = "%compare"
|
||||
|
|
|
@ -148,6 +148,7 @@ module Stdlib : sig
|
|||
include module type of String
|
||||
module Set : Set.S with type elt = string
|
||||
module Map : Map.S with type key = string
|
||||
module Tbl : Hashtbl.S with type key = string
|
||||
end
|
||||
|
||||
external compare : 'a -> 'a -> int = "%compare"
|
||||
|
|
Loading…
Reference in New Issue