Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Ensure the entrypoint is taken into account when computing the export table #146

Open
wants to merge 4 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 3 additions & 1 deletion CHANGES
Original file line number Diff line number Diff line change
@@ -1,7 +1,9 @@
Next version
- GPR#127: Recognise hyphens in option names in the COFF .drectve section. Fixes #126 (Reza Barazesh)
- GPR#136: Fix parallel access crashes and misbehavior (David Allsopp, Jan Midtgaard, Antonin Décimo)

- GPR#146: Take the entrypoint (main, wmainCRTStartup, etc.) into account when
determining the modules which will be linked. For mingw-w64, select crt2u.o
instead of crt2.o if -link -municode is specified (David Allsopp)

Version 0.43
- GPR#108: Add -lgcc_s to Cygwin's link libraries, upstreaming a patch from the
Expand Down
149 changes: 110 additions & 39 deletions reloc.ml
Original file line number Diff line number Diff line change
Expand Up @@ -697,7 +697,7 @@ let needed imported defined resolve_alias resolve_alternate obj =
StrSet.empty
obj.symbols

let build_dll link_exe output_file files exts extra_args =
let build_dll link_exe output_file files exts extra_args_string =
let main_pgm = link_exe <> `DLL in

(* fully resolve filenames, eliminate duplicates *)
Expand Down Expand Up @@ -739,7 +739,7 @@ let build_dll link_exe output_file files exts extra_args =
in
(* Collect all the available symbols, including those defined
in default libraries *)
let defined, from_imports, resolve_alias, resolve_alternate =
let defined, from_imports, resolve_alias, resolve_alternate, collected =
let aliases = Hashtbl.create 16 in
let alternates = Hashtbl.create 16 in
let defined = ref StrSet.empty in
Expand Down Expand Up @@ -808,14 +808,16 @@ let build_dll link_exe output_file files exts extra_args =

and collect_file fn =
if not (Hashtbl.mem collected (String.lowercase_ascii fn)) then begin
Hashtbl.replace collected (String.lowercase_ascii fn) ();
debug 2 "** open: %s" fn;
collect_defined fn (Lib.read fn)
end

and collect_defined fn = function
| `Obj obj -> collect_defined_obj obj
| `Obj obj ->
Hashtbl.replace collected (String.lowercase_ascii fn) [fn, obj];
collect_defined_obj obj
| `Lib (objs,imports) ->
Hashtbl.replace collected (String.lowercase_ascii fn) objs;
List.iter (fun (_, obj) -> collect_defined_obj obj) objs;
List.iter
(fun (s,_) ->
Expand All @@ -826,12 +828,7 @@ let build_dll link_exe output_file files exts extra_args =
)
imports
in
List.iter
(fun (fn,x) ->
Hashtbl.replace collected (String.lowercase_ascii fn) ();
collect_defined fn x
)
files;
List.iter (fun (fn,x) -> collect_defined fn x) files;
if !use_default_libs then List.iter (fun fn -> collect_file (find_file fn)) !default_libs;
List.iter (fun fn -> collect_file (find_file fn)) exts;

