├── .gitattributes
├── .gitignore
├── .ocp-indent
├── CHANGES
├── Compat.ml.in
├── LICENSE
├── Makefile
├── README.md
├── appveyor.yml
├── appveyor_build.sh
├── checkenv
├── clear_appveyor_cache.sh
├── cmdline.ml
├── coff.ml
├── create_dll.ml
├── default.manifest
├── default_amd64.manifest
├── flexdll.c
├── flexdll.h
├── flexdll.install
├── flexdll.opam
├── flexdll_initer.c
├── installer.nsi
├── msvs-detect
├── reloc.ml
├── test
    ├── Makefile
    ├── api.h
    ├── dump.c
    ├── plug1.c
    └── plug2.c
└── version.rc


/.gitattributes:
--------------------------------------------------------------------------------
1 | * text=auto
2 | 
3 | msvs-detect text eol=lf
4 | checkenv text eol=lf
5 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
 1 | *.swp
 2 | *.obj
 3 | *.o
 4 | *.cmx
 5 | *.cmo
 6 | *.cmi
 7 | *.dll
 8 | *.tar.gz
 9 | *.zip
10 | flexlink.exe
11 | flexlink.opt
12 | test/dump.exe
13 | version.res
14 | version.ml
15 | Makefile.winsdk
16 | COMPILER-*
17 | Compat.ml
18 | 


--------------------------------------------------------------------------------
/.ocp-indent:
--------------------------------------------------------------------------------
1 | match_clause=4
2 | strict_with=auto
3 | 


--------------------------------------------------------------------------------
/CHANGES:
--------------------------------------------------------------------------------
  1 | Version 0.44
  2 | - GPR#127: Recognise hyphens in option names in the COFF .drectve section.
  3 |   Fixes #126 (Reza Barazesh)
  4 | - GPR#136: Fix parallel access crashes and misbehavior
  5 |   (David Allsopp, Jan Midtgaard, Antonin Décimo)
  6 | - GPR#141: Support relocation kind 0003 (IMAGE_REL_AMD64_ADDR32NB) and
  7 |   IMAGE_REL_I386_DIR32NB. Extend relative types to IMAGE_REL_AMD64_REL32_5.
  8 |   Fixes GPR#29 (Jonah Beckford)
  9 | - GPR#148: Pass-through -pthread to the linker (Romain Beauxis)
 10 | - GPR#150: Fix stack reserve incorrectly reading from the start of the PE
 11 |   executable instead of the COFF file header. Fix reading the file address of
 12 |   new exe header.
 13 |   (Antonin Décimo, review by David Allsopp and Nicolás Ojeda Bär)
 14 | - GPR#153: Allow the names of the compiler binaries to be overridden without
 15 |   losing the flags which go with them to assist use of alternate compilers and
 16 |   for cross-compilation. Fix FlexDLL cross-build on macOS and BSD.
 17 |   (Antonin Décimo, review by Nicolás Ojeda Bär)
 18 | - GPR#151: Use response files with all toolchains
 19 |   (Puneeth Chaganti, review by David Allsopp and Antonin Décimo)
 20 | - GPR#152: Use a response file to pass arguments to cygpath
 21 |   (Puneeth Chaganti, review by David Allsopp and Antonin Décimo)
 22 | - GPR#156: Allow choosing an alternative linker and manifest tool at runtime
 23 |   with -use-linker=<cmd> and -use-mt=<cmd>.
 24 |   (Antonin Décimo, review by David Allsopp)
 25 | - GPR#133, GPR#147: Allow default libraries to be marked as optional
 26 |   (David Allsopp, report by Romain Beauxis)
 27 | - GPR#157: Improve flexlink support on Unix (for cross-compiling contexts).
 28 |   (Antonin Décimo, review by David Allsopp)
 29 | - GPR#158: Reuse the compilers used during the build for later operations, such
 30 |   as querying the compilers for their library search paths. Support parsing
 31 |   clang output.
 32 |   (Antonin Décimo, review by David Allsopp)
 33 | 
 34 | Version 0.43
 35 | - GPR#108: Add -lgcc_s to Cygwin's link libraries, upstreaming a patch from the
 36 |   Cygwin flexdll package (David Allsopp)
 37 | - GPR#112: Put error global variables into thread-local storage (Samuel Hym, Nicolás Ojeda Bär)
 38 | - GPR#114: Support for /alternatename directive. Fixes GPR#113 (Jonah Beckford)
 39 | - GPR#116: Remove Cygwin32 (David Allsopp)
 40 | - GPR#117: Fix handling of object names of length > 16 in archive files. Fixes GPR#101 (Nicolás Ojeda Bär)
 41 | - GPR#118: Defer the detection of cygpath to the first time it's actually
 42 |   required, reducing the overall number of calls. Further, detect whether
 43 |   mingw-w64 gcc's library path requires cygpath, which further reduces the
 44 |   calls when using Cygwin's build of mingw-w64 as the search path is then
 45 |   converted only once. In passing, this trivially adds support for MSYS2's
 46 |   mingw-w64 compilers, fixing GPR#97. (David Allsopp)
 47 | 
 48 | Version 0.42
 49 | - GPR#106: Support -l: syntax, to allow static linking of specific libraries (David Allsopp)
 50 | - GPR#103: Delete objects from C files compiled by flexlink (David Allsopp, report by Xavier Leroy)
 51 | - GPR#85: Split multiple arguments passed with a single -Wl (David Allsopp)
 52 | 
 53 | Version 0.41
 54 | - GPR#98: Eliminate Warning 6 compiling coff.ml (David Allsopp)
 55 | - GPR#99: Harden version number parsing from ocamlopt -version (David Allsopp)
 56 | 
 57 | Version 0.40
 58 | - GPR#65: Support for compiling objects with /bigobj (Extended COFF) (Dmitry Bely)
 59 | - GPR#80: Silence MSVC filenames for long commands as well as short ones (David Allsopp)
 60 | - GPR#94: Fix parsing of COFF archives to ignore <XFGHASH> headers, allowing the Windows 11 SDK to be used. (David Allsopp)
 61 | - GPR#96: Suppress volatile metadata on versions of MSVC which support it (David Allsopp)
 62 | - GPR#88: Correctly handle relative search paths coming from gcc -print-search-dirs (Boris Yakobowski)
 63 | 
 64 | Version 0.39
 65 | - GPR#89: Stop passing --image-base on Cygwin64 - Cygwin64 DLLs should load at
 66 |   0x4:00000000-0x6:00000000 if not rebased or 0x2:00000000-0x4:00000000 if rebased. (David Allsopp)
 67 | - GPR#90: Fix passing NULL to flexdll_dlopen on non-Cygwin builds (David Allsopp)
 68 | 
 69 | Version 0.38
 70 | - GPR#58: Bug fix: fix -custom-crt regression (Dmitry Bely)
 71 | - GPR#61: Ignore x64 debug relocs (Dmitry Bely)
 72 | - GPR#49: Adding support for 64bit GNAT compiler (Johannes Kanig)
 73 | - GPR#64: Fix problem with setting page permission during relocation (report
 74 |   by Dmitry Bely)
 75 | - GPR#48: Enable linking of C++ object files for mingw ports (David Allsopp)
 76 | - GPR#81, GPR#84: use msvs-detect (from metastack/msvs-tools) for detecting Windows SDK
 77 |   or Visual Studio (David Allsopp)
 78 | - GPR#78: Eliminate deprecation warnings on OCaml 4.08+ (Bernhard Schommer)
 79 | - GPR#68: fix incorrect calculation of maximum path length (Bryan Phelps and David Allsopp)
 80 | - GPR#3: Recognise data symbols in import libraries (Andreas Hauptmann)
 81 | - GPR#73: Pass GCC-style linker options (-Wl,...) onto the the linker (Michael Soegtrop)
 82 | 
 83 | Version 0.37
 84 | - Bug fix: the IMAGE_SCN_LNK_NRELOC_OVFL section flag was not propertly reset when
 85 |   the number of relocations was reduced enough to fit in the 16-bit field,
 86 |   causing https://caml.inria.fr/mantis/view.php?id=7603
 87 | - Support for passing argument through external files (-arg/-arg0)
 88 |   (Bernhard Schommer)
 89 | - Fix encoding of high surrogate for U+10000-U+10FFFF in UTF-16 response files (David Allsopp)
 90 | 
 91 | Version 0.36
 92 | - Add Unicode support (patch by Nicolás Ojeda Bär)
 93 | - Workaround apparent bug in VS 2017.3 link (patch by David Allsopp)
 94 | - Additional heuristic for -lfoo on MSVC: try libfoo.lib but then try foo.lib (David Allsopp)
 95 | 
 96 | Version 0.35
 97 | - Fixes for clang (patch by Roven Gabriel)
 98 | - Improve autodetection of WinSDK paths (patch by David Allsopp)
 99 | - Add MSVC_DETECT Makefile variable which overrides all C Compiler detection logic when 0.