Expand All @@ -841,13 +838,13 @@ let build_dll link_exe output_file files exts extra_args =
if !machine = `x64 then add_def "__ImageBase"
else add_def "___ImageBase";

!defined, !from_imports, (Hashtbl.find aliases), (Hashtbl.find alternates)
!defined, !from_imports, (Hashtbl.find aliases), (Hashtbl.find alternates), collected
in

(* Determine which objects from the given libraries should be linked
in. First step: find the mapping (symbol -> object) for these
objects. *)
let defined_in =
let defined_in, default_libs =
let defined_in = Hashtbl.create 16 in
let def_in_obj fn (objname, obj) =
List.iter
Expand All @@ -865,29 +862,36 @@ let build_dll link_exe output_file files exts extra_args =
)
obj.symbols
in
List.iter
(fun (fn,objs) ->
if !explain then Printf.printf "Scanning lib %s\n%!" fn;
List.iter (def_in_obj fn) objs
)
libs;
Hashtbl.find defined_in
let scan (fn,objs) =
if !explain then Printf.printf "Scanning lib %s\n%!" fn;
List.iter (def_in_obj fn) objs
in
let default_libs =
List.fold_right
(fun fn acc ->
let fn = find_file fn in
scan (fn, Hashtbl.find collected (String.lowercase_ascii fn));
StrSet.add fn acc)
(if !use_default_libs then !default_libs else [])
StrSet.empty
in
List.iter scan libs;
Hashtbl.find defined_in, default_libs
in

let imported_from_implib = ref StrSet.empty in
let imported = ref StrSet.empty in

let imports obj =
let n = needed imported defined resolve_alias resolve_alternate obj in
imported_from_implib := StrSet.union !imported_from_implib (StrSet.inter n from_imports);
let undefs = StrSet.diff n defined in
StrSet.filter
(fun s ->
match check_prefix "__imp_" s with
| Some _ -> false
| None -> s <> "environ" (* special hack for Cygwin64 *)
)
undefs
undefs, StrSet.inter n from_imports
in

(* Second step: transitive closure, starting from given objects *)
Expand Down Expand Up @@ -935,7 +939,7 @@ let build_dll link_exe output_file files exts extra_args =
in

let dll_exports = ref StrSet.empty in
let rec link_obj fn obj =
let record_exports obj =
List.iter
(fun sym ->
if Symbol.is_defin sym && exportable sym.sym_name
Expand All @@ -944,7 +948,9 @@ let build_dll link_exe output_file files exts extra_args =
obj.symbols;

dll_exports := List.fold_left (fun accu x -> StrSet.add x accu)
!dll_exports (collect_dllexports obj);
!dll_exports (collect_dllexports obj)
in
let rec link_obj fn obj =
StrSet.iter
(fun s ->
if StrSet.mem s !exported then ()
Expand All @@ -961,16 +967,75 @@ let build_dll link_exe output_file files exts extra_args =
(needed imported defined resolve_alias resolve_alternate obj)

and link_libobj (libname,objname,obj) =
let default = StrSet.mem libname default_libs in
if Hashtbl.mem libobjects (libname,objname) then ()
else (Hashtbl.replace libobjects (libname,objname) (obj,imports obj);
else (let imports, from_imports = imports obj in
let imports = if default then StrSet.empty else imports in
Hashtbl.replace libobjects (libname,objname) (obj,imports);
if not default then begin
imported_from_implib := StrSet.union !imported_from_implib from_imports;
record_exports obj
end;
link_obj (Printf.sprintf "%s(%s)" libname objname) obj)
in

let entrypoint =
if not main_pgm then
None
else
match !toolchain with
| `CYGWIN64 ->
Some "main"
| `MINGW | `MINGW64 -> begin
let entry_point s =
String.length s > 7 && String.sub s 0 7 = "-Wl,-e,"
in
try
let s = List.find entry_point !extra_args in
Some (String.sub s 7 (String.length s - 7))
with Not_found ->
Some "mainCRTStartup"
end
| `MSVC | `MSVC64 -> begin
let entry_point s =
String.length s > 7 && String.lowercase_ascii (String.sub s 0 7) = "/entry:"
in
try
let s = List.find entry_point !extra_args in
Some (String.sub s 7 (String.length s - 7))
with Not_found ->
if !subsystem = "windows" then
Some "WinMainCRTStartup"
else
Some "mainCRTStartup"
end
| `LIGHTLD | `GNAT | `GNAT64 ->
None
in
let () =
match entrypoint with
| None -> ()
| Some entrypoint ->
try
let (libname, objname, _) as o = defined_in entrypoint in
if !explain then
Printf.printf "%s(%s) because of entrypoint %s\n%!" libname objname
entrypoint;
link_libobj o
with Not_found ->
if !explain then
Printf.printf "Entrypoint %s not found\n%!" entrypoint
in
let redirect = Hashtbl.create 16 in
List.iter
(fun (fn, obj) ->
let default = StrSet.mem fn default_libs in
let imps, from_imports = imports obj in
if not default then begin
imported_from_implib := StrSet.union !imported_from_implib from_imports;
record_exports obj
end;
link_obj fn obj;
let imps = imports obj in
if StrSet.is_empty imps then ()
else Hashtbl.replace redirect fn (close_obj fn imps obj);
) objs;
Expand Down Expand Up @@ -1095,21 +1160,21 @@ let build_dll link_exe output_file files exts extra_args =
being an empty file. *)
let c = open_out implib in output_string c "x"; close_out c;
let _impexp = add_temp (Filename.chop_suffix implib ".lib" ^ ".exp") in
let extra_args =
if !custom_crt then "/nodefaultlib:LIBCMT /nodefaultlib:MSVCRT " ^ extra_args
else "msvcrt.lib " ^ extra_args
let extra_args_string =
if !custom_crt then "/nodefaultlib:LIBCMT /nodefaultlib:MSVCRT " ^ extra_args_string
else "msvcrt.lib " ^ extra_args_string
in

let extra_args =
if !machine = `x64 then (Printf.sprintf "/base:%s " !base_addr) ^ extra_args else extra_args
let extra_args_string =
if !machine = `x64 then (Printf.sprintf "/base:%s " !base_addr) ^ extra_args_string else extra_args_string
in

let extra_args =
let extra_args_string =
(* FlexDLL doesn't process .voltbl sections correctly, so don't allow the linker
to process them. *)
if Sys.command "link | findstr EMITVOLATILEMETADATA > nul" = 0 then
"/EMITVOLATILEMETADATA:NO " ^ extra_args
else extra_args
"/EMITVOLATILEMETADATA:NO " ^ extra_args_string
else extra_args_string
in

(* Flexdll requires that all images (main programs and all the DLLs) are
Expand All @@ -1136,7 +1201,7 @@ let build_dll link_exe output_file files exts extra_args =
(Filename.quote output_file)
!subsystem
files descr
extra_args
extra_args_string
| `CYGWIN64 ->
let def_file =
if main_pgm then ""
Expand All @@ -1157,7 +1222,7 @@ let build_dll link_exe output_file files exts extra_args =
descr
files
def_file
extra_args
extra_args_string
| `MINGW | `MINGW64 | `GNAT | `GNAT64 ->
let def_file =
if main_pgm then ""
Expand All @@ -1180,7 +1245,7 @@ let build_dll link_exe output_file files exts extra_args =
files
def_file
(if !implib then "-Wl,--out-implib=" ^ Filename.quote (Filename.chop_extension output_file ^ ".a") else "")
extra_args
extra_args_string
| `LIGHTLD ->
no_merge_manifest := true;
Printf.sprintf
Expand All @@ -1191,7 +1256,7 @@ let build_dll link_exe output_file files exts extra_args =
descr
files
(if !implib then "--out-implib " ^ Filename.quote (Filename.chop_extension output_file ^ ".a") else "")
extra_args
extra_args_string
in
debug ~dry_mode 1 "+ %s" cmd;
if not !dry_mode then begin
Expand Down Expand Up @@ -1360,8 +1425,14 @@ let setup_toolchain () =
default_libs :=
["-lmingw32"; "-lgcc"; "-lgcc_eh"; "-lmoldname"; "-lmingwex"; "-lmsvcrt";
"-luser32"; "-lkernel32"; "-ladvapi32"; "-lshell32" ];
if !exe_mode = `EXE then default_libs := "crt2.o" :: !default_libs
else default_libs := "dllcrt2.o" :: !default_libs
if not (List.mem "-nostartfiles" !extra_args) then begin
if !exe_mode = `EXE then
if List.mem "-municode" !extra_args then
default_libs := "crt2u.o" :: !default_libs
else
default_libs := "crt2.o" :: !default_libs
else default_libs := "dllcrt2.o" :: !default_libs
end
in
match !toolchain with
| _ when !builtin_linker ->
Expand Down