100 | - Add checkenv script which determines if the environment is sound specifying MSVC_DETECT=0
101 | - Improve performance of -builtin
102 | - Better support for @response files, which can contain options in
103 |   addition to filenames (patch by Bernhard Schommer)
104 | - Ignore "-g" (passed by OCaml when building ocamlrund) (patch by whitequark)
105 | - Uses gcc -print-search-dirs instead of gcc -print-sysroot when figuring out the default
106 |   library search paths (patch by whitequark)
107 | - Modernize code for OCaml 4.03 (patch for compatibility layers for earlier versions by David Allsopp)
108 | - Better support for long command line when calling the toolchain linker
109 | - Do not perform relocation from the DLL entry point when the DLL is loaded in "not for
110 |   execution mode" (http://caml.inria.fr/mantis/view.php?id=7268)
111 | - Fix -stack for Cygwin (when the resulting executable is called XXX.exe, not XXX)
112 | 
113 | Version 0.34
114 | - New option -norelrelocs to check that no relative flexdll relocations are created (this ensures that the generated DLLs can be loaded at any address),
115 | - New option -base to specify the image base address (msvc64 only).
116 | - Always generate a table for used __flimp_XXX symbols (even when X is defined in the generated image).
117 | - Fix bug with empty sections in "-builtin" mode
118 | - -builtin: Generate proper ADDR64 instead of HIGHLOW (32-bit) relocations in the dll
119 | 
120 | Version 0.33
121 | - Turn 'too far' messages into proper errors, avoid terminating the process
122 | 
123 | Version 0.31
124 | - Support for "@respfiles" arguments (for long command lines).
125 |   Used to be implemented by OCaml runtime system.
126 | - Fix bug when relocation counter > 0xffff
127 | - Fix bug with REL32 relocations on non-zero base in DLLs
128 | - Fix bug with empty .a files
129 | 
130 | Version 0.30
131 | - Allow the internal linker to create large DLLs (>= 16Mb)
132 | 
133 | Version 0.29
134 | - use "cygpath -S", not "cygpath -v" which no longer exists
135 | 
136 | Version 0.28
137 | - new option '-stack' to set the stack reserve
138 | - new option '-patch' (to be used in conjunction with -stack and -o to
139 |   patch the an existing image)
140 | 
141 | Version 0.27
142 | - support for mingw64; the mingw toolcgain now relies on the 32-bit version of mingw64;
143 |   the old "gcc -mno-cygwin" is no longer supporte.
144 |   Patch from Antointe Mine:
145 |   http://caml.inria.fr/mantis/view.php?id=5179
146 | - fix directive parsing bug (http://caml.inria.fr/mantis/view.php?id=5339)
147 | - support for new file layout for cygwin's version of mingw
148 | - support for objects with more than 65536 relocations
149 | 
150 | Version 0.26
151 | - fix for Win64 (use a PE32+ optional header, and a lower base address)
152 | - use _putenv_s instead of putenv for FLEXDLL_RELOCATE (thanks to Yasutaka Atarashi)
153 | - use /dev/null instead of NUL for Cygwin (thanks to Yasutaka Atarashi)
154 | 
155 | Version 0.25
156 | - fix a bug with archive member names that contain a slash
157 | 
158 | Version 0.24
159 | - add new toolchain msvc64; replace the old combination "-chain msvc -x64" (-x64 has been removed)
160 | - change build system to create a single binary version of flexdll that includes both the 32-bit and 64-bit
161 |   version for MSVC's support objects
162 | - switch to Visual Studio 2008 (to compile the binary distribution and for the default manifests)
163 | 
164 | Version 0.23
165 | - ignore -D and -U flags (OCaml PR #4979)
166 | - change limit before using a response file (OCaml PR #4645)
167 | 
168 | Version 0.22
169 | - fix a bug when emitting IMAGE_COMDAT_SELECT_ASSOCIATIVE symbols
170 | 
171 | Version 0.21
172 | - always use bash to call external commands under Cygwin (to make it work
173 |   when gcc is a symlink)
174 | 
175 | Version 0.20
176 | - (build) Avoid the use of the rc tool
177 | - (dist) add version.rc to the source release
178 | - Allow "/link XXX" as an equivalent to "-link XXX" (or "/linkXXX")
179 | - Use an explicit .def file under MinGW and Cygwin to force the two symbols reloctbl and symtbl to be exported
180 | - Fixes for x64
181 | - Allow to write sections with more than 0xffff relocations
182 | - Create a Win32 installer
183 | 
184 | Version 0.19
185 | - fix bug introduced in version 0.17 about virtual addresses for the builtin
186 |   linker mode
187 | 
188 | Version 0.18
189 | - support for .sxdata section
190 | 
191 | Version 0.17
192 | - patch from Lars Nilsson to ease compilation of flexdll.h with C++
193 | - prefer using XXX.dll.a (import lib) over XXX.a (static lib)
194 | - fix bug introduced in commit 136 about virtual addresses
195 | 
196 | Version 0.16
197 | - New -noexport command line option to force an empty symbol table
198 | 
199 | Version 0.15, released on 2009-02-25
200 | - protects calls to cygpath with long command lines (patch from
201 |   Matthieu Dubuget)
202 | - always pass msvcrt.lib to link.exe
203 | 
204 | Version 0.14, released on 2008-28-01
205 | - mingw port: put /lib/mingw before /lib
206 | - support for a built-in linker
207 | 
208 | Version 0.13, released on 2008-11-20
209 | - another technique to work around the lack of response file for gcc:
210 |   put the command line in an external bash script and apply bash to it
211 |   (relies on the fact that Cygwin programs can call Cygwin programs
212 |   with long command lines); this idea is from Xavier Leroy
213 | - the -subsystem switch is now supported for the mingw toolchain
214 | 
215 | Version 0.12, released on 2008-11-17
216 | - gcc 3 does not support response files; to support longer command lines, we use a
217 |   custom replacement for cmd.exe (which restricts the length of the command line
218 |   to 8kB whereas Windows supports 32kB)
219 | - patch for Richard Jones: do not find directories when looking for a file
220 | 
221 | Version 0.11, released on 2008-11-10
222 | - compiled with mingw port so as to depend on msvcrt.dll, not msvcr80.dll
223 | - experimental support for directly calling "ld" instead of "gcc"
224 | - by default, reexport symbols imported from an import library
225 | - quote the response file argument
226 | - use slashes instead of backslashed in response file (needed for mingw's ld)
227 | - by default, use the real manifest
228 | 
229 | Version 0.10, released on 2008-10-21
230 | - use "gcc -mno-cygwin -print-libgcc-file-name" to get the standard
231 |   library directory for mingw
232 | - lower the length threshold to use a diversion file when calling the
233 |   linker with many arguments
234 | 
235 | Version 0.9, released on 2008-09-18
236 |  - fix bug with COFF symbols for sections (with more than 1 auxilliary block)
237 |  - ignore debug relocations on x86 (of kind 0x000a, 0x000b)
238 | 
239 | Version 0.8, released on 2008-03-10
240 |  - new -no-merge-manifest
241 | 
242 | Version 0.7, released on 2008-03-09
243 |  - allow .dll.a as automatic extension for libraries
244 |  - minor bug fixes
245 | 
246 | Version 0.6, released on 2008-02-11
247 |  - support COMDAT section symbols
248 |  - support mixed libraries (import library + regular objects)
249 |  - optimizations (do not rewrite library objects when not needed,
250 |    pass the lib to the linker)
251 |  - new -real-manifest, replace -default-manifest
252 |  - new -implib option
253 |  - new -outdef option
254 |  - new zlib/libpng license
255 | 
256 | Version 0.5, released on 2008-01-11
257 |  - new -default-manifest option (always on, currently)
258 |  - use a temp file name for getting the output of commands (allow
259 |    several instances of flexlink to run in parallel)
260 | 
261 | Version 0.4, released on 2008-01-02
262 |  - Code cleanup
263 |  - FLEXLINKFLAGS env var to pass extra arguments
264 | 
265 | Version 0.3, released on 2007-11-20
266 |  - Make it work under x86_64
267 |  - New -subsystem option (currently for MSVC chain only)
268 |  - New -explain option
269 |  - New -link option
270 | 
271 | Version 0.2, released on 2007-11-06
272 |  - New -maindll option (to build a DLL that contains the "main program"
273 |    from FlexDLL's point of view)
274 |  - Can now explicitly enable/disable the use of cygpath (on by default
275 |    only for Cygwin)
276 |  - New -L xxx (or -Lxxx) option
277 |  - New -where option
278 |  - FLEXDIR environment variable (where to look for FlexDLL's .obj files)
279 | 
280 | Version 0.1, released on 2007-06-14
281 |  - Initial release
282 | 
283 | <!-- Local Variables:  -->
284 | <!-- coding: utf-8     -->
285 | <!-- End:              -->
286 | 


--------------------------------------------------------------------------------
/Compat.ml.in:
--------------------------------------------------------------------------------
  1 | (************************************************************************)
  2 | (*   FlexDLL                                                            *)
  3 | (*   Alain Frisch                                                       *)
  4 | (*                                                                      *)
  5 | (*   Copyright 2007 Institut National de Recherche en Informatique et   *)
  6 | (*   en Automatique.                                                    *)
  7 | (************************************************************************)
  8 | 
  9 | (* Compatibility shims. Each line is prefixed with the compiler at which the
 10 |    line ceases to be necessary. A function introduced in OCaml 4.01, therefore,
 11 |    is prefixed with "401:" *)
 12 | 
 13 | 405:module Arg = struct
 14 | 405:  include Arg
 15 | 405:
 16 | 405:  let trim_cr s =
 17 | 405:    let len = String.length s in
 18 | 405:    if len > 0 && String.get s (len - 1) = '\r' then
 19 | 405:      String.sub s 0 (len - 1)
 20 | 405:    else
 21 | 405:      s
 22 | 405:
 23 | 405:  let read_aux trim sep file =
 24 | 405:    let ic = open_in_bin file in
 25 | 405:    let buf = Buffer.create 200 in
 26 | 405:    let words = ref [] in
 27 | 405:    let stash () =
 28 | 405:      let word = Buffer.contents buf in
 29 | 405:      let word = if trim then trim_cr word else word in
 30 | 405:      words := word :: !words;
 31 | 405:      Buffer.clear buf
 32 | 405:    in
 33 | 405:    begin
 34 | 405:      try while true do
 35 | 405:          let c = input_char ic in
 36 | 405:          if c = sep then stash () else Buffer.add_char buf c
 37 | 405:        done
 38 | 405:      with End_of_file -> ()
 39 | 405:    end;
 40 | 405:    if Buffer.length buf > 0 then stash ();
 41 | 405:    close_in ic;
 42 | 405:    Array.of_list (List.rev !words)
 43 | 405:
 44 | 405:  let read_arg = read_aux true '\n'
 45 | 405:
 46 | 405:  let read_arg0 = read_aux false '\x00'
 47 | 405:
 48 | 405:end
 49 | 
 50 | 403:module Uchar = struct
 51 | 403:  let unsafe_of_int c = c
 52 | 403:
 53 | 403:  let to_int c = c
 54 | 403:end
 55 | 
 56 | 406:module Buffer = struct
 57 | 406:  include Buffer
 58 | 406:
 59 | 402:  let to_bytes = contents
 60 | 402:
 61 | 406:  let add_utf_16le_uchar b u = match Uchar.to_int u with
 62 | 406:  | u when u < 0 -> assert false
 63 | 406:  | u when u <= 0xFFFF ->
 64 | 406:      add_char b (Char.unsafe_chr (u land 0xFF));
 65 | 406:      add_char b (Char.unsafe_chr (u lsr 8))
 66 | 406:  | u when u <= 0x10FFFF ->
 67 | 406:      let u' = u - 0x10000 in
 68 | 406:      let hi = 0xD800 lor (u' lsr 10) in
 69 | 406:      let lo = 0xDC00 lor (u' land 0x3FF) in
 70 | 406:      add_char b (Char.unsafe_chr (hi land 0xFF));
 71 | 406:      add_char b (Char.unsafe_chr (hi lsr 8));
 72 | 406:      add_char b (Char.unsafe_chr (lo land 0xFF));
 73 | 406:      add_char b (Char.unsafe_chr (lo lsr 8))
 74 | 406:  | _ -> assert false
 75 | 406:end
 76 | 
 77 | 402:module Bytes = struct
 78 | 402:  include String
 79 | 402:
 80 | 402:  let blit_string = blit
 81 | 402:  let sub_string = sub
 82 | 402:  let of_string x = x
 83 | 402:  let to_string x = x
 84 | 402:  let cat = (^)
 85 | 402:end
 86 | 
 87 | 403:module Char = struct
 88 | 403:  include Char
 89 | 403:
 90 | 403:  let lowercase_ascii c =
 91 | 403:    if (c >= 'A' && c <= 'Z')
 92 | 403:    then unsafe_chr(code c + 32)
 93 | 403:    else c
 94 | 403:
 95 | 403:  let uppercase_ascii c =
 96 | 403:    if (c >= 'a' && c <= 'z')
 97 | 403:    then unsafe_chr(code c - 32)
 98 | 403:    else c
 99 | 403:end
100 | 
101 | 408:module Option = struct
102 | 408:  let some v = Some v
103 | 408:  let value o ~default = match o with Some v -> v | None -> default
104 | 408:  let fold ~none ~some = function Some v -> some v | None -> none
105 | 408:end
106 | 
107 | 407:module Stdlib = Pervasives
108 | 
109 | 404:module String = struct
110 | 404:  include String
111 | 402:
112 | 402:  let init n f =
113 | 402:    let s = create n in
114 | 402:    for i = 0 to n - 1 do
115 | 402:      unsafe_set s i (f i)
116 | 402:    done;
117 | 402:    s
118 | 403:
119 | 403:  let lowercase_ascii s =
120 | 403:    init (length s) (fun i -> Char.lowercase_ascii (unsafe_get s i))
121 | 403:  let uppercase_ascii s =
122 | 403:    init (length s) (fun i -> Char.uppercase_ascii (unsafe_get s i))
123 | 404:
124 | 404:  let split_on_char sep s =
125 | 404:    let r = ref [] in
126 | 404:    let j = ref (length s) in
127 | 404:    for i = length s - 1 downto 0 do
128 | 404:      if unsafe_get s i = sep then begin
129 | 404:        r := sub s (i + 1) (!j - i - 1) :: !r;
130 | 404:        j := i
131 | 404:      end
132 | 404:    done;
133 | 404:    sub s 0 !j :: !r
134 | 404:end
135 | 
136 | 401:module Sys = struct
137 | 401:  include Sys
138 | 401:
139 | 401:  let win32 = (Sys.os_type = "Win32")
140 | 401:  let cygwin = (Sys.os_type = "Cygwin")
141 | 401:  let unix = (Sys.os_type = "Unix")
142 | 401:end
143 | 
144 | 402:type bytes = string
145 | 402:let output_bytes = output_string
146 | 
147 | 401:let ( |> ) x f = f x
148 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | The package FlexDLL is released under the terms of the zlib/libpng License.
 2 | 
 3 | Copyright (c) 2007, 2008, 2009
 4 | Institut National de Recherche en Informatique et en Automatique
 5 | 
 6 | This software is provided 'as-is', without any express or implied
 7 | warranty. In no event will the authors be held liable for any damages
 8 | arising from the use of this software.
 9 | 
10 | Permission is granted to anyone to use this software for any purpose,
11 | including commercial applications, and to alter it and redistribute it
12 | freely, subject to the following restrictions:
13 | 
14 | 1. The origin of this software must not be misrepresented; you must not
15 |    claim that you wrote the original software. If you use this software
16 |    in a product, an acknowledgment in the product documentation would be
17 |    appreciated but is not required.
18 | 
19 | 2. Altered source versions must be plainly marked as such, and must not be
20 |    misrepresented as being the original software.
21 | 
22 | 3. This notice may not be removed or altered from any source distribution.
23 | 


--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
  1 | ## Tips to build flexdll:
  2 | ##
  3 | ##  To use an already configured 64-bit MSVC toolchain:
  4 | ##     make all MSVC_DETECT=0 CHAINS="mingw mingw64 cygwin64 msvc64"
  5 | ##
  6 | 
  7 | 
  8 | # Fetch the version number from its source, in flexdll.opam
  9 | VERSION = \
 10 |   $(eval VERSION := $$(shell sed -ne 's/^version: *"\(.*\)"/\1/p' flexdll.opam))$(VERSION)
 11 | 
 12 | all: flexlink.exe support
 13 | 
 14 | OCAML_CONFIG_FILE=$(shell cygpath -ad "$(shell ocamlopt -where 2>/dev/null)/Makefile.config" 2>/dev/null)
 15 | include $(OCAML_CONFIG_FILE)
 16 | OCAMLOPT=ocamlopt
 17 | EMPTY=
 18 | SPACE=$(EMPTY) $(EMPTY)
 19 | COMMA=,
 20 | OCAML_VERSION:=$(firstword $(subst ~, ,$(subst +, ,$(shell $(OCAMLOPT) -version 2>/dev/null))))
 21 | ifeq ($(OCAML_VERSION),)
 22 | OCAML_VERSION:=0
 23 | COMPAT_VERSION:=0
 24 | else
 25 | COMPAT_VERSION:=$(subst ., ,$(OCAML_VERSION))
 26 | COMPAT_VERSION:=$(subst $(SPACE),,$(firstword $(COMPAT_VERSION))$(foreach i,$(wordlist 2,$(words $(COMPAT_VERSION)),$(COMPAT_VERSION)),$(if $(filter 0 1 2 3 4 5 6 7 8 9,$(i)),0,)$(i)))
 27 | endif
 28 | 
 29 | GCC_FLAGS = -Wall
 30 | 
 31 | MINGW_PREFIX = i686-w64-mingw32-
 32 | MINCC = $(MINGW_PREFIX)gcc
 33 | 
 34 | MINGW64_PREFIX = x86_64-w64-mingw32-
 35 | MIN64CC = $(MINGW64_PREFIX)gcc
 36 | 
 37 | CYGWIN64_PREFIX = x86_64-pc-cygwin-
 38 | CYG64CC = $(CYGWIN64_PREFIX)gcc
 39 | 
 40 | version.ml: Makefile flexdll.opam
 41 | 	echo 'let version = "$(VERSION)"' > $@
 42 | 	echo 'let mingw_prefix = "$(MINGW_PREFIX)"' >> $@
 43 | 	echo 'let mingw64_prefix = "$(MINGW64_PREFIX)"' >> $@
 44 | 	echo 'let msvc = "$(notdir $(MSVCC))"' >> $@
 45 | 	echo 'let msvc64 = "$(notdir $(MSVCC64))"' >> $@
 46 | 	echo 'let cygwin64 = "$(notdir $(CYG64CC))"' >> $@
 47 | 	echo 'let mingw = "$(notdir $(MINCC))"' >> $@
 48 | 	echo 'let mingw64 = "$(notdir $(MIN64CC))"' >> $@
 49 | 	echo 'let gnat = "gcc"' >> $@
 50 | 
 51 | # Supported tool-chains
 52 | 
 53 | CHAINS = mingw mingw64 cygwin64 msvc msvc64
 54 | 
 55 | # Compilers
 56 | 
 57 | # NB MSVC_DETECT is expected by OCaml's build system
 58 | MSVC_DETECT=1
 59 | 
 60 | # Attempt to locate the Windows SDK
 61 | 
 62 | ifeq ($(MSVC_DETECT),1)
 63 | ifeq ($(if $(MAKECMDGOALS),$(if $(strip $(filter-out clean,$(MAKECMDGOALS))),,1)),)
 64 | include Makefile.winsdk
 65 | endif
 66 | endif
 67 | 
 68 | Makefile.winsdk: msvs-detect
 69 | 	bash ./msvs-detect --output=make > $@
 70 | 
 71 | MSVC_FLAGS = /nologo /MD -D_CRT_SECURE_NO_DEPRECATE /GS- /W3
 72 | 
 73 | ifeq ($(MSVC_DETECT),0)
 74 | # Assume that the environment is correctly set for a single Microsoft C Compiler; don't attempt to guess anything
 75 | MSVCC_ROOT=
 76 | MSVC_PREFIX=
 77 | MSVC64_PREFIX=
 78 | MSVCC = cl.exe
 79 | MSVCC64 = cl.exe
 80 | else
 81 | ifeq ($(MSVS_PATH),)
 82 | # Otherwise, assume the 32-bit version of VS 2008 or Win7 SDK is in the path.
 83 | 
 84 | MSVCC_ROOT := $(shell which cl.exe 2>/dev/null | cygpath -f - -ad | xargs -d \\n dirname 2>/dev/null | cygpath -f - -m)
 85 | MSVC_LIB1 = $(shell dirname $(MSVCC_ROOT))
 86 | MSVC_LIB2 = $(shell which ResGen.exe | cygpath -f - -ad | xargs -d \\n dirname | xargs -d \\n dirname | cygpath -f - -m)
 87 | MSVC_LIB = $(MSVC_LIB1)/Lib;$(MSVC_LIB2)/Lib
 88 | MSVC_INCLUDE = $(MSVC_LIB1)/Include;$(MSVC_LIB2)/Include
 89 | MSVC_PREFIX=LIB="$(MSVC_LIB)" INCLUDE="$(MSVC_INCLUDE)"
 90 | 
 91 | MSVC64_LIB = $(MSVC_LIB1)/Lib/amd64;$(MSVC_LIB2)/Lib/x64
 92 | MSVC64_PREFIX=LIB="$(MSVC64_LIB)" INCLUDE="$(MSVC_INCLUDE)"
 93 | 
 94 | MSVCC = $(MSVCC_ROOT)/cl.exe
 95 | MSVCC64 = $(MSVCC_ROOT)/amd64/cl.exe
 96 | else
 97 | MSVCC_ROOT:=
 98 | MSVC_PREFIX=PATH="$(MSVS_PATH)$(PATH)" LIB="$(MSVS_LIB)$(LIB)" INCLUDE="$(MSVS_INC)$(INCLUDE)"
 99 | MSVC64_PREFIX=PATH="$(MSVS64_PATH)$(PATH)" LIB="$(MSVS64_LIB)$(LIB)" INCLUDE="$(MSVS64_INC)$(INCLUDE)"
100 | 
101 | MSVCC = cl.exe
102 | MSVCC64 = cl.exe
103 | endif
104 | endif
105 | 
106 | FLEXDLL_WARN_ERROR ?=
107 | ifeq ($(FLEXDLL_WARN_ERROR),true)
108 | GCC_FLAGS += -Wextra -std=c99 -Werror -fdiagnostics-color=always
109 | MSVC_FLAGS += /WX
110 | endif
111 | 
112 | show_root:
113 | ifeq ($(MSVCC_ROOT),)
114 | 	@echo "$(MSVS_PATH)"
115 | 	@echo "$(MSVS_LIB)"
116 | else
117 | 	@echo "$(MSVCC_ROOT)"
118 | 	@echo "$(MSVC_LIB)"
119 | endif
120 | 
121 | OCAMLOPT = ocamlopt -g
122 | 
123 | #OCAMLOPT += -strict-sequence -strict-formats -safe-string -w +A-9
124 | 
125 | #OCAMLOPT = FLEXLINKFLAGS=-real-manifest ocamlopt
126 | #LINKFLAGS = unix.cmxa
127 | 
128 | ifeq ($(TOOLCHAIN), msvc)
129 | RC = rc
130 | RES=version.res
131 | ifeq ($(ARCH), i386)
132 | RES_PREFIX=$(MSVC_PREFIX)
133 | else
134 | RES_PREFIX=$(MSVC64_PREFIX)
135 | endif
136 | else
137 | RC = $(TOOLPREF)windres
138 | RES=version_res.o
139 | RES_PREFIX=
140 | endif
141 | 
142 | ifeq ($(NATDYNLINK), false)
143 | #when ocaml is not built with flexlink i.e. -no-shared-libs
144 | LINKFLAGS = -cclib "$(RES)"
145 | else
146 | LINKFLAGS = -cclib "-link $(RES)"
147 | endif
148 | 
149 | support: $(addprefix build_, $(CHAINS))
150 | 
151 | build_gnat: flexdll_gnat.o flexdll_initer_gnat.o
152 | build_msvc: flexdll_msvc.obj flexdll_initer_msvc.obj
153 | build_msvc64: flexdll_msvc64.obj flexdll_initer_msvc64.obj
154 | build_cygwin64: flexdll_cygwin64.o flexdll_initer_cygwin64.o
155 | build_mingw: flexdll_mingw.o flexdll_initer_mingw.o
156 | build_mingw64: flexdll_mingw64.o flexdll_initer_mingw64.o
157 | 
158 | OBJS = version.ml Compat.ml coff.ml cmdline.ml create_dll.ml reloc.ml
159 | 
160 | COMPILER-$(COMPAT_VERSION):
161 | 	rm -f COMPILER-*
162 | 	touch COMPILER-$(COMPAT_VERSION)
163 | 
164 | test_ver = $(shell if [ $(COMPAT_VERSION) -ge $(1) ] ; then echo ge ; fi)
165 | 
166 | # This list must be in order
167 | COMPAT_LEVEL := \
168 |   $(strip $(if $(call test_ver,40100),401) \
169 |           $(if $(call test_ver,40200),402) \
170 |           $(if $(call test_ver,40300),403) \
171 |           $(if $(call test_ver,40400),404) \
172 |           $(if $(call test_ver,40500),405) \
173 |           $(if $(call test_ver,40600),406) \
174 |           $(if $(call test_ver,40700),407) \
175 |           $(if $(call test_ver,40800),408))
176 | 
177 | Compat.ml: Compat.ml.in COMPILER-$(COMPAT_VERSION)
178 | 	sed -E -e '$(if $(COMPAT_LEVEL),/^$(subst $(SPACE),:|^,$(COMPAT_LEVEL)):/d;)s/^[0-9]*://' $< > $@
179 | 
180 | flexlink.exe: $(OBJS) $(RES)
181 | 	@echo Building flexlink.exe with TOOLCHAIN=$(TOOLCHAIN) for OCaml $(OCAML_VERSION)
182 | 	rm -f $@
183 | 	$(RES_PREFIX) $(OCAMLOPT) -o $@ $(LINKFLAGS) $(OBJS)
184 | 
185 | # VERSION at present is x.y, but there would be no reason not to have x.y.z in
186 | # future. Windows versions have four components. $(FLEXDLL_FULL_VERSION) adds
187 | # additional .0s to the right of $(VERSION) such that $(FLEXDLL_FULL_VERSION)
188 | # has four version components.
189 | # Thus if VERSION=0.43, then FLEXDLL_FULL_VERSION=0.43.0.0
190 | # $(FLEXDLL_VS_VERSION_INFO) is the same value, but using a ',' to separate the
191 | # items rather than a '.', as this is the format used in a VS_VERSION_INFO block
192 | # in Resource Compiler format.
193 | FLEXDLL_FULL_VERSION = \
194 |   $(subst $(SPACE),.,$(wordlist 1, 4, $(subst .,$(SPACE),$(VERSION)) 0 0 0))
195 | FLEXDLL_VS_VERSION_INFO = $(subst .,$(COMMA),$(FLEXDLL_FULL_VERSION))
196 | 
197 | RC_FLAGS = \
198 |   /d FLEXDLL_VS_VERSION_INFO=$(FLEXDLL_VS_VERSION_INFO) \
199 |   /d FLEXDLL_FULL_VERSION=\"$(FLEXDLL_FULL_VERSION)\"
200 | 
201 | # cf. https://sourceware.org/bugzilla/show_bug.cgi?id=27843
202 | WINDRES_FLAGS = \
203 |   -D FLEXDLL_VS_VERSION_INFO=$(FLEXDLL_VS_VERSION_INFO) \
204 |   -D FLEXDLL_FULL_VERSION=\\\"$(FLEXDLL_FULL_VERSION)\\\"
205 | 
206 | version.res: version.rc flexdll.opam
207 | 	$(RES_PREFIX) $(RC) /nologo $(RC_FLAGS) $<
208 | 
209 | version_res.o: version.rc flexdll.opam
210 | 	$(RC) $(WINDRES_FLAGS) -i $< -o $@
211 | 
212 | flexdll_msvc.obj: flexdll.c flexdll.h
213 | 	$(MSVC_PREFIX) $(MSVCC) $(MSVC_FLAGS) /DMSVC -c /Fo"$@" $<
214 | 
215 | flexdll_msvc64.obj: flexdll.c flexdll.h
216 | 	$(MSVC64_PREFIX) $(MSVCC64) $(MSVC_FLAGS) /DMSVC /DMSVC64 -c /Fo"$@" $<
217 | 
218 | flexdll_cygwin64.o: flexdll.c flexdll.h
219 | 	$(CYG64CC) $(GCC_FLAGS) -DCYGWIN -c -o $@ $<
220 | 
221 | flexdll_mingw.o: flexdll.c flexdll.h
222 | 	$(MINCC) $(GCC_FLAGS) -DMINGW -c -o $@ $<
223 | 
224 | flexdll_gnat.o: flexdll.c flexdll.h
225 | 	gcc -c -o $@ $<
226 | 
227 | flexdll_mingw64.o: flexdll.c flexdll.h
228 | 	$(MIN64CC) $(GCC_FLAGS) -DMINGW -c -o $@ $<
229 | 
230 | flexdll_initer_msvc.obj: flexdll_initer.c
231 | 	$(MSVC_PREFIX) $(MSVCC) $(MSVC_FLAGS) -c /Fo"$@" $<
232 | 
233 | flexdll_initer_msvc64.obj: flexdll_initer.c
234 | 	$(MSVC64_PREFIX) $(MSVCC64) $(MSVC_FLAGS) -c /Fo"$@" $<
235 | 
236 | flexdll_initer_cygwin64.o: flexdll_initer.c
237 | 	$(CYG64CC) $(GCC_FLAGS) -c -o $@ $<
238 | 
239 | flexdll_initer_mingw.o: flexdll_initer.c
240 | 	$(MINCC) $(GCC_FLAGS) -c -o $@ $<
241 | 
242 | flexdll_initer_gnat.o: flexdll_initer.c
243 | 	gcc -c -o $@ $<
244 | 
245 | flexdll_initer_mingw64.o: flexdll_initer.c
246 | 	$(MIN64CC) $(GCC_FLAGS) -c -o $@ $<
247 | 
248 | 
249 | demo_msvc: flexlink.exe flexdll_msvc.obj flexdll_initer_msvc.obj
250 | 	$(MSVC_PREFIX) $(MAKE) -C test clean demo CHAIN=msvc CC="$(MSVCC)" CFLAGS="$(MSVC_FLAGS)" PLUG2_CFLAGS="/bigobj" O=obj
251 | 
252 | demo_cygwin64: flexlink.exe flexdll_cygwin64.o flexdll_initer_cygwin64.o
253 | 	$(MAKE) -C test clean demo CHAIN=cygwin64 CC="$(CYG64CC)" CFLAGS="$(GCC_FLAGS)" O=o RUN="PATH=\"/cygdrive/c/cygwin64/bin:$(PATH)\""
254 | 
255 | demo_mingw: flexlink.exe flexdll_mingw.o flexdll_initer_mingw.o
256 | 	$(MAKE) -C test clean demo CHAIN=mingw CC="$(MINCC)" CFLAGS="$(GCC_FLAGS)" O=o
257 | 
258 | demo_mingw64: flexlink.exe flexdll_mingw64.o flexdll_initer_mingw64.o
259 | 	$(MAKE) -C test clean demo CHAIN=mingw64 CC="$(MIN64CC)" CFLAGS="$(GCC_FLAGS)" O=o
260 | 
261 | demo_msvc64:  flexlink.exe flexdll_msvc64.obj flexdll_initer_msvc64.obj
262 | 	$(MSVC64_PREFIX) $(MAKE) -C test clean demo CHAIN=msvc64 CC="$(MSVCC64)" CFLAGS="$(MSVC_FLAGS)" PLUG2_CFLAGS="/bigobj" O=obj
263 | 
264 | distclean: clean
265 | 	rm -f Makefile.winsdk
266 | 
267 | clean:
268 | 	rm -f *.obj *.o *.lib *.a *.exe *.opt *.cmx *.dll *.exp *.cmi *.cmo *~ version.res version.ml COMPILER-* Compat.ml
269 | 	$(MAKE) -C test clean
270 | 
271 | 
272 | ## Packaging
273 | 
274 | COMMON_FILES = LICENSE README.md CHANGES flexdll.h flexdll.c flexdll_initer.c default.manifest default_amd64.manifest
275 | URL = frisch@frisch.fr:www/flexdll/
276 | 
277 | # Source packages
278 | 
279 | PACKAGE = flexdll-$(VERSION).tar.gz
280 | 
281 | package_src:
282 | 	rm -Rf flexdll-$(VERSION)
283 | 	mkdir flexdll-$(VERSION)
284 | 	mkdir flexdll-$(VERSION)/test
285 | 	cp -a $(filter-out version.ml,$(OBJS:Compat.ml=Compat.ml.in)) Makefile msvs-detect $(COMMON_FILES) version.rc flexdll.install flexdll.opam flexdll-$(VERSION)/
286 | 	cp -aR test/Makefile test/*.c flexdll-$(VERSION)/test/
287 | 	tar czf $(PACKAGE) flexdll-$(VERSION)
288 | 	rm -Rf flexdll-$(VERSION)
289 | 
290 | upload:
291 | 	rsync $(PACKAGE) CHANGES LICENSE $(URL)
292 | 
293 | upload_dev:
294 | 	$(MAKE) VERSION=dev upload_src
295 | 
296 | upload_src: package_src upload
297 | 
298 | # Binary package
299 | 
300 | PACKAGE_BIN = flexdll-bin-$(VERSION)$(PACKAGE_BIN_SUFFIX).zip
301 | INSTALLER = flexdll-$(VERSION)$(PACKAGE_BIN_SUFFIX)-setup.exe
302 | 
303 | package_bin:
304 | 	$(MAKE) clean all
305 | 	rm -f $(PACKAGE_BIN)
306 | 	zip $(PACKAGE_BIN) $(COMMON_FILES) \
307 | 	    flexlink.exe flexdll_*.obj flexdll_*.o flexdll.c flexdll_initer.c
308 | 
309 | do_upload_bin:
310 | 	rsync $(PACKAGE_BIN) $(URL)
311 | 
312 | upload_bin: package_bin do_upload_bin
313 | 
314 | show_toolchain:
315 | 	@echo Toolchain for the visible ocamlopt: $(TOOLCHAIN)
316 | 
317 | swap:
318 | 	$(OCAMLOPT) -o flexlink-new.exe $(LINKFLAGS) $(OBJS)
319 | 	cp flexlink.exe flexlink.exe.bak
320 | 	cp flexlink-new.exe flexlink.exe
321 | 
322 | PREFIX = "C:\Program Files (x86)\flexdll"
323 | 
324 | install:
325 | 	mkdir -p $(PREFIX)
326 | 	cp $(COMMON_FILES) flexlink.exe flexdll_*.obj flexdll_*.o flexdll.c flexdll_initer.c $(PREFIX)
327 | 
328 | installer:
329 | 	rm -rf flexdll_install_files
330 | 	mkdir flexdll_install_files
331 | 	(cd flexdll_install_files && unzip ../$(PACKAGE_BIN))
332 | 	/cygdrive/c/Program\ Files\ \(x86\)/NSIS/makensis installer.nsi
333 | 	mv flexdll_setup.exe $(INSTALLER)
334 | 
335 | upload_installer:
336 | 	rsync $(INSTALLER) $(URL)
337 | 
338 | 
339 | upload_all:
340 | 	$(MAKE) upload_src upload_bin installer upload_installer
341 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
  1 | # FlexDLL: an implementation of a dlopen-like API for Windows
  2 | 
  3 | [![Build status](https://ci.appveyor.com/api/projects/status/github/ocaml/flexdll?svg=true)](https://ci.appveyor.com/project/dra27/flexdll-7sptc)
  4 | 
  5 | ## Introduction
  6 | 
  7 | Under Windows, DLL ([Dynamically-Linked Libraries][DLL]) are generally
  8 | used to improve code modularity and sharing. A DLL can be loaded
  9 | automatically when the program is loaded (if it requires the DLL).
 10 | The program can also explicitly request Windows to load a DLL at any
 11 | moment during runtime, using the [`LoadLibrary`][LoadLibrary] function
 12 | from the Win32 API.
 13 | 
 14 | This naturally suggests to use DLLs as a plugin mechanism. For instance,
 15 | a web server could load extensions modules stored in DLLs at runtime.
 16 | But Windows does not really make it easy to implement plugins that way.
 17 | The reason is that when you try to create a DLL from a set of object
 18 | files, the linker needs to resolve all the symbols, which leads to the
 19 | very problem solved by FlexDLL:
 20 | 
 21 | **Windows DLL cannot refer to symbols defined in the main application or
 22 | in previously loaded DLLs.**
 23 | 
 24 | Some usual solutions exist, but they are not very flexible. A notable
 25 | exception is the [edll][] library (its homepage also describes the usual
 26 | solutions), which follows a rather drastic approach; indeed, edll
 27 | implements a new dynamic linker which can directly load object files
 28 | (without creating a Windows DLL).
 29 | 
 30 | FlexDLL is another solution to the same problem. Contrary to edll, it
 31 | relies on the native static and dynamic linkers. Also, it works both
 32 | with the Microsoft environment (MS linker, Visual Studio compilers) and
 33 | with Cygwin (GNU linker and compilers, in Cygwin or MinGW mode).
 34 | Actually, FlexDLL implements mostly the usual [`dlopen`][dlopen] POSIX
 35 | API, without trying to be fully conformant though (e.g. it does not
 36 | respect the official priority ordering for symbol resolution).  This
 37 | should make it easy to port applications developed for Unix.
 38 | 
 39 | [DLL]: https://en.wikipedia.org/wiki/Dynamic-link_library
 40 | [LoadLibrary]: https://learn.microsoft.com/en-us/windows/win32/api/libloaderapi/nf-libloaderapi-loadlibraryw
 41 | [edll]: https://edll.sourceforge.net/
 42 | [dlopen]: https://pubs.opengroup.org/onlinepubs/9799919799/functions/dlopen.html
 43 | 
 44 | ## About
 45 | 
 46 | FlexDLL is distributed under the terms of a zlib/libpng open source
 47 | [license](LICENSE). The copyright holder is the Institut National de
 48 | Recherche en Informatique et en Automatique (INRIA). The project was
 49 | started when I (= Alain Frisch) was working at INRIA. I'm now working
 50 | for [LexiFi][], which is kind enough to let me continue my work on
 51 | FlexDLL. My office mate at INRIA, Jean-Baptiste Tristan, coined the name
 52 | FlexDLL.
 53 | 
 54 | The runtime support library is written in C. The `flexlink` wrapper is
 55 | implemented in the wonderful [OCaml][] language.
 56 | 
 57 | [LexiFi]: https://www.lexifi.com
 58 | [OCaml]: https://ocaml.org/
 59 | 
 60 | ## Supported toolchains
 61 | 
 62 | MSVC: the 32-bit C compiler from Microsoft.
 63 | 
 64 | MSVC64: the 64-bit C compiler from Microsoft.
 65 | 
 66 | CYGWIN64: the 64-bit gcc compiler shipped with Cygwin.
 67 | 
 68 | MINGW: the 32-bit gcc compiler from the MinGW-w64 project, packaged in
 69 | Cygwin (as i686-w64-mingw32-gcc).
 70 | 
 71 | MINGW64: the 64-bit gcc compiler from the MinGW-w64 project, packaged in
 72 | Cygwin (as x86\_64-w64-mingw32-gcc).
 73 | 
 74 | LD: an internal linker to produce .dll (only).
 75 | 
 76 | ## Download
 77 | 
 78 | - [Source and binary releases](https://github.com/ocaml/flexdll/releases).
 79 | - [Development version](https://github.com/ocaml/flexdll).
 80 | - [Changelog](CHANGES).
 81 | 
 82 | **Installation instructions:** Simply run the installer and add the
 83 | resulting directory (e.g. `C:\Program Files\flexdll` or
 84 | `C:\Program Files (x86)\flexdll`) to the PATH. You can also create this
 85 | directory by hand and unzip the .zip file in it.
 86 | 
 87 | **Compiling from sources:** To compile the code from sources, you'll
 88 | need a working installation of OCaml, GNU Make, and a C toolchain
 89 | (compiler + linker) either the one from Microsoft (any version of Visual
 90 | Studio should work), Cygwin, or MinGW. It is probably a good idea to use
 91 | a native version of ocamlopt (not the Cygwin port) to compile flexlink.
 92 | By default, the `Makefile` will compile support objects for the
 93 | supported toolchains; you can choose a subset with the `CHAINS`
 94 | variable, e.g.: `make CHAINS="mingw msvc"`.
 95 | 
 96 | 
 97 | ## Overview
 98 | 
 99 | FlexDLL has two components: a wrapper around the static linker, and a
100 | tiny runtime library to be linked with the main application. The wrapper
101 | must be called in place of the normal linker when you want to produce a
102 | DLL or to link the main application. The runtime library relies
103 | internally on the native `LoadLibrary` API to implement a dlopen-like
104 | interface.
105 | 
106 | Let's see a simple example of a plugin. Here is the code for the main
107 | program (file `dump.c`):
108 | 
109 | ```c
110 | #include <stdlib.h>
111 | #include "flexdll.h"
112 | 
113 | typedef void torun(void);
114 | 
115 | void api(char *msg){ printf("API: %s\n", msg); }
116 | 
117 | int main(int argc, char **argv)
118 | {
119 |   void *sym;
120 |   void *handle;
121 |   int i;
122 |   torun *torun;
123 | 
124 |   for (i = 1; i < argc; i++) {
125 |     handle = flexdll_dlopen(argv[i], FLEXDLL_RTLD_GLOBAL);
126 | 
127 |     if (NULL == handle) { printf("error: %s\n", flexdll_dlerror()); exit(2); }
128 | 
129 |     torun = flexdll_dlsym(handle, "torun");
130 |     if (torun) torun();
131 |   }
132 |   exit(0);
133 | }
134 | ```
135 | 
136 | This application opens in turn all the DLLs given on its command line,
137 | using the FlexDLL function `flexdll_dlopen`. For each DLL, the program
138 | looks for a symbol named `torun` (which is supposed to refer to a
139 | function) and if the symbol is available in the DLL, the function is
140 | called. The program also provides a very simple API to its plugin: the
141 | `api` function. The `FLEX_RTLD_GLOBAL` flag makes all the symbols
142 | exported by each DLL available for the DLL to be loaded later.
143 | 
144 | This main program can be compiled and linked like the commands below
145 | (the `[...]` refers to the directory where FlexDLL is installed).
146 | 
147 | ```sh
148 | # MSVC
149 | cl /nologo /MD -I[...] -c dump.c
150 | flexlink -chain msvc -exe -o dump.exe dump.obj
151 | 
152 | # MINGW
153 | i686-w64-mingw32-gcc -I[...] -c dump.c
154 | flexlink -chain mingw -exe -o dump.exe dump.o
155 | 
156 | # CYGWIN
157 | gcc -I[...] -c dump.c
158 | flexlink -chain cygwin64 -exe -o dump.exe dump.o
159 | ```
160 | 
161 | The compilation step is completely standard, but in order to link the
162 | main application, you must call the `flexlink` tool, which is the
163 | wrapper around the linker. The `-chain` command line switch selects
164 | which linker to use, and the `-exe` option tells the wrapper that it
165 | must produce a stand-alone application (not a DLL).
166 | 
167 | Now we can provide a first plugin (file `plug1.c`):
168 | 
169 | ```c
170 | int x = 3;
171 | void dump_x(void) { printf("x=%i\n", x); }
172 | void torun(void) { api("plug1.torun();"); }
173 | ```
174 | 
175 | Note that the plugin uses the `api` symbol from the main application (it
176 | would be cleaner to introduce it with an `extern` declaration). You can
177 | compile and link this plugin (into a DLL) with the following commands:
178 | 
179 | ```sh
180 | # MSVC
181 | cl /nologo /MD -c plug1.c
182 | flexlink -chain msvc -o plug1.dll plug1.obj
183 | 
184 | # MINGW
185 | i686-w64-mingw32-gcc -c plug1.c
186 | flexlink -chain mingw -o plug1.dll plug1.o
187 | 
188 | # CYGWIN
189 | gcc -D_CYGWIN_  -c plug1.c
190 | flexlink -chain cygwin64 -o plug1.dll plug1.o
191 | ```
192 | 
193 | And now you can ask the main program to load the plugin:
194 | 
195 | ```console
196 | $ ./dump plug1.dll
197 | API: plug1.torun();
198 | ```
199 | 
200 | Here is the code for a second plugin (file `plug2.c`) that refers to
201 | symbols (a function and a global variable) defined in the first plugin:
202 | 
203 | ```c
204 | extern int x;
205 | 
206 | void torun(void) {
207 |   api("plug2.torun();");
208 | 
209 |   dump_x();
210 |   x = 100;
211 |   dump_x();
212 | }
213 | ```
214 | 
215 | Since the second plugin depends on the first one, you need to load both:
216 | 
217 | ```console
218 | $ ./dump plug2.dll
219 | error: Cannot resolve dump_x
220 | $ ./dump plug1.dll plug2.dll;
221 | API: plug1.torun();
222 | API: plug2.torun();
223 | x=3
224 | x=100
225 | ```
226 | 
227 | Simple, isn't it? No `declspec` declaration, no import library to deal
228 | with, …
229 | 
230 | 
231 | ## How it works
232 | 
233 | Object files (.obj/.o) contain relocation information that explain to
234 | the linker how some addresses in their code or data sections have to be
235 | patched, using the value of some global symbols. When the static linker
236 | is invoked to produce a DLL from a set of object files, it assumes that
237 | all the relocations can be performed: all the symbols which are used in
238 | relocations must be defined in some the objects linked together.
239 | FlexDLL drops this constraint following a very simple idea: when a
240 | relocation refers to a symbol which is not available, the relocation is
241 | turned into a piece of data that will be passed to the runtime support
242 | library.
243 | 
244 | In the example above, the `plug1.obj` object refers to a symbol
245 | `api`. When this object is turned into a DLL, FlexDLL produce a new
246 | temporary object file derived from `plug1.obj` without the relocation
247 | that mentions `api`. Instead, it adds an “import table”, which is just a
248 | piece of data that tells the FlexDLL support library which address has
249 | to be patched with the value of a symbol called `api` to be found
250 | somewhere else. You can see the list of such imported symbols by adding
251 | the `-show-imports` option to the `flexlink` command line:
252 | 
253 | ```console
254 | $ ../flexlink -chain msvc -o plug1.dll plug1.obj -show-imports
255 | ** Imported symbols for plug1.obj:
256 | _api
257 | ```
258 | 
259 | When the `flexdll_dlopen` function opens this DLL, it will look for an
260 | internal symbol that points to the import table, resolve the symbols and
261 | patch the code and data segments accordingly. The FlexDLL runtime
262 | library must thus maintain a set of symbols together with their concrete
263 | values (addresses). In particular, it knows about the global symbols
264 | defined in the main program. Indeed, when you link the main program with
265 | `flexlink -exe`, the wrapper produces a small fresh object file that
266 | contains a symbol table, mapping symbol names to their addresses.
267 | 
268 | ```console
269 | $ ../flexlink -chain msvc -exe -o dump.exe dump.obj -show-exports
270 | ** Exported symbols:
271 | _api
272 | _flexdll_dlclose
273 | _flexdll_dlerror
274 | _flexdll_dlopen
275 | _flexdll_dlsym
276 | _flexdll_dump_exports
277 | _flexdll_dump_relocations
278 | _main
279 | ```
280 | 
281 | As you can see, all the global symbols (including those that comes from
282 | FlexDLL itself) appear in the global symbol table. FlexDLL knows not
283 | only about symbols that comes from the main program, but also about
284 | symbols exported by the DLL it loads. This is needed to implement the
285 | `flexdll_dlsym` function, but also to deal with import tables that
286 | mention symbols defined in previously loaded DLLs (for which the
287 | `FLEXDLL_RTLD_GLOBAL` was used). So the wrapper produces not only an
288 | import table for DLLs, but also an export table:
289 | 
290 | ```console
291 | $ ../flexlink -chain msvc -o plug1.dll plug1.obj -show-imports -show-exports
292 | ** Imported symbols for plug1.obj:
293 | _api
294 | ** Exported symbols:
295 | _dump_x
296 | _torun
297 | _x
298 | 
299 | $ ../flexlink -chain msvc -o plug2.dll plug2.obj -show-imports -show-exports
300 | ** Imported symbols for plug2.obj:
301 | _api
302 | _dump_x
303 | _x
304 | ** Exported symbols:
305 | _torun
306 | ```
307 | 
308 | How does FlexDLL determine which symbols are imported or exported? It
309 | uses an algorithm similar to the linker itself. The command line
310 | mentions a number of object and library files. In a first pass, the
311 | wrapper computed which objects embedded in those libraries will be used.
312 | To do that, it looks at which symbols are used, and where they are
313 | defined. Then the wrapper considers that all the global (external)
314 | symbols are exported. Note that the `/export` or `__declspec(dllexport)`
315 | directives are not used: all the symbols are exported. (In a future
316 | version, FlexDLL will allow to control more precisely which symbols are
317 | exported). All the object files (given explicitly, or embedded in a
318 | library) that need to import symbols must be rewritten. The `flexlink`
319 | wrapper will produce new temporary object files for them. If you want to
320 | understand better how FlexDLL works, you can use the `-v` and
321 | `-save-temps` command options to tell the wrapper to show you the linker
322 | command line and to preserve those temporary files alive (by default, they
323 | are removed automatically).
324 | 
325 | Some object files can mention default libraries (they correspond to the
326 | `/defaultlib` linker flag, which is often embedded in the object
327 | `.drectve` section). FlexDLL will parse those libraries, but only to see
328 | which symbols they define. Those symbols are not considered as being
329 | imported by the DLL, but they won't be exported either. A typical case
330 | of default libraries are import libraries that behave as interfaces to
331 | (normal, non-FlexDLL) DLLs.
332 | 
333 | 
334 | ## Advanced topic: `__declspec(dllimport)`
335 | 
336 | C compilers under Windows support a special declaration of external
337 | symbols. You can write:
338 | 
339 | ```c
340 | __declspec(dllimport) extern int mysymbol;
341 | ```
342 | 
343 | Internally, this declaration has the same effect as declaring:
344 | 
345 | ```c
346 | extern int *_imp__mysymbol;
347 | ```
348 | 
349 | and using `&x` instead of `x` everywhere in the current unit. In other
350 | words, even if your code seems to access `x` directly, each access
351 | actually goes through an extra indirection.
352 | 
353 | FlexDLL knows about this convention. When a object refers to a symbol of
354 | the form `_imp__XXX` which is not available in the objects that will
355 | form the DLL to be created, it resists the temptation of putting an
356 | entry for `_imp__XXX` in the import table. Instead, it adds the
357 | equivalent of the following declaration:
358 | 
359 | ```c
360 | void *_imp__XXX = &XXX;
361 | ```
362 | 
363 | If the symbol `XXX` itself is not available, this will in turn produce
364 | an entry for `XXX` in the import table. All these new declarations are
365 | put in the same object file that contain the export table, which is
366 | global for the DLL to be produced. So, if all the external symbols in a
367 | given object files are accessed through this convention, the object file
368 | need not be patched at all.
369 | 
370 | Note that you can define and use the `_imp__XXX` symbols by hand, you
371 | don't have to use the `__declspec(dllimport)` notation (this is useful
372 | if you use a compiler that doesn't support this notation).
373 | 
374 | There *are* compelling reasons to adopt this style.
375 | 
376 | A very small advantage might be that there will be fewer relocations at
377 | runtime and that more code pages can be shared amongst several instances
378 | of the same DLL used by different processes.
379 | 
380 | A big advantage on x86_64 systems is to avoid relocation errors like:
381 | 
382 | ```text
383 | Fatal error: cannot load shared library plug1
384 | Reason: flexdll error: cannot relocate XXX
385 |   RELOC_REL32, target is too far: FFFFFFFF2EDEC956  000000002EDEC956
386 | ```
387 | 
388 | Without `__declspec(dllimport)` your symbol (ex. `extern XXX`) generates
389 | the following pseudo-assembly:
390 | 
391 | ```asm
392 | CALL XXX ; this is a 32-bit relative address
393 | ```
394 | 
395 | These 32-bit relative addresses are restricted to 2GiB jumps, and there is
396 | no guarantee that your main programs and all its DLLs will reside in the same
397 | 2GiB block of virtual memory. The more DLLs you have, and the bigger they
398 | are, the more likely you will encounter a `RELOC_REL32` error.
399 | 
400 | flexdll will verify every 32-bit relative address `CALL` during
401 | `flexdll_dlopen` to ensure they are within 2GiB.
402 | However, the indirection introduced by `__declspec(dllimport) extern` makes
403 | the pseudo-assembly instead:
404 | 
405 | ```asm
406 | void *_imp__XXX = &XXX;
407 | CALL [_imp__XXX] ; this is a 64-bit indirect address
408 | ```
409 | 
410 | which works well with flexdll.
411 | 
412 | ## Advanced topic: static constructors and the entry point
413 | 
414 | A Windows DLL can define an optional entry point. When the DLL is
415 | loaded, this function is automatically called. (The same function is
416 | called when the DLL is unloaded, or when threads are spawned or
417 | destroyed.)
418 | 
419 | Usually, the real entry point is provided by the C runtime library:
420 | `_cygwin_dll_entry` for Cygwin, `DllMainCRTStartup` for MinGW,
421 | `_DllMainCRTStartup` for MSVC. These functions perform various
422 | initialization for the C runtime library, invoke the code that has to be
423 | run automatically at load time (e.g for C++: constructors of static
424 | objects, or right-hand sides of non-constant initializers for global
425 | variables), and then call the function [`DllMain`][DllMain], which by
426 | default does nothing but can be overridden by the program to perform
427 | custom initialization of the DLL.
428 | 
429 | FlexDLL must take control before any custom code (static constructors,
430 | `DllMain`) so as to perform relocations (in case this code refers to
431 | symbols found in the main program or previously loaded DLLs). As a
432 | consequence, FlexDLL defines its own entry point, which first asks the
433 | main program to perform relocations and then calls the regular entry
434 | point of the C runtime library. This behavior is implemented in the
435 | `flexdll_initer.c` file, and the corresponding object file (whose name
436 | depends on the toolchain) is automatically included by `flexlink`.
437 | 
438 | It is possible to completely disable the DLL entry point with the
439 | `-noentry` option passed to `flexlink`. In this case, FlexDLL will
440 | perform relocations after the DLL has been opened.
441 | 
442 | [DllMain]: https://learn.microsoft.com/en-us/windows/win32/dlls/dllmain
443 | 
444 | ## The API
445 | 
446 | Here is the content of the `flexdll.h` file:
447 | 
448 | ```c
449 | #define FLEXDLL_RTLD_GLOBAL 0x0001
450 | #define FLEXDLL_RTLD_LOCAL  0x0000
451 | #define FLEXDLL_RTLD_NOEXEC 0x0002
452 | 
453 | void *flexdll_dlopen(const char *, int);
454 | #ifndef CYGWIN
455 | void *flexdll_wdlopen(const wchar_t *, int);
456 | #endif
457 | void *flexdll_dlsym(void *, const char *);
458 | void flexdll_dlclose(void *);
459 | char *flexdll_dlerror(void);
460 | 
461 | void flexdll_dump_exports(void *);
462 | void flexdll_dump_relocations(void *);
463 | ```
464 | 
465 | The `flexdll_dl*` functions are mostly compatible with their POSIX
466 | counterparts. Here is a short explanation of their semantics.
467 | 
468 | The most important function is `flexdll_dlopen`. The first argument
469 | gives the filename of a DLL to be opened. This DLL must have been
470 | produced by the `flexlink` wrapper. The function resolves the symbols
471 | mentioned in the DLL's import table and performs the relocations.
472 | The second argument is a mode, made of flags that can be or'ed together.
473 | The flag `FLEXDLL_RTLD_GLOBAL` means that the symbols exported by the
474 | opened DLL can be used to resolve relocations for DLLs to be opened
475 | later on. The flag `FLEXDLL_RTLD_NOEXEC` opens the DLL is a special
476 | mode, disabling the automatic loading of dependencies and the FlexDLL
477 | resolution pass. This is useful if you want to open a DLL only to check
478 | whether it defines some symbol.
479 | 
480 | The `flexdll_dlopen` function returns a pointer to an opaque handle that
481 | can be used as an argument to the other API functions. If the filename
482 | is `NULL`, the function returns a special handle which refers to the
483 | global unit: it includes all the static symbols, plus the symbols from
484 | the DLLs opened with the `FLEXDLL_RTLD_GLOBAL` flag. A given DLL will be
485 | opened only once, even if you call the function several times on the
486 | same file. The `FLEXDLL_RTLD_GLOBAL` flag is sticky: if one of the calls
487 | mentions it, it will stay forever, even if the corresponding handle is
488 | then passed to `dlclose` (this is because the same handle is actually
489 | returned for all the calls). If an error occurs during the call to
490 | `flexdll_dlopen`, the functions returns `NULL` and the error message can
491 | be retrieved using `flexdll_dlerror`.
492 | 
493 | The function `flexdll_wdlopen` is a wide-character version of
494 | `flexdll_dlopen`. The filename argument to `flexdll_wdlopen` is a
495 | wide-character string. `flexdll_wdlopen` and `flexdll_dlopen` behave
496 | identically otherwise.
497 | 
498 | The second most important function is `flexdll_dlsym` which looks for a
499 | symbol whose name is the second argument. The first argument can be
500 | either a regular handle returned by `flexdll_dlopen` (the symbol is
501 | searched only in the corresponding DLL), the special handle for the
502 | global unit as return by a call to `flexdll_dlopen(NULL,...)` (the
503 | symbol is searched amongst the static symbols plus the ones in the DLL
504 | opened with the flag `FLEXDLL_RTLD_GLOBAL`), or `NULL` (the symbol is
505 | searched only amongst the static symbols). If the symbol cannot be
506 | found, the function returns `NULL`.
507 | 
508 | The same symbol name can be defined several times. The policy used to
509 | choose amongst the various definitions is not specified. This applies
510 | both to the automatic resolution that happens when you open a DLL and to
511 | the explicit resolution performed by `dlsym`.
512 | 
513 | The function `flexdll_dlclose` must be used with caution. It decrements
514 | the reference counter for the given handle and releases the DLL from memory
515 | when the counter reaches 0. After that time, symbols defined in this DLL
516 | are no longer used for resolution. You most probably don't want to close
517 | a DLL if you still hold pointers to some of its symbols.
518 | 
519 | The two functions `flexdll_dump_exports` and `flexdll_dump_relocations`
520 | are used to display (to the standard output) the internal tables
521 | associated with a given DLL handle.
522 | 
523 | 
524 | ## Command line for the flexlink wrapper
525 | 
526 | ```
527 | Usage:
528 |   flexlink -o <result.dll/exe> file1.obj file2.obj ... -- <extra linker arguments>
529 | 
530 |   -o                  Choose the name of the output file
531 |   -exe                Link the main program as an exe file
532 |   -maindll            Link the main program as a dll file
533 |   -noflexdllobj       Do not add the Flexdll runtime object (for exe)
534 |   -noentry            Do not use the Flexdll entry point (for dll)
535 |   -noexport           Do not export any symbol
536 |   -norelrelocs        Ensure that no relative relocation is generated
537 |   -base               Specify base address (Win64 only)
538 |   -pthread            Pass -pthread to the linker
539 |   -I <dir>            Add a directory where to search for files
540 |   -L <dir>            Add a directory where to search for files
541 |   -l <lib>            Library file
542 |   -chain {msvc|msvc64|cygwin64|mingw|mingw64|gnat|gnat64|ld}
543 |                       Choose which linker to use
544 |   -use-linker <cmd>   Choose an alternative linker to use
545 |   -use-mt <cmd>       Choose an alternative manifest tool to use
546 |   -x64                (Deprecated)
547 |   -defaultlib <obj>   External object (no export, no import)
548 |   -save-temps         Do not delete intermediate files
549 |   -implib             Do not delete the generated import library
550 |   -outdef             Produce a def file with exported symbols
551 |   -v                  Increment verbosity (can be repeated)
552 |   -show-exports       Show exported symbols
553 |   -show-imports       Show imported symbols
554 |   -dry                Show the linker command line, do not actually run it
555 |   -dump               Only dump the content of object files
556 |   -patch              Only patch the target image (to be used with -stack)
557 |   -nocygpath          Do not use cygpath (default for msvc, mingw)
558 |   -cygpath            Use cygpath (default for cygwin)
559 |   -no-merge-manifest  Do not merge the manifest (takes precedence over -merge-manifest)
560 |   -merge-manifest     Merge manifest to the dll or exe (if generated)
561 |   -real-manifest      Use the generated manifest (default behavior)
562 |   -default-manifest   Use the default manifest (default.manifest/default_amd64.manifest)
563 |   -export <sym>       Explicitly export a symbol
564 |   -noreexport         Do not reexport symbols imported from import libraries
565 |   -where              Show the FlexDLL directory
566 |   -nounderscore       Normal symbols are not prefixed with an underscore
567 |   -nodefaultlibs      Do not assume any default library
568 |   -builtin            Use built-in linker to produce a dll
569 |   -explain            Explain why library objects are linked
570 |   -subsystem <id>     Set the subsystem (default: console)
571 |   -custom-crt         Use a custom CRT
572 |   -stack <int>        Set the stack reserve in the resulting image
573 |   -link <option>      Next argument is passed verbatim to the linker
574 |   -g                  (Ignored)
575 |   -D <symbol>         (Ignored)
576 |   -U <symbol>         (Ignored)
577 |   --                  Following arguments are passed verbatim to the linker
578 |   -version            Print linker version and FlexDLL directory and exit
579 |   -vnum               Print linker version number and exit
580 |   -help               Display this list of options
581 |   --help              Display this list of options
582 | ```
583 | 
584 | The files given on the command line can be object files (.obj/.o),
585 | library files (.a/.lib), or C files (.c). C files will be compiled using
586 | the toolchain's C compiler and the resulting object will be used for the
587 | actual linking.
588 | 
589 | The argument for the `-l`, `-I` and `-L` options does not need to be
590 | separated by whitespace from the option (i.e. `-LXXX` is equivalent to
591 | `-L XXX`).
592 | 
593 | There is a single set of search directories for all kinds of files.
594 | The `-I` and `-L` options are synonyms.
595 | 
596 | As usual, object files included in libraries are linked in only if one
597 | of the symbol they export is needed.
598 | 
599 | The `-export` option explicitly exports a symbol. If this symbols is
600 | found in a library, it will force the corresponding object file to be
601 | included.
602 | 
603 | The `-defaultlib` option is used to tell `flexlink` that some object
604 | (usually, a library) does not need any relocations (that is, all the
605 | symbols it refers to are defined in one of the objects being linked) and
606 | that we don't want to re-export the symbols exported by this object.
607 | This is usually used for system libraries.
608 | 
609 | The `-cygpath` and `-nocygpath` options control whether `flexlink` uses
610 | the `cygpath` command or not (default is: no under MSVC, yes under
611 | Cygwin/MinGW if cygpath can be found in the PATH). When it uses
612 | `cygpath`, `flexlink` tries to resolve file names directly and otherwise
613 | calls `cygpath -m` (to produce Windows paths from Cygwin paths) if
614 | `cygpath` is available in the path.
615 | 
616 | The `-maindll` option is used to build a DLL that behaves as the main
617 | program from the point of view of FlexDLL. It cannot have unresolved
618 | symbols.
619 | 
620 | By default, `flexlink` looks for FlexDLL's object files in the same
621 | directory as `flexlink.exe` itself. It is possible to specify another
622 | directory with the `FLEXDIR` environment variable.
623 | 
624 | Extra arguments can be passed to `flexlink.exe` through the environment
625 | variable `FLEXLINKFLAGS`. The arguments coming from this variable are
626 | parsed before those coming from the command line.
627 | 
628 | 
629 | ## Performance
630 | 
631 | FlexDLL performs relocations at runtime in the code of the DLL. The good
632 | consequence is that there is no indirection: a function call or a
633 | reference to a global variable where the target symbol is not in the
634 | current DLL be compiled as if it were. This might improve performance,
635 | especially because an indirection would consume a register that might be
636 | better used for something more interesting. The bad consequence is that
637 | the memory pages that contains relocations cannot be shared between
638 | different processes.
639 | 
640 | 
641 | ## Bugs, limitations
642 | 
643 | FlexDLL relies on a parser and generator for COFF files. However, some
644 | features are not very well specified, and some well specified features
645 | have not been fully implemented. Normally, you should get some assertion
646 | failure in these cases. Please report them, so that I can improve
647 | FlexDLL.
648 | 
649 | FlexDLL works for 32 and 64 bits version of Windows. The 32 bits version
650 | has been tested under XP and Vista, with the three supported toolchains.
651 | The 64 bits version has been tested under Windows Vista x64 with the
652 | Microsoft Platform SDK and under Windows 7 64-bit with the Win7 SDK
653 | toolchain (no Cygwin).
654 | 
655 | 
656 | ## Real-world examples
657 | 
658 | Please let me know if you use FlexDLL!
659 | 
660 | ### Dynamic loading for OCaml
661 | 
662 | The initial motivation for FlexDLL was to add dynamic linking of native
663 | code to Windows ports of [OCaml][] (Cygwin, MinGW, MSVC). A side-effect
664 | was to simplify the dynamic loading of C libraries (e.g. for the
665 | toplevel) and to make it work under the Cygwin port, to simplify
666 | Makefiles of libraries (now shared between Unix and Windows ports), and
667 | to create a native toplevel.
668 | 
669 | 
670 | ## Links
671 | 
672 | - [Microsoft Portable Executable and Common Object File Format Specification](https://learn.microsoft.com/en-us/windows/win32/debug/pe-format).
673 | - [Enhanced Dynamic Linking Library for MinGW under MS-Windows (edll)][edll].
674 | - [`dlopen` (POSIX)][dlopen].
675 | - [`DllMain`][DllMain].
676 | 


--------------------------------------------------------------------------------
/appveyor.yml:
--------------------------------------------------------------------------------
 1 | platform:
 2 |   - x64
 3 | 
 4 | image: Visual Studio 2015
 5 | 
 6 | environment:
 7 |   global:
 8 |     CYG_ROOT: C:/cygwin64
 9 |     CYG_MIRROR: http://mirrors.kernel.org/sourceware/cygwin/
10 |     CYG_CACHE: C:/cygwin64/var/cache/setup
11 |     OCAML_PORT: msvc64
12 |     ARTEFACTS: no
13 |     FLEXDLL_VERSION: 0.43
14 |     FLEXDLL_WARN_ERROR: true
15 |   matrix:
16 |     - OCAMLBRANCH: 3.11
17 |     - OCAMLBRANCH: 3.12
18 |       OCAMLREV: 1
19 |     - OCAMLBRANCH: 4.00
20 |     - OCAMLBRANCH: 4.01
21 |     - OCAMLBRANCH: 4.02
22 |     - OCAMLBRANCH: 4.03
23 |       SKIP_OCAML_TEST: no
24 |     - OCAMLBRANCH: 4.04
25 |     - OCAMLBRANCH: 4.05
26 |     - OCAMLBRANCH: 4.06
27 |     - OCAMLBRANCH: 4.07
28 |     - OCAMLBRANCH: 4.08
29 |     - OCAMLBRANCH: 4.09
30 |     - OCAMLBRANCH: 4.10
31 |     - OCAMLBRANCH: 4.11
32 |     - OCAMLBRANCH: 4.12
33 |       OCAML_PORT: mingw
34 |       ARTEFACTS: yes
35 |       MSVS_PREFERENCE: SDK7.0
36 |     - OCAMLBRANCH: 4.13
37 |     - OCAMLBRANCH: 4.14
38 |       SKIP_OCAML_TEST: no
39 |     - OCAMLBRANCH: 5.0
40 |       OCAML_PORT: mingw64
41 |     - OCAMLBRANCH: 5.1
42 |       OCAML_PORT: mingw64
43 |     - OCAMLBRANCH: 5.2
44 |       OCAML_PORT: mingw64
45 |     - OCAMLBRANCH: 5.3
46 |       OCAML_PORT: mingw64
47 |       SKIP_OCAML_TEST: no
48 |     - OCAMLBRANCH: trunk
49 |       OCAML_PORT: mingw64
50 |       SKIP_OCAML_TEST: no
51 |   OCAMLROOT: C:/OCaml
52 | 
53 | cache:
54 |   - C:/OCaml
55 | 
56 | install:
57 |   # Make sure the Cygwin path comes before the Git one (otherwise
58 |   # cygpath behaves crazily), but after the MSVC one.
59 |   - set Path=C:\cygwin64\bin;%OCAMLROOT%\bin;C:\flexdll;%Path%
60 |   - '%CYG_ROOT%\bin\bash -lc "cygcheck -dc cygwin"'
61 |   - if exist "%CYG_ROOT%\setup-x86_64.exe" del "%CYG_ROOT%\setup-x86_64.exe"
62 |   - appveyor DownloadFile "https://cygwin.com/setup-x86_64.exe" -FileName "%CYG_ROOT%\setup-x86_64.exe"
63 |   - '"%CYG_ROOT%\setup-x86_64.exe" --quiet-mode --no-shortcuts --no-startmenu --no-desktop --only-site --root "%CYG_ROOT%" --site "%CYG_MIRROR%" --local-package-dir "%CYG_CACHE%" --packages unzip,zip > nul'
64 |   - '%CYG_ROOT%\bin\bash -lc "zip --version" > nul || "%CYG_ROOT%\setup-x86_64.exe" --quiet-mode --no-shortcuts --no-startmenu --no-desktop --only-site --root "%CYG_ROOT%" --site "%CYG_MIRROR%" --local-package-dir "%CYG_CACHE%" --upgrade-also > nul'
65 |   - '%CYG_ROOT%\bin\bash -lc "cygcheck -dc cygwin"'
66 |   - call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\bin\amd64\vcvars64.bat"
67 |   - appveyor DownloadFile "https://github.com/ocaml/flexdll/archive/%FLEXDLL_VERSION%.tar.gz" -FileName "flexdll.tar.gz"
68 |   - appveyor DownloadFile "https://github.com/ocaml/flexdll/releases/download/%FLEXDLL_VERSION%/flexdll-bin-%FLEXDLL_VERSION%.zip" -FileName "flexdll.zip"
69 |   - appveyor DownloadFile "https://raw.githubusercontent.com/ocaml/ocaml/trunk/tools/msvs-promote-path" -FileName "msvs-promote-path"
70 | 
71 | build_script:
72 |   - "%CYG_ROOT%/bin/bash -lc \"echo 'eval $($APPVEYOR_BUILD_FOLDER/msvs-promote-path)' >> ~/.bash_profile\""
73 |   - '%CYG_ROOT%/bin/bash -lc "$APPVEYOR_BUILD_FOLDER/appveyor_build.sh"'
74 | 
75 | test: off
76 | 


--------------------------------------------------------------------------------
/appveyor_build.sh:
--------------------------------------------------------------------------------
  1 | #!/bin/bash
  2 | 
  3 | set -e
  4 | 
  5 | function run {
  6 |     NAME=$1
  7 |     shift
  8 |     echo "-=-=- $NAME -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-"
  9 |     "$@"
 10 |     CODE=$?
 11 |     if [ $CODE -ne 0 ]; then
 12 |         echo "-=-=- $NAME failed! -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-"
 13 |         exit $CODE
 14 |     else
 15 |         echo "-=-=- End of $NAME -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-"
 16 |     fi
 17 | }
 18 | 
 19 | function configure_ocaml {
 20 |     if [[ -z $HEADER_DIR ]] ; then
 21 |       if [[ $FLEXDLL_BOOTSTRAP_WORKS -eq 0 ]]; then
 22 |         # Unfortunately, configure fails to set-up bootstrapping if flexlink is
 23 |         # in PATH
 24 |         sed -i -e 's/@iflexdir@/-I"$(ROOTDIR)\/flexdll"/' Makefile.config.in
 25 |       fi
 26 | 
 27 |       ./configure --build=x86_64-pc-cygwin --host=$OCAML_TARGET \
 28 |                     --prefix=$OCAMLROOT \
 29 |                     --disable-debugger \
 30 |                     --disable-ocamldoc \
 31 |                     --disable-systhreads \
 32 |                     --disable-str-lib \
 33 |                     --disable-unix-lib \
 34 |                     --disable-bigarray-lib \
 35 |                     $GRAPHICS_DISABLE \
 36 |                     $OCAMLTEST_DISABLE \
 37 |                     --disable-debug-runtime
 38 |     else
 39 |       # "Classic" configuration
 40 |       cp config/m-nt.h $HEADER_DIR/m.h
 41 |       cp config/s-nt.h $HEADER_DIR/s.h
 42 | 
 43 |       sed -e "s|PREFIX=.*|PREFIX=$OCAMLROOT|" \
 44 |           -e 's/\(OTHERLIBRARIES\|WITH_DEBUGGER\|WITH_OCAMLDOC\|DEBUGGER\|EXTRALIBS\|WITH_OCAMLBUILD\|CAMLP4\)=.*/\1=/' \
 45 |           config/Makefile.$OCAML_PORT > $CONFIG_DIR/Makefile
 46 |       #run "Content of config/Makefile" cat $CONFIG_DIR/Makefile
 47 |     fi
 48 | }
 49 | 
 50 | case "$OCAML_PORT" in
 51 |   msvc) OCAML_TARGET=i686-pc-windows; OCAML_SYSTEM=win32;;
 52 |   msvc64) OCAML_TARGET=x86_64-pc-windows; OCAML_SYSTEM=win64;;
 53 |   mingw) OCAML_TARGET=i686-w64-mingw32; OCAML_SYSTEM=mingw;;
 54 |   mingw64) OCAML_TARGET=x86_64-w64-mingw32; OCAML_SYSTEM=mingw64;;
 55 |   *) echo "Unrecognised OCAML_PORT: $OCAML_PORT"; exit 1;;
 56 | esac
 57 | 
 58 | echo ** OCAMLROOT=$OCAMLROOT
 59 | 
 60 | #echo "APPVEYOR_PULL_REQUEST_NUMBER = $APPVEYOR_PULL_REQUEST_NUMBER"
 61 | #echo "APPVEYOR_PULL_REQUEST_TITLE = $APPVEYOR_PULL_REQUEST_TITLE"
 62 | #echo "APPVEYOR_PULL_REQUEST_HEAD_REPO_NAME = $APPVEYOR_PULL_REQUEST_HEAD_REPO_NAME"
 63 | #echo "APPVEYOR_PULL_REQUEST_HEAD_REPO_BRANCH = $APPVEYOR_PULL_REQUEST_HEAD_REPO_BRANCH"
 64 | #echo "APPVEYOR_PULL_REQUEST_HEAD_COMMIT = $APPVEYOR_PULL_REQUEST_HEAD_COMMIT"
 65 | #echo "APPVEYOR_REPO_PROVIDER = $APPVEYOR_REPO_PROVIDER"
 66 | #echo "APPVEYOR_REPO_NAME = $APPVEYOR_REPO_NAME"
 67 | #echo "APPVEYOR_REPO_BRANCH = $APPVEYOR_REPO_BRANCH"
 68 | 
 69 | APPVEYOR_BUILD_FOLDER=$(echo "$APPVEYOR_BUILD_FOLDER" | cygpath -f -)
 70 | cd $APPVEYOR_BUILD_FOLDER
 71 | 
 72 | git tag merge
 73 | 
 74 | # Do not perform end-of-line conversion
 75 | git config --global core.autocrlf false
 76 | git clone https://github.com/ocaml/ocaml.git --branch $OCAMLBRANCH${OCAMLREV:+.}$OCAMLREV --depth 1 --recurse-submodules ocaml
 77 | 
 78 | cd ocaml
 79 | 
 80 | case "$OCAMLBRANCH" in
 81 |   trunk|[0-9].[0-9])
 82 |     if [ "$OCAMLBRANCH" = 'trunk' ]; then
 83 |       OCAML_RELEASE="$(sed -ne '1s/\([^.]*\.[^.]*\).*/\1/p' VERSION)"
 84 |       echo "trunk VERSION is $OCAML_RELEASE"
 85 |     else
 86 |       OCAML_RELEASE="$OCAMLBRANCH"
 87 |     fi
 88 |     OCAML_RELEASE="${OCAML_RELEASE%.*}0${OCAML_RELEASE#*.}";;
 89 |   [0-9].[0-9][0-9])
 90 |     OCAML_RELEASE="${OCAMLBRANCH/./}";;
 91 |   *) echo "Unsupported OCAMLBRANCH: $OCAMLBRANCH"; exit 1;;
 92 | esac
 93 | 
 94 | MAKEOCAML=make
 95 | CONFIG_DIR=config
 96 | GRAPHICS_DISABLE=
 97 | OCAMLTEST_DISABLE=--disable-ocamltest
 98 | HEADER_DIR=
 99 | FLEXDLL_BOOTSTRAP_WORKS=1
100 | 
101 | case $OCAML_RELEASE in
102 |   311|312|400|401|402|403|404)
103 |     MAKEOCAML="make -f Makefile.nt"
104 |     HEADER_DIR=config;;
105 |   405)
106 |     HEADER_DIR=config;;
107 |   406|407)
108 |     HEADER_DIR=byterun/caml;;
109 |   408)
110 |     OCAMLTEST_DISABLE=''
111 |     GRAPHICS_DISABLE=--disable-graph-lib
112 |     FLEXDLL_BOOTSTRAP_WORKS=0;;
113 |   409|410)
114 |     OCAMLTEST_DISABLE=''
115 |     FLEXDLL_BOOTSTRAP_WORKS=0;;
116 |   411|412)
117 |     FLEXDLL_BOOTSTRAP_WORKS=0;;
118 | esac
119 | 
120 | if [ $OCAML_RELEASE -eq 403 ] ; then
121 |   sed -i -e "s/:=.*/:=/" config/Makefile.msvc64
122 | fi
123 | 
124 | if [ ! -f $OCAMLROOT/STAMP ] || [ "$(git rev-parse HEAD)" != "$(cat $OCAMLROOT/STAMP)" ] || [ "$(sed -ne 's/ *SYSTEM *= *//p' "$(ocamlc -where | tr -d '\r')/Makefile.config" | tr -d '\r')" != "$OCAML_SYSTEM" ] ; then
125 |     if [ ! -f $OCAMLROOT/STAMP ] ; then
126 |         echo "Building the compiler"
127 |     else
128 |         echo "Rebuilding the compiler"
129 |     fi
130 | 
131 |     rm -rf $OCAMLROOT
132 | 
133 |     configure_ocaml
134 | 
135 |     if [ $OCAML_RELEASE -lt 403 ] ; then
136 |       mkdir -p /cygdrive/c/flexdll
137 |       mv "$APPVEYOR_BUILD_FOLDER/flexdll.zip" /cygdrive/c/flexdll
138 |       pushd /cygdrive/c/flexdll
139 |       unzip -q flexdll.zip
140 |       popd
141 |       mkdir -p ../flexdll-src
142 |       pushd ../flexdll-src
143 |       tar -xzf "$APPVEYOR_BUILD_FOLDER/flexdll.tar.gz"
144 |       cd flexdll-*
145 |       make CHAINS=msvc64 MSVC_DETECT=0 support
146 |       mkdir -p $OCAMLROOT/bin
147 |       cp -v *.obj /cygdrive/c/flexdll/
148 |       cp -v *.obj $OCAMLROOT/bin/
149 |       cp /cygdrive/c/flexdll/default_amd64.manifest $OCAMLROOT/bin/
150 |       popd
151 |       # GPR#405
152 |       sed -i -e '/kernel/a#pragma comment(lib , "ucrt.lib")\n#pragma comment(lib , "vcruntime.lib")' stdlib/headernt.c
153 |       if [ -e byterun/caml/misc.h ] ; then
154 |         sed -i -e 's/def _WIN32/ndef _UCRT/' byterun/caml/misc.h
155 |       fi
156 |       # MPR#6319
157 |       sed -i -e '/chmod -w/d' Makefile.nt
158 |       # Unavailable configuration
159 |       sed -i -e '/^opt.opt:/,+1s/ocamlbuild.native\|camlp4opt\|ocamldoc.opt//g' \
160 |              -e '/[^(]cd ocamldoc/d' \
161 |              -e '/partial-install/d' \
162 |              -e '/^opt:/s/other.*//' \
163 |              -e '/^all:/,+1s/ocamldoc.byte\|ocamlbuild.byte\|camlp4out//g' Makefile.nt
164 |       run "make world.opt" $MAKEOCAML world opt opt.opt
165 |       cp /cygdrive/c/flexdll/flexlink.exe $OCAMLROOT/bin/
166 |     else
167 |       run "make world.opt" $MAKEOCAML flexdll world.opt
168 |     fi
169 |     run "make install" $MAKEOCAML install
170 |     git clean -dfx > /dev/null
171 |     if [ -e flexdll/Makefile ] ; then
172 |         cd flexdll
173 |         git clean -dfx > /dev/null
174 |         cd ..
175 |     fi
176 | 
177 |     git rev-parse HEAD > $OCAMLROOT/STAMP
178 | fi
179 | 
180 | export CAML_LD_LIBRARY_PATH=$OCAMLROOT/lib/stublibs
181 | 
182 | pushd $APPVEYOR_BUILD_FOLDER
183 | 
184 | run "make flexlink.exe" make MSVC_DETECT=0 flexlink.exe
185 | 
186 | CHAINS="mingw mingw64 cygwin64 msvc msvc64"
187 | 
188 | for CHAIN in $CHAINS; do
189 |     run "make build_$CHAIN" make build_$CHAIN
190 | done
191 | 
192 | for CHAIN in $CHAINS; do
193 |     run "make demo_$CHAIN" make demo_$CHAIN
194 | done
195 | 
196 | popd
197 | 
198 | if [ "$SKIP_OCAML_TEST" = no ] ; then
199 |     configure_ocaml
200 | 
201 |     cd flexdll
202 |     git remote add local $(echo "$APPVEYOR_BUILD_FOLDER"| cygpath -f -) -f --tags
203 |     run "git checkout $APPVEYOR_REPO_COMMIT" git checkout merge
204 |     cd ..
205 | 
206 |     run "make world" $MAKEOCAML flexdll world
207 | fi
208 | 
209 | if [ "$ARTEFACTS" = 'yes' ] ; then
210 |     pushd "$APPVEYOR_BUILD_FOLDER" &> /dev/null
211 | 
212 |     make package_bin installer
213 |     SUFFIX="$(git describe)"
214 |     VERSION="$(sed -ne 's/^version: *"\(.*\)"/\1/p' flexdll.opam)"
215 |     if [ "$SUFFIX" != "$VERSION" ] ; then
216 |       mv "flexdll-bin-$VERSION.zip" "flexdll-bin-$SUFFIX.zip"
217 |       mv "flexdll-$VERSION-setup.exe" "flexdll-$SUFFIX-setup.exe"
218 |     fi
219 |     appveyor PushArtifact "flexdll-$SUFFIX-setup.exe"
220 |     appveyor PushArtifact "flexdll-bin-$SUFFIX.zip"
221 | 
222 |     popd &> /dev/null
223 | fi
224 | 


--------------------------------------------------------------------------------
/checkenv:
--------------------------------------------------------------------------------
 1 | #!/bin/bash
 2 | 
 3 | # Analyse the environment for Microsoft C Compilers
 4 | 
 5 | # Care needed because spaces in directory names are a given
 6 | #   (if only Unix were routinely configured that way...)
 7 | # IFS chosen to be a character illegal in Windows filenames and unlikely in Unix
 8 | SAVE_IFS=$IFS
 9 | 
10 | test ()
11 | {
12 |   IFS=*
13 |   for f in $1; do find "$f" -maxdepth 1 -iname $2 -print -quit; done 2>/dev/null | grep "." -q
14 |   if [ $? -eq 1 ] ; then
15 |     echo "Cannot find $3">&2
16 |     exit 1
17 |   fi
18 |   IFS=$SAVE_IFS
19 | }
20 | 
21 | # Check for Windows.h in INCLUDE
22 | test "${INCLUDE//;/*}" windows.h "Windows SDK Headers (Windows.h, etc.)"
23 | 
24 | # Check for stdlib.h in INCLUDE
25 | test "${INCLUDE//;/*}" stdlib.h "Microsoft CRT Headers (stdlib.h, etc.)"
26 | 
27 | # Check for msvcrt.lib in LIB
28 | test "${LIB//;/*}" msvcrt.lib "Microsoft CRT Libraries (msvcrt.lib, etc.)"
29 | 
30 | # Check for kernel32.lib in LIB
31 | test "${LIB//;/*}" kernel32.lib "Windows SDK Libraries (kernel32.lib, etc.)"
32 | 
33 | # Check for cl.exe in PATH
34 | test "${PATH//:/*}" cl.exe "Microsoft C Compiler (cl.exe)"
35 | 
36 | # Check for rc.exe in PATH
37 | test "${PATH//:/*}" rc.exe "Microsoft Resource Compiler (rc.exe)"
38 | 
39 | # Check for link.exe in PATH (largely academic - should hit coreutils link if nothing else)
40 | test "${PATH//:/*}" link.exe "Microsoft Linker (link.exe)"
41 | 
42 | PROB=
43 | # Check that link is the Microsoft Linker
44 | if [ "`link --version | head -1 | fgrep "Microsoft (R) Incremental Linker"`" == "" ] ; then
45 |   echo "Warning - link does not appear to be the Microsoft Linker, you may need to adjust your PATH"
46 |   PROB="Probably "
47 | fi
48 | 
49 | echo Microsoft C Compiler environment appears to be sound
50 | if [ -z "`cl /? 2>&1 | head -1 | fgrep x86`" ] ; then
51 |   CHAINS=msvc64
52 | else
53 |   CHAINS=msvc
54 | fi
55 | echo ${PROB}OK to build using MSVC_DETECT=0 CHAINS=$CHAINS
56 | 


--------------------------------------------------------------------------------
/clear_appveyor_cache.sh:
--------------------------------------------------------------------------------
 1 | #!/bin/sh
 2 | 
 3 | set -e
 4 | 
 5 | if [ $# -ne 2 ]; then
 6 |     echo Usage: $0 REPO TOKEN
 7 |     exit 1
 8 | fi
 9 | 
10 | curl -X DELETE https://ci.appveyor.com/api/projects/$1/buildcache \
11 |      -H "Authorization: Bearer $2" \
12 |      -H "Content-Type: application/json"
13 | 


--------------------------------------------------------------------------------
/cmdline.ml:
--------------------------------------------------------------------------------
  1 | (************************************************************************)
  2 | (*   FlexDLL                                                            *)
  3 | (*   Alain Frisch                                                       *)
  4 | (*                                                                      *)
  5 | (*   Copyright 2007 Institut National de Recherche en Informatique et   *)
  6 | (*   en Automatique.                                                    *)
  7 | (************************************************************************)
  8 | 
  9 | open Compat
 10 | 
 11 | let underscore = ref true
 12 |     (* Are "normal" symbols prefixed with an underscore? *)
 13 | 
 14 | let machine : [ `x86 | `x64 ] ref = ref `x86
 15 | 
 16 | let noexport = ref false
 17 | let custom_crt = ref false
 18 | let reexport_from_implibs = ref true
 19 | let use_default_libs = ref true
 20 | let subsystem = ref "console"
 21 | let explain = ref false
 22 | let builtin_linker = ref false
 23 | let toolchain : [ `MSVC | `MSVC64 | `MINGW | `MINGW64 | `GNAT | `GNAT64 | `CYGWIN64 | `LIGHTLD ] ref = ref `MSVC
 24 | let use_linker = ref None
 25 | let use_mt = ref None
 26 | let save_temps = ref false
 27 | let show_exports = ref false
 28 | let show_imports = ref false
 29 | let dry_mode = ref false
 30 | let verbose = ref 0
 31 | let dirs = ref []
 32 | let no_merge_manifest = ref false
 33 | let merge_manifest = ref false
 34 | let real_manifest = ref true
 35 | let add_flexdll_obj = ref true
 36 | let files = ref []
 37 | let exts = ref []
 38 | let output_file = ref ""
 39 | let exe_mode : [`DLL | `EXE | `MAINDLL] ref = ref `DLL
 40 | let extra_args = ref []
 41 | let mode : [`NORMAL | `DUMP | `PATCH] ref = ref `NORMAL
 42 | let defexports = ref []
 43 | let noentry = ref false
 44 | let use_cygpath : [`Yes | `No | `Try] ref = ref `Try
 45 | let implib = ref false
 46 | let deffile = ref None
 47 | let stack_reserve = ref None
 48 | let no_rel_relocs = ref false
 49 | let base_addr = ref "0x10000"
 50 | 
 51 | let usage_msg =
 52 |   Printf.sprintf
 53 |     "FlexDLL version %s\n\nUsage:\n  flexlink -o <result.dll/exe> file1.obj file2.obj ... -- <extra linker arguments>\n"
 54 |     Version.version
 55 | 
 56 | let footer =
 57 | "Notes:
 58 | * The -I, -l and -L options do not need to be separated from their argument.
 59 | * An option like /linkXXX is an abbrevation for '-link XXX'.
 60 | * An option like -Wl,-XXX is an abbreviation for '-link -XXX'.
 61 | * FlexDLL's object files are searched by default in the same directory as
 62 |   flexlink, or in the directory given by the environment variable FLEXDIR
 63 |   if it is defined.
 64 | * Extra argument can be passed in the environment variable FLEXLINKFLAGS.
 65 | 
 66 | Homepage: https://github.com/ocaml/flexdll"
 67 | 
 68 | let specs = [
 69 | 
 70 |   "-o", Arg.Set_string output_file,
 71 |   " Choose the name of the output file";
 72 | 
 73 |   "-exe", Arg.Unit (fun () -> exe_mode := `EXE),
 74 |   " Link the main program as an exe file";
 75 | 
 76 |   "-maindll", Arg.Unit (fun () -> exe_mode := `MAINDLL),
 77 |   " Link the main program as a dll file";
 78 | 
 79 |   "-noflexdllobj", Arg.Clear add_flexdll_obj,
 80 |   " Do not add the Flexdll runtime object (for exe)";
 81 | 
 82 |   "-noentry", Arg.Set noentry,
 83 |   " Do not use the Flexdll entry point (for dll)";
 84 | 
 85 |   "-noexport", Arg.Set noexport,
 86 |   " Do not export any symbol";
 87 | 
 88 |   "-norelrelocs", Arg.Set no_rel_relocs,
 89 |   " Ensure that no relative relocation is generated";
 90 | 
 91 |   "-base", Arg.String (fun s -> base_addr := s),
 92 |   " Specify base address (Win64 only)";
 93 | 
 94 |   "-pthread", Arg.Unit (fun () -> extra_args := "-pthread" :: !extra_args),
 95 |   " Pass -pthread to the linker";
 96 | 
 97 |   "-I", Arg.String (fun dir -> dirs := dir :: !dirs),
 98 |   "<dir> Add a directory where to search for files";
 99 | 
100 |   "-L", Arg.String (fun dir -> dirs := dir :: !dirs),
101 |   "<dir> Add a directory where to search for files";
102 | 
103 |   "-l", Arg.String (fun s -> files := ("-l" ^ s) :: !files),
104 |   "<lib> Library file";
105 | 
106 |   "-chain", Arg.Symbol (["msvc";"msvc64";"cygwin64";"mingw";"mingw64";"gnat";"gnat64";"ld"],
107 | 			(fun s ->
108 |                           machine := `x86; underscore := true;
109 |                           toolchain := match s with
110 | 			  | "msvc" -> `MSVC
111 | 			  | "msvc64" -> machine := `x64; underscore := false; `MSVC64
112 | 			  | "cygwin64" -> machine := `x64; underscore := false; `CYGWIN64
113 | 			  | "mingw" -> `MINGW
114 | 			  | "gnat" -> `GNAT
115 | 			  | "gnat64" -> machine := `x64; underscore := false; `GNAT64
116 | 			  | "mingw64" -> machine := `x64; underscore := false; `MINGW64
117 |                           | "ld" -> `LIGHTLD
118 | 			  | _ -> assert false)),
119 |   " Choose which linker to use";
120 | 
121 |   "-use-linker", Arg.String (fun s -> use_linker := Some s),
122 |   "<cmd> Choose an alternative linker to use";
123 | 
124 |   "-use-mt", Arg.String (fun s -> use_mt := Some s),
125 |   "<cmd> Choose an alternative manifest tool to use";
126 | 
127 |   "-x64", Arg.Unit (fun () -> machine := `x64; underscore := false; toolchain := `MSVC64),
128 |   " (Deprecated)";
129 | 
130 |   "-defaultlib", Arg.String (fun s -> exts := s :: !exts),
131 |   "<obj> External object (no export, no import)";
132 | 
133 |   "-save-temps", Arg.Set save_temps,
134 |   " Do not delete intermediate files";
135 | 
136 |   "-implib", Arg.Set implib,
137 |   " Do not delete the generated import library";
138 | 
139 |   "-outdef", Arg.String (fun s -> deffile := Some s),
140 |   " Produce a def file with exported symbols";
141 | 
142 |   "-v", Arg.Unit (fun () -> incr verbose),
143 |   " Increment verbosity (can be repeated)";
144 | 
145 |   "-show-exports", Arg.Set show_exports,
146 |   " Show exported symbols";
147 | 
148 |   "-show-imports", Arg.Set show_imports,
149 |   " Show imported symbols";
150 | 
151 |   "-dry", Arg.Set dry_mode,
152 |   " Show the linker command line, do not actually run it";
153 | 
154 |   "-dump", Arg.Unit (fun () -> mode := `DUMP),
155 |   " Only dump the content of object files";
156 | 
157 |   "-patch", Arg.Unit (fun () -> mode := `PATCH),
158 |   " Only patch the target image (to be used with -stack)";
159 | 
160 |   "-nocygpath", Arg.Unit (fun () -> use_cygpath := `No),
161 |   " Do not use cygpath (default for msvc, mingw)";
162 | 
163 |   "-cygpath", Arg.Unit (fun () -> use_cygpath := `Yes),
164 |   " Use cygpath (default for cygwin)";
165 | 
166 |   "-no-merge-manifest", Arg.Set no_merge_manifest,
167 |   " Do not merge the manifest (takes precedence over -merge-manifest)";
168 | 
169 |   "-merge-manifest", Arg.Set merge_manifest,
170 |   " Merge manifest to the dll or exe (if generated)";
171 | 
172 |   "-real-manifest", Arg.Set real_manifest,
173 |   " Use the generated manifest (default behavior)";
174 | 
175 |   "-default-manifest", Arg.Clear real_manifest,
176 |   " Use the default manifest (default.manifest/default_amd64.manifest)";
177 | 
178 |   "-export", Arg.String (fun s -> defexports := s :: !defexports),
179 |   "<sym> Explicitly export a symbol";
180 | 
181 |   "-noreexport", Arg.Clear reexport_from_implibs,
182 |   " Do not reexport symbols imported from import libraries";
183 | 
184 |   "-where", Arg.Unit
185 |     (fun () ->
186 |       print_endline (Filename.dirname Sys.executable_name);
187 |       exit 0
188 |     ),
189 |   " Show the FlexDLL directory";
190 | 
191 |   "-nounderscore", Arg.Clear underscore,
192 |   " Normal symbols are not prefixed with an underscore";
193 | 
194 |   "-nodefaultlibs", Arg.Clear use_default_libs,
195 |   " Do not assume any default library";
196 | 
197 |   "-builtin", Arg.Set builtin_linker,
198 |   " Use built-in linker to produce a dll";
199 | 
200 |   "-explain", Arg.Set explain,
201 |   " Explain why library objects are linked";
202 | 
203 |   "-subsystem", Arg.Set_string subsystem,
204 |   "<id> Set the subsystem (default: console)";
205 | 
206 |   "-custom-crt", Arg.Set custom_crt,
207 |   " Use a custom CRT";
208 | 
209 |   "-stack", Arg.String (fun s -> try stack_reserve := Some (Int32.of_string s) with _ -> raise (Arg.Bad "integer argument expected for -stack")),
210 |   "<int> Set the stack reserve in the resulting image";
211 | 
212 |   "-link", Arg.String (fun s -> extra_args := s :: !extra_args),
213 |   "<option> Next argument is passed verbatim to the linker";
214 | 
215 |   "-g", Arg.Unit (fun () -> ()),
216 |   " (Ignored)";
217 | 
218 |   "-D", Arg.String (fun _ -> ()),
219 |   "<symbol> (Ignored)";
220 | 
221 |   "-U", Arg.String (fun _ -> ()),
222 |   "<symbol> (Ignored)";
223 | 
224 |   "--", Arg.Rest (fun s -> extra_args := s :: !extra_args),
225 |   " Following arguments are passed verbatim to the linker";
226 | 
227 |   "-version", Arg.Unit
228 |     (fun () ->
229 |       Printf.printf "FlexDLL version %s\nFlexDLL directory: %s\n"
230 |                     Version.version
231 |                     (Filename.dirname Sys.executable_name);
232 |       exit 0
233 |     ),
234 |   " Print linker version and FlexDLL directory and exit";
235 | 
236 |   "-vnum", Arg.Unit (fun () -> print_endline Version.version; exit 0),
237 |   " Print linker version number and exit";
238 | ]
239 | 
240 | 
241 | let flexlinkflags =
242 |   let s =
243 |     try Sys.getenv "FLEXLINKFLAGS"
244 |     with Not_found -> ""
245 |   in
246 |   let n = String.length s in
247 |   let rec skip_ws i = if i < n && s.[i] = ' ' then skip_ws (i + 1) else i in
248 |   let rec scan_quote i = if i = n then i else if s.[i] = '"' then i + 1 else scan_quote (i+1) in
249 |   let rec scan_arg i =
250 |     if i = n || s.[i] = ' ' then i
251 |     else if s.[i] = '"' then scan_arg (scan_quote (i + 1))
252 |     else scan_arg (i + 1) in
253 |   let rec args i =
254 |     let i = skip_ws i in
255 |     if i = n then []
256 |     else let j = scan_arg i in String.sub s i (j - i) :: args j
257 |   in
258 |   args 0
259 | 
260 | let parse_cmdline () =
261 |   (* Split -lXXX, -LXXX and -IXXX options *)
262 |   let tosplit = function
263 |     | "-l" | "-L" | "-I" | "-D" | "-U" -> true
264 |     | _ -> false
265 |   in
266 | 
267 |   let rec tr = function
268 |     | (("-defaultlib"|"-link") as d) :: x :: rest -> d :: x :: tr rest
269 |     | "/link" :: x :: rest -> "-link" :: x :: tr rest
270 |     | s :: rest when String.length s > 2 && tosplit (String.sub s 0 2) ->
271 |         String.sub s 0 2 :: String.sub s 2 (String.length s - 2) :: tr rest
272 |     | s :: rest when String.length s >= 5 && String.sub s 0 5 = "/link" ->
273 |         "-link" :: String.sub s 5 (String.length s - 5) :: tr rest
274 |     (* Convert gcc linker option prefix -Wl, to flexlink linker prefix -link *)
275 |     | s :: rest when String.length s >= 6 && String.sub s 0 5 = "-Wl,-" ->
276 |         let args =
277 |           String.split_on_char ',' (String.sub s 4 (String.length s - 4))
278 |         in
279 |           List.fold_right (fun arg args -> "-link" :: arg :: args) args (tr rest)
280 |     | "-arg" :: x :: rest ->
281 |         tr (Array.to_list (Arg.read_arg x)) @ rest
282 |     | "-arg0" :: x :: rest ->
283 |         tr (Array.to_list (Arg.read_arg0 x)) @ rest
284 |     | x :: rest when x <> "" && x.[0] = '-' ->
285 |         begin
286 |           try
287 |             let i = String.index x ':' in
288 |             String.sub x 0 i :: String.sub x (i + 1) (String.length x - i - 1)
289 |             :: tr rest
290 |           with Not_found ->
291 |             x :: tr rest
292 |         end
293 |     | s::rest when String.length s  > 1 && s.[0] = '@' ->
294 |         let ic = open_in (String.sub s 1 (String.length s - 1)) in
295 |         let opts = ref [] in
296 |         begin
297 |           try
298 |             while true do
299 |               let fn = input_line ic in
300 |               if fn <> "" then
301 |                 (* todo: better unquoting *)
302 |                 let fn =
303 |                   if fn.[0] = '\"' && fn.[String.length fn - 1] = '\"'
304 |                   then String.sub fn 1 (String.length fn - 2)
305 |                   else fn
306 |                 in
307 |                 opts := fn :: !opts
308 |             done
309 |           with End_of_file -> ()
310 |         end;
311 |         close_in ic;
312 |         tr (List.rev_append !opts rest)
313 |     | x :: rest -> x :: tr rest
314 |     | [] -> []
315 |   in
316 |   let args =
317 |     match Array.to_list Sys.argv with
318 |     | pgm :: args -> pgm :: tr (flexlinkflags @ args)
319 |     | _ -> assert false
320 |   in
321 | 
322 |   let add_file s =
323 |        files := s :: !files
324 |   in
325 |   Arg.parse_argv (Array.of_list args) (Arg.align specs)
326 |     add_file usage_msg;
327 |   if !output_file = "" && !mode <> `DUMP then begin
328 |     Printf.eprintf
329 |       "Please specify an output file (-help to get some usage information)\n";
330 |     exit 1
331 |   end
332 | 
333 | let usym s = if !underscore then "_" ^ s else s
334 | 


--------------------------------------------------------------------------------
/coff.ml:
--------------------------------------------------------------------------------
   1 | (************************************************************************)
   2 | (*   FlexDLL                                                            *)
   3 | (*   Alain Frisch                                                       *)
   4 | (*                                                                      *)
   5 | (*   Copyright 2007 Institut National de Recherche en Informatique et   *)
   6 | (*   en Automatique.                                                    *)
   7 | (************************************************************************)
   8 | 
   9 | (* This module implements a reader/writer for COFF object files
  10 |    and libraries. *)
  11 | 
  12 | open Compat
  13 | 
  14 | module Buf : sig
  15 |   type t
  16 |   val create: unit -> t
  17 |   val length: t -> int
  18 |   val dump: out_channel -> t -> unit
  19 |   val string: t -> string -> unit
  20 |   val bytes: t -> bytes -> unit
  21 |   val int8: t -> int -> unit
  22 |   val int32: t -> int32 -> unit
  23 |   val int16: t -> int -> unit
  24 |   val lazy_int32: t -> int32 Lazy.t -> unit
  25 |   val patch_lazy_int32: t -> int -> int32 Lazy.t -> unit
  26 |   val future_int32: t -> int32 Lazy.t -> int32 ref
  27 |   val set_future: t -> int32 ref -> unit
  28 | end = struct
  29 |   type t = {
  30 |       mutable buf: bytes;
  31 |       mutable pos: int;
  32 |       mutable len: int;
  33 |       mutable patches: (unit -> unit) list;
  34 |     }
  35 | 
  36 |   let create () =
  37 |     { buf = Bytes.create 16;
  38 |       pos = 0;
  39 |       len = 16;
  40 |       patches = [] }
  41 | 
  42 |   let ensure b n =
  43 |     let len = ref b.len in
  44 |     let pos = b.pos in
  45 |     if n > Sys.max_string_length then
  46 |      failwith (Printf.sprintf "Cannot grow string buffer to len %i.\n" n);
  47 |     while n > !len do len := !len * 2 done;
  48 |     if !len > Sys.max_string_length then len := Sys.max_string_length;
  49 |     let nbuf = Bytes.create !len in
  50 |     Bytes.blit b.buf 0 nbuf 0 pos;
  51 |     b.buf <- nbuf;
  52 |     b.len <- !len
  53 | 
  54 |   let int8 b x =
  55 |     let pos = b.pos in
  56 |     if pos = b.len then begin
  57 |       let nlen = b.len * 2 in
  58 |       let nbuf = Bytes.create nlen in
  59 |       Bytes.blit b.buf 0 nbuf 0 pos;
  60 |       b.buf <- nbuf;
  61 |       b.len <- nlen
  62 |     end;
  63 |     Bytes.set b.buf pos (Char.chr (x land 0xff));
  64 |     b.pos <- succ pos
  65 | 
  66 |   let int16 b x =
  67 |     int8 b x;
  68 |     int8 b (x asr 8)
  69 | 
  70 |   let length b = b.pos
  71 | 
  72 |   let patch b =
  73 |     List.iter (fun f -> f ()) b.patches;
  74 |     b.patches <- []
  75 | 
  76 |   let add_patch b f =
  77 |     b.patches <- f :: b.patches
  78 | 
  79 |   let dump oc b =
  80 |     patch b;
  81 |     output_bytes oc (Bytes.sub b.buf 0 b.pos)
  82 | 
  83 |   let string b s =
  84 |     let l = String.length s in
  85 |     let r = b.pos + l in
  86 |     if r > b.len then ensure b r;
  87 |     Bytes.blit_string s 0 b.buf b.pos l;
  88 |     b.pos <- r
  89 | 
  90 |   let bytes b s =
  91 |     let l = Bytes.length s in
  92 |     let r = b.pos + l in
  93 |     if r > b.len then ensure b r;
  94 |     Bytes.blit s 0 b.buf b.pos l;
  95 |     b.pos <- r
  96 | 
  97 |   let blit_int32 s pos i =
  98 |     Bytes.set s pos (Char.chr ((Int32.to_int i) land 0xff));
  99 |     Bytes.set s (pos+1) (Char.chr ((Int32.to_int (Int32.shift_right i 8)) land 0xff));
 100 |     Bytes.set s (pos+2) (Char.chr ((Int32.to_int (Int32.shift_right i 16)) land 0xff));
 101 |     Bytes.set s (pos+3) (Char.chr ((Int32.to_int (Int32.shift_right i 24)) land 0xff))
 102 | 
 103 |   let int32 b i =
 104 |     let r = b.pos + 4 in
 105 |     if r > b.len then ensure b r;
 106 |     blit_int32 b.buf b.pos i;
 107 |     b.pos <- r
 108 | 
 109 |   let lazy_int32 b i =
 110 |     let pos = b.pos in
 111 |     let r = b.pos + 4 in
 112 |     if r > b.len then ensure b r;
 113 |     b.pos <- r;
 114 |     add_patch b (fun () -> blit_int32 b.buf pos (Lazy.force i))
 115 | 
 116 |   let patch_lazy_int32 b pos i =
 117 |     add_patch b (fun () -> blit_int32 b.buf pos (Lazy.force i))
 118 | 
 119 |   let future_int32 b ofs =
 120 |     let r = ref 0l in
 121 |     lazy_int32 b (lazy (Int32.add !r (Lazy.force ofs)));
 122 |     r
 123 | 
 124 |   let set_future b r =
 125 |     r := Int32.of_int (length b)
 126 | end
 127 | 
 128 | 
 129 | (* Internal representation of COFF object files *)
 130 | 
 131 | type symbol = {
 132 |   mutable sym_pos: int;
 133 |   mutable sym_name: string;
 134 |   mutable value: int32;
 135 |   mutable section: [ `Num of int | `Section of section ];
 136 |   stype: int;
 137 |   storage: int;
 138 |   auxn: int;
 139 |   mutable auxs: bytes;
 140 |   mutable extra_info: [ `Alias of symbol | `Section of section | `None ];
 141 | }
 142 | 
 143 | and reloc = {
 144 |   addr: int32;
 145 |   symbol: symbol;
 146 |   rtype: int;
 147 | }
 148 | 
 149 | and section = {
 150 |   mutable sec_pos: int;
 151 |   mutable sec_name: string;
 152 |   mutable vsize: int32;
 153 |   mutable vaddress: int32;
 154 |   mutable data:
 155 |       [ `String of bytes | `Uninit of int
 156 |     | `Buf of Buf.t list
 157 |     | `Sxdata of symbol array
 158 | ];
 159 |   mutable relocs: reloc list;
 160 |   mutable sec_opts: int32;
 161 | }
 162 | 
 163 | type coff = {
 164 |   bigobj: bool;
 165 |   obj_name: string;
 166 |   machine: int;
 167 |   date: int32;
 168 |   mutable sections: section list;
 169 |   mutable symbols: symbol list;
 170 |   opts: int;
 171 | }
 172 | 
 173 | (* Misc *)
 174 | 
 175 | 
 176 | let (++) = Int32.add
 177 | let (&&&) = Int32.logand
 178 | let (|||) = Int32.logor
 179 | let (>>>) = Int32.shift_right_logical
 180 | 
 181 | let filter f l =
 182 |   let rec aux accu = function
 183 |     | [] -> accu
 184 |     | hd::tl -> if f hd then aux (hd::accu) tl else aux accu tl
 185 |   in
 186 |   aux [] l
 187 | 
 188 | let is_zero s =
 189 |   try
 190 |     for i = 0 to String.length s - 1 do
 191 |       if s.[i] <> '\000' then raise Exit
 192 |     done;
 193 |     true
 194 |   with Exit -> false
 195 | 
 196 | (* Tools to read/write binary data *)
 197 | 
 198 | let mk_int32 a b c d =
 199 |   let a = Int32.of_int a
 200 |   and b = Int32.shift_left (Int32.of_int b) 8
 201 |   and c = Int32.shift_left (Int32.of_int c) 16
 202 |   and d = Int32.shift_left (Int32.of_int d) 24 in
 203 |   a ++ b ++ c ++ d
 204 | 
 205 | let read ic pos len =
 206 |   if len = 0 then Bytes.of_string ""
 207 |   else (
 208 |     seek_in ic pos;
 209 |     let buf = Bytes.create len in
 210 |     really_input ic buf 0 len;
 211 |     buf
 212 |   )
 213 | 
 214 | let read_str ic pos len =
 215 |   Bytes.to_string (read ic pos len)
 216 | 
 217 | let int32 buf loc =
 218 |   mk_int32
 219 |     (Char.code (Bytes.get buf loc)) (Char.code (Bytes.get buf (loc + 1)))
 220 |     (Char.code (Bytes.get buf (loc + 2))) (Char.code (Bytes.get buf (loc + 3)))
 221 | 
 222 | let emit_int32 oc i =
 223 |   output_byte oc (Int32.to_int (i &&& 0xffl));
 224 |   output_byte oc (Int32.to_int ((i >>> 8) &&& 0xffl));
 225 |   output_byte oc (Int32.to_int ((i >>> 16) &&& 0xffl));
 226 |   output_byte oc (Int32.to_int ((i >>> 24) &&& 0xffl))
 227 | 
 228 | let patch_int32 oc pos i =
 229 |   let bak = pos_out oc in
 230 |   seek_out oc pos;
 231 |   emit_int32 oc i;
 232 |   seek_out oc bak
 233 | 
 234 | let emit_int16 oc i =
 235 |   output_byte oc (i land 0xff);
 236 |   output_byte oc (i lsr 8)
 237 | 
 238 | let emit_int8 = output_byte
 239 | 
 240 | let int32_ buf loc = Int32.to_int (int32 buf loc)
 241 | 
 242 | let int16 buf loc = Char.code (Bytes.get buf loc) + (Char.code (Bytes.get buf (loc + 1))) lsl 8
 243 | 
 244 | let int8 buf loc = Char.code (Bytes.get buf loc)
 245 | 
 246 | let strz buf loc ?(max=Bytes.length buf - loc) c =
 247 |   let i =
 248 |     try Bytes.index_from buf loc c
 249 |     with Not_found -> Bytes.length buf in
 250 |   Bytes.sub_string buf loc (min max (i - loc))
 251 | 
 252 | let emit_zero oc n =
 253 |   for _i = 1 to n do output_char oc '\000' done
 254 | 
 255 | let delayed_ptr oc f =
 256 |   let bak = pos_out oc in
 257 |   emit_int32 oc 0l;
 258 |   (fun () ->
 259 |      patch_int32 oc bak (Int32.of_int (pos_out oc));
 260 |      f ()
 261 |   )
 262 | 
 263 | let copy_data ic pos oc len =
 264 |   (* TODO: bufferized copy when len > threshold *)
 265 |   output_bytes oc (read ic pos len)
 266 | 
 267 | (* Human readable pretty-printers *)
 268 | 
 269 | let flags x =
 270 |   let b = Buffer.create 16 in
 271 |   for i = 0 to 31 do
 272 |     let m = Int32.shift_left 1l i in
 273 |       if m &&& x <> 0l then
 274 |         Printf.bprintf b "0x%08lx " m
 275 |   done;
 276 |   Buffer.contents b
 277 | 
 278 | let rec dump ic pos len w =
 279 |   if len = 0 then (Printf.printf "---\n"; flush stdout)
 280 |   else let l = min len w in
 281 |   let b = read ic pos l in
 282 |   Printf.printf "%08x: " pos;
 283 |   for i = 0 to l - 1 do Printf.printf "%02x " (Char.code (Bytes.get b i)) done;
 284 |   for _i = l to w - 1 do Printf.printf "   " done;
 285 |   Printf.printf " ";
 286 |   for i = 0 to l - 1 do match Bytes.get b i with
 287 |     | '\032'..'\127' as c -> print_char c
 288 |     | _ -> print_char '.'
 289 |   done;
 290 |   Printf.printf "\n%!";
 291 |   dump ic (pos + l) (len - l) w
 292 | 
 293 | module Symbol = struct
 294 |   let counter = ref 0
 295 |   let gen_sym () = incr counter; Printf.sprintf "_DREL%i" !counter
 296 | 
 297 |   let empty () =
 298 |     { sym_pos = (-1); sym_name = gen_sym(); value = 0l;
 299 |       section = `Num 0; storage = 0; stype = 0; auxn = 0; auxs = Bytes.of_string "";
 300 |       extra_info = `None }
 301 | 
 302 |   let intern sec addr =
 303 |     { (empty ()) with section = `Section sec; storage = 3; value = addr }
 304 | 
 305 |   let named_intern name sec addr =
 306 |     { (empty ()) with sym_name = name; section = `Section sec; storage = 3; value = addr }
 307 | 
 308 |   let label name sec addr =
 309 |     { (empty ()) with sym_name = name; section = `Section sec; storage = 6; value = addr }
 310 | 
 311 |   let export name sec addr =
 312 |     { (empty ()) with sym_name = name; value = addr;
 313 |         section = `Section sec; storage = 2 }
 314 | 
 315 |   let extern name =
 316 |     { (empty ()) with sym_pos = (-1); sym_name = name;
 317 |         section = `Num 0; storage = 2 }
 318 | 
 319 | 
 320 |   let get ~bigobj strtbl ic pos =
 321 |     let size, sec_get = if bigobj then (20, int32_) else (18, int16) in
 322 |     let buf = read ic pos size in
 323 |     let auxn = int8 buf (size - 1) in
 324 |     { sym_pos = (-1);
 325 |       sym_name =
 326 |         (if int32_ buf 0 <> 0 then strz buf 0 ~max:8 '\000'
 327 |          else strtbl (int32_ buf 4));
 328 |       value = int32 buf 8;
 329 |       section = `Num (sec_get buf 12);
 330 |       stype = int16 buf (size - 4);
 331 |       storage = int8 buf (size - 2);
 332 |       auxn = auxn;
 333 |       auxs = read ic (pos + size) (size * auxn);
 334 |       extra_info = `None;
 335 |     }
 336 | 
 337 |   let is_extern = function
 338 |     | { storage = 2; section = `Num 0; value = 0l } -> true
 339 |     | _ -> false
 340 | 
 341 |   let is_export = function
 342 |     | { storage = 2; section = `Section _ } -> true
 343 |     | { storage = 2; section = `Num 0; value = 0l } -> false
 344 |     | { storage = 2; section = `Num 0 } -> true
 345 |     | _ -> false
 346 | 
 347 |   let is_defin = function
 348 |     | { storage = 2; section = `Section _ } -> true
 349 |     | { storage = 2; section = `Num 0; value = 0l } -> false
 350 |     | { storage = 2; section = `Num (0 | 0xffff) } -> true
 351 |     | _ -> false
 352 | 
 353 |   let dump s =
 354 |     Printf.printf " %s: " s.sym_name;
 355 |     if s.stype <> 0 then Printf.printf "(typ:%i) " s.stype;
 356 |     let sect = match s.section with
 357 |       | `Num 0xffff -> "absolute"
 358 |       | `Num 0xfffe -> "debug"
 359 |       | `Num i -> string_of_int i
 360 |       | `Section s -> Printf.sprintf "%S" s.sec_name in
 361 |     let storage = match s.storage with
 362 |       | 2 -> "extern"
 363 |       | 3 -> "static"
 364 |       | 6 -> "label"
 365 |       | 103 -> "srcfile"
 366 |       | n -> string_of_int n in
 367 |     match s with
 368 |       | { storage = 6 } ->
 369 |           Printf.printf "label %s @ 0x%08lx\n" sect s.value
 370 |       | { storage = 2; section = `Section _ } ->
 371 |           Printf.printf "export %s @ 0x%08lx\n" sect s.value
 372 |       | { storage = 2; section = `Num 0; value = 0l } ->
 373 |           Printf.printf "extern\n"
 374 |       | { storage = 2; section = `Num 0; value = n } ->
 375 |           Printf.printf "common symbol, size %ld\n" n
 376 |       | { storage = 3; value = 0l; auxn = auxn } when auxn > 0 ->
 377 |           Printf.printf "section %s, num %i, select %i\n" sect
 378 |             (int16 s.auxs 12)
 379 |             (int8 s.auxs 14)
 380 |       | { storage = 3 } ->
 381 |           Printf.printf "static %s @ 0x%08lx\n" sect s.value
 382 |       | { storage = 103 } ->
 383 |           Printf.printf "filename %s\n" (strz s.auxs 0 '\000')
 384 |       | { storage = 105 } ->
 385 |           Printf.printf "weak ext\n"
 386 |       | _ ->
 387 |           Printf.printf
 388 |             "value=0x%08lx, sect=%s, storage=%s, aux=%S\n"
 389 |             s.value sect storage (Bytes.to_string s.auxs)
 390 | 
 391 |   let put ~bigobj strtbl oc s =
 392 |     let sec_get, sec_put, type_ofs =
 393 |       if bigobj then
 394 |         (int32_, (fun oc i -> emit_int32 oc (Int32.of_int i)), 16)
 395 |       else
 396 |         (int16, emit_int16, 14) in
 397 |     if String.length s.sym_name <= 8
 398 |     then (output_string oc s.sym_name;
 399 |           emit_zero oc (8 - String.length s.sym_name))
 400 |     else (emit_zero oc 4; emit_int32 oc (strtbl s.sym_name));
 401 |     emit_int32 oc s.value;
 402 |     let sec = match s.section with
 403 |       | `Num i -> i
 404 |       | `Section sec when sec.sec_pos <= 0 ->
 405 |           failwith (Printf.sprintf
 406 |                       "Cannot emit section for symbol %s" s.sym_name)
 407 |       | `Section sec -> sec.sec_pos in
 408 |     sec_put oc sec;
 409 |     emit_int16 oc s.stype;
 410 |     emit_int8 oc s.storage;
 411 |     emit_int8 oc s.auxn;
 412 |     match s with
 413 |       | { storage = 105; extra_info = `Alias s' } when s'.sym_pos >= 0 ->
 414 |           (* weak ext *)
 415 |           emit_int32 oc (Int32.of_int s'.sym_pos);
 416 |           output_bytes oc (Bytes.sub s.auxs 4 (Bytes.length s.auxs - 4))
 417 |       | { storage = 3; extra_info = `Section s' } when int8 s.auxs 14 = 5 (* IMAGE_COMDAT_SELECT_ASSOCIATIVE *) ->
 418 |           (* section def *)
 419 |           output_bytes oc (Bytes.sub s.auxs 0 12);
 420 |           sec_put oc s'.sec_pos;
 421 |           output_bytes oc (Bytes.sub s.auxs type_ofs (Bytes.length s.auxs - type_ofs))
 422 |       | { storage = 3; extra_info = `Section s' } ->
 423 |           (* section def *)
 424 |           Printf.eprintf "!!! section symbol not supported (symbol: %s -> section:%s)\n%!" s.sym_name s'.sec_name;
 425 |           Printf.eprintf "length = %i\n" (int32_ s.auxs 0);
 426 |           Printf.eprintf "# reloc = %i\n" (int16 s.auxs 4);
 427 |           Printf.eprintf "# linenum = %i\n" (int16 s.auxs 6);
 428 |           Printf.eprintf "checksum = %i\n" (int32_ s.auxs 8);
 429 |           Printf.eprintf "idx = %i\n" (int16 s.auxs 12);
 430 |           Printf.eprintf "sel = %i\n" (int8 s.auxs 14);
 431 |           assert false
 432 |       | _ ->
 433 |           if s.storage = 105 then assert (sec_get s.auxs 12 = 0);
 434 |           output_bytes oc s.auxs
 435 | end
 436 | 
 437 | module Reloc = struct
 438 |   let abs machine sec addr sym =
 439 |     let rtype =
 440 |       match machine with
 441 |       | `x86 -> 0x06
 442 |       | `x64 -> 0x01
 443 |     in
 444 |     sec.relocs <- { addr = addr; symbol = sym; rtype = rtype } :: sec.relocs
 445 | 
 446 |   let rel32 machine sec addr sym =
 447 |     let rtype =
 448 |       match machine with
 449 |       | `x86 -> 0x14
 450 |       | `x64 -> 0x04
 451 |     in
 452 |     sec.relocs <- { addr = addr; symbol = sym; rtype = rtype } :: sec.relocs
 453 | 
 454 |   let get symtbl va ic base =
 455 |     let buf = read ic base 10 in
 456 |     { addr = Int32.sub (int32 buf 00) va;
 457 |       symbol = (try match symtbl.(int32_ buf 4) with Some s -> s
 458 |                   | None -> assert false
 459 |                 with _exn -> assert false);
 460 |       rtype = int16 buf 8
 461 |     }
 462 | 
 463 |   let dump x =
 464 |     Printf.printf " Reloc %ld -> %s, type 0x%04x\n"
 465 |       x.addr x.symbol.sym_name x.rtype
 466 | 
 467 |   let put oc x =
 468 |     emit_int32 oc x.addr;
 469 |     if x.symbol.sym_pos < 0 then
 470 |       failwith (Printf.sprintf
 471 |                   "Cannot emit relocation for symbol %s\n"
 472 |                   x.symbol.sym_name);
 473 |     emit_int32 oc (Int32.of_int x.symbol.sym_pos);
 474 |     emit_int16 oc x.rtype
 475 | end
 476 | 
 477 | module Section = struct
 478 |   let create name flags = {
 479 |     sec_pos = (-1); sec_name = name; data = `String (Bytes.of_string ""); relocs = [];
 480 |     vaddress = 0l; vsize = 0l; sec_opts = flags;
 481 |   }
 482 | 
 483 |   let nreloc_ovfl = 0x01000000l
 484 | 
 485 |   let get filebase strtbl symtbl ic base =
 486 |     let buf = read ic base 40 in
 487 |     let size = int32_ buf 16 in
 488 |     let name =
 489 |       if Bytes.get buf 0 = '/'
 490 |       then strtbl (int_of_string (strz buf 1 ~max:7 '\000'))
 491 |       else strz buf 0 ~max:8 '\000'
 492 |     in
 493 |     let va = int32 buf 12 in
 494 | 
 495 |     let nrelocs = int16 buf 32 in
 496 |     let more_relocs = int32 buf 36 &&& nreloc_ovfl <> 0l in
 497 |     let base_relocs = filebase + int32_ buf 24 in
 498 |     let base_relocs, nrelocs =
 499 |       if more_relocs then begin
 500 |         let buf_first_reloc = read ic base_relocs 4 in
 501 |         let n = int32_ buf_first_reloc 0 in
 502 |         base_relocs + 10, n - 1
 503 |       end else
 504 |         base_relocs, nrelocs
 505 |     in
 506 | 
 507 |     let relocs =
 508 |       let r = ref [] in
 509 |       for i = 0 to nrelocs - 1 do
 510 |         r := Reloc.get symtbl va ic (base_relocs + 10 * i) :: !r
 511 |       done;
 512 |       !r
 513 |     in
 514 | 
 515 |     let data =
 516 |       if name = ".sxdata" then
 517 |         let s = read ic (filebase + int32_ buf 20) size in
 518 |         `Sxdata
 519 |           (Array.init (size /4)
 520 |              (fun i -> match symtbl.(int32_ s (i * 4)) with None -> assert false | Some s -> s))
 521 |       else if int32_ buf 20 = 0 then `Uninit size
 522 |       else `String (read ic (filebase + int32_ buf 20) size)
 523 |     in
 524 | 
 525 |     { sec_pos = (-1);
 526 |       sec_name = name;
 527 |       vsize = int32 buf 8;
 528 |       vaddress = 0l;
 529 |       data = data;
 530 |       relocs = relocs;
 531 |       sec_opts = int32 buf 36
 532 |     }
 533 | 
 534 |   let dump x =
 535 |     Printf.printf "Section %s (0x%08lx: %s)\n"
 536 |       x.sec_name
 537 |       x.sec_opts
 538 |       (flags x.sec_opts);
 539 |     List.iter Reloc.dump x.relocs
 540 | 
 541 |   let size s =
 542 |     match s.data with
 543 |     | `String s -> Bytes.length s
 544 |     | `Uninit len -> len
 545 |     | `Buf bufs -> List.fold_left (fun s b -> s + Buf.length b) 0 bufs
 546 |     | `Sxdata syms -> Array.length syms * 4
 547 | 
 548 |   let put strtbl oc x =
 549 |     let name =
 550 |       if String.length x.sec_name <= 8
 551 |       then x.sec_name
 552 |       else Printf.sprintf "/%ld" (strtbl x.sec_name)
 553 |     in
 554 |     output_string oc name; emit_zero oc (8 - String.length name);
 555 |     emit_int32 oc x.vsize;
 556 | (*    assert(x.vaddress = 0l); *)
 557 |     emit_int32 oc x.vaddress;
 558 |     emit_int32 oc (Int32.of_int (size x));
 559 |     let send_data = match x.data with
 560 |       | `String s ->
 561 |           delayed_ptr oc (fun () -> output_bytes oc s)
 562 |       | `Uninit _len ->
 563 |           emit_int32 oc 0l; (fun () -> ())
 564 |       | `Buf bufs ->
 565 |           delayed_ptr oc (fun () -> List.iter (Buf.dump oc) bufs)
 566 |       | `Sxdata syms ->
 567 |           delayed_ptr oc
 568 |             (fun () ->
 569 |               Array.iter (fun sym -> assert(sym.sym_pos >= 0); emit_int32 oc (Int32.of_int sym.sym_pos)) syms
 570 |             )
 571 |     in
 572 | 
 573 |     let nrelocs = List.length x.relocs in
 574 |     let many_relocs = nrelocs > 0xffff in
 575 | 
 576 |     let send_reloc =
 577 |       if x.relocs = [] then (emit_int32 oc 0l; fun () -> ())
 578 |       else delayed_ptr oc
 579 |           (fun () ->
 580 |             if many_relocs then begin
 581 |               emit_int32 oc (Int32.of_int (nrelocs + 1));
 582 |               (* +1 because this slot counts as well! *)
 583 |               emit_int32 oc 0l;
 584 |               emit_int16 oc 0
 585 |             end;
 586 |             List.iter (Reloc.put oc) x.relocs
 587 |           )
 588 |     in
 589 | 
 590 |     emit_int32 oc 0l;
 591 |     if many_relocs then emit_int16 oc 0xffff
 592 |     else emit_int16 oc nrelocs;
 593 |     emit_int16 oc 0;
 594 |     let sec_opts = if many_relocs then x.sec_opts ||| nreloc_ovfl else x.sec_opts &&& Int32.lognot nreloc_ovfl in
 595 |     emit_int32 oc sec_opts;
 596 | 
 597 |     send_data, send_reloc
 598 | end
 599 | 
 600 | module FileHeader = struct
 601 |   type header = {
 602 |     hdrsize : int;
 603 |     machine : int;
 604 |     seccount : int;
 605 |     date: int32;
 606 |     symtable : int;
 607 |     symcount : int;
 608 |     opthdr : int;
 609 |     opts : int;
 610 | 
 611 |     symsize : int;
 612 |     bigobj: bool;
 613 |   }
 614 | 
 615 |   let bigobj_classid =
 616 |     "\xC7\xA1\xBA\xD1\xEE\xBA\xA9\x4B\xAF\x20\xFA\xF6\x6A\xA4\xDC\xB8"
 617 | 
 618 |   let get_image_file_header ic ofs =
 619 |     let hdrsize = 20 in
 620 |     let buf = read ic ofs hdrsize in
 621 |     let machine = int16 buf 0 in
 622 |     let seccount = int16 buf 2 in
 623 |     let date = int32 buf 4 in
 624 |     let symtable = int32_ buf 8 in
 625 |     let symcount = int32_ buf 12 in
 626 |     let opthdr = int16 buf 16 in
 627 |     let opts = int16 buf 18 in
 628 |     let symsize = 18 in
 629 |     let bigobj = false in
 630 |     { hdrsize = hdrsize; machine = machine; seccount = seccount; date = date;
 631 |       symtable = symtable; symcount = symcount; opthdr = opthdr; opts = opts;
 632 |       symsize = symsize; bigobj = bigobj }
 633 | 
 634 |   let get_header_bigobj ic ofs =
 635 |     let hdrsize = 56 in
 636 |     let buf = read ic ofs hdrsize in
 637 |     let machine = int16 buf 6 in
 638 |     let date = int32 buf 8 in
 639 |     let opts = int32_ buf 32 in
 640 |     let seccount = int32_ buf 44 in
 641 |     let symtable = int32_ buf 48 in
 642 |     let symcount = int32_ buf 52 in
 643 |     let symsize = 20 in
 644 |     let opthdr = 0 in
 645 |     let bigobj = true in
 646 |     { hdrsize = hdrsize; machine = machine; seccount = seccount; date = date;
 647 |       symtable = symtable; symcount = symcount; opthdr = opthdr; opts = opts;
 648 |       symsize = symsize; bigobj = bigobj }
 649 | 
 650 |   let get ic ofs =
 651 |     let buf = read ic ofs 6 in
 652 |     let sig1 = int16 buf 0 in
 653 |     let sig2 = int16 buf 2 in
 654 |     if sig1 = 0 && sig2 = 0xFFFF then
 655 |       let version = int16 buf 4 in
 656 |       if version = 0 then
 657 |         `IMPORT_OBJECT_HEADER (* names from winnt.h *)
 658 |       else if version = 1 then
 659 |         `ANON_OBJECT_HEADER
 660 |       else (* version >= 2 *)
 661 |         `ANON_OBJECT_HEADER_BIGOBJ (get_header_bigobj ic ofs)
 662 |     else
 663 |       `IMAGE_FILE_HEADER (get_image_file_header ic ofs)
 664 | end
 665 | 
 666 | module Coff = struct
 667 |   let add_section x sect =
 668 |     x.sections <- sect :: x.sections
 669 |   let add_symbol x sym =
 670 |     x.symbols <- sym :: x.symbols
 671 | 
 672 |   let create machine =
 673 |     let machine =
 674 |       match machine with
 675 |       | `x64 -> 0x8664
 676 |       | `x86 -> 0x14c
 677 |     in
 678 |     { bigobj = false;
 679 |       obj_name = "generated";
 680 |       machine = machine; date = 0x4603de0el;
 681 |       sections = []; symbols = []; opts = 0 }
 682 | 
 683 |   let parse_directives s =
 684 |     let rec find_end i =
 685 |       if i = 0 || s.[i - 1] <> '\000' then i
 686 |       else find_end (i - 1)
 687 |     in
 688 |     let l = find_end (String.length s) in
 689 |     let rec aux0 i = if i = l then [] else match s.[i] with
 690 |       | ' ' -> aux0 (i+1)
 691 |       | '-' | '/' -> aux1 (i+1) (i+1)
 692 |       | _ -> raise Exit
 693 |     and aux1 i0 i = if i = l then (String.sub s i0 (i - i0), [])::[]
 694 |     else match s.[i] with
 695 |       | 'a'..'z' | 'A'..'Z' | '-' -> aux1 i0 (i+1)
 696 |       | ' ' -> (String.sub s i0 (i - i0), []) :: aux0 (i+1)
 697 |       | ':' -> aux2 (String.sub s i0 (i - i0)) [] (i+1)
 698 |       | _   -> raise Exit
 699 |     and aux2 cmd args i = match s.[i] with
 700 |       | '"' -> aux3 cmd args (i+1) (i+1)
 701 |       | _   -> aux4 cmd args i i
 702 |     and aux3 cmd args i0 i = match s.[i] with
 703 |       | '"' -> aux5 cmd (String.sub s i0 (i - i0) :: args) (i+1)
 704 |       | _   -> aux3 cmd args i0 (i+1)
 705 |     and aux4 cmd args i0 i =
 706 |       if i = l then (cmd, String.sub s i0 (i - i0) :: args)::[]
 707 |       else match s.[i] with
 708 |         | ' ' -> (cmd, String.sub s i0 (i - i0) :: args) :: aux0 (i+1)
 709 |         | ',' -> aux2 cmd (String.sub s i0 (i - i0) :: args) (i+1)
 710 |         | _   -> aux4 cmd args i0 (i+1)
 711 |     and aux5 cmd args i =
 712 |       if i = l then (cmd, args) :: []
 713 |       else match s.[i] with
 714 |       | ' ' -> (cmd,args) :: aux0 (i+1)
 715 |       | ',' -> aux2 cmd args (i+1)
 716 |       | _   -> raise Exit
 717 |     in
 718 |     try List.map (fun (cmd,args) -> (cmd,List.rev args)) (aux0 0)
 719 |     with _ ->
 720 |       failwith (Printf.sprintf "Cannot parse directive: %s\n" s)
 721 | 
 722 |   let directives obj =
 723 |     try
 724 |       let sec = List.find (fun s -> s.sec_name = ".drectve") obj.sections in
 725 |       match sec.data with
 726 |         | `String s -> parse_directives (Bytes.to_string s)
 727 |         | `Uninit _ | `Sxdata _ -> []
 728 |         | `Buf _ -> assert false
 729 |     with Not_found -> []
 730 | 
 731 |   let get ic ofs base h name =
 732 |     let symtable = base + h.FileHeader.symtable in
 733 | 
 734 |     (* the string table *)
 735 |     let strtbl =
 736 |       let pos = symtable + h.FileHeader.symsize * h.FileHeader.symcount in
 737 |       if pos = 0 then fun _ -> assert false
 738 |       else
 739 |         let len = int32_ (read ic pos 4) 0 in
 740 |         let data = read ic pos len in
 741 |         fun i -> strz data i '\000'
 742 |     in
 743 | 
 744 | 
 745 |     (* the symbol table *)
 746 |     let symbols,symtbl =
 747 |       let tbl = Array.make h.FileHeader.symcount None in
 748 |       let rec fill accu i =
 749 |         if i = h.FileHeader.symcount then List.rev accu
 750 |         else let s = Symbol.get ~bigobj:h.FileHeader.bigobj strtbl ic (symtable + h.FileHeader.symsize * i) in
 751 |         (try tbl.(i) <- Some s
 752 |          with Invalid_argument _ -> assert false);
 753 |         fill (s :: accu) (i + 1 + s.auxn) in
 754 |       fill [] 0, tbl
 755 |     in
 756 | 
 757 |     (* the sections *)
 758 |     let sectable = ofs + h.FileHeader.hdrsize + h.FileHeader.opthdr in
 759 |     let sections =
 760 |       Array.init h.FileHeader.seccount
 761 |         (fun i -> Section.get base strtbl symtbl ic (sectable + 40 * i))
 762 |     in
 763 | 
 764 |     (* remove .bf/.ef/.lf symbols *)
 765 |     let symbols =
 766 |       List.filter (function { storage = 101 } -> false | _ -> true)
 767 |         symbols in
 768 |     List.iter
 769 |       (fun s ->
 770 |          (match s with
 771 |             | { storage = 105; auxn = 1 } ->
 772 |                 (* weak ext *)
 773 |                 (try match symtbl.(Int32.to_int (int32 s.auxs 0)) with
 774 |                    | Some s' -> s.extra_info <- `Alias s'
 775 |                    | None -> assert false
 776 |                  with Invalid_argument _ -> assert false);
 777 |             | { storage = 3; stype = 0; auxn = auxn } when auxn > 0 ->
 778 |                 (* section def *)
 779 |                 let num = int16 s.auxs 12 in
 780 |                 let sel = int8 s.auxs 14 in
 781 |                 if sel = 5 && num > 0 then
 782 |                   (try s.extra_info <- `Section sections.(num - 1)
 783 |                    with Invalid_argument _ ->
 784 |                      Printf.eprintf "** section %i / %i (%s)\n" num
 785 |                        (Array.length sections) s.sym_name;
 786 |                      assert false);
 787 |             | { storage = 103 }
 788 |             | { auxn = 0 } -> ()
 789 |             | { storage = (2|3); stype = 0x20; auxn = 1; auxs = auxs } ->
 790 |                 (* Remove extra information for function symbols *)
 791 |                 s.auxs <- Bytes.make (Bytes.length auxs) '\000'
 792 |             | _ ->
 793 |                 Symbol.dump s;
 794 |                 Printf.printf "aux=%S\n%!" (Bytes.to_string s.auxs);
 795 |                 assert false);
 796 |          (match s.section with
 797 |             | `Num i when i > 0 && i <= Array.length sections ->
 798 |                 assert (i <= Array.length sections);
 799 |                 (try s.section <- `Section sections.(i - 1)
 800 |                  with Invalid_argument _ -> assert false);
 801 |             | _ -> ()))
 802 |       symbols;
 803 | 
 804 |     { bigobj = h.FileHeader.bigobj;
 805 |       obj_name = name;
 806 |       machine = h.FileHeader.machine;
 807 |       sections = Array.to_list sections;
 808 |       date = h.FileHeader.date;
 809 |       symbols = symbols;
 810 |       opts = h.FileHeader.opts;
 811 |     }
 812 | 
 813 |   let aliases x =
 814 |     let a = ref [] in
 815 |     List.iter
 816 |       (fun s ->
 817 |          match s.extra_info with
 818 |            | `Alias s' -> a := (s.sym_name,s'.sym_name) :: !a
 819 |            | _ -> ()
 820 |       )
 821 |       x.symbols;
 822 |     !a
 823 | 
 824 | 
 825 | 
 826 |   let dump x =
 827 |     Printf.printf "machine: 0x%x\n" x.machine;
 828 |     Printf.printf "date:    0x%lx\n" x.date;
 829 |     Printf.printf "opts:    0x%x\n" x.opts;
 830 |     List.iter Symbol.dump x.symbols;
 831 |     List.iter Section.dump x.sections;
 832 |     flush stdout
 833 | 
 834 |   let put oc x =
 835 |     let () =
 836 |       let no = ref 0 in
 837 |       List.iter
 838 |         (fun s -> incr no; assert(s.sec_pos < 0); s.sec_pos <- !no)
 839 |         x.sections
 840 |     in
 841 | 
 842 |     if x.bigobj then begin
 843 |       emit_int16 oc 0; (* Sig1 *)
 844 |       emit_int16 oc 0xffff; (* Sig2 *)
 845 |       emit_int16 oc 2; (* Version *)
 846 |       emit_int16 oc x.machine;
 847 |       emit_int32 oc x.date;
 848 |       output_string oc FileHeader.bigobj_classid;
 849 |       emit_int32 oc 0l;
 850 |       emit_int32 oc (Int32.of_int x.opts);
 851 |       emit_int32 oc 0l;
 852 |       emit_int32 oc 0l;
 853 |       emit_int32 oc (Int32.of_int (List.length x.sections));
 854 |     end
 855 |     else begin
 856 |       emit_int16 oc x.machine;
 857 |       emit_int16 oc (List.length x.sections);
 858 |       emit_int32 oc x.date;
 859 |     end;
 860 | 
 861 |     let strbuf = Buffer.create 1024 in
 862 |     let strtbl s =
 863 |       let pos = Buffer.length strbuf in
 864 |       Buffer.add_string strbuf s;
 865 |       Buffer.add_char strbuf '\000';
 866 |       Int32.of_int (4 + pos)
 867 |     in
 868 | 
 869 |     let patch_sym =
 870 |       delayed_ptr oc
 871 |         (fun () -> List.iter (Symbol.put ~bigobj:x.bigobj strtbl oc) x.symbols)
 872 |     in
 873 |     let nbsym =
 874 |       let no = ref 0 in
 875 |       List.iter
 876 |         (fun s ->
 877 |            assert(s.sym_pos < 0);
 878 |            s.sym_pos <- !no;
 879 |            no := !no + 1 + s.auxn
 880 |         )
 881 |         x.symbols;
 882 |       !no
 883 |     in
 884 |     emit_int32 oc (Int32.of_int nbsym);
 885 |     if not x.bigobj then begin
 886 |       emit_int16 oc 0;
 887 |       emit_int16 oc x.opts;
 888 |     end;
 889 | 
 890 |     let sects =
 891 |       List.map (Section.put strtbl oc) x.sections in
 892 |     List.iter
 893 |       (fun (data,relocs) -> data (); relocs ())
 894 |       sects;
 895 | 
 896 |     patch_sym ();
 897 | 
 898 |     emit_int32 oc (Int32.of_int (Buffer.length strbuf + 4));
 899 |     Buffer.output_buffer oc strbuf;
 900 | 
 901 |     List.iter (fun s -> s.sym_pos <- 0) x.symbols;
 902 |     List.iter (fun s -> s.sec_pos <- 0) x.sections;
 903 |     ()
 904 | end
 905 | 
 906 | module Import = struct
 907 |   let read ic pos size =
 908 |     let buf = read ic pos size in
 909 |     let w = int16 buf 18 in
 910 |     let name = strz buf 20 '\000' in
 911 | (*    Printf.printf "Import header. Version = %i\n" (int16 buf 4);
 912 |     Printf.printf " machine     = 0x%x\n" (int16 buf 6);
 913 |     Printf.printf " time stamp  = 0x%lx\n" (int32 buf 8);
 914 |     Printf.printf " size data   = %ld\n" (int32 buf 12);
 915 |     Printf.printf " ord/hint    = %i\n" (int16 buf 16);
 916 |     Printf.printf " type        = %i\n" (w land 0b11);
 917 |     Printf.printf " name type   = %i\n" ((w land 0b11100) lsr 2);
 918 |     Printf.printf " symbol      = %s\n" name;
 919 |     Printf.printf " DLL         = %s\n"
 920 |       (strz buf (21 + String.length name) '\000'); *)
 921 |     name, w
 922 | 
 923 | end
 924 | 
 925 | module Lib = struct
 926 |   let magic_lib = "!<arch>\n"
 927 | 
 928 |   let read_lib ic libname =
 929 |     let strtbl = ref (Bytes.of_string "") in
 930 |     let imports = ref [] and objects = ref [] in
 931 |     let obj size name =
 932 | (*      Printf.printf "-> %s (size %i)\n" name size;  *)
 933 |       let pos = pos_in ic in
 934 |       match FileHeader.get ic pos with
 935 |       | `IMPORT_OBJECT_HEADER ->
 936 |         if size > 18 then
 937 |           imports := Import.read ic pos size :: !imports
 938 |       | `ANON_OBJECT_HEADER_BIGOBJ h
 939 |       | `IMAGE_FILE_HEADER h ->
 940 |         objects := (name,
 941 |                     Coff.get ic pos pos h
 942 |                       (Printf.sprintf "%s(%s)" libname name)) :: !objects
 943 |       | `ANON_OBJECT_HEADER ->
 944 |         () (* ignore *)
 945 |     in
 946 |     let rec read_member () =
 947 |       let buf = read ic (pos_in ic) 60 in
 948 |       let base = pos_in ic in
 949 |       let size = int_of_string (strz (Bytes.sub buf 48 10) 0 ' ') in
 950 |       let name = strz (Bytes.sub buf 0 16) 0 ' ' in
 951 |       begin match name with
 952 |         | "/" | "" -> ()
 953 |         | "//" ->
 954 |             let tbl = read ic (pos_in ic) size in
 955 |             (* GNU-produced archive files are supposed to be printable if the
 956 |                archive members contain text, so the entries in the list are
 957 |                newline-padded, not null-padded. Let's fix that here. *)
 958 |             for i = 0 to Bytes.length tbl - 1 do
 959 |               if Bytes.get tbl i = '\n' then
 960 |                 let i = if i > 0 && Bytes.get tbl (i-1) = '/' then i-1 else i in
 961 |                 Bytes.set tbl i '\000'
 962 |             done;
 963 |             strtbl := tbl
 964 |         | s when s.[0] = '/' ->
 965 |             let ofs =
 966 |               try Scanf.sscanf s "/%u%!" (fun x -> x)
 967 |               with Scanf.Scan_failure _
 968 |                  | Failure _
 969 |                  | End_of_file -> -1
 970 |             in
 971 |               (* Ignore special sections which we don't know about *)
 972 |               if ofs >= 0 then
 973 |                 obj size (strz !strtbl ofs '\000')
 974 |         | s when s.[String.length s - 1] = '/' ->
 975 |             let s = String.sub s 0 (String.length s - 1) in
 976 |             obj size s
 977 |         | s ->
 978 |             Printf.ksprintf failwith "Cannot parse archive member %s" s
 979 |       end;
 980 |       seek_in ic (base + size + size mod 2);
 981 |       read_member ()
 982 |     in
 983 |     (try read_member () with End_of_file -> ());
 984 |     !objects,!imports
 985 | 
 986 |   let is_lib ic =
 987 |     in_channel_length ic >= String.length magic_lib
 988 |     && read_str ic 0 (String.length magic_lib) = magic_lib
 989 | 
 990 |   let obj_ofs ic =
 991 |     try
 992 |       let b = read ic 0x3c 4 in
 993 |       let ofs = int32_ b 0 in
 994 |       if read_str ic ofs 4 = "PE\000\000" then ofs + 4
 995 |       else 0
 996 |     with _exn ->
 997 |       0
 998 | 
 999 |   let is_dll filename =
1000 |     let ic = open_in_bin filename in
1001 |     let ofs = obj_ofs ic in
1002 |     close_in ic;
1003 |     ofs > 0
1004 | 
1005 |   let read filename =
1006 |     let ic = open_in_bin filename in
1007 |     try
1008 | (*      let t0 = Unix.gettimeofday () in
1009 |       Printf.printf "Reading %s...%!" filename; *)
1010 |       let r =
1011 |         if is_lib ic then `Lib (read_lib ic filename)
1012 |         else
1013 |           let ofs = obj_ofs ic in
1014 |           let h = match FileHeader.get ic ofs with
1015 |           | `ANON_OBJECT_HEADER_BIGOBJ h
1016 |           | `IMAGE_FILE_HEADER h -> h
1017 |           | `IMPORT_OBJECT_HEADER
1018 |           | `ANON_OBJECT_HEADER -> assert false in
1019 |           `Obj (Coff.get ic ofs 0 h filename)
1020 |       in
1021 | (*      let t1 = Unix.gettimeofday () in
1022 |       Printf.printf "  Done  (%f ms)\n%!" (t1 -. t0);  *)
1023 |       close_in ic;
1024 |       r
1025 |     with exn ->
1026 |       close_in ic;
1027 |       raise exn
1028 | 
1029 |   let read filename =
1030 |     try
1031 |       read filename
1032 |     with exn ->
1033 |       failwith
1034 |         (Printf.sprintf "Error while reading %s: %s"
1035 |            filename (Printexc.to_string exn))
1036 | 
1037 | end
1038 | 
1039 | 
1040 | module Stacksize = struct
1041 |   let set_stack_reserve filename size_of_stack_reserve =
1042 |     let filename =
1043 |       if not (Sys.file_exists filename) && (Sys.file_exists (filename ^ ".exe")) then filename ^ ".exe"
1044 |       else filename
1045 |     in
1046 |     let ic = open_in_bin filename in
1047 |     (* Read e_lfanew from the IMAGE_DOS_HEADER (see winnt.h) *)
1048 |     let pe_signature_offset = int32_ (read ic 0x3c 4) 0 in
1049 |     let pe_signature = read_str ic pe_signature_offset 4 in
1050 |     assert(pe_signature = "PE\000\000");
1051 |     let coff_file_header = read ic (pe_signature_offset + 4) 20 in
1052 |     let size_of_optional_header = int16 coff_file_header 16 in
1053 |     let optional_header = read ic (pe_signature_offset + 4 + 20) size_of_optional_header in
1054 |     let pe_format =
1055 |       match int16 optional_header 0 with
1056 |       | 0x10b -> `PE32
1057 |       | 0x20b -> `PE32plus
1058 |       | magic -> Printf.ksprintf failwith "Cannot determine PE format (magic = %x)." magic
1059 |     in
1060 |     let size_of_stack_reserve_offset = pe_signature_offset + 4 + 20 + 72 in
1061 |     close_in ic;
1062 | 
1063 |     let oc = open_out_gen [Open_wronly; Open_binary] 0x777 filename in
1064 |     seek_out oc size_of_stack_reserve_offset;
1065 |     emit_int32 oc size_of_stack_reserve;
1066 |     if pe_format = `PE32plus then emit_int32 oc 0l;
1067 |     close_out oc
1068 | end
1069 | 


--------------------------------------------------------------------------------
/create_dll.ml:
--------------------------------------------------------------------------------
  1 | (************************************************************************)
  2 | (*   FlexDLL                                                            *)
  3 | (*   Alain Frisch                                                       *)
  4 | (*                                                                      *)
  5 | (*   Copyright 2007 Institut National de Recherche en Informatique et   *)
  6 | (*   en Automatique.                                                    *)
  7 | (************************************************************************)
  8 | 
  9 | (* Create a DLL from a set of "closed" COFF files (no imported symbol). *)
 10 | 
 11 | include (struct
 12 | open Compat
 13 | open Coff
 14 | 
 15 | let (&&&) = Int32.logand
 16 | let (|||) = Int32.logor
 17 | let (<<<) = Int32.shift_left
 18 | 
 19 | let read_int32 s i =
 20 |   Int32.of_int (Char.code (Bytes.get s i)) |||
 21 |   (Int32.of_int (Char.code (Bytes.get s (i+1))) <<< 8) |||
 22 |   (Int32.of_int (Char.code (Bytes.get s (i+2))) <<< 16) |||
 23 |   (Int32.of_int (Char.code (Bytes.get s (i+3))) <<< 24)
 24 | 
 25 | let align x n =
 26 |   let k = Int32.rem x n in
 27 |   if k = 0l then x
 28 |   else Int32.add x (Int32.sub n k)
 29 | 
 30 | let discard_section s =
 31 |   let opts = s.sec_opts in
 32 |   opts &&&
 33 |   (0x00000200l (* Info section (.drectve) *)
 34 |  ||| 0x00000800l (* Remove *)
 35 |  ||| 0x02000000l) <> 0l (* Discardable *)
 36 | 
 37 | let sect_data s =
 38 |   match s.data with
 39 |   | `String data -> data
 40 |   | `Buf _ -> assert false
 41 |   | `Sxdata _ -> assert false
 42 |   | `Uninit 0 -> Bytes.of_string ""
 43 |   | `Uninit size ->
 44 |       failwith
 45 |         (Printf.sprintf
 46 |            "uninitialized section %s (size %d): not supported"
 47 |            s.sec_name size
 48 |         )
 49 | 
 50 | let split_relocs page_size relocs =
 51 |   let relocs = Array.of_list relocs in
 52 |   Array.sort (fun (i, _) (j, _) -> compare i j) relocs;
 53 |   let blocks = ref [] and current_block = ref (ref []) and current_base = ref (-1l) in
 54 |   Array.iter
 55 |     (fun (rva, k) ->
 56 |       let base = Int32.mul (Int32.div rva page_size) page_size in
 57 |       let ofs = Int32.to_int (Int32.sub rva base) in
 58 |       if base = !current_base then (!current_block) := (ofs, k) :: !(!current_block)
 59 |       else begin
 60 |         current_base := base;
 61 |         current_block := ref [(ofs, k)];
 62 |         blocks := (base, !current_block) :: !blocks
 63 |       end
 64 |     )
 65 |     relocs;
 66 |   List.rev_map (fun (base, relocs) -> (base, List.rev !relocs)) !blocks
 67 | 
 68 | 
 69 | type sec_info = {
 70 |     sec_info_obj: coff; (* original object *)
 71 |     mutable sec_info_sec: section; (* target section in the image *)
 72 |     mutable sec_info_ofs: int32; (* offset within the target image *)
 73 |     sec_info_vaddress: int32 Lazy.t;
 74 |   }
 75 | 
 76 | let create_dll oc objs =
 77 |   let image_base = 0x10000l in
 78 |   let page_size = 0x1000l in
 79 |   let dllname = "foo.dll" in
 80 | 
 81 |   (* msdos stub *)
 82 |   output_string oc "MZ";
 83 |   for _i = 3 to 0x3c do output_byte oc 0 done;
 84 |   emit_int32 oc 0xe8l; (* file offset of COFF file header, just here *)
 85 |   for _i = 0x40 to 0xe7 do output_byte oc 0 done;
 86 | 
 87 |   let sections = Hashtbl.create 8 in
 88 |   let sec_id = ref 0 in
 89 |   let sec_info = Hashtbl.create 8 in
 90 |   let sym_id = ref 0 in
 91 |   let globals = Hashtbl.create 8 in
 92 |   let locals = Hashtbl.create 8 in
 93 |   let commons = Hashtbl.create 8 in
 94 |   let relocs = ref [] in
 95 | 
 96 |   List.iter
 97 |     (fun obj ->
 98 |       List.iter
 99 |         (fun s ->
100 |           (* todo: cut the section name at 8 chars, remove the part of $ *)
101 |           if discard_section s then ()
102 |           else let (l, sect) =
103 |             try Hashtbl.find sections s.sec_name
104 |             with Not_found ->
105 |               let r =
106 |                 ref [],
107 |                 Section.create s.sec_name
108 |                   (s.sec_opts
109 |                      &&& (0x00000020l
110 |                         ||| 0x00000040l
111 |                         ||| 0x00000080l
112 |                         ||| 0x10000000l
113 |                         ||| 0x20000000l
114 |                         ||| 0x40000000l
115 |                         ||| 0x80000000l))
116 |               in
117 |               Hashtbl.replace sections s.sec_name r;
118 |               r
119 |           in
120 |           l := s :: !l;
121 |           s.sec_pos <- !sec_id;
122 |           incr sec_id;
123 |           let rec info =
124 |             {
125 |              sec_info_obj = obj;
126 |              sec_info_sec = sect;
127 |              sec_info_ofs = 0l;
128 |              sec_info_vaddress = lazy (Int32.add info.sec_info_ofs sect.vaddress)
129 |            }
130 |           in
131 |           Hashtbl.replace sec_info s.sec_pos info
132 |         )
133 |         obj.sections;
134 | 
135 |       List.iter
136 |         (function
137 |           | {sym_name=name; value=ofs; storage=storage; section = `Section s} as sym when s.sec_pos >= 0 ->
138 |               let info = Hashtbl.find sec_info s.sec_pos in
139 |               let rva = lazy (Int32.add ofs (Lazy.force info.sec_info_vaddress)) in
140 |               if storage = 2
141 |               then
142 |                 if Hashtbl.mem globals name
143 |                 then failwith ("Multiply defined symbol: " ^ name)
144 |                 else Hashtbl.replace globals name rva
145 |               else begin
146 |                 sym.sym_pos <- !sym_id;
147 |                 incr sym_id;
148 |                 Hashtbl.replace locals sym.sym_pos rva
149 |               end
150 |           | {sym_name=name; storage=2; section=`Num 0; value=size } ->
151 |               let oldsize =
152 |                 try Hashtbl.find commons name
153 |                 with Not_found -> 0l
154 |               in
155 |               Hashtbl.replace commons name (max size oldsize)
156 |           | _ -> ()
157 |         )
158 |         obj.symbols;
159 |     )
160 |     objs;
161 | 
162 |   let rva_of_global s =
163 |     try Hashtbl.find globals s
164 |     with Not_found -> failwith ("Cannot find global symbol " ^ s)
165 |   in
166 |   let rva_of_local s =
167 |     try Hashtbl.find locals s
168 |     with Not_found -> assert false
169 |   in
170 | 
171 |   let sects = ref [] in
172 |   (* Put image sections at their target rva *)
173 |   let va = ref 0x1000l in
174 |   let put_sect s =
175 |     s.vsize <- Int32.of_int (Section.size s);
176 |     s.vaddress <- !va;
177 |     va := align (Int32.add !va s.vsize) 0x1000l;
178 |     sects := s :: !sects
179 |   in
180 | 
181 |   (* create the uninitialized section data *)
182 |   let () =
183 |     let bss = Section.create ".bss" 0xC0000080l in
184 |     let total = ref 0l in
185 |     Hashtbl.iter
186 |       (fun name size ->
187 |         if not (Hashtbl.mem globals name) && size > 0l
188 |         then
189 |           let pos = !total in
190 |           total := Int32.add !total size;
191 |           let rva = lazy (Int32.add pos bss.vaddress) in
192 |           Hashtbl.replace globals name rva
193 |       )
194 |       commons;
195 |     bss.data <- `Uninit (Int32.to_int !total);
196 |     if !total <> 0l then put_sect bss
197 |   in
198 | 
199 |   let treat_sect (l, sect) =
200 |     let sect_len = ref 0 in
201 |     let mk_sect s =
202 |       let buf = Buf.create () in
203 |       let info = Hashtbl.find sec_info s.sec_pos in
204 |       let sec_ofs = !sect_len in
205 |       info.sec_info_ofs <- Int32.of_int sec_ofs;
206 |       let sdata = sect_data s in
207 |       let slen = Bytes.length sdata in
208 | 
209 |       let pad =
210 |         if slen mod 16 = 0 then 0
211 |         else 16 - slen mod 16
212 |       in
213 |       sect_len := !sect_len + Bytes.length sdata + pad;
214 |       Buf.bytes buf sdata;
215 |       if pad > 0 then
216 |         Buf.bytes buf (Bytes.make pad '\000');
217 | 
218 |       let mk_reloc r =
219 |         (* rva of the target symbol *)
220 |         let sym = r.symbol in
221 |         let rva =
222 |           if Symbol.is_extern sym || Symbol.is_export sym then rva_of_global sym.sym_name
223 |           else if sym.sym_pos >= 0 then rva_of_local sym.sym_pos
224 |           else begin
225 |             Symbol.dump sym;
226 |             failwith (Printf.sprintf "Cannot resolve symbol %s\n" sym.sym_name)
227 |           end
228 |         in
229 | 
230 |         (* rva of the relocation *)
231 |         let rel_rva = lazy (Int32.add r.addr (Lazy.force info.sec_info_vaddress)) in
232 | 
233 |         let pos = Int32.to_int r.addr in
234 |         let initial = read_int32 sdata pos in
235 |         match !Cmdline.machine, r.rtype with
236 |         | `x86, 0x06 (* IMAGE_REL_I386_DIR32 *)
237 |         | `x64, 0x02 (* IMAGE_REL_AMD64_ADDR32 *) ->
238 |             (* 32-bit VA *)
239 |             relocs := (rel_rva, `R32) :: !relocs;
240 |             Buf.patch_lazy_int32 buf pos (lazy (Int32.add (Int32.add initial (Lazy.force rva)) image_base))
241 | 
242 |         | `x64, 0x01 (* IMAGE_REL_AMD64_ADDR64 *) ->
243 |             (* 64-bit VA *)
244 |             assert(read_int32 sdata (pos + 4) = 0l);
245 |             relocs := (rel_rva, `R64) :: !relocs;
246 |             Buf.patch_lazy_int32 buf pos (lazy (Int32.add (Int32.add initial (Lazy.force rva)) image_base))
247 | 
248 |         | `x86, 0x14 (* IMAGE_REL_I386_REL32 *)
249 |         | `x64, 0x04 (* IMAGE_REL_AMD64_REL32 *) ->
250 |             Buf.patch_lazy_int32 buf pos (lazy (Int32.sub (Int32.add initial (Lazy.force rva)) (Int32.add (Lazy.force rel_rva) 4l)))
251 |         | _, k ->
252 |             Printf.ksprintf failwith "Unsupport relocation kind %04x for %s"
253 |               k r.symbol.sym_name
254 |       in
255 |       List.iter mk_reloc s.relocs;
256 |       buf
257 |     in
258 |     let bufs = List.map mk_sect !l in
259 |     sect.data <- `Buf bufs;
260 |     put_sect sect
261 |   in
262 | 
263 |   Hashtbl.iter
264 |     (fun _name x -> treat_sect x)
265 |     sections;
266 | 
267 |   (* create the export table *)
268 |   let edata =
269 |     let edata = Section.create ".dllexp" 0x40000040l in
270 |     let b = Buf.create () in
271 |     edata.data <- `Buf [b];
272 |     let vaddress = lazy edata.vaddress in
273 | 
274 |     let export_symbols = ["symtbl";"reloctbl"] in
275 |     let export_symbols = List.sort compare export_symbols in
276 |     Buf.int32 b 0l; (* flags *)
277 |     Buf.int32 b 0l; (* timestamp *)
278 |     Buf.int32 b 0l; (* version *)
279 |     let dllname_offset = Buf.future_int32 b vaddress in (* name rva *)
280 |     Buf.int32 b 1l; (* ordinal base *)
281 |     Buf.int32 b (Int32.of_int (List.length export_symbols)); (* addr table entries *)
282 |     Buf.int32 b (Int32.of_int (List.length export_symbols)); (* number of name pointers *)
283 |     let exp_tbl = Buf.future_int32 b vaddress in (* export address table rva *)
284 |     let name_ptr_tbl = Buf.future_int32 b vaddress in (* name pointer rva *)
285 |     let ord_ptr_tbl = Buf.future_int32 b vaddress in (* ordinal table pointer rva *)
286 |     Buf.set_future b dllname_offset;
287 |     Buf.string b dllname;
288 |     Buf.int8 b 0;
289 |     Buf.set_future b exp_tbl;
290 |     List.iter (fun s -> Buf.lazy_int32 b (rva_of_global (Cmdline.usym s)))
291 |       export_symbols;
292 |     Buf.set_future b name_ptr_tbl;
293 |     let export_symbols_ofs =
294 |       List.map (fun _ -> Buf.future_int32 b vaddress) export_symbols
295 |     in
296 |     Buf.set_future b ord_ptr_tbl;
297 |     for i = 0 to List.length export_symbols - 1 do
298 |       Buf.int16 b i
299 |     done;
300 |     List.iter2
301 |       (fun s f ->
302 |         Buf.set_future b f;
303 |         Buf.string b s;
304 |         Buf.int8 b 0
305 |       )
306 |       export_symbols
307 |       export_symbols_ofs;
308 |     put_sect edata;
309 |     edata
310 |   in
311 | 
312 |   (* create the reloc table *)
313 |   let rdata =
314 |     let rdata = Section.create ".reloc" 0x40000040l in
315 |     let b = Buf.create () in
316 |     rdata.data <- `Buf [b];
317 | 
318 |     (* careful with list functions: the list of relocs can be very long *)
319 |     let relocs = List.rev_map (fun (rva, k) -> (Lazy.force rva, k)) !relocs in
320 |     let relocs = split_relocs page_size relocs in
321 |     List.iter
322 |       (fun (base, relocs) ->
323 |         let n = List.length relocs in
324 |         let size = 8 + 2 * n in
325 |         let size = if n mod 2 = 1 then size + 2 else size in
326 |         Buf.int32 b base;
327 |         Buf.int32 b (Int32.of_int size);
328 |         List.iter
329 |           (fun (ofs, k) ->
330 |              let k =
331 |                match k with
332 |                | `R32 -> 0x3000 (* IMAGE_REL_BASED_HIGHLOW *)
333 |                | `R64 -> 0xA000 (* IMAGE_REL_BASED_DIR64 *)
334 |              in
335 |              Buf.int16 b (ofs lor k)
336 |           )
337 |           relocs;
338 |         if n mod 2 = 1 then Buf.int16 b 0
339 |       )
340 |       relocs;
341 |     put_sect rdata;
342 |     rdata
343 |   in
344 | 
345 |   output_string oc "PE\000\000";
346 |   (* coff header *)
347 |   let machine = !Cmdline.machine in
348 |   let disp_mach ~x86 ~x64 =
349 |     match machine with `x86 -> x86 | `x64 -> x64
350 |   in
351 |   let emit_int32_64 x =
352 |     emit_int32 oc x;
353 |     if machine = `x64 then emit_int32 oc 0l
354 |   in
355 |   emit_int16 oc (disp_mach ~x86:0x14c ~x64:0x8664);
356 |   emit_int16 oc (List.length !sects); (* number of sections *)
357 |   emit_int32 oc 0l; (* date *)
358 |   emit_int32 oc 0l; (* ptr to symbol table *)
359 |   emit_int32 oc 0l; (* number of symbols *)
360 |   emit_int16 oc ((disp_mach ~x86:28 ~x64:24) + (disp_mach ~x86:68 ~x64:88) + 8 * 16); (* size of optional headers *)
361 |   emit_int16 oc
362 |     (disp_mach
363 |        ~x86:0x2102 (* flags: exec, 32-bit, dll *)
364 |        ~x64:0x2022 (* flags: exec, large address aware(?), dll *)
365 |     );
366 | 
367 |   (* optional header *)
368 |   (*   standard fields *)
369 |   emit_int16 oc (disp_mach ~x86:0x10b ~x64:0x20b); (* magic: pe32/pe32+ *)
370 |   emit_int16 oc 8; (* linker version *)
371 |   emit_int32 oc 0l; (* size of code *)
372 |   emit_int32 oc 0l; (* size of initialized data *)
373 |   emit_int32 oc 0l; (* size of uninitialized data *)
374 |   emit_int32 oc 0l; (* entry point *)
375 |   emit_int32 oc 0x1000l; (* base of code *)
376 |   if machine = `x86 then emit_int32 oc 0x1000l; (* base of data *)
377 |   (*   windows-specific fields *)
378 |   emit_int32_64 image_base; (* image base *)
379 |   emit_int32 oc 0x1000l; (* section alignment *)
380 |   emit_int32 oc 0x200l; (* file alignment *)
381 |   emit_int32 oc 0x04l; (* OS version *)
382 |   emit_int32 oc 0l; (* image version *)
383 |   emit_int32 oc 0x04l; (* subsystem version *)
384 |   emit_int32 oc 0l; (* win32 version *)
385 |   emit_int32 oc !va; (* size of image *)
386 |   let size_of_headers = pos_out oc in
387 |   emit_int32 oc 0l; (* size of headers *)
388 |   emit_int32 oc 0l; (* checksum *)
389 |   emit_int16 oc 3; (* subsystem: windows CUI *)
390 |   emit_int16 oc 0x400; (* characteristics: no EH *)
391 |   emit_int32_64 0x100000l; (* size of stack reserve *)
392 |   emit_int32_64 0x1000l; (* size of stack commit *)
393 |   emit_int32_64 0x100000l; (* size of heap reserve *)
394 |   emit_int32_64 0x1000l; (* size of heap commit *)
395 |   emit_int32 oc 0l; (* loader flags *)
396 |   emit_int32 oc 16l; (* number of directories *)
397 | 
398 |   (* directories *)
399 |   for i = 0 to 15 do
400 |     match i with
401 |     | 0 -> emit_int32 oc edata.vaddress; emit_int32 oc edata.vsize
402 |     | 5 -> emit_int32 oc rdata.vaddress; emit_int32 oc rdata.vsize
403 |     | _ -> emit_int32 oc 0l; emit_int32 oc 0l;
404 |   done;
405 | 
406 |   let sects =
407 |     List.map (Section.put (fun _ -> assert false) oc) (List.rev !sects)
408 |   in
409 |   let align_file () =
410 |     let i = pos_out oc mod 0x200 in
411 |     if i <> 0 then for _k = i + 1 to 0x200 do output_char oc '\000' done;
412 |   in
413 |   align_file ();
414 |   patch_int32 oc size_of_headers (Int32.of_int (pos_out oc));
415 |   List.iter (fun (data,_) -> align_file (); data ()) sects
416 | 
417 | end : sig
418 |            val create_dll: out_channel -> Coff.coff list -> unit
419 | end)
420 | 


--------------------------------------------------------------------------------
/default.manifest:
--------------------------------------------------------------------------------
1 | <?xml version="1.0" encoding="UTF-8" standalone="yes"?>
2 | <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
3 |   <dependency>
4 |     <dependentAssembly>
5 |       <assemblyIdentity type="win32" name="Microsoft.VC90.CRT" version="9.0.21022.8" processorArchitecture="x86" publicKeyToken="1fc8b3b9a1e18e3b"></assemblyIdentity>
6 |     </dependentAssembly>
7 |   </dependency>
8 | </assembly>
9 | 


--------------------------------------------------------------------------------
/default_amd64.manifest:
--------------------------------------------------------------------------------
1 | <?xml version="1.0" encoding="UTF-8" standalone="yes"?>
2 | <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
3 |   <dependency>
4 |     <dependentAssembly>
5 |       <assemblyIdentity type="win32" name="Microsoft.VC90.CRT" version="9.0.21022.8" processorArchitecture="amd64" publicKeyToken="1fc8b3b9a1e18e3b"></assemblyIdentity>
6 |     </dependentAssembly>
7 |   </dependency>
8 | </assembly>
9 | 


--------------------------------------------------------------------------------
/flexdll.c:
--------------------------------------------------------------------------------
  1 | /*****************************************************************
  2 |    FlexDLL
  3 |    Alain Frisch
  4 | 
  5 |    Copyright 2007 Institut National de Recherche en Informatique et
  6 |    en Automatique.
  7 | 
  8 | ******************************************************************/
  9 | 
 10 | /* Runtime support library */
 11 | 
 12 | #ifdef CYGWIN
 13 | #define _POSIX_C_SOURCE 200112L
 14 | #include <stdlib.h> /* for setenv */
 15 | #endif
 16 | #include <stdio.h>
 17 | #include <string.h>
 18 | #include <windows.h>
 19 | #include "flexdll.h"
 20 | 
 21 | /* Guard against compiling with the wrong cl! */
 22 | #ifdef MSVC
 23 | #if defined(_M_AMD64) && !defined(MSVC64)
 24 | #error 64-bit cl selected for a 32-bit build
 25 | #elif !defined(_M_AMD64) && defined(MSVC64)
 26 | #error 32-bit cl selected for a 64-bit build
 27 | #endif
 28 | #endif /* MSVC */
 29 | 
 30 | typedef long intnat;
 31 | typedef unsigned long uintnat;
 32 | 
 33 | /* RELOC_ constants except RELOC_DONE have ordinal values based on when
 34 |    they were introduced to the code base. These ordinal values are
 35 |    persisted in .obj files so do not re-use any existing ordinals. */
 36 | #define RELOC_REL32     0x0001
 37 | #define RELOC_ABS       0x0002
 38 | #define RELOC_REL32_1   0x0004
 39 | #define RELOC_REL32_2   0x0005
 40 | #define RELOC_REL32_3   0x0008
 41 | #define RELOC_REL32_4   0x0003
 42 | #define RELOC_REL32_5   0x0006
 43 | #define RELOC_32NB      0x0007
 44 | #define RELOC_DONE      0x0100
 45 | 
 46 | typedef struct { UINT_PTR kind; char *name; UINT_PTR *addr; } reloc_entry;
 47 | typedef struct { char *first; char *last; DWORD old; } nonwr;
 48 | typedef struct { nonwr *nonwr; reloc_entry entries[]; } reloctbl;
 49 | typedef struct { void *addr; char *name; } dynsymbol;
 50 | typedef struct { UINT_PTR size; dynsymbol entries[]; } symtbl;
 51 | typedef struct dlunit {
 52 |   void *handle;
 53 |   symtbl *symtbl;
 54 |   int global;
 55 |   int count;
 56 |   struct dlunit *next,*prev;
 57 | } dlunit;
 58 | typedef void *resolver(void*, const char*);
 59 | 
 60 | static HANDLE units_mutex = INVALID_HANDLE_VALUE;
 61 | 
 62 | /* Error reporting */
 63 | /* The latest error must be kept in some variable so that flexdll_dlerror can
 64 |  * report it but this causes data races (and possible segmentation faults) in
 65 |  * multithreaded programs if that variable is global. So this must use
 66 |  * thread-local storage instead.
 67 |  *
 68 |  * To ensure compatibility, the implementation does not require compiler support
 69 |  * for thread-local storage (__thread) and instead relies on functions
 70 |  * TlsGetValue, TlsSetValue, etc.
 71 |  *
 72 |  * This implementation is structured around the function get_tls_error that
 73 |  * returns a structure containing, for the current thread, the code (and a
 74 |  * buffer for the corresponding message) of the last flexdll error. It accepts
 75 |  * an argument to choose whether the structure should be reset:
 76 |  *
 77 |  * - TLS_ERROR_RESET will reset what is stored in the structure, so this is
 78 |  *   intended for initialisation entry points (flexdll_dlopen, flexdll_relocate)
 79 |  * - TLS_ERROR_NOP will keep the current content of the structure, for all other
 80 |  *   entry points (flexdll_dlerror, ll_dlerror, flexdll_dlsym)
 81 |  *
 82 |  * The other exported entrypoints do not need to access the error storage.
 83 |  */
 84 | 
 85 | typedef struct error_s {
 86 |   int code;
 87 |   char message[256];
 88 | } err_t;
 89 | 
 90 | #define TLS_ERROR_NOP 0
 91 | #define TLS_ERROR_RESET 1
 92 | 
 93 | #define TLS_ACCESS_ERRMSG "error accessing thread-local storage"
 94 | 
 95 | static err_t *get_tls_error(int op) {
 96 |   static volatile DWORD error_idx = TLS_OUT_OF_INDEXES;
 97 |   DWORD new_idx, last_error;
 98 |   err_t *error;
 99 | 
100 |   /* We store the last system error to restore it on leaving, so that
101 |    * get_tls_error is transparent with regards to GetLastError */
102 |   last_error = GetLastError();
103 | 
104 |   if(error_idx == TLS_OUT_OF_INDEXES) {
105 |     new_idx = TlsAlloc();
106 |     if(new_idx == TLS_OUT_OF_INDEXES) {
107 |       /* If we cannot allocate the structure required to report errors... */
108 |       /* Maybe we should set the last error to some standard value
109 |        * that correspond to such cases instead of resetting it? */
110 |       SetLastError(last_error);
111 |       return NULL;
112 |     }
113 |     /* According to documentation DWORD and LONG take both 32 bits so
114 |      * this uses InterlockedCompareExchange to store a DWORD */
115 |     if (InterlockedCompareExchange((LONG*)&error_idx, (LONG)new_idx, (LONG)TLS_OUT_OF_INDEXES) != (LONG)TLS_OUT_OF_INDEXES) {
116 |       if(!TlsFree(new_idx)) {
117 |         SetLastError(last_error);
118 |         return NULL;
119 |       }
120 |     }
121 |   }
122 | 
123 |   error = TlsGetValue(error_idx);
124 |   if(error == NULL) {
125 |     error = malloc(sizeof(err_t));
126 |     if(error == NULL) {
127 |       SetLastError(last_error);
128 |       return NULL;
129 |     }
130 |     if(!TlsSetValue(error_idx, error)) {
131 |       free(error);
132 |       SetLastError(last_error);
133 |       return NULL;
134 |     }
135 |     error->code = 0;
136 |     error->message[0] = 0;
137 |   }
138 | 
139 |   SetLastError(last_error);
140 | 
141 |   switch(op) {
142 |   case TLS_ERROR_NOP:
143 |     break;
144 |   case TLS_ERROR_RESET:
145 |     error->code = 0;
146 |     error->message[0] = 0;
147 |     break;
148 |   default:
149 |     return NULL;
150 |   }
151 | 
152 |   return error;
153 | }
154 | 
155 | /* Emulate a low-level dlopen-like interface */
156 | 
157 | #ifdef __CYGWIN__
158 | 
159 | /* Under Cygwin, use the dlopen interface to allow POSIX paths */
160 | 
161 | #include <dlfcn.h>
162 | 
163 | static void *ll_dlopen(const char *libname, int for_execution) {
164 |   (void)for_execution; /* for_execution is currently unused */
165 |   return dlopen(libname, RTLD_NOW | RTLD_GLOBAL);
166 |   /* Could use RTLD_LAZY if for_execution == 0, but needs testing */
167 | }
168 | 
169 | static void ll_dlclose(void * handle)
170 | {
171 |   dlclose(handle);
172 | }
173 | 
174 | static void * ll_dlsym(void * handle, char * name)
175 | {
176 |   return dlsym(handle, name);
177 | }
178 | 
179 | static char * ll_dlerror(void)
180 | {
181 |   return dlerror();
182 | }
183 | 
184 | #else
185 | 
186 | static void *ll_dlopen(const wchar_t *libname, int for_execution) {
187 |   HMODULE m;
188 |   m = LoadLibraryExW(libname, NULL,
189 |                      for_execution ? 0 : DONT_RESOLVE_DLL_REFERENCES);
190 |   /* See https://blogs.msdn.microsoft.com/oldnewthing/20050214-00/?p=36463
191 |      Should use LOAD_LIBRARY_AS_DATAFILE instead of DONT_RESOLVE_DLL_REFERENCES? */
192 | 
193 |   /* Under Win 95/98/ME, LoadLibraryEx can fail in cases where LoadLibrary
194 |      would succeed.  Just try again with LoadLibrary for good measure. */
195 |   if (m == NULL) m = LoadLibraryW(libname);
196 |   return (void *) m;
197 | }
198 | 
199 | 
200 | static void ll_dlclose(void *handle) {
201 |   FreeLibrary((HMODULE) handle);
202 | }
203 | 
204 | static void *ll_dlsym(void *handle, char *name) {
205 |   return (void *) GetProcAddress((HMODULE) handle, name);
206 | }
207 | 
208 | static char *ll_dlerror(void)
209 | {
210 |   DWORD msglen;
211 |   err_t * err;
212 |   err = get_tls_error(TLS_ERROR_NOP);
213 |   if(err == NULL) return TLS_ACCESS_ERRMSG;
214 | 
215 |   msglen =
216 |     FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
217 |                   NULL,                 /* message source */
218 |                   GetLastError(),       /* error number */
219 |                   0,                    /* default language */
220 |                   err->message,         /* destination */
221 |                   sizeof(err->message), /* size of destination */
222 |                   NULL);                /* no inserts */
223 |   if (msglen == 0) return "unknown error";
224 |   else return err->message;
225 | }
226 | 
227 | #endif
228 | 
229 | /** Relocation tables **/
230 | 
231 | static void dump_reloctbl(reloctbl *tbl) {
232 |   reloc_entry *ptr;
233 |   nonwr *wr;
234 | 
235 |   if (!tbl) { printf("No relocation table\n"); return; }
236 |   printf("Dynamic relocation table found at %p\n", (void *) tbl);
237 | 
238 |   for (wr = tbl->nonwr; wr->last != 0; wr++)
239 |     printf(" Non-writable relocation in zone %p -> %p\n",
240 | 	   wr->first,
241 | 	   wr->last);
242 | 
243 |   for (ptr = tbl->entries; ptr->kind; ptr++)
244 |     printf(" %p (kind:%04lx) (now:%p)  %s\n",
245 | 	   (void *)ptr->addr,
246 | 	   (unsigned long)ptr->kind,
247 | 	   (void *)((UINT_PTR)(*((uintnat*) ptr->addr))),
248 | 	   ptr->name
249 | 	   );
250 | }
251 | 
252 | static void dump_master_reloctbl(reloctbl **ptr) {
253 |   if (!ptr) return;
254 |   while (*ptr) dump_reloctbl(*ptr++);
255 | }
256 | 
257 | /* Avoid the use of snprintf */
258 | static void cannot_resolve_msg(char *name, err_t *err) {
259 |   static char msg[] = "Cannot resolve ";
260 |   static size_t l = sizeof(msg) - 1;
261 |   size_t n = strlen(name);
262 |   memcpy(err->message,msg,l);
263 |   memcpy(err->message+l,name,min(n,sizeof(err->message) - l - 1));
264 |   err->message[l+n] = 0;
265 | }
266 | 
267 | static void relocate(resolver f, void *data, reloctbl *tbl, err_t *err) {
268 |   reloc_entry *ptr;
269 |   INT_PTR s;
270 |   DWORD prev_protect;
271 |   static long int page_size = 0;
272 |   SYSTEM_INFO si;
273 |   char *page_start, *page_end;
274 |   char *prev_page_start = (char*)1, *prev_page_end = (char*)1;
275 | 
276 |   if (!tbl) return;
277 | 
278 |   if (0 == page_size) {
279 |     GetSystemInfo (&si);
280 |     page_size = si.dwPageSize;
281 |   }
282 | 
283 |   for (ptr = tbl->entries; ptr->kind; ptr++) {
284 |     if (ptr->kind & RELOC_DONE) continue;
285 | 
286 |     s = (UINT_PTR) f(data,ptr->name);
287 |     if (!s) {
288 |       err->code = 2;
289 |       cannot_resolve_msg(ptr->name, err);
290 |       goto restore;
291 |     }
292 | 
293 |     /* Set up page protection to allow the relocation.  We will undo
294 |        the change on the next relocation if it falls in a different
295 |        page (or at the end of the process), to avoid too many calls to
296 |        VirtualProtect.
297 | 
298 |        prev_page_start, prev_page_end, prev_protect: describe the
299 |        protection to be reset.
300 | 
301 |        Note that a single relocation can fall between two pages.
302 |     */
303 | 
304 |     page_start = (char*)ptr->addr;
305 |     page_end = page_start+((ptr->kind & 0xff) == RELOC_ABS ? sizeof(UINT_PTR) - 1 : 3);
306 |     page_start -= (size_t) page_start % page_size;
307 |     page_end -= (size_t) page_end % page_size;
308 | 
309 |     if (prev_page_start != page_start || prev_page_end != page_end) {
310 |       if (prev_page_start != (char*)1) {
311 |         /* Restore */
312 |         if (0 == VirtualProtect(prev_page_start, prev_page_end-prev_page_start+page_size, prev_protect, &prev_protect)) {
313 |           fprintf(stderr, "natdynlink: VirtualProtect failed (%s), page_start = 0x%p\n", ll_dlerror(), page_start);
314 |           exit(2);
315 |         }
316 |       }
317 | 
318 |       prev_page_start = page_start;
319 |       prev_page_end = page_end;
320 |       if (0 == VirtualProtect(page_start, page_end-page_start+page_size, PAGE_READWRITE, &prev_protect)) {
321 |         fprintf(stderr, "natdynlink: VirtualProtect failed (%s), page_start = 0x%p\n", ll_dlerror(), page_start);
322 |         exit(2);
323 |       }
324 |     }
325 | 
326 |     switch (ptr->kind & 0xff) {
327 |     case RELOC_ABS:
328 |       *(ptr->addr) += s;
329 |       break;
330 |     case RELOC_REL32:
331 |       s -= (INT_PTR)(ptr -> addr) + 4;
332 |       s += *((INT32*) ptr -> addr);
333 |       if (s != (INT32) s) {
334 |         sprintf(err->message, "flexdll error: cannot relocate %s RELOC_REL32, target is too far: %p  %p", ptr->name, (void *)((UINT_PTR) s), (void *) ((UINT_PTR)(INT32) s));
335 |         err->code = 3;
336 |         goto restore;
337 |       }
338 |       *((UINT32*) ptr->addr) = (INT32) s;
339 |       break;
340 |     case RELOC_REL32_1:
341 |       s -= (INT_PTR)(ptr -> addr) + 5;
342 |       s += *((INT32*) ptr -> addr);
343 |       if (s != (INT32) s) {
344 |         sprintf(err->message, "flexdll error: cannot relocate RELOC_REL32_1, target is too far: %p  %p",(void *)((UINT_PTR) s), (void *) ((UINT_PTR)(INT32) s));
345 |         err->code = 3;
346 |         goto restore;
347 |       }
348 |       *((UINT32*) ptr->addr) = (INT32) s;
349 |       break;
350 |     case RELOC_REL32_2:
351 |       s -= (INT_PTR)(ptr -> addr) + 6;
352 |       s += *((INT32*) ptr -> addr);
353 |       if (s != (INT32) s) {
354 |         sprintf(err->message, "flexdll error: cannot relocate RELOC_REL32_2, target is too far: %p  %p",(void *)((UINT_PTR) s), (void *) ((UINT_PTR)(INT32) s));
355 |         err->code = 3;
356 |         goto restore;
357 |       }
358 |       *((UINT32*) ptr->addr) = (INT32) s;
359 |       break;
360 |     case RELOC_REL32_3:
361 |       s -= (INT_PTR)(ptr -> addr) + 7;
362 |       s += *((INT32*) ptr -> addr);
363 |       if (s != (INT32) s) {
364 |         sprintf(err->message, "flexdll error: cannot relocate RELOC_REL32_3, target is too far: %p  %p",(void *)((UINT_PTR) s), (void *) ((UINT_PTR)(INT32) s));
365 |         err->code = 3;
366 |         goto restore;
367 |       }
368 |       *((UINT32*) ptr->addr) = (INT32) s;
369 |       break;
370 |     case RELOC_REL32_4:
371 |       s -= (INT_PTR)(ptr -> addr) + 8;
372 |       s += *((INT32*) ptr -> addr);
373 |       if (s != (INT32) s) {
374 |         sprintf(err->message, "flexdll error: cannot relocate RELOC_REL32_4, target is too far: %p  %p",(void *)((UINT_PTR) s), (void *) ((UINT_PTR)(INT32) s));
375 |         err->code = 3;
376 |         goto restore;
377 |       }
378 |       *((UINT32*) ptr->addr) = (INT32) s;
379 |       break;
380 |     case RELOC_REL32_5:
381 |       s -= (INT_PTR)(ptr -> addr) + 9;
382 |       s += *((INT32*) ptr -> addr);
383 |       if (s != (INT32) s) {
384 |         sprintf(err->message, "flexdll error: cannot relocate RELOC_REL32_5, target is too far: %p  %p",(void *)((UINT_PTR) s), (void *) ((UINT_PTR)(INT32) s));
385 |         err->code = 3;
386 |         goto restore;
387 |       }
388 |       *((UINT32*) ptr->addr) = (INT32) s;
389 |       break;
390 |     case RELOC_32NB:
391 |       s += *((INT32*) ptr -> addr);
392 |       if (s != (INT32) s) {
393 |         sprintf(err->message, "flexdll error: cannot relocate %s RELOC_32NB, target is too far: %p  %p", ptr->name, (void *)((UINT_PTR) s), (void *) ((UINT_PTR)(INT32) s));
394 |         err->code = 3;
395 |         goto restore;
396 |       }
397 |       *((UINT32*) ptr->addr) = (INT32) s;
398 |       break;
399 |     default:
400 |       fprintf(stderr, "flexdll: unknown relocation kind");
401 |       exit(2);
402 |     }
403 |     ptr->kind |= RELOC_DONE;
404 |   }
405 |  restore:
406 |   /* Restore page permission */
407 |   if (prev_page_start != (char*)1) {
408 |     if (0 == VirtualProtect(prev_page_start, prev_page_end-prev_page_start+page_size, prev_protect, &prev_protect)) {
409 |       fprintf(stderr, "natdynlink: VirtualProtect failed (%s), page_start = 0x%p\n", ll_dlerror(), page_start);
410 |       exit(2);
411 |     }
412 |   }
413 | }
414 | 
415 | static void relocate_master(resolver f, void *data, reloctbl **ptr, err_t *err) {
416 |   while (0 == err->code && *ptr) relocate(f,data,*ptr++,err);
417 | }
418 | 
419 | /* Symbol tables */
420 | 
421 | static void dump_symtbl(symtbl *tbl)
422 | {
423 |   unsigned i;
424 | 
425 |   if (!tbl) { printf("No symbol table\n"); return; }
426 |   printf("Dynamic symbol at %p (size = %u)\n", (void *) tbl, (unsigned int) tbl->size); fflush(stdout);
427 | 
428 |   for (i = 0; i < tbl->size; i++) {
429 |     printf("[%u] ", i); fflush(stdout);
430 |     printf(" %p: ", tbl->entries[i].addr); fflush(stdout);
431 |     printf("%s\n", tbl->entries[i].name);
432 |     fflush(stdout);
433 |   }
434 | }
435 | 
436 | static int compare_dynsymbol(const void *s1, const void *s2) {
437 |   return strcmp(((dynsymbol*) s1) -> name, ((dynsymbol*) s2) -> name);
438 | }
439 | 
440 | static void *find_symbol(symtbl *tbl, const char *name) {
441 |   static dynsymbol s;
442 |   dynsymbol *sym;
443 | 
444 |   if (!tbl) return NULL;
445 | 
446 |   s.name = (char*) name;
447 |   sym =
448 |     bsearch(&s,&tbl->entries,tbl->size, sizeof(dynsymbol),&compare_dynsymbol);
449 | 
450 |   return (NULL == sym ? NULL : sym -> addr);
451 | }
452 | 
453 | 
454 | 
455 | /* API */
456 | 
457 | extern symtbl static_symtable;
458 | static dlunit *units = NULL;
459 | static dlunit main_unit;
460 | 
461 | static void push_unit(dlunit *unit) {
462 |   unit->next = units;
463 |   unit->prev = NULL;
464 |   if (units) units->prev = unit;
465 |   units = unit;
466 | }
467 | 
468 | static void unlink_unit(dlunit *unit) {
469 |   if (unit->prev) unit->prev->next=unit->next;
470 |   else units=unit->next;
471 | 
472 |   if (unit->next) unit->next->prev=unit->prev;
473 | }
474 | 
475 | static void *find_symbol_global(void *data, const char *name) {
476 |   void *sym;
477 |   dlunit *unit;
478 |   (void)data; /* data is unused */
479 | 
480 |   if (!name) return NULL;
481 |   sym = find_symbol(&static_symtable, name);
482 |   if (sym) return sym;
483 | 
484 |   for (unit = units; unit; unit = unit->next) {
485 |     if (unit->global) {
486 |       sym = find_symbol(unit->symtbl, name);
487 |       if (sym) {
488 | 	if (unit != units) { unlink_unit(unit); push_unit(unit); }
489 | 	return sym;
490 |       }
491 |     }
492 |   }
493 |   return NULL;
494 | }
495 | 
496 | int flexdll_relocate(void *tbl) {
497 |   err_t * err;
498 |   err = get_tls_error(TLS_ERROR_RESET);
499 |   if(err == NULL) return 0;
500 | 
501 |   if (!tbl) { printf("No master relocation table\n"); return 0; }
502 |   relocate_master(find_symbol_global, NULL, tbl, err);
503 |   if (err->code) return 0;
504 |   return 1;
505 | }
506 | 
507 | #ifdef CYGWIN
508 | void *flexdll_dlopen(const char *file, int mode) {
509 | #else
510 | void *flexdll_wdlopen(const wchar_t *file, int mode) {
511 | #endif
512 |   void *handle;
513 |   dlunit *unit;
514 |   char flexdll_relocate_env[256];
515 |   int exec = (mode & FLEXDLL_RTLD_NOEXEC ? 0 : 1);
516 |   void* relocate = (exec ? &flexdll_relocate : 0);
517 | 
518 |   err_t * err;
519 |   err = get_tls_error(TLS_ERROR_RESET);
520 |   if(err == NULL) return NULL;
521 |   if (!file) return &main_unit;
522 | 
523 | #ifdef CYGWIN
524 |   sprintf(flexdll_relocate_env,"%p",relocate);
525 |   setenv("FLEXDLL_RELOCATE", flexdll_relocate_env, 1);
526 | #else
527 | #if __STDC_SECURE_LIB__ >= 200411L
528 |   sprintf(flexdll_relocate_env,"%p",relocate);
529 |   _putenv_s("FLEXDLL_RELOCATE", flexdll_relocate_env);
530 | #else
531 |   {
532 |     char* s;
533 |     sprintf(flexdll_relocate_env,"FLEXDLL_RELOCATE=%p",relocate);
534 |     s = malloc(strlen(flexdll_relocate_env) + 1);
535 |     strcpy(s, flexdll_relocate_env);
536 |     putenv(s);
537 |   }
538 | #endif /* __STDC_SECURE_LIB__ >= 200411L*/
539 | #endif /* CYGWIN */
540 | 
541 | again:
542 |   if (units_mutex == INVALID_HANDLE_VALUE) {
543 |     HANDLE hMutex = CreateMutex(NULL, TRUE, NULL);
544 |     if (hMutex == NULL) {
545 |       if (!err->code) err->code = 1;
546 |       return NULL;
547 |     }
548 |     if (InterlockedCompareExchangePointer(&units_mutex, hMutex, INVALID_HANDLE_VALUE) != INVALID_HANDLE_VALUE) {
549 |       CloseHandle(hMutex);
550 |       goto again;
551 |     }
552 |   } else if (WaitForSingleObject(units_mutex, INFINITE) == WAIT_FAILED) {
553 |       if (!err->code) err->code = 1;
554 |       return NULL;
555 |   }
556 | 
557 |   handle = ll_dlopen(file, exec);
558 |   if (!handle) { if (!err->code) err->code = 1; ReleaseMutex(units_mutex); return NULL; }
559 | 
560 |   unit = units;
561 |   while ((NULL != unit) && (unit->handle != handle)) unit = unit->next;
562 |   if (unit) { unit->count++; }
563 |   else {
564 |     unit = malloc(sizeof(dlunit));
565 |     unit->handle = handle;
566 |     unit->symtbl = ll_dlsym(handle, "symtbl");
567 |     unit->count = 1;
568 |     unit->global = 0;
569 |     push_unit(unit);
570 |   }
571 |   if (mode & FLEXDLL_RTLD_GLOBAL) unit->global=1;
572 | 
573 |   if (exec) {
574 |     /* Relocation has already been done if the flexdll's DLL entry point
575 |        is used */
576 |     flexdll_relocate(ll_dlsym(handle, "reloctbl"));
577 |     if (err->code) { flexdll_dlclose(unit); ReleaseMutex(units_mutex); return NULL; }
578 |   }
579 | 
580 |   ReleaseMutex(units_mutex);
581 | 
582 |   return unit;
583 | }
584 | 
585 | #ifndef CYGWIN
586 | 
587 | void *flexdll_dlopen(const char *file, int mode)
588 | {
589 |   wchar_t * p = NULL;
590 |   int nbr;
591 |   void * handle;
592 | 
593 |   err_t * err;
594 |   err = get_tls_error(TLS_ERROR_RESET);
595 |   if(err == NULL) return NULL;
596 | 
597 |   if (file) {
598 |     nbr = MultiByteToWideChar(CP_THREAD_ACP, 0, file, -1, NULL, 0);
599 |     if (nbr == 0) { if (!err->code) err->code = 1; return NULL; }
600 |     p = malloc(nbr*sizeof(*p));
601 |     MultiByteToWideChar(CP_THREAD_ACP, 0, file, -1, p, nbr);
602 |   }
603 | 
604 |   handle = flexdll_wdlopen(p, mode);
605 | 
606 |   if (p) free(p);
607 | 
608 |   return handle;
609 | }
610 | 
611 | #endif
612 | 
613 | void flexdll_dlclose(void *u) {
614 |   dlunit *unit = u;
615 | 
616 |   if (NULL == u || u == &main_unit) return;
617 |   ll_dlclose(unit->handle);
618 |   unit->count--;
619 |   if (unit->count == 0) { unlink_unit(unit); free(unit); }
620 | }
621 | 
622 | 
623 | void *flexdll_dlsym(void *u, const char *name) {
624 |   void *res;
625 |   err_t * err;
626 |   err = get_tls_error(TLS_ERROR_NOP);
627 |   if (err == NULL) return NULL;
628 | 
629 |   if (WaitForSingleObject(units_mutex, INFINITE) == WAIT_FAILED) {
630 |     if (!err->code) err->code = 1;
631 |     return NULL;
632 |   }
633 |   if (u == &main_unit) res = find_symbol_global(NULL,name);
634 |   else if (NULL == u) res = find_symbol(&static_symtable,name);
635 |   else res = find_symbol(((dlunit*)u)->symtbl,name);
636 |   ReleaseMutex(units_mutex);
637 |   return res;
638 | }
639 | 
640 | char *flexdll_dlerror(void) {
641 |   err_t * err;
642 |   err = get_tls_error(TLS_ERROR_NOP);
643 |   if(err == NULL) return TLS_ACCESS_ERRMSG;
644 | 
645 |   switch (err->code) {
646 |   case 0: return NULL;
647 |   case 1: err->code = 0; return ll_dlerror();
648 |   case 2: err->code = 0; return err->message;
649 |   case 3: err->code = 0; return err->message;
650 |   }
651 |   return NULL;
652 | }
653 | 
654 | void flexdll_dump_exports(void *u) {
655 |   dlunit *unit = u;
656 |   if (NULL == u) { dump_symtbl(&static_symtable); }
657 |   else if (u == &main_unit) {
658 |     dump_symtbl(&static_symtable);
659 |     for (unit = units; unit; unit = unit->next)
660 |       if (unit->global) { dump_symtbl(unit->symtbl); }
661 |   }
662 |   else { dump_symtbl(unit->symtbl); }
663 | }
664 | 
665 | void flexdll_dump_relocations(void *u) {
666 |   if (NULL == u || u == &main_unit) return;
667 |   dump_master_reloctbl(ll_dlsym(((dlunit*)u) -> handle, "reloctbl"));
668 | }
669 | 


--------------------------------------------------------------------------------
/flexdll.h:
--------------------------------------------------------------------------------
 1 | /*****************************************************************
 2 |    FlexDLL
 3 |    Alain Frisch
 4 | 
 5 |    Copyright 2007 Institut National de Recherche en Informatique et
 6 |    en Automatique.
 7 | 
 8 | ******************************************************************/
 9 | 
10 | /* Header for the runtime support library */
11 | 
12 | #ifndef FLEXDLL_H
13 | #define FLEXDLL_H
14 | 
15 | #include <wchar.h>
16 | 
17 | #define FLEXDLL_RTLD_GLOBAL 0x0001
18 | #define FLEXDLL_RTLD_LOCAL  0x0000
19 | #define FLEXDLL_RTLD_NOEXEC 0x0002
20 | 
21 | #ifdef __cplusplus
22 | extern "C"
23 | {
24 | #endif
25 | 
26 | void *flexdll_dlopen(const char *, int);
27 | #ifndef CYGWIN
28 | void *flexdll_wdlopen(const wchar_t *, int);
29 | #endif
30 | 
31 | void *flexdll_dlsym(void *, const char *);
32 | void flexdll_dlclose(void *);
33 | char *flexdll_dlerror(void);
34 | 
35 | void flexdll_dump_exports(void *);
36 | void flexdll_dump_relocations(void *);
37 | 
38 | #ifdef __cplusplus
39 | }
40 | #endif
41 | 
42 | #endif
43 | 


--------------------------------------------------------------------------------
/flexdll.install:
--------------------------------------------------------------------------------
 1 | share: [
 2 |   "Makefile"
 3 |   "cmdline.ml"
 4 |   "coff.ml"
 5 |   "Compat.ml.in"
 6 |   "create_dll.ml"
 7 |   "default.manifest"
 8 |   "default_amd64.manifest"
 9 |   "flexdll.c"
10 |   "flexdll.h"
11 |   "flexdll.opam"
12 |   "flexdll_initer.c"
13 |   "reloc.ml"
14 |   "version.rc"
15 | ]
16 | 


--------------------------------------------------------------------------------
/flexdll.opam:
--------------------------------------------------------------------------------
 1 | opam-version: "2.0"
 2 | version: "0.44"
 3 | authors: "Alain Frisch"
 4 | maintainer: "David Allsopp <david@tarides.com>"
 5 | bug-reports: "https://github.com/ocaml/flexdll/issues"
 6 | dev-repo: "git+https://github.com/ocaml/flexdll.git"
 7 | homepage: "https://github.com/ocaml/flexdll#readme"
 8 | license: "Zlib"
 9 | synopsis: "FlexDLL Sources"
10 | description: "Source package for FlexDLL. Installs the required files for
11 | bootstrapping FlexDLL as part of an OCaml build."
12 | 


--------------------------------------------------------------------------------
/flexdll_initer.c:
--------------------------------------------------------------------------------
 1 | /*****************************************************************
 2 |    FlexDLL
 3 |    Alain Frisch
 4 | 
 5 |    Copyright 2007 Institut National de Recherche en Informatique et
 6 |    en Automatique.
 7 | 
 8 | ******************************************************************/
 9 | 
10 | /* Custom entry point to perform relocations before the real
11 |    entry point is called */
12 | 
13 | /* The adress of the flexdll_relocate function is passed in an
14 |    environment variable. This is ugly, but I couldn't find a cleaner
15 |    solution. Let me know if you have some idea! */
16 | 
17 | #include <stdlib.h>
18 | #include <stdio.h>
19 | #include <windows.h>
20 | 
21 | extern int reloctbl;
22 | 
23 | static int flexdll_init(void) {
24 |   int (*sym)(void *) = 0;
25 |   char *s = getenv("FLEXDLL_RELOCATE");
26 |   if (!s) { fprintf(stderr, "Cannot find FLEXDLL_RELOCATE\n"); return FALSE; }
27 |   sscanf(s,"%p",(void **) &sym);
28 |   /* sym = 0 means "loaded not for execution" */
29 |   if (!sym || sym(&reloctbl)) return TRUE;
30 |   return FALSE;
31 | }
32 | 
33 | #ifdef __GNUC__
34 | #ifdef __CYGWIN__
35 | #define entry  _cygwin_dll_entry
36 | #endif
37 | #ifdef __MINGW32__
38 | #define entry DllMainCRTStartup
39 | #endif
40 | #else
41 | #define entry _DllMainCRTStartup
42 | #endif
43 | 
44 | 
45 | BOOL WINAPI entry(HINSTANCE, DWORD, LPVOID);
46 | 
47 | BOOL WINAPI FlexDLLiniter(HINSTANCE hinstDLL, DWORD fdwReason,
48 | 			  LPVOID lpReserved) {
49 |   if (fdwReason == DLL_PROCESS_ATTACH && !flexdll_init())
50 |     return FALSE;
51 | 
52 |   return entry(hinstDLL, fdwReason, lpReserved);
53 | }
54 | 


--------------------------------------------------------------------------------
/installer.nsi:
--------------------------------------------------------------------------------
 1 | !include "MUI.nsh"
 2 | 
 3 | 
 4 | Name "FlexDLL"
 5 | OutFile "flexdll_setup.exe"
 6 | InstallDir "$PROGRAMFILES\flexdll"
 7 | 
 8 | !insertmacro MUI_PAGE_DIRECTORY
 9 | 
10 | !insertmacro MUI_PAGE_INSTFILES
11 | !define MUI_FINISHPAGE_NOAUTOCLOSE
12 | !insertmacro MUI_PAGE_FINISH
13 | 
14 | !insertmacro MUI_LANGUAGE "English"
15 | 
16 | section
17 | setOutPath $INSTDIR
18 | file "flexdll_install_files\*"
19 | sectionEnd
20 | 


--------------------------------------------------------------------------------
/msvs-detect:
--------------------------------------------------------------------------------
   1 | #!/usr/bin/env bash
   2 | # ################################################################################################ #
   3 | # MetaStack Solutions Ltd.                                                                         #
   4 | # ################################################################################################ #
   5 | # Microsoft C Compiler Environment Detection Script                                                #
   6 | # ################################################################################################ #
   7 | # Copyright (c) 2016, 2017, 2018, 2019, 2020, 2021 MetaStack Solutions Ltd.                        #
   8 | # Copyright (c) 2022, 2024 David Allsopp Ltd.                                                      #
   9 | # ################################################################################################ #
  10 | # Author: David Allsopp                                                                            #
  11 | # 16-Feb-2016                                                                                      #
  12 | # ################################################################################################ #
  13 | # Redistribution and use in source and binary forms, with or without modification, are permitted   #
  14 | # provided that the following two conditions are met:                                              #
  15 | #     1. Redistributions of source code must retain the above copyright notice, this list of       #
  16 | #        conditions and the following disclaimer.                                                  #
  17 | #     2. Neither the name of MetaStack Solutions Ltd. nor the names of its contributors may be     #
  18 | #        used to endorse or promote products derived from this software without specific prior     #
  19 | #        written permission.                                                                       #
  20 | #                                                                                                  #
  21 | # This software is provided by the Copyright Holder 'as is' and any express or implied warranties  #
  22 | # including, but not limited to, the implied warranties of merchantability and fitness for a       #
  23 | # particular purpose are disclaimed. In no event shall the Copyright Holder be liable for any      #
  24 | # direct, indirect, incidental, special, exemplary, or consequential damages (including, but not   #
  25 | # limited to, procurement of substitute goods or services; loss of use, data, or profits; or       #
  26 | # business interruption) however caused and on any theory of liability, whether in contract,       #
  27 | # strict liability, or tort (including negligence or otherwise) arising in any way out of the use  #
  28 | # of this software, even if advised of the possibility of such damage.                             #
  29 | # ################################################################################################ #
  30 | 
  31 | VERSION=0.7.0
  32 | 
  33 | set -f
  34 | 
  35 | # debug [level=2] message
  36 | debug ()
  37 | {
  38 |   if [[ -z ${2+x} ]] ; then
  39 |     DEBUG_LEVEL=2
  40 |   else
  41 |     DEBUG_LEVEL=$1
  42 |     shift
  43 |   fi
  44 | 
  45 |   if [[ $DEBUG -ge $DEBUG_LEVEL ]] ; then
  46 |     echo "$1">&2
  47 |   fi
  48 | }
  49 | 
  50 | # warning message
  51 | warning ()
  52 | {
  53 |   if [[ $DEBUG -gt 0 ]] ; then
  54 |     echo "Warning: $1">&2
  55 |   fi
  56 | }
  57 | 
  58 | # reg_string key value
  59 | # Retrieves a REG_SZ value from the registry (redirected on WOW64)
  60 | reg_string ()
  61 | {
  62 |   reg query "$1" /v "$2" 2>/dev/null | tr -d '\r' | sed -ne "s/ *$2 *REG_SZ *//p"
  63 | }
  64 | 
  65 | # reg64_string key value
  66 | # As reg_string, but without WOW64 redirection (i.e. guaranteed access to 64-bit registry)
  67 | reg64_string ()
  68 | {
  69 |   $REG64 query "$1" /v "$2" 2>/dev/null | tr -d '\r' | sed -ne "s/ *$2 *REG_SZ *//p"
  70 | }
  71 | 
  72 | # find_in list file
  73 | # Increments $RET if file does not exist in any of the directories in the *-separated list
  74 | find_in ()
  75 | {
  76 |   debug 4 "Looking for $2 in $1"
  77 |   if [[ -z $1 ]] ; then
  78 |     STATUS=1
  79 |   else
  80 |     IFS='*'
  81 |     STATUS=1
  82 |     for f in $1; do
  83 |       if [[ -e "$f/$2" ]] ; then
  84 |         STATUS=0
  85 |         break
  86 |       fi
  87 |     done
  88 |     unset IFS
  89 |   fi
  90 |   if [[ $STATUS -eq 1 ]] ; then
  91 |     debug 4 "$2 not found"
  92 |   fi
  93 |   ((RET+=STATUS))
  94 | }
  95 | 
  96 | # check_environment PATH INC LIB name arch
  97 | # By checking for the presence of various files, verifies that PATH, INC and LIB provide a complete
  98 | # compiler and indicates this in its return status. RET is assumed to be zero on entry. $ASSEMBLER
  99 | # will contain the name of assembler for this compiler series (ml.exe or ml64.exe).
 100 | # The following files are checked:
 101 | #   cl.exe        PATH  Microsoft C compiler
 102 | #   kernel32.lib  LIB   Implies Windows SDK present
 103 | #   link.exe      PATH  Microsoft Linker
 104 | #   ml[64].exe    PATH  Microsoft Assembler (ml.exe or ml64.exe)
 105 | #   msvcrt.lib    LIB   Implies C Runtime Libraries present
 106 | #   mt.exe        PATH  Microsoft Manifest Tool
 107 | #   oldnames.lib  LIB   Implies C Runtime Libraries present
 108 | #   rc.exe        PATH  Microsoft Resource Compiler (implies tools present)
 109 | #   stdlib.h      INC   Implies Microsoft C Runtime Libraries present
 110 | #   windows.h     INC   Implies Windows SDK present
 111 | # oldnames.lib is included, because certain SDKs and older versions don't correctly install the
 112 | # entire runtime if only some options (e.g. Dynamic Runtime and not Static) are selected.
 113 | check_environment ()
 114 | {
 115 |   debug 4 "Checking $4 ($5)"
 116 |   for tool in cl rc link ; do
 117 |     find_in "$1" $tool.exe
 118 |   done
 119 | 
 120 |   if [[ $RET -gt 0 ]] ; then
 121 |     warning "Microsoft C Compiler tools not all found - $4 ($5) excluded"
 122 |     return 1
 123 |   fi
 124 | 
 125 |   RET=0
 126 |   find_in "$2" windows.h
 127 |   find_in "$3" kernel32.lib
 128 |   if [[ $RET -gt 0 ]] ; then
 129 |     warning "Windows SDK not all found - $4 ($5) excluded"
 130 |     return 1
 131 |   fi
 132 | 
 133 |   RET=0
 134 |   find_in "$2" stdlib.h
 135 |   find_in "$3" msvcrt.lib
 136 |   find_in "$3" oldnames.lib
 137 |   if [[ $RET -gt 0 ]] ; then
 138 |     warning "Microsoft C runtime library not all found - $4 ($5) excluded"
 139 |     return 1
 140 |   fi
 141 | 
 142 |   ASSEMBLER=ml${5#x}
 143 |   ASSEMBLER=${ASSEMBLER%86}.exe
 144 |   if [[ $ML_REQUIRED -eq 1 ]] ; then
 145 |     RET=0
 146 |     find_in "$1" "$ASSEMBLER"
 147 |     if [[ $RET -gt 0 ]] ; then
 148 |       warning "Microsoft Assembler ($ASSEMBLER) not found - $4 ($5)"
 149 |       return 1
 150 |     fi
 151 |   fi
 152 | 
 153 |   if [[ $MT_REQUIRED -eq 1 ]] ; then
 154 |     RET=0
 155 |     find_in "$1" mt.exe
 156 |     if [[ $RET -gt 0 ]] ; then
 157 |       warning "Microsoft Manifest Tool not found - $4 ($5)"
 158 |       return 1
 159 |     fi
 160 |   fi
 161 | 
 162 |   return 0
 163 | }
 164 | 
 165 | # output VAR value arch
 166 | # Outputs a command for setting VAR to value based on $OUTPUT. If $ENV_ARCH is arch, then an empty
 167 | # value (i.e. no change) is output.
 168 | output ()
 169 | {
 170 |   if [[ $3 = "$ENV_ARCH" ]] ; then
 171 |     VALUE=
 172 |   else
 173 |     VALUE=$2
 174 |   fi
 175 |   case "$OUTPUT" in
 176 |     0)
 177 |       echo "$1='${VALUE//\'/\'\"\'\"\'}'";;
 178 |     1)
 179 |       VALUE=${VALUE//#/\\\#}
 180 |       echo "$1=${VALUE//\$/\$\$}";;
 181 |     2)
 182 |       case $1 in
 183 |         MSVS_PATH)
 184 |           prefix='bin';;
 185 |         MSVS_INC)
 186 |           prefix='inc';;
 187 |         MSVS_LIB)
 188 |           prefix='lib';;
 189 |         MSVS_ML)
 190 |           prefix='asm';;
 191 |         *)
 192 |           echo Internal fault "$1">&2
 193 |           exit 3;;
 194 |       esac
 195 |       while IFS= read -r entry; do
 196 |         if [[ -n $entry ]] ; then
 197 |           echo "$prefix*$entry"
 198 |         fi
 199 |       done <<< "${VALUE//;/$'\n'}"
 200 |       ;;
 201 |   esac
 202 | }
 203 | 
 204 | # DEBUG       Debugging level
 205 | # MODE        Operation mode
 206 | #               0 - Normal
 207 | #               1 - --all
 208 | #               2 - --help
 209 | #               3 - --version
 210 | #               4 - --installed
 211 | # OUTPUT      --output option
 212 | #               0 - =shell
 213 | #               1 - =make
 214 | #               2 - =data
 215 | # MT_REQUIRED --with-mt
 216 | # ML_REQUIRED --with-assembler
 217 | # TARGET_ARCH Normalised --arch (x86, x64 or blank for both)
 218 | # LEFT_ARCH   \ If $TARGET_ARCH is blank, these will be x86 and x64 respectively, otherwise they
 219 | # RIGHT_ARCH  / equal $TARGET_ARCH
 220 | # SCAN_ENV    Controls from parsing whether the environment should be queried for a compiler
 221 | DEBUG=0
 222 | MODE=0
 223 | OUTPUT=0
 224 | MT_REQUIRED=0
 225 | ML_REQUIRED=0
 226 | TARGET_ARCH=
 227 | SCAN_ENV=0
 228 | 
 229 | # Various PATH messing around means it's sensible to know where tools are now
 230 | WHICH=$(which which)
 231 | 
 232 | # Parse command-line. At the moment, the short option which usefully combines with anything is -d,
 233 | # so for the time being, combining short options is not permitted, as the loop becomes even less
 234 | # clear with getopts. GNU getopt isn't installed by default on Cygwin...
 235 | if [[ $# -gt 0 ]] ; then
 236 |   while true ; do
 237 |     case "$1" in
 238 |       # Mode settings ($MODE)
 239 |       -a|--all)
 240 |         MODE=1
 241 |         shift 1;;
 242 |       -i|--installed)
 243 |         MODE=2
 244 |         shift;;
 245 |       -h|--help)
 246 |         MODE=3
 247 |         shift;;
 248 |       -v|--version)
 249 |         MODE=4
 250 |         shift;;
 251 | 
 252 |       # Simple flags ($MT_REQUIRED and $ML_REQUIRED)
 253 |       --with-mt)
 254 |         MT_REQUIRED=1
 255 |         shift;;
 256 |       --with-assembler)
 257 |         ML_REQUIRED=1
 258 |         shift;;
 259 | 
 260 |       # -o, --output ($OUTPUT)
 261 |       -o|--output)
 262 |         case "$2" in
 263 |           shell)
 264 |             ;;
 265 |           make)
 266 |             OUTPUT=1;;
 267 |           data)
 268 |             OUTPUT=2;;
 269 |           *)
 270 |             echo "$0: unrecognised option for $1: '$2'">&2
 271 |             exit 2;;
 272 |         esac
 273 |         shift 2;;
 274 |       -oshell|--output=shell)
 275 |         shift;;
 276 |       -omake|--output=make)
 277 |         OUTPUT=1
 278 |         shift;;
 279 |       -odata|--output=data)
 280 |         OUTPUT=2
 281 |         shift;;
 282 |       -o*)
 283 |         echo "$0: unrecognised option for -o: '${1#-o}'">&2
 284 |         exit 2;;
 285 |       --output=*)
 286 |         echo "$0: unrecognised option for --output: '${1#--output=}'">&2
 287 |         exit 2;;
 288 | 
 289 |       # -x, --arch ($TARGET_ARCH)
 290 |       -x|--arch)
 291 |         case "$2" in
 292 |           86|x86|x86_32)
 293 |             TARGET_ARCH=x86;;
 294 |           64|x64|x86_64)
 295 |             TARGET_ARCH=x64;;
 296 |           *)
 297 |             echo "$0: unrecognised option for $1: '$2'">&2
 298 |             exit 2
 299 |         esac
 300 |         shift 2;;
 301 |       -x86|-xx86|-xx86_32|--arch=x86|--arch=86|--arch=x86_32)
 302 |         TARGET_ARCH=x86
 303 |         shift;;
 304 |       -x64|-xx64|-xx86_64|--arch=x64|--arch=64|--arch=x86_64)
 305 |         TARGET_ARCH=x64
 306 |         shift;;
 307 |       -x*)
 308 |         echo "$0: unrecognised option for -x: '${1#-x}'">&2
 309 |         exit 2;;
 310 |       --arch=*)
 311 |         echo "$0: unrecognised option for --arch: '${1#--arch}'">&2
 312 |         exit 2;;
 313 | 
 314 |       # -d, --debug ($DEBUG)
 315 |       -d*)
 316 |         DEBUG=${1#-d}
 317 |         if [[ -z $DEBUG ]] ; then
 318 |           DEBUG=1
 319 |         fi
 320 |         shift;;
 321 |       --debug=*)
 322 |         DEBUG=${1#*=}
 323 |         shift;;
 324 |       --debug)
 325 |         DEBUG=1
 326 |         shift;;
 327 | 
 328 |       # End of option marker
 329 |       --)
 330 |         shift
 331 |         break;;
 332 | 
 333 |       # Invalid options
 334 |       --*)
 335 |         echo "$0: unrecognised option: '${1%%=*}'">&2
 336 |         exit 2;;
 337 |       -*)
 338 |         echo "$0: unrecognised option: '${1:1:1}'">&2
 339 |         exit 2;;
 340 | 
 341 |       # MSVS_PREFERENCE (without end-of-option marker)
 342 |       *)
 343 |         break;;
 344 |     esac
 345 |   done
 346 | 
 347 |   if [[ -n ${1+x} ]] ; then
 348 |     if [[ $MODE -eq 1 || $MODE -eq 2 ]] ; then
 349 |       echo "$0: cannot specify MSVS_PREFERENCE and --all or --installed">&2
 350 |       exit 2
 351 |     else
 352 |       MSVS_PREFERENCE="$*"
 353 |     fi
 354 |   fi
 355 | fi
 356 | 
 357 | # Options sanitising
 358 | if [[ $MODE -eq 1 ]] ; then
 359 |   if [[ -n $TARGET_ARCH ]] ; then
 360 |     echo "$0: --all/--installed and --arch are mutually exclusive">&2
 361 |     exit 2
 362 |   fi
 363 |   MSVS_PREFERENCE=
 364 |   SCAN_ENV=1
 365 | elif [[ $OUTPUT -eq 2 && -z $TARGET_ARCH ]] ; then
 366 |   echo "$0: --output=data requires --arch">&2
 367 |   exit 2
 368 | elif [[ -z ${MSVS_PREFERENCE+x} ]] ; then
 369 |   MSVS_PREFERENCE='@;VS17.*;VS16.*;VS15.*;VS14.0;VS12.0;VS11.0;10.0;9.0;8.0;7.1;7.0'
 370 | fi
 371 | 
 372 | MSVS_PREFERENCE=${MSVS_PREFERENCE//;/ }
 373 | 
 374 | if [[ -z $TARGET_ARCH ]] ; then
 375 |   LEFT_ARCH=x86
 376 |   RIGHT_ARCH=x64
 377 | else
 378 |   LEFT_ARCH=$TARGET_ARCH
 379 |   RIGHT_ARCH=$TARGET_ARCH
 380 | fi
 381 | 
 382 | # Command line parsing complete (MSVS_PREFERENCE pending)
 383 | 
 384 | NAME="Microsoft C Compiler Environment Detection Script"
 385 | case $MODE in
 386 |   3)
 387 |     echo "$NAME"
 388 |     echo "Queries the environment and registry to locate Visual Studio / Windows SDK"
 389 |     echo "installations and uses their initialisation scripts (SetEnv.cmd, vcvarsall.bat,"
 390 |     echo "etc.) to determine INCLUDE, LIB and PATH alterations."
 391 |     echo
 392 |     echo "Usage:"
 393 |     echo "  $0 [OPTIONS] [--] [MSVS_PREFERENCE]"
 394 |     echo
 395 |     echo "Options:"
 396 |     echo "  -a, --all            Display all available compiler packages"
 397 |     echo "  -x, --arch=ARCH      Only consider packages for ARCH (x86 or x64). Default is"
 398 |     echo "                       to return packages containing both architectures"
 399 |     echo "  -d, --debug[=LEVEL]  Set debug messages level"
 400 |     echo "  -h, --help           Display this help screen"
 401 |     echo "  -i, --installed      Display all detected compiler packages; similarly to --all,"
 402 |     echo "                       except the list includes versions and may include packages"
 403 |     echo "                       which don't include the required compiler, tools, or libraries."
 404 |     echo "  -o, --output=OUTPUT  Set final output. Default is shell. Valid values:"
 405 |     echo "                         shell - shell assignments, for use with eval"
 406 |     echo "                         make  - make assignments, for inclusion in a Makefile"
 407 |     echo "                         data  - raw data, for parsing in other systems. The first"
 408 |     echo "                                 line is the full path to the batch file which was"
 409 |     echo "                                 analysed. The following lines are the individual"
 410 |     echo "                                 components of MSVS_PATH, MSVS_INC and MSVS_LIB, each"
 411 |     echo "                                 prefixed bin*, inc* or lib* respectively."
 412 |     echo "  -v, --version        Display the version"
 413 |     echo "      --with-mt        Only consider packages including the Manifest Tool"
 414 |     echo "      --with-assembler Only consider packages including an assembler"
 415 |     echo
 416 |     echo "If MSVS_PREFERENCE is not given, then the environment variable MSVS_PREFERENCE"
 417 |     echo "is read. MSVS_PREFERENCE is a semicolon separated list of preferred versions."
 418 |     echo "Three kinds of version notation are supported:"
 419 |     echo "  1. @ - which refers to the C compiler found in PATH (if it can be identified)"
 420 |     echo "     (this allows the C compiler corresponding to the opposite architecture to"
 421 |     echo "     be selected, if possible)."
 422 |     echo "  2. mm.n - which refers to a Visual Studio version (e.g. 14.0, 7.1) but which"
 423 |     echo "     also allows an SDK to provide the compiler (e.g. Windows SDK 7.1 provides"
 424 |     echo "     10.0). Visual Studio packages are always preferred ahead of SDKs."
 425 |     echo "  3. SPEC - an actual package specification. Visual Studio packages are VSmm.n"
 426 |     echo "     (e.g. VS14.0, VS7.1) and SDK packages are SDKm.n (e.g. SDK7.1)."
 427 |     echo "     Any Visual Studio 2017 update can be selected with VS15.*"
 428 |     echo "The default behaviour is to match the environment compiler followed by the most"
 429 |     echo "recent version of the compiler."
 430 |     exit 0;;
 431 |   4)
 432 |     echo "$NAME"
 433 |     echo "Version $VERSION"
 434 |     exit 0;;
 435 | esac
 436 | 
 437 | # Known compiler packages. Visual Studio .NET 2002 onwards. Detection is in place for Visual Studio
 438 | # 2005 Express, but because it doesn't include a Windows SDK, it can only ever be detected if the
 439 | # script has been launched from within a Platform SDK command prompt (this provides the Windows
 440 | # Headers and Libraries which allows this script to detect the rest).
 441 | # Each element is either a Visual Studio or SDK package and the value is the syntax for a bash
 442 | # associative array to be eval'd. Each of these contains the following properties:
 443 | #   NAME           - the friendly name of the package
 444 | #   ENV            - (VS only) the version-specific portion of the VSCOMNTOOLS environment variable
 445 | #   VERSION        - (VS only) version number of the package
 446 | #   ARCH           - Lists the architectures available in this version
 447 | #   ARCH_SWITCHES  - The script is assumed to accept x86 and x64 to indicate architecture. This key
 448 | #                    contains another eval'd associative array allowing alternate values to be given
 449 | #   SETENV_RELEASE - (SDK only) script switch necessary to select release than debugging versions
 450 | #   EXPRESS        - (VS only) the prefix to the registry key to detect the Express edition
 451 | #   EXPRESS_ARCH   - (VS only) overrides ARCH if Express edition is detected
 452 | #   EXPRESS_ARCH_SWITCHES - (VS only) overrides ARCH_SWITCHES if Express edition is detected
 453 | #   VC_VER         - (SDK only) specifies the version of the C Compilers included in the SDK (SDK
 454 | #                    equivalent of the VERSION key)
 455 | #   REG_KEY        - (SDK only) registry key to open to identify this package installation
 456 | #   REG_VALUE      - (SDK only) registry value to query to identify this package installation
 457 | #   VSWHERE        - (VS 2017+) is 1 if the compiler can only be detected using vswhere
 458 | # For a while, Windows SDKs followed a standard pattern which is stored in the SDK element and
 459 | # copied to the appropriate version. SDKs after 7.1 do not include compilers, and so are not
 460 | # captured (as of Visual Studio 2015, the Windows SDK is official part of Visual Studio).
 461 | declare -A COMPILERS
 462 | # shellcheck disable=SC2034 # SDK52_KEY is used in COMPILERS which is eval'd...
 463 | SDK52_KEY='HKLM\SOFTWARE\Microsoft\MicrosoftSDK\InstalledSDKs\8F9E5EF3-A9A5-491B-A889-C58EFFECE8B3'
 464 | # shellcheck disable=SC2016 # ... and is therefore intentionally in a quoted string
 465 | COMPILERS=(
 466 |   ["VS7.0"]='(
 467 |     ["NAME"]="Visual Studio .NET 2002"
 468 |     ["ENV"]=""
 469 |     ["VERSION"]="7.0"
 470 |     ["ARCH"]="x86")'
 471 |   ["VS7.1"]='(
 472 |     ["NAME"]="Visual Studio .NET 2003"
 473 |     ["ENV"]="71"
 474 |     ["VERSION"]="7.1"
 475 |     ["ARCH"]="x86")'
 476 |   ["VS8.0"]='(
 477 |     ["NAME"]="Visual Studio 2005"
 478 |     ["ENV"]="80"
 479 |     ["VERSION"]="8.0"
 480 |     ["EXPRESS"]="VC"
 481 |     ["ARCH"]="x86 x64"
 482 |     ["EXPRESS_ARCH"]="x86")'
 483 |   ["VS9.0"]='(
 484 |     ["NAME"]="Visual Studio 2008"
 485 |     ["ENV"]="90"
 486 |     ["VERSION"]="9.0"
 487 |     ["EXPRESS"]="VC"
 488 |     ["ARCH"]="x86 x64"
 489 |     ["EXPRESS_ARCH"]="x86")'
 490 |   ["VS10.0"]='(
 491 |     ["NAME"]="Visual Studio 2010"
 492 |     ["ENV"]="100"
 493 |     ["VERSION"]="10.0"
 494 |     ["EXPRESS"]="VC"
 495 |     ["ARCH"]="x86 x64"
 496 |     ["EXPRESS_ARCH"]="x86")'
 497 |   ["VS11.0"]='(
 498 |     ["NAME"]="Visual Studio 2012"
 499 |     ["ENV"]="110"
 500 |     ["VERSION"]="11.0"
 501 |     ["EXPRESS"]="WD"
 502 |     ["ARCH"]="x86 x64"
 503 |     ["EXPRESS_ARCH_SWITCHES"]="([\"x64\"]=\"x86_amd64\")")'
 504 |   ["VS12.0"]='(
 505 |     ["NAME"]="Visual Studio 2013"
 506 |     ["ENV"]="120"
 507 |     ["VERSION"]="12.0"
 508 |     ["EXPRESS"]="WD"
 509 |     ["ARCH"]="x86 x64"
 510 |     ["EXPRESS_ARCH_SWITCHES"]="([\"x64\"]=\"x86_amd64\")")'
 511 |   ["VS14.0"]='(
 512 |     ["NAME"]="Visual Studio 2015"
 513 |     ["ENV"]="140"
 514 |     ["VERSION"]="14.0"
 515 |     ["ARCH"]="x86 x64")'
 516 |   ["VS15.*"]='(
 517 |     ["NAME"]="Visual Studio 2017"
 518 |     ["VSWHERE"]="1")'
 519 |   ["VS16.*"]='(
 520 |     ["NAME"]="Visual Studio 2019"
 521 |     ["VSWHERE"]="1")'
 522 |   ["VS17.*"]='(
 523 |     ["NAME"]="Visual Studio 2022"
 524 |     ["VSWHERE"]="1")'
 525 |   ["SDK5.2"]='(
 526 |     ["NAME"]="Windows Server 2003 SP1 SDK"
 527 |     ["VC_VER"]="8.0"
 528 |     ["VERSION"]="5.2"
 529 |     ["REG_KEY"]="$SDK52_KEY"
 530 |     ["REG_VALUE"]="Install Dir"
 531 |     ["SETENV_RELEASE"]="/RETAIL"
 532 |     ["ARCH"]="x64"
 533 |     ["ARCH_SWITCHES"]="([\"x64\"]=\"/X64\")")'
 534 |   ["SDK"]='(
 535 |     ["NAME"]="Generalised Windows SDK"
 536 |     ["SETENV_RELEASE"]="/Release"
 537 |     ["ARCH"]="x86 x64"
 538 |     ["ARCH_SWITCHES"]="([\"x86\"]=\"/x86\" [\"x64\"]=\"/x64\")")'
 539 |   ["SDK6.1"]='(
 540 |     ["NAME"]="Windows Server 2008 with .NET 3.5 SDK"
 541 |     ["VC_VER"]="9.0")'
 542 |   ["SDK7.0"]='(
 543 |     ["NAME"]="Windows 7 with .NET 3.5 SP1 SDK"
 544 |     ["VC_VER"]="9.0")'
 545 |   ["SDK7.1"]='(
 546 |     ["NAME"]="Windows 7 with .NET 4 SDK"
 547 |     ["VC_VER"]="10.0")'
 548 | )
 549 | 
 550 | # FOUND is ultimately an associative array containing installed compiler packages. It's
 551 | # hijacked here as part of MSVS_PREFERENCE validation.
 552 | # Ultimately, it contains a copy of the value from COMPILERS with the following extra keys:
 553 | #   IS_EXPRESS - (VS only) indicates whether the Express edition was located
 554 | #   SETENV     - (SDK only) the full location of the SetEnv.cmd script
 555 | #   ASSEMBLER  - the name of the assembler (ml or ml64)
 556 | #   MSVS_PATH \
 557 | #   MSVS_INC   > prefix values for PATH, INCLUDE and LIB determined by running the scripts.
 558 | #   MSVS_LIB  /
 559 | declare -A FOUND
 560 | 
 561 | # Check that MSVS_PREFERENCE is valid and contains no repetitions.
 562 | for v in $MSVS_PREFERENCE ; do
 563 |   if [[ -n ${FOUND[$v]+x} ]] ; then
 564 |     echo "$0: corrupt MSVS_PREFERENCE: repeated '$v'">&2
 565 |     exit 2
 566 |   fi
 567 |   if [[ $v != "@" ]] ; then
 568 |     if [[ -z ${COMPILERS[$v]+x} && -z ${COMPILERS["VS$v"]+x} && -z ${COMPILERS[${v%.*}.*]+x} ]] ; then
 569 |       echo "$0: corrupt MSVS_PREFERENCE: unknown compiler '$v'">&2
 570 |       exit 2
 571 |     fi
 572 |   else
 573 |     SCAN_ENV=1
 574 |   fi
 575 |   FOUND["$v"]=""
 576 | done
 577 | 
 578 | # Reset FOUND for later use.
 579 | FOUND=()
 580 | 
 581 | if "$WHICH" cl >/dev/null 2>&1 ; then
 582 |   env_has_cl=1
 583 | else
 584 |   env_has_cl=0
 585 | fi
 586 | 
 587 | # Scan the environment for a C compiler, and check that it's valid. Throughout the rest of the
 588 | # script, it is assumed that if ENV_ARCH is set then there is a valid environment compiler.
 589 | if [[ $SCAN_ENV -eq 1 ]] ; then
 590 |   if [[ $env_has_cl -eq 1 ]]; then
 591 |     # Determine its architecture from the Microsoft Logo line.
 592 |     ENV_ARCH=$(cl 2>&1 | head -1 | tr -d '\r')
 593 |     case "${ENV_ARCH#* for }" in
 594 |       x64|AMD64)
 595 |         ENV_ARCH=x64;;
 596 |       80x86|x86)
 597 |         ENV_ARCH=x86;;
 598 |       *)
 599 |         echo "Unable to identify C compiler architecture from '${ENV_ARCH#* for }'">&2
 600 |         echo "Environment C compiler discarded">&2
 601 |         unset ENV_ARCH;;
 602 |     esac
 603 | 
 604 |     # Environment variable names are a bit of a nightmare on Windows - they are actually case
 605 |     # sensitive (at the kernel level) but not at the user level! To compound the misery is that SDKs
 606 |     # use Include and Lib where vcvars32 tends to use INCLUDE and LIB. Windows versions also contain
 607 |     # a mix of Path and PATH, but fortunately Cygwin normalises that to PATH for us! For this
 608 |     # reason, use env to determine the actual case of the LIB and INCLUDE variables.
 609 |     if [[ -n ${ENV_ARCH+x} ]] ; then
 610 |       RET=0
 611 |       ENV_INC=$(env | sed -ne 's/^\(INCLUDE\)=.*/\1/pi')
 612 |       ENV_LIB=$(env | sed -ne 's/^\(LIB\)=.*/\1/pi')
 613 |       if [[ -z $ENV_INC || -z $ENV_LIB ]] ; then
 614 |         warning "Microsoft C Compiler Include and/or Lib not set - Environment C compiler ($ENV_ARCH) excluded"
 615 |         unset ENV_ARCH
 616 |       else
 617 |         if check_environment "${PATH//:/*}" \
 618 |                              "${!ENV_INC//;/*}" \
 619 |                              "${!ENV_LIB//;/*}" \
 620 |                              "Environment C compiler" \
 621 |                              "$ENV_ARCH" ; then
 622 |           ENV_CL=$("$WHICH" cl)
 623 |           ENV_cl=${ENV_CL,,}
 624 |           ENV_cl=${ENV_cl/bin\/*_/bin\/}
 625 |           debug "Environment appears to include a compiler at $ENV_CL"
 626 |           # It doesn't matter whether the architecture matches - when the full probe happens in the
 627 |           # next loop, the corresponding architecture should then be selected (so, for example, if
 628 |           # the environment compiler is x86 VS2017, but VS2022 is installed, then by default the
 629 |           # compiler returned for x64 is VS2017's x64 compiler, not VS2022's).
 630 |           if [[ -n $TARGET_ARCH && $TARGET_ARCH != "$ENV_ARCH" ]] ; then
 631 |             debug "But architecture doesn't match required value"
 632 |           fi
 633 |         else
 634 |           unset ENV_ARCH
 635 |         fi
 636 |       fi
 637 |     fi
 638 |   fi
 639 | fi
 640 | 
 641 | # Even if launched from a 64-bit Command Prompt, Cygwin is usually 32-bit and so the scripts
 642 | # executed will inherit that fact. This is a problem when querying the registry, but fortunately
 643 | # WOW64 provides a mechanism to break out of the 32-bit environment by mapping $WINDIR/sysnative to
 644 | # the real 64-bit programs.
 645 | # Thus:
 646 | #   MS_ROOT is the 32-bit Microsoft Registry key (all Visual Studio keys are located there)
 647 | #   REG64 is the processor native version of the reg utility (allowing 64-bit keys to be read for
 648 | #         the SDKs)
 649 | if [[ -n ${PROCESSOR_ARCHITEW6432+x} ]] ; then
 650 |   debug "WOW64 detected"
 651 |   MS_ROOT='HKLM\SOFTWARE\Microsoft'
 652 |   REG64=$WINDIR/sysnative/reg
 653 | else
 654 |   MS_ROOT='HKLM\SOFTWARE\Wow6432Node\Microsoft'
 655 |   REG64=reg
 656 | fi
 657 | 
 658 | # COMPILER contains each eval'd element from COMPILERS
 659 | declare -A COMPILER
 660 | 
 661 | # Scan the registry for compiler package (vswhere is later)
 662 | for i in "${!COMPILERS[@]}" ; do
 663 |   eval "COMPILER=${COMPILERS["$i"]}"
 664 | 
 665 |   if [[ -n ${COMPILER["ENV"]+x} ]] ; then
 666 |     # Visual Studio package - test for its environment variable
 667 |     ENV=VS${COMPILER["ENV"]}COMNTOOLS
 668 |     if [[ -n ${!ENV+x} ]] ; then
 669 |       debug "$ENV is a candidate"
 670 |       TEST_PATH=${!ENV%\"}
 671 |       TEST_PATH=$(cygpath -u "${TEST_PATH#\"}")
 672 |       if [[ -e $TEST_PATH/vsvars32.bat ]] ; then
 673 |         debug "Directory pointed to by $ENV contains vsvars32.bat"
 674 |         EXPRESS=0
 675 |         # Check for the primary Visual Studio registry value indicating installation
 676 |         INSTALL_DIR=$(reg_string "$MS_ROOT\\VisualStudio\\${COMPILER["VERSION"]}" InstallDir)
 677 |         if [[ -z $INSTALL_DIR ]] ; then
 678 |           if [[ -n ${COMPILER["EXPRESS"]+x} ]] ; then
 679 |             TEST_KEY="$MS_ROOT\\${COMPILER["EXPRESS"]}Express\\${COMPILER["VERSION"]}"
 680 |             INSTALL_DIR=$(reg_string "$TEST_KEY" InstallDir)
 681 |             # Exception for Visual Studio 2005 Express, which doesn't set the registry correctly, so
 682 |             # set INSTALL_DIR to a fake value to pass the next test.
 683 |             if [[ ${COMPILER["VERSION"]} = "8.0" ]] ; then
 684 |               INSTALL_DIR=$(cygpath -w "$TEST_PATH")
 685 |               EXPRESS=1
 686 |             else
 687 |               if [[ -z $INSTALL_DIR ]] ; then
 688 |                 warning "vsvars32.bat found, but registry value not located (Exp or Pro)"
 689 |               else
 690 |                 EXPRESS=1
 691 |               fi
 692 |             fi
 693 |           else
 694 |             warning "vsvars32.bat found, but registry value not located"
 695 |           fi
 696 |         fi
 697 | 
 698 |         if [[ -n $INSTALL_DIR ]] ; then
 699 |           if [[ ${TEST_PATH%/} = $(cygpath -u "$INSTALL_DIR\\..\\Tools") ]] ; then
 700 |             RESULT=${COMPILERS[$i]%)}
 701 |             DISPLAY=${COMPILER["NAME"]}
 702 |             if [[ $EXPRESS -eq 1 ]] ; then
 703 |               DISPLAY="$DISPLAY Express"
 704 |             fi
 705 |             ENV=VS${COMPILER["ENV"]}COMNTOOLS
 706 |             ENV=${!ENV%\"}
 707 |             ENV=${ENV#\"}
 708 |             if [[ ${COMPILER["ENV"]}0 -ge 800 ]] ; then
 709 |               SCRIPT="$(cygpath -d "$ENV")\\..\\..\\VC\\vcvarsall.bat"
 710 |             else
 711 |               SCRIPT="$(cygpath -d "$ENV")\\vsvars32.bat"
 712 |             fi
 713 |             FOUND+=(["$i"]="$RESULT [\"DISPLAY\"]=\"$DISPLAY\" [\"IS_EXPRESS\"]=\"$EXPRESS\" [\"SETENV\"]=\"$SCRIPT\")")
 714 |             debug "${COMPILER["NAME"]} accepted for further detection"
 715 |           else
 716 |             warning "$ENV doesn't agree with registry"
 717 |           fi
 718 |         else
 719 |           warning "vsvars32.bat found, but registry settings not found"
 720 |         fi
 721 |       else
 722 |         warning "$ENV set, but vsvars32.bat not found"
 723 |       fi
 724 |     fi
 725 |   elif [[ -n ${COMPILER["REG_KEY"]+x} ]] ; then
 726 |     # SDK with explicit registry detection value
 727 |     INSTALL_DIR=$(reg64_string "${COMPILER["REG_KEY"]}" "${COMPILER["REG_VALUE"]}")
 728 |     if [[ -n $INSTALL_DIR ]] ; then
 729 |       TEST_PATH=$(cygpath -u "$INSTALL_DIR")
 730 |       if [[ -e $TEST_PATH/SetEnv.cmd ]] ; then
 731 |         RESULT=${COMPILERS[$i]%)}
 732 |         FOUND+=(["$i"]="$RESULT [\"DISPLAY\"]=\"${COMPILER["NAME"]}\" [\"SETENV\"]=\"$INSTALL_DIR\\SetEnv.cmd\")")
 733 |         debug "${COMPILER["NAME"]} accepted for further detection"
 734 |       else
 735 |         warning "Registry set for Windows Server 2003 SDK, but SetEnv.cmd not found"
 736 |       fi
 737 |     fi
 738 |   fi
 739 | done
 740 | 
 741 | # Now enumerate installed SDKs for v6.0+
 742 | SDK_ROOT='HKLM\SOFTWARE\Microsoft\Microsoft SDKs\Windows'
 743 | for i in $(reg query "$SDK_ROOT" 2>/dev/null | tr -d '\r' | sed -ne '/Windows\\v/s/.*\\//p') ; do
 744 |   debug "Analysing SDK key $SDK_ROOT\\$i"
 745 |   INSTALL_DIR=$(reg_string "$SDK_ROOT\\$i" InstallationFolder)
 746 |   VERSION=$(reg_string "$SDK_ROOT\\$i" ProductVersion)
 747 |   if [[ -n $INSTALL_DIR ]] ; then
 748 |     TEST_PATH=$(cygpath -u "$INSTALL_DIR")
 749 |     if [[ -e $TEST_PATH/Bin/SetEnv.cmd ]] ; then
 750 |       if [[ -z ${COMPILERS["SDK${i#v}"]+x} ]] ; then
 751 |         warning "SDK $i is not known to this script - assuming compatibility"
 752 |         DISPLAY="Windows SDK $i"
 753 |       else
 754 |         eval "COMPILER=${COMPILERS["SDK${i#v}"]}"
 755 |         DISPLAY=${COMPILER['NAME']}
 756 |       fi
 757 |       RESULT=${COMPILERS['SDK']%)}
 758 |       FOUND+=(["SDK${i/v/}"]="$RESULT [\"DISPLAY\"]=\"$DISPLAY\" [\"VERSION\"]=\"$VERSION\" [\"SETENV\"]=\"$INSTALL_DIR\\Bin\\SetEnv.cmd\")")
 759 |     else
 760 |       if [[ -n ${COMPILERS["SDK${i#v}"]+x} ]] ; then
 761 |         warning "Registry set for Windows SDK $i, but SetEnv.cmd not found"
 762 |       fi
 763 |     fi
 764 |   else
 765 |     warning "Registry key for Windows SDK $i doesn't contain expected InstallationFolder value"
 766 |   fi
 767 | done
 768 | 
 769 | # Now enumerate Visual Studio 2017+ instances
 770 | VSWHERE="$(dirname "$(realpath "$0")")/vswhere.exe"
 771 | if [[ ! -x $VSWHERE ]] ; then
 772 |   VSWHERE="$(printenv 'ProgramFiles(x86)')\\Microsoft Visual Studio\\Installer\\vswhere.exe"
 773 |   VSWHERE=$(cygpath "$VSWHERE")
 774 | fi
 775 | if [[ -x $VSWHERE ]] ; then
 776 |   debug "$VSWHERE found"
 777 |   while IFS= read -r line; do
 778 |     case ${line%: *} in
 779 |       instanceId)
 780 |         INSTANCE=${line#*: };;
 781 |       installationPath)
 782 |         INSTANCE_PATH=${line#*: };;
 783 |       installationVersion)
 784 |         INSTANCE_FULL_VER=${line#*: }
 785 |         INSTANCE_VER=${INSTANCE_FULL_VER%.*}
 786 |         INSTANCE_VER=${INSTANCE_VER%.*};;
 787 |       displayName)
 788 |         INSTANCE_NAME=${line#*: }
 789 |         debug "Looking at $INSTANCE in $INSTANCE_PATH ($INSTANCE_FULL_VER $INSTANCE_NAME)"
 790 |         if [[ -e "$(cygpath "$INSTANCE_PATH")/VC/Auxiliary/Build/vcvarsall.bat" ]] ; then
 791 |           debug "vcvarsall.bat found"
 792 |           if [[ $MODE -eq 2 ]]; then
 793 |             INSTANCE_VER="$INSTANCE_VER-$INSTANCE"
 794 |           fi
 795 |           FOUND+=(["VS$INSTANCE_VER"]="([\"DISPLAY\"]=\"$INSTANCE_NAME\" [\"VERSION\"]=\"$INSTANCE_FULL_VER\" [\"ARCH\"]=\"x86 x64\" [\"SETENV\"]=\"$INSTANCE_PATH\\VC\\Auxiliary\\Build\\vcvarsall.bat\" [\"SETENV_RELEASE\"]=\"\")")
 796 |         else
 797 |           warning "vcvarsall.bat not found for $INSTANCE"
 798 |         fi;;
 799 |     esac
 800 |   done < <("$VSWHERE" -all -prerelease -products '*' -nologo | tr -d '\r')
 801 | fi
 802 | 
 803 | if [[ $DEBUG -gt 1 || $MODE -eq 2 ]] ; then
 804 |   for i in "${!FOUND[@]}" ; do
 805 |     if [[ $MODE -eq 2 ]]; then
 806 |       eval "COMPILER=${FOUND["$i"]}"
 807 |       echo "  $i (${COMPILER["VERSION"]}; ${COMPILER["SETENV"]})"
 808 |     else
 809 |       echo "Inspect $i">&2
 810 |     fi
 811 |   done | sort
 812 | fi
 813 | 
 814 | if [[ $MODE -eq 2 ]] ; then
 815 |   exit 0
 816 | fi
 817 | 
 818 | # Basic scanning is complete, now interrogate the packages which seem to be installed and ensure
 819 | # that they pass the check_environment tests.
 820 | 
 821 | # CANDIDATES is a hash table of the keys of FOUND. The result of the next piece of processing is to
 822 | # derive two arrays PREFERENCE and TEST. TEST will contain a list of the keys of FOUND in the order
 823 | # in which they should be evaluated. PREFERENCE contains a parsed version of MSVS_PREFERENCE but
 824 | # filtered on the basis of the compiler packages already identified. The current "hoped for"
 825 | # preference is stored in $pref (the index into PREFERENCE) and $PREF (which is
 826 | # ${PREFERENCE[$pref]}). These two arrays together allow testing to complete quickly if the desired
 827 | # version is found (note that often this won't be possible as the @ environment option requires all
 828 | # packages to be tested in order to be sure that the environment compiler is not ambiguous).
 829 | declare -A CANDIDATES
 830 | for i in "${!FOUND[@]}" ; do
 831 |   CANDIDATES[$i]="";
 832 | done
 833 | 
 834 | # For --all/--installed, act as though MSVS_PREFERENCE were "@" because this causes all packages to
 835 | # be tested.
 836 | if [[ $MODE -gt 0 ]] ; then
 837 |   PREFER_ENV=1
 838 |   PREFERENCE=("@")
 839 | else
 840 |   PREFER_ENV=0
 841 |   PREFERENCE=()
 842 | fi
 843 | 
 844 | TEST=()
 845 | for i in $MSVS_PREFERENCE ; do
 846 |   if [[ $i = "@" ]] ; then
 847 |     if [[ -n ${ENV_ARCH+x} ]] ; then
 848 |       PREFERENCE+=("@")
 849 |       PREFER_ENV=1
 850 |     else
 851 |       debug "Preference @ ignored since no environment compiler selected"
 852 |     fi
 853 |   else
 854 |     if [[ -n ${COMPILERS[$i]+x} || -n ${COMPILERS[${i%.*}.*]+x} ]] ; then
 855 |       if [[ -n ${CANDIDATES[$i]+x} ]] ; then
 856 |         unset "CANDIDATES[$i]"
 857 |         TEST+=("$i")
 858 |         PREFERENCE+=("$i")
 859 |       elif [[ ${i#*.} = "*" ]] ; then
 860 |         INSTANCES=
 861 |         for j in "${!CANDIDATES[@]}" ; do
 862 |           if [[ "${j%.*}.*" = "$i" ]] ; then
 863 |             unset "CANDIDATES[$j]"
 864 |             INSTANCES="$INSTANCES $j"
 865 |           fi
 866 |         done
 867 |         INSTANCES="$(sort -r <<< "${INSTANCES// /$'\n'}")"
 868 |         eval "TEST+=($INSTANCES)"
 869 |         eval "PREFERENCE+=($INSTANCES)"
 870 |       fi
 871 |     else
 872 |       if [[ -n ${CANDIDATES["VS$i"]+x} ]] ; then
 873 |         unset "CANDIDATES[VS$i]"
 874 |         TEST+=("VS$i")
 875 |         PREFERENCE+=("VS$i")
 876 |       fi
 877 |       SDKS=
 878 |       for j in "${!COMPILERS[@]}" ; do
 879 |         eval "COMPILER=${COMPILERS["$j"]}"
 880 |         if [[ -n ${COMPILER["VC_VER"]+x} ]] ; then
 881 |           if [[ $i = "${COMPILER["VC_VER"]}" && -n ${CANDIDATES[$j]+x} ]] ; then
 882 |             unset "CANDIDATES[$j]"
 883 |             SDKS="$j $SDKS"
 884 |           fi
 885 |         fi
 886 |       done
 887 |       SDKS=${SDKS% }
 888 |       SDKS="$(sort -r <<< "${SDKS// /$'\n'}")"
 889 |       SDKS=${SDKS//$'\n'/ }
 890 |       eval "TEST+=($SDKS)"
 891 |       eval "PREFERENCE+=($SDKS)"
 892 |     fi
 893 |   fi
 894 | done
 895 | 
 896 | # If MSVS_PREFERENCE includes @, add any remaining items from CANDIDATES to TEST, otherwise remove
 897 | # them from FOUND so that they don't accidentally get reported on later.
 898 | for i in "${!CANDIDATES[@]}" ; do
 899 |   if [[ $PREFER_ENV -eq 1 ]] ; then
 900 |     TEST+=("$i")
 901 |   else
 902 |     unset "FOUND[$i]"
 903 |   fi
 904 | done
 905 | 
 906 | # Initialise pref and PREF to ${PREFERENCE[0]}
 907 | pref=0
 908 | PREF=${PREFERENCE[0]}
 909 | 
 910 | if [[ $DEBUG -gt 1 ]] ; then
 911 |   for i in "${!TEST[@]}" ; do
 912 |     echo "Test ${TEST[$i]}">&2
 913 |   done
 914 | fi
 915 | 
 916 | 
 917 | # Now run each compiler's environment script and then test whether it is suitable. During this loop,
 918 | # attempt to identify the environment C compiler (if one was found). The environment C compiler is
 919 | # strongly identified if the full location of cl matches the one in PATH and both LIB and INCLUDE
 920 | # contain the strings returned by the script in an otherwise empty environment (if one or both of
 921 | # the LIB and INCLUDE variables do not contain the string returned, then the compiler is weakly
 922 | # identified). If the environment compiler is strongly identified by more than one package, then it
 923 | # is not identified at all; if it is strongly identified by no packages but weakly identified by
 924 | # exactly 1, then we grudgingly accept that that's probably the one.
 925 | ENV_COMPILER=
 926 | WEAK_ENV=
 927 | 
 928 | # ARCHINFO contains the appropriate ARCH_SWITCHES associative array for each compiler.
 929 | declare -A ARCHINFO
 930 | 
 931 | for i in "${TEST[@]}" ; do
 932 |   CURRENT=${FOUND[$i]}
 933 |   eval "COMPILER=$CURRENT"
 934 |   # At the end of this process, the keys of FOUND will be augmented with the architecture found in
 935 |   # each case (so if "VS14.0" was in FOUND from the scan and both the x86 and x64 compilers are
 936 |   # valid, then at the end of this loop FOUND will contain "VS14.0-x86" and "VS14.0-x64").
 937 |   unset "FOUND[$i]"
 938 | 
 939 |   if [[ ${COMPILER["IS_EXPRESS"]}0 -gt 0 && -n ${COMPILER["EXPRESS_ARCH_SWITCHES"]+x} ]] ; then
 940 |     eval "ARCHINFO=${COMPILER['EXPRESS_ARCH_SWITCHES']}"
 941 |   elif [[ -n ${COMPILER["ARCH_SWITCHES"]+x} ]] ; then
 942 |     eval "ARCHINFO=${COMPILER['ARCH_SWITCHES']}"
 943 |   else
 944 |     ARCHINFO=()
 945 |   fi
 946 | 
 947 |   # Determine the script to be executed and any non-architecture specific switches needed.
 948 |   # $ENV will contain the value of the environment variable for the compiler (empty for an SDK)
 949 |   # which is required for the Visual Studio 7.x shim later.
 950 |   SCRIPT=${COMPILER["SETENV"]}
 951 |   if [[ -n ${COMPILER["ENV"]+x} ]] ; then
 952 |     SCRIPT_SWITCHES=''
 953 |   else
 954 |     ENV=
 955 |     if [[ -n ${COMPILER["SETENV_RELEASE"]} ]]; then
 956 |       SCRIPT_SWITCHES=" ${COMPILER["SETENV_RELEASE"]}"
 957 |     else
 958 |       SCRIPT_SWITCHES=''
 959 |     fi
 960 |   fi
 961 |   # For reasons of escaping, the script is executed using its basename so the directory needs
 962 |   # prepending to PATH.
 963 |   DIR=$(cygpath -u "$(dirname "$SCRIPT")")
 964 | 
 965 |   if [[ ${COMPILER["IS_EXPRESS"]} -gt 0 && -n ${COMPILER["EXPRESS_ARCH"]+x} ]] ; then
 966 |     ARCHS=${COMPILER["EXPRESS_ARCH"]}
 967 |   else
 968 |     ARCHS=${COMPILER["ARCH"]}
 969 |   fi
 970 | 
 971 |   for arch in $ARCHS ; do
 972 |     # Determine the command line switch for this architecture
 973 |     if [[ -n ${ARCHINFO[$arch]+x} ]] ; then
 974 |       ARCH_SWITCHES=${ARCHINFO[$arch]}
 975 |     else
 976 |       ARCH_SWITCHES=$arch
 977 |     fi
 978 | 
 979 |     # Run the script in order to determine changes made to PATH, INCLUDE and LIB. These scripts
 980 |     # always prepend changes to the environment variables.
 981 |     MSVS_PATH=
 982 |     MSVS_LIB=
 983 |     MSVS_INC=
 984 | 
 985 |     COMMAND='%EXEC_SCRIPT% && echo XMARKER && echo !PATH! && echo !LIB! && echo !INCLUDE! && echo !VCToolsVersion! && echo !VSCMD_VER! && echo !VisualStudioVersion!'
 986 | 
 987 |     if [[ $env_has_cl -eq 1 ]]; then
 988 |       if [[ -n $__VSCMD_PREINIT_PATH ]]; then
 989 |         TEST_PATH=$(cygpath -p "$__VSCMD_PREINIT_PATH")
 990 |       elif [[ -n $ORIGINALPATH ]]; then
 991 |         TEST_PATH="$ORIGINALPATH"
 992 |       else
 993 |         TEST_PATH="$PATH"
 994 |       fi
 995 |     else
 996 |       TEST_PATH="$PATH"
 997 |     fi
 998 | 
 999 |     # Note that EXEC_SCRIPT must have ARCH_SWITCHES first for older Platform SDKs (newer ones parse
1000 |     # arguments properly)
1001 |     if [[ $DEBUG -gt 3 ]] ; then
1002 |       printf "Scanning %s... " "$(basename "$SCRIPT") $ARCH_SWITCHES$SCRIPT_SWITCHES">&2
1003 |     fi
1004 |     # Setting MSYS2_ARG_CONV_EXCL to * inhibits attempts to convert the flags to COMSPEC as
1005 |     # command line parameters.
1006 |     num=0
1007 |     INCLUDE_KEY="$(env | grep -i '^include=')"
1008 |     LIB_KEY="$(env | grep -i '^lib=')"
1009 |     INCLUDE_KEY="${INCLUDE_KEY%=*}"
1010 |     LIB_KEY="${LIB_KEY%=*}"
1011 |     unset_keys=(-u ORIGINAL_PATH -u ORIGINALPATH -u TARGET_CPU -u TARGET_PLATFORM -u DevEnvDir \
1012 |                 -u VSINSTALLDIR -u VCToolsVersion -u Framework35Version \
1013 |                 -u __VSCMD_PREINIT_VCToolsVersion)
1014 |     if [[ -n $INCLUDE_KEY ]]; then
1015 |       unset_keys+=(-u "$INCLUDE_KEY")
1016 |     fi
1017 |     if [[ -n $LIB_KEY ]]; then
1018 |       unset_keys+=(-u "$LIB_KEY")
1019 |     fi
1020 |     while IFS= read -r line; do
1021 |       case $num in
1022 |         0)
1023 |           MSVS_PATH=${line%% };;
1024 |         1)
1025 |           MSVS_LIB=${line%% };;
1026 |         2)
1027 |           MSVS_INC=${line%% };;
1028 |         3)
1029 |           VC_VERSION=${line%% };;
1030 |         4)
1031 |           VSCMD_VER=${line%% };;
1032 |         5)
1033 |           if [[ $VC_VERSION = '!VCToolsVersion!' ]] ; then
1034 |             VC_VERSION=${line%% }
1035 |           fi;;
1036 |       esac
1037 |       ((num++))
1038 |     done < <(env "${unset_keys[@]}" PATH="?msvs-detect?:$DIR:/usr/bin:$TEST_PATH" \
1039 |                  EXEC_SCRIPT="$(basename "$SCRIPT") $ARCH_SWITCHES$SCRIPT_SWITCHES" \
1040 |                  MSYS2_ARG_CONV_EXCL='*' \
1041 |              "$(cygpath "$COMSPEC")" /d /v:on /c "$COMMAND" 2>/dev/null | grep -F XMARKER -A 6 | tr -d '\015' | tail -6)
1042 |     if [[ $VC_VERSION = '!VisualStudioVersion!' ]] ; then
1043 |       VC_VERSION="${COMPILER["VERSION"]}"
1044 |     fi
1045 |     if [[ $VSCMD_VER = '!VSCMD_VER!' ]]; then
1046 |       VSCMD_VER=''
1047 |     fi
1048 |     if [[ $DEBUG -gt 3 ]] ; then
1049 |       echo 'done'>&2
1050 |     fi
1051 | 
1052 |     if [[ -n $MSVS_PATH ]] ; then
1053 |       MSVS_PATH_WIN32="${MSVS_PATH/?msvs-detect?*/}"
1054 |       # Translate MSVS_PATH back to Cygwin notation (/cygdrive, etc. and colon-separated)
1055 |       MSVS_PATH=$(cygpath "$MSVS_PATH" -p)
1056 |       # Remove any trailing / from elements of MSVS_PATH
1057 |       MSVS_PATH=$(echo "$MSVS_PATH" | sed -e 's|\([^:]\)/\+\(:\|$\)|\1\2|g;s/?msvs-detect?.*//')
1058 |       # Guarantee that MSVS_PATH ends with a single :
1059 |       MSVS_PATH="${MSVS_PATH%%:}:"
1060 |     fi
1061 |     # Ensure that both variables end with a semi-colon (it doesn't matter if for some erroneous
1062 |     # reason they have come back blank, because check_environment will shortly fail)
1063 |     MSVS_LIB="${MSVS_LIB%%;};"
1064 |     MSVS_INC="${MSVS_INC%%;};"
1065 | 
1066 |     # Visual Studio .NET 2002 and 2003 do not include mt in PATH, for not entirely clear reasons.
1067 |     # This shim detects that scenario and adds the winnt folder to MSVS_PATH.
1068 |     RET=0
1069 |     if [[ ${i/.*/} = "VS7" ]] ; then
1070 |       find_in "${MSVS_PATH//:/*}" mt.exe
1071 |       if [[ $RET -eq 1 ]] ; then
1072 |         MSVS_PATH="$MSVS_PATH$(cygpath -u "$ENV\\Bin\\winnt"):"
1073 |         RET=0
1074 |       fi
1075 |     fi
1076 | 
1077 |     # Ensure that these derived values give a valid compiler.
1078 |     if check_environment "${MSVS_PATH//:/*}" "${MSVS_INC//;/*}" "${MSVS_LIB//;/*}" "$i" "$arch" ; then
1079 |       # Put the package back into FOUND, but augmented with the architecture name and with the
1080 |       # derived values.
1081 |       FOUND["$i-$arch"]="${CURRENT%)} [\"MSVS_PATH\"]=\"$MSVS_PATH\" \
1082 |                                       [\"MSVS_PATH_WIN32\"]=\"$MSVS_PATH_WIN32\" \
1083 |                                       [\"MSVS_INC\"]=\"$MSVS_INC\" \
1084 |                                       [\"MSVS_LIB\"]=\"$MSVS_LIB\" \
1085 |                                       [\"SETENV_SWITCHES\"]=\"$ARCH_SWITCHES$SCRIPT_SWITCHES\" \
1086 |                                       [\"VC_VERSION\"]=\"$VC_VERSION\" \
1087 |                                       [\"VSCMD_VER\"]=\"$VSCMD_VER\" \
1088 |                                       [\"ASSEMBLER\"]=\"$ASSEMBLER\")" #"# fixes vim syn match error
1089 | 
1090 |       # Check to see if this is a match for the environment C compiler.
1091 |       if [[ -n ${ENV_ARCH+x} ]] ; then
1092 |         TEST_cl=$(PATH="$MSVS_PATH:$PATH" "$WHICH" cl)
1093 |         TEST_cl=${TEST_cl,,}
1094 |         TEST_cl=${TEST_cl/bin\/*_/bin\/}
1095 |         if [[ $TEST_cl = "$ENV_cl" ]] ; then
1096 |           # Create trailing semi-colon versions of the expansions of ENV_ for comparison with MSVS_
1097 |           ENV_EXPAND_INC="${!ENV_INC%%;};"
1098 |           ENV_EXPAND_LIB="${!ENV_LIB%%;};"
1099 | 
1100 |           if [[ ${ENV_EXPAND_INC/"$MSVS_INC"/} != "${ENV_EXPAND_INC}" && \
1101 |                 ${ENV_EXPAND_LIB/"$MSVS_LIB"/} != "${ENV_EXPAND_LIB}" ]] ; then
1102 |             debug "$i-$arch is a strong candidate for the Environment C compiler"
1103 |             if [[ -n ${ENV_COMPILER+x} ]] ; then
1104 |               if [[ -z ${ENV_COMPILER} ]] ; then
1105 |                 ENV_COMPILER=$i-$arch
1106 |                 unset WEAK_ENV
1107 |               else
1108 |                 # More than one strong candidate - no fall back available
1109 |                 unset ENV_COMPILER
1110 |                 unset WEAK_ENV
1111 |               fi
1112 |             fi
1113 |           else
1114 |             debug "$i-$arch is a weak candidate for the Environment C compiler"
1115 |             if [[ -n ${WEAK_ENV+x} ]] ; then
1116 |               if [[ -z ${WEAK_ENV} ]] ; then
1117 |                 WEAK_ENV=$i-$arch
1118 |               else
1119 |                 # More than one weak candidate - no fall back available
1120 |                 unset WEAK_ENV
1121 |               fi
1122 |             fi
1123 |           fi
1124 |         fi
1125 |       fi
1126 |     fi
1127 |   done
1128 | 
1129 |   # Does this package match the current preference? Note that PREFERENCE and TEST are constructed in
1130 |   # a cunning (and hopefully not too "You are not expected to understand this" way) such that $PREF
1131 |   # will always equal $i, unless $PREF = "@".
1132 |   if [[ $PREF = "$i" ]] ; then
1133 |     # In which case, check that the architecture(s)s were found
1134 |     if [[ -n ${FOUND["$i-$LEFT_ARCH"]+x} && -n ${FOUND["$i-$RIGHT_ARCH"]+x} ]] ; then
1135 |       debug "Solved TARGET_ARCH=$TARGET_ARCH with $i"
1136 |       SOLUTION=$i
1137 |       break
1138 |     fi
1139 |   fi
1140 | 
1141 |   if [[ $PREF != "@" ]] ; then
1142 |     ((pref++))
1143 |     PREF=${PREFERENCE[$pref]}
1144 |   fi
1145 | done
1146 | 
1147 | # If we got this far, then either we failed to find a compiler at all, or we were looking for the
1148 | # environment compiler (or --all was specified).
1149 | 
1150 | # Adopt a weak match for the environment compiler, if that's the best we can do.
1151 | if [[ -n ${ENV_COMPILER+x} && -z ${ENV_COMPILER} && -n ${WEAK_ENV} ]] ; then
1152 |   warning "Assuming Environment C compiler is $WEAK_ENV"
1153 |   ENV_COMPILER=$WEAK_ENV
1154 | fi
1155 | 
1156 | declare -A FLIP
1157 | FLIP=(["x86"]="x64" ["x64"]="x86")
1158 | 
1159 | if [[ $MODE -eq 0 ]] ; then
1160 |   if [[ $PREF = "@" && -n ${ENV_COMPILER} ]] ; then
1161 |     SOLUTION=${ENV_COMPILER%-"$ENV_ARCH"}
1162 |     # If --arch wasn't specified, then ensure that the other architecture was also found. If --arch
1163 |     # was specified, then validate that the compiler was valid. This should always happen, unless
1164 |     # something went wrong running the script to get MSVS_PATH, MSVS_LIB and MSVS_INC.
1165 |     if [[ -n ${FOUND["$SOLUTION-${FLIP[$ENV_ARCH]}"]+x} ||
1166 |           -n ${FOUND["$SOLUTION-$TARGET_ARCH"]+x} ]] ; then
1167 |       debug "Solved with $SOLUTION"
1168 |     else
1169 |       unset SOLUTION
1170 |       unset ENV_ARCH
1171 |     fi
1172 |   fi
1173 | 
1174 |   if [[ -z ${SOLUTION+x} ]] ; then
1175 |     ((pref++))
1176 |     debug "Search remaining: ${PREFERENCE[*]}"
1177 |     for i in "${PREFERENCE[@]:$pref}" ; do
1178 |       if [[ -n ${FOUND["$i-$LEFT_ARCH"]+x} && -n ${FOUND["$i-$RIGHT_ARCH"]+x} ]] ; then
1179 |         debug "Solved TARGET_ARCH='$TARGET_ARCH' with $i"
1180 |         SOLUTION=$i
1181 |         break
1182 |       fi
1183 |     done
1184 |   fi
1185 | fi
1186 | 
1187 | debug "Solution: $SOLUTION"
1188 | 
1189 | if [[ -n ${ENV_COMPILER} && $MODE -eq 1 ]] ; then
1190 |   echo "Identified Environment C compiler as $ENV_COMPILER"
1191 | fi
1192 | 
1193 | if [[ $MODE -eq 1 ]] ; then
1194 |   echo "Installed and usable packages:"
1195 |   for key in "${!FOUND[@]}" ; do
1196 |     eval "COMPILER=${FOUND["$key"]}"
1197 |     switches="${COMPILER["SETENV_SWITCHES"]}"
1198 |     if [[ $switches != "${switches% *}" ]]; then
1199 |       switches="\"$switches\""
1200 |     fi
1201 |     echo "- ${key/-/ } \"${COMPILER["SETENV"]}\" $switches"
1202 |   done | sort
1203 |   exit 0
1204 | fi
1205 | 
1206 | if [[ -n $SOLUTION ]] ; then
1207 |   eval "COMPILER=${FOUND["$SOLUTION-$LEFT_ARCH"]}"
1208 |   if [[ $OUTPUT -ne 2 ]] ; then
1209 |     output MSVS_NAME "${COMPILER["DISPLAY"]}" "always"
1210 |     output MSVS_PATH "${COMPILER["MSVS_PATH"]}" $LEFT_ARCH
1211 |   else
1212 |     echo "${COMPILER["DISPLAY"]} (${COMPILER["VERSION"]})"
1213 |     cmd="${COMPILER["SETENV"]}"
1214 |     if [[ $cmd != "${cmd% *}" ]]; then
1215 |       cmd="\"$cmd\""
1216 |     fi
1217 |     echo "cmd*$cmd ${COMPILER["SETENV_SWITCHES"]}"
1218 |     output MSVS_PATH "${COMPILER["MSVS_PATH_WIN32"]}" $LEFT_ARCH
1219 |   fi
1220 |   output MSVS_INC "${COMPILER["MSVS_INC"]}" $LEFT_ARCH
1221 |   output MSVS_LIB "${COMPILER["MSVS_LIB"]}" $LEFT_ARCH
1222 |   if [[ $ML_REQUIRED -eq 1 ]] ; then
1223 |     output MSVS_ML "${COMPILER["ASSEMBLER"]%.exe}" always
1224 |   fi
1225 |   if [[ -z $TARGET_ARCH ]] ; then
1226 |     eval "COMPILER=${FOUND["$SOLUTION-$RIGHT_ARCH"]}"
1227 |     output MSVS64_PATH "${COMPILER["MSVS_PATH"]}" $RIGHT_ARCH
1228 |     output MSVS64_INC "${COMPILER["MSVS_INC"]}" $RIGHT_ARCH
1229 |     output MSVS64_LIB "${COMPILER["MSVS_LIB"]}" $RIGHT_ARCH
1230 |     if [[ $ML_REQUIRED -eq 1 ]] ; then
1231 |       output MSVS64_ML "${COMPILER["ASSEMBLER"]%.exe}" always
1232 |     fi
1233 |   fi
1234 |   exit 0
1235 | else
1236 |   exit 1
1237 | fi
1238 | 


--------------------------------------------------------------------------------
/test/Makefile:
--------------------------------------------------------------------------------
 1 | #CC = cl /MD
 2 | #O = obj
 3 | #CHAIN = msvc
 4 | 
 5 | #CC = gcc
 6 | #O = o
 7 | #CHAIN=cygwin
 8 | 
 9 | #CC = gcc -mno-cygwin
10 | #O = o
11 | #CHAIN = mingw
12 | 
13 | RUN=
14 | FLEXLINK = $(RUN) ../flexlink.exe -chain $(CHAIN) -merge-manifest $(EXTRA_OPTS)
15 | 
16 | .PHONY: demo
17 | demo: dump.exe plug1.dll plug2.dll
18 | 	$(RUN) ./dump.exe plug1.dll plug2.dll
19 | 
20 | dump.exe: dump.$(O)
21 | 	$(FLEXLINK) -exe -o dump.exe dump.$(O)
22 | 
23 | dump.$(O): dump.c
24 | 	$(CC) $(CPPFLAGS) $(CFLAGS) -I.. -c dump.c
25 | 
26 | plug1.$(O): plug1.c
27 | 	$(CC) $(CPPFLAGS) $(CFLAGS) $(PLUG1_CFLAGS) -c plug1.c
28 | 
29 | plug2.$(O): plug2.c
30 | 	$(CC) $(CPPFLAGS) $(CFLAGS) $(PLUG2_CFLAGS) -c plug2.c
31 | 
32 | plug1.dll: plug1.$(O)
33 | 	$(FLEXLINK) -o plug1.dll plug1.$(O)
34 | 
35 | plug2.dll: plug2.$(O)
36 | 	$(FLEXLINK) -o plug2.dll plug2.$(O)
37 | 
38 | plug12.dll: plug1.$(O) plug2.$(O)
39 | 	$(FLEXLINK) -o plug12.dll plug1.$(O) plug2.$(O)
40 | 
41 | 
42 | clean:
43 | 	rm -f *.o *.obj *.dll *.exe *~ *.manifest
44 | 


--------------------------------------------------------------------------------
/test/api.h:
--------------------------------------------------------------------------------
1 | __declspec(dllimport) void api1(char *msg);
2 | __declspec(dllimport) void api2(char *msg);
3 | 


--------------------------------------------------------------------------------
/test/dump.c:
--------------------------------------------------------------------------------
 1 | /*****************************************************************
 2 |    FlexDLL
 3 |    Alain Frisch
 4 | 
 5 |    Copyright 2007 Institut National de Recherche en Informatique et
 6 |    en Automatique.
 7 | 
 8 | ******************************************************************/
 9 | 
10 | /* An example (main program) */
11 | 
12 | #include <stdlib.h>
13 | #include <stdio.h>
14 | #include "flexdll.h"
15 | 
16 | typedef void torun(void);
17 | 
18 | void api1(char *msg){ printf("API1: %s\n", msg); }
19 | void api2(char *msg){ printf("API2: %s\n", msg); }
20 | 
21 | int main(int argc, char **argv)
22 | {
23 |   void *handle;
24 |   int i;
25 |   torun *torun;
26 | 
27 |   printf("INIT\n"); fflush(stdout);
28 |   flexdll_dump_exports(NULL);
29 |   printf("OK\n"); fflush(stdout);
30 |   for (i = 1; i < argc; i++) {
31 |     printf("** Loading %s\n", argv[i]);
32 |     handle = flexdll_dlopen(argv[i], FLEXDLL_RTLD_GLOBAL);
33 |     if (NULL == handle) { printf("error: %s\n", flexdll_dlerror()); exit(2); }
34 |     printf("** handle = %p\n", handle);
35 |     flexdll_dump_exports(handle);
36 |     flexdll_dump_relocations(handle);
37 | 
38 |     if (NULL == handle) { printf("error: %s\n", flexdll_dlerror()); exit(2); }
39 | 
40 |     torun = flexdll_dlsym(handle, "torun");
41 |     printf("Now running %p...\n", torun); fflush(stdout);
42 |     if (torun) torun();
43 |   }
44 |   exit(0);
45 | }
46 | 


--------------------------------------------------------------------------------
/test/plug1.c:
--------------------------------------------------------------------------------
1 | #include <stdio.h>
2 | 
3 | #include "api.h"
4 | 
5 | int x = 10;
6 | void dump_x(void) { printf("AAA\nx=%i\n", x); }
7 | void torun(void) { api1("plug1.torun();"); api2("plug1.torun();"); }
8 | 


--------------------------------------------------------------------------------
/test/plug2.c:
--------------------------------------------------------------------------------
 1 | #include "api.h"
 2 | 
 3 | extern int x;
 4 | 
 5 | void torun(void) {
 6 |   api1("plug2.torun();");
 7 |   api2("plug2.torun();");
 8 |   /*
 9 |   dump_x();
10 |   // printf("XXX\n");
11 |   printf("x = %d\n", x);
12 |   x = 100;
13 |   printf("x = %d\n", x);
14 |   dump_x();
15 |   //  printf("XXX\n");
16 |   */
17 | }
18 | 


--------------------------------------------------------------------------------
/version.rc:
--------------------------------------------------------------------------------
 1 | //#include "afxres.h"
 2 | #include <windows.h>
 3 | 
 4 | LANGUAGE LANG_ENGLISH, SUBLANG_ENGLISH_US
 5 | #pragma code_page(1252)
 6 | /////////////////////////////////////////////////////////////////////////////
 7 | //
 8 | // Version
 9 | //
10 | 
11 | VS_VERSION_INFO VERSIONINFO
12 |  FILEVERSION FLEXDLL_VS_VERSION_INFO
13 |  PRODUCTVERSION FLEXDLL_VS_VERSION_INFO
14 |  FILEFLAGSMASK 0x3fL
15 |  FILEFLAGS 0x0L
16 |  FILEOS 0x40004L
17 |  FILETYPE 0x1L
18 |  FILESUBTYPE 0x0L
19 | BEGIN
20 |     BLOCK "StringFileInfo"
21 |     BEGIN
22 |         BLOCK "040904b0"
23 |         BEGIN
24 |             VALUE "FileVersion", FLEXDLL_FULL_VERSION
25 |             VALUE "ProductVersion", FLEXDLL_FULL_VERSION
26 |             VALUE "ProductName", "FlexDLL"
27 |             VALUE "FileDescription", "FlexDLL Linker"
28 |             VALUE "LegalCopyright", "Institut National de Recherche en Informatique et en Automatique"
29 |         END
30 |     END
31 |     BLOCK "VarFileInfo"
32 |     BEGIN
33 |         VALUE "Translation", 0x409, 1200
34 |     END
35 | END
36 | 


--------------------------------------------------------------------------